content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE LambdaCase #-}
  {-# LANGUAGE OverloadedRecordDot #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE TypeOperators #-}
  
  module GLuaFixer.Effects.Files where
  
  import Control.DeepSeq (deepseq, force)
  import Control.Monad.IO.Class (liftIO)
  import Data.List (foldl', stripPrefix)
  import Data.Maybe (fromMaybe, listToMaybe, mapMaybe)
  import Effectful (Dispatch (Dynamic), DispatchOf, Eff, Effect, IOE, (:>))
  import Effectful.Dispatch.Dynamic (interpose, interpret, send)
  import Effectful.Dispatch.Static (HasCallStack)
  import GLuaFixer.Effects.Logging (Logging, putStrLnStdError)
  import qualified System.Directory as Dir
  import System.FilePath (takeDirectory, (</>))
  import System.FilePath.Find (FindClause, always, fileName, filePath, find, (&&?), (/~?), (~~?))
  import System.FilePath.GlobPattern (GlobPattern)
  import System.IO (IOMode (..), hGetContents, hPutStrLn, hSetEncoding, utf8_bom, withFile)
  import Prelude hiding (readFile, writeFile)
  
  newtype Directory = Directory {dir :: FilePath}
  newtype FileNames = FileNames {names :: [String]}
  newtype IgnoreFiles = IgnoreFiles {ignore :: [GlobPattern]}
  
  -- | Interacting with the file system
  data Files :: Effect where
    -- | Get current working directory alias
    GetCurrentDirectory :: Files m FilePath
    -- | Read stdin
    ReadStdIn :: Files m String
    -- | Read a file
    ReadFile :: FilePath -> Files m String
    -- | Write to a file
    WriteFile :: FilePath -> String -> Files m ()
    -- | Returns whether a file exists
    FileExists :: FilePath -> Files m Bool
    -- | Returns whether a file exists and is a directory
    IsDirectory :: FilePath -> Files m Bool
    -- | Will search upwards in directories for a file, returning it if it exists
    SearchUpwardsForFile :: Directory -> FileNames -> Files m (Maybe FilePath)
    -- | Returns the file path of the first path that exists
    FirstExists :: [FilePath] -> Files m (Maybe FilePath)
    -- | Search for Lua files
    FindLuaFiles :: IgnoreFiles -> FilePath -> Files m [FilePath]
    -- | Get Home directory
    GetHomeDirectory :: Files m FilePath
    -- | Make a path absolute
    MakeAbsolute :: FilePath -> Files m FilePath
  
  type instance DispatchOf Files = Dynamic
  
  makeAbsolute :: Files :> es => FilePath -> Eff es FilePath
  makeAbsolute filepath = send $ MakeAbsolute filepath
  
  getHomeDirectory :: Files :> es => Eff es FilePath
  getHomeDirectory = send GetHomeDirectory
  
  findLuaFiles :: Files :> es => IgnoreFiles -> FilePath -> Eff es [FilePath]
  findLuaFiles ignoreFiles filepath =
    send $ FindLuaFiles ignoreFiles filepath
  
  firstExists :: Files :> es => [FilePath] -> Eff es (Maybe FilePath)
  firstExists files = send $ FirstExists files
  
  searchUpwardsForFile :: Files :> es => Directory -> FileNames -> Eff es (Maybe FilePath)
  searchUpwardsForFile directory files = send $ SearchUpwardsForFile directory files
  
  isDirectory :: Files :> es => FilePath -> Eff es Bool
  isDirectory filepath = send $ IsDirectory filepath
  
  fileExists :: Files :> es => FilePath -> Eff es Bool
  fileExists filepath = send $ FileExists filepath
  
  writeFile :: Files :> es => FilePath -> String -> Eff es ()
  writeFile filepath contents = send $ WriteFile filepath contents
  
  readFile :: Files :> es => FilePath -> Eff es String
  readFile filepath = send $ ReadFile filepath
  
  readStdIn :: Files :> es => Eff es String
  readStdIn = send ReadStdIn
  
  getCurrentDirectory
    :: forall (es_a9miX :: [Effect])
     . (HasCallStack, Files :> es_a9miX)
    => Eff es_a9miX FilePath
  getCurrentDirectory = send (GetCurrentDirectory @(Eff es_a9miX))
  
  runFilesIO :: forall es a. IOE :> es => Eff (Files : es) a -> Eff es a
  runFilesIO = interpret $ \_ -> \case
    GetCurrentDirectory -> liftIO Dir.getCurrentDirectory
    ReadStdIn -> liftIO getContents
    ReadFile file -> liftIO $ do
      withFile file ReadMode $ \handle -> do
        hSetEncoding handle utf8_bom
        !contents <- force <$> hGetContents handle
        pure contents
    WriteFile file contents -> deepseq contents $
      liftIO $
        withFile file WriteMode $ \handle -> do
          hSetEncoding handle utf8_bom
          hPutStrLn handle contents
    FileExists filepath -> liftIO $ Dir.doesFileExist filepath
    IsDirectory filepath -> liftIO $ Dir.doesDirectoryExist filepath
    SearchUpwardsForFile (Directory directory) (FileNames filename) ->
      let
        go !subdir = do
          let
            filepaths = fmap (subdir </>) filename
          mbFoundFile <- runFilesIO $ firstExists filepaths
          case mbFoundFile of
            Just file -> pure $ Just file
            Nothing -> do
              let
                up = takeDirectory subdir
              dirExists <- runFilesIO $ isDirectory up
              if up == subdir || not dirExists
                then pure Nothing
                else go up
      in
        go directory
    FirstExists filepath -> case filepath of
      (file : files) -> do
        exists <- runFilesIO $ fileExists file
        if exists
          then pure $ Just file
          else runFilesIO $ firstExists files
      [] -> pure Nothing
    FindLuaFiles (IgnoreFiles ignoreFiles) path ->
      let
        ignoredGlobs = foldl' (&&?) always $ map excludeFiles ignoreFiles
  
        -- Exclude a path when either its relative path or its full path match the ignore globs.
        excludeFiles :: GlobPattern -> FindClause Bool
        excludeFiles glob = relativeFilePath /~? glob &&? filePath /~? glob
  
        relativeFilePath :: FindClause FilePath
        relativeFilePath = fmap stripFromPath filePath
  
        -- Turn absolute path into relative path by stripping prefix
        stripFromPath :: FilePath -> FilePath
        stripFromPath fp =
          fromMaybe fp $ listToMaybe $ mapMaybe (`stripPrefix` fp) pathsToStrip
  
        -- Prefixes to attempt to strip, in order
        pathsToStrip =
          [ "./"
          , path ++ "/"
          , path
          ]
      in
        liftIO $ find always (fileName ~~? "*.lua" &&? ignoredGlobs) path
    GetHomeDirectory -> liftIO Dir.getHomeDirectory
    MakeAbsolute filepath -> liftIO $ Dir.makeAbsolute filepath
  
  -- | Trace actions on files, useful for debugging
  traceFiles :: (Files :> es, Logging :> es) => Eff es a -> Eff es a
  traceFiles = interpose $ \_ -> \case
    GetCurrentDirectory -> do
      putStrLnStdError "GetCurrentDirectory"
      send GetCurrentDirectory
    ReadStdIn -> do
      putStrLnStdError "ReadStdIn"
      send ReadStdIn
    ReadFile filepath -> do
      putStrLnStdError $ "ReadFile " <> filepath
      send $ ReadFile filepath
    WriteFile filepath contents -> do
      putStrLnStdError $ "WriteFile " <> filepath
      send $ WriteFile filepath contents
    FileExists filepath -> do
      putStrLnStdError "FileExists"
      send $ FileExists filepath
    IsDirectory filepath -> do
      putStrLnStdError $ "IsDirectory " <> filepath
      send $ IsDirectory filepath
    SearchUpwardsForFile directory filenames -> do
      putStrLnStdError $ "SearchUpwardsForFile " <> directory.dir <> " " <> show filenames.names
      send $ SearchUpwardsForFile directory filenames
    FirstExists filepath -> do
      putStrLnStdError $ "FirstExists " <> show filepath
      send $ FirstExists filepath
    FindLuaFiles ignores filepath -> do
      putStrLnStdError $ "FindLuaFiles " <> show ignores.ignore <> " " <> filepath
      send $ FindLuaFiles ignores filepath
    GetHomeDirectory -> do
      putStrLnStdError "GetHomeDirectory"
      send GetHomeDirectory
    MakeAbsolute filepath -> do
      putStrLnStdError $ "MakeAbsolute " <> filepath
      send $ MakeAbsolute filepath
  
  traceFilesIfEnabled :: (Files :> es, Logging :> es) => Bool -> Eff es a -> Eff es a
  traceFilesIfEnabled enabled = if enabled then traceFiles else id
  