{-# LANGUAGE OverloadedStrings #-}

module StackYaml
  ( findStackYamlFiles
  , parseStackYaml
  , applyAction
  , isStackYaml
  , getSymlinkMap
  ) where

import Control.Monad (filterM, when)
import Data.List (isPrefixOf, isSuffixOf, sort)
import Data.Map.Strict qualified as Map
import Data.Maybe (catMaybes)
import Data.Text (Text)
import Data.Text qualified as T
import Data.Text.IO qualified as TIO
import System.Directory (listDirectory, doesFileExist, pathIsSymbolicLink, getSymbolicLinkTarget)
import System.FilePath (takeFileName, normalise, makeRelative)
import Types (Action(..))

-- | Check if a filename is a stack*.yaml file
isStackYaml :: FilePath -> Bool
isStackYaml name =
  let fname = takeFileName name
  in "stack" `isPrefixOf` fname && ".yaml" `isSuffixOf` fname

-- | Find all stack*.yaml files in the current directory
findStackYamlFiles :: IO [FilePath]
findStackYamlFiles = do
  files <- listDirectory "."
  let candidates = filter isStackYaml files
  sort <$> filterM doesFileExist candidates

-- | Get a map of symlinks to their targets (only for symlinks pointing to other stack*.yaml files in the list)
getSymlinkMap :: [FilePath] -> IO (Map.Map FilePath FilePath)
getSymlinkMap files = do
  -- Find symlinks in the list
  symlinks <- filterM pathIsSymbolicLink files

  -- For each symlink, check if it points to another file in the list
  results <- mapM checkSymlink symlinks

  return $ Map.fromList $ catMaybes results
  where
    checkSymlink :: FilePath -> IO (Maybe (FilePath, FilePath))
    checkSymlink link = do
      target <- getSymbolicLinkTarget link
      -- Normalize the target path to handle relative paths
      let normalizedTarget = normalise target
      let relativeTarget = makeRelative "." normalizedTarget
      -- Check if the target is in our file list
      if relativeTarget `elem` files
        then return $ Just (link, relativeTarget)
        else return Nothing

-- | Parse a stack.yaml file to extract the snapshot field
parseStackYaml :: FilePath -> IO (Maybe (Text, Bool, (Int, Int)))
parseStackYaml file = do
  content <- TIO.readFile file
  return $ findSnapshot (T.unpack content) 0
  where
    findSnapshot s pos =
      case findField "snapshot:" s pos of
        Just (value, start, end) -> Just (T.pack value, False, (start, end))
        Nothing ->
          case findField "resolver:" s pos of
            Just (value, start, end) -> Just (T.pack value, True, (start, end))
            Nothing -> Nothing

    findField :: String -> String -> Int -> Maybe (String, Int, Int)
    findField field s pos =
      findFieldHelper field s pos s

    findFieldHelper :: String -> String -> Int -> String -> Maybe (String, Int, Int)
    findFieldHelper _field _orig _pos [] = Nothing
    findFieldHelper field orig pos s@(_:cs)
      | field `isPrefixOf` s =
          let afterField = drop (length field) s
              trimmed = dropWhile (\c -> c `elem` (" \t" :: String)) afterField
              value = takeWhile (`notElem` ("\n\r" :: String)) trimmed
              valueStart = pos + (length orig - length s) + length field + (length afterField - length trimmed)
              valueEnd = valueStart + length value
          in if null value
               then Nothing
               else Just (value, valueStart, valueEnd)
      | otherwise = findFieldHelper field orig pos cs

-- | Apply an action to update a stack.yaml file
applyAction :: Bool -> Action -> IO ()
applyAction verbose action = do
  -- Skip symlinks that point to other stack*.yaml files in the list
  case actionSymlinkTarget action of
    Just _ -> return ()  -- Skip symlinks
    Nothing ->
      case actionNewSnapshot action of
        Nothing -> return ()  -- No update needed
        Just newSnap -> do
          when verbose $ putStrLn $ "Updating " ++ actionFile action
          content <- TIO.readFile (actionFile action)
          let (before, after) = splitAtSpan (actionSpan action) content
          let updated = before <> newSnap <> after
          TIO.writeFile (actionFile action) updated

-- | Split text at a character span
splitAtSpan :: (Int, Int) -> Text -> (Text, Text)
splitAtSpan (start, end) text =
  let before = T.take start text
      after = T.drop end text
  in (before, after)