content: {-# LANGUAGE BangPatterns #-}
  {-# LANGUAGE DataKinds #-}
  {-# LANGUAGE FlexibleContexts #-}
  {-# LANGUAGE GADTs #-}
  {-# LANGUAGE OverloadedRecordDot #-}
  {-# LANGUAGE ScopedTypeVariables #-}
  {-# LANGUAGE TypeApplications #-}
  {-# LANGUAGE TypeFamilies #-}
  {-# LANGUAGE TypeOperators #-}
  
  module GLuaFixer.Effects.Run where
  
  import Control.Monad (when)
  import qualified Data.Aeson as JSON
  import qualified Data.ByteString.Lazy.Char8 as BL8
  import Effectful (Eff, (:>))
  import qualified Effectful.Environment as Eff
  import Effectful.Error.Static (runErrorNoCallStack)
  import GLua.AG.AST (AST)
  import GLua.AG.Token (MToken)
  import GLua.ASTInstances ()
  import qualified GLua.Parser as Parser
  import GLuaFixer.Cli (Command (..), Options (..), OverriddenSettings, SettingsPath)
  import GLuaFixer.Effects.AnalyseGlobals (analyseFile, execAnalysis, reportAnalysis)
  import GLuaFixer.Effects.Cli (Cli, CliParseResult (..), parseCliOptions)
  import GLuaFixer.Effects.Files (Files, IgnoreFiles (..), findLuaFiles, getCurrentDirectory, isDirectory, readFile, readStdIn, traceFilesIfEnabled, writeFile)
  import GLuaFixer.Effects.Interruptible (Interruptible, interruptibleFoldMStrict)
  import GLuaFixer.Effects.Logging (Logging, emitLintMessage, getLogFormat, putStrLnStdError, putStrLnStdOut, putStrStdOut)
  import GLuaFixer.Effects.Settings (Settings, SettingsError (CouldNotParseSettings), getSettingsForFile, runSettings, traceSettingsIfEnabled)
  import qualified GLuaFixer.Interface as Interface
  import GLuaFixer.LintMessage (sortLintMessages)
  import GLuaFixer.LintSettings (
    LintSettings (..),
    StdInOrFiles (..),
   )
  import GLuaFixer.Version (version)
  import System.Exit (ExitCode (..))
  import Prelude hiding (lex, readFile, writeFile)
  
  -- | Top level run function
  run
    :: ( Interruptible :> es
       , Files :> es
       , Logging :> es
       , Eff.Environment :> es
       , Cli :> es
       )
    => Eff es ExitCode
  run = do
    pareResult <- parseCliOptions
  
    case pareResult of
      PrintHelpText exitCode helpText -> do
        putStrLnStdError helpText
        pure exitCode
      ParseSuccessful options -> do
        result <-
          runErrorNoCallStack @SettingsError $
            runSettings $
              runOptions options
  
        case result of
          Left (CouldNotParseSettings err) -> do
            putStrLnStdError $ "Could not parse settings file: " <> err
            pure $ ExitFailure 1
          Right exitCode -> pure exitCode
  
  -- | Run the given options
  runOptions
    :: ( Interruptible :> es
       , Files :> es
       , Settings :> es
       , Logging :> es
       , Eff.Environment :> es
       , Cli :> es
       )
    => Options
    -> Eff es ExitCode
  runOptions options =
    traceFilesIfEnabled options.optsDebug $
      traceSettingsIfEnabled options.optsDebug $ do
        when (options.optsDebug) $
          putStrLnStdError $
            show options
        case (options.optsCommand, options.optsFiles) of
          (Lint, UseStdIn) -> do
            (lintSettings, contents) <- getStdIn options.optsConfigFile options.optsOverridden
            lint lintSettings "stdin" contents
          (Lint, UseFiles files) ->
            foldLuaFiles
              options.optsConfigFile
              options.optsOverridden
              ExitSuccess
              files
              $ \exitCode lintSettings filepath contents ->
                worstExitCode exitCode <$> lint lintSettings filepath contents
          (PrettyPrint, UseStdIn) -> do
            (lintSettings, contents) <- getStdIn options.optsConfigFile options.optsOverridden
            case prettyprint lintSettings "stdin" contents of
              Nothing -> pure $ ExitFailure 1
              Just prettyprinted -> do
                putStrStdOut prettyprinted
                pure ExitSuccess
          (PrettyPrint, UseFiles files) ->
            foldLuaFiles
              options.optsConfigFile
              options.optsOverridden
              ExitSuccess
              files
              $ \exitCode lintSettings filepath contents -> do
                putStrLnStdOut $ "Pretty printing " <> filepath
                case prettyprint lintSettings filepath contents of
                  Nothing -> pure $ ExitFailure 1
                  Just prettyprinted -> do
                    writeFile filepath prettyprinted
                    pure exitCode
          (AnalyseGlobals, UseStdIn) -> do
            (lintSettings, contents) <- getStdIn options.optsConfigFile options.optsOverridden
            withParsed lintSettings "stdin" contents (ExitFailure 1) $ \ast -> do
              analysis <- execAnalysis $ analyseFile lintSettings "stdin" ast
              reportAnalysis analysis
              pure ExitSuccess
          (AnalyseGlobals, UseFiles files) -> do
            analysis <- execAnalysis
              $ foldLuaFiles
                options.optsConfigFile
                options.optsOverridden
                ()
                files
              $ \() lintSettings filepath contents -> do
                withParsed lintSettings filepath contents () $ \ast ->
                  analyseFile lintSettings filepath ast
            reportAnalysis analysis
            pure ExitSuccess
          (DumpLexicon, UseStdIn) -> do
            (lintSettings, contents) <- getStdIn options.optsConfigFile options.optsOverridden
            mbTokens <- getLexicon lintSettings "stdin" contents
            case mbTokens of
              Nothing -> pure $ ExitFailure 1
              tokens -> do
                putStrLnStdOut $ show tokens
                pure ExitSuccess
          (DumpLexicon, UseFiles files) ->
            foldLuaFiles
              options.optsConfigFile
              options.optsOverridden
              ExitSuccess
              files
              $ \exitCode lintSettings filepath contents -> do
                mbTokens <- getLexicon lintSettings filepath contents
                case mbTokens of
                  Nothing -> pure $ ExitFailure 1
                  Just tokens -> do
                    putStrLnStdOut $ show tokens
                    pure exitCode
          (DumpAst, UseStdIn) -> do
            (lintSettings, contents) <- getStdIn options.optsConfigFile options.optsOverridden
            withParsed lintSettings "stdin" contents (ExitFailure 1) $ \ast -> do
              putStrLnStdOut $ BL8.unpack $ JSON.encode ast
              pure ExitSuccess
          (DumpAst, UseFiles files) ->
            foldLuaFiles
              options.optsConfigFile
              options.optsOverridden
              ExitSuccess
              files
              $ \exitCode lintSettings filepath contents ->
                withParsed lintSettings filepath contents (ExitFailure 1) $ \ast -> do
                  putStrLnStdOut $ BL8.unpack $ JSON.encode ast
                  pure exitCode
          (Test, UseStdIn) -> do
            (lintSettings, contents) <- getStdIn options.optsConfigFile options.optsOverridden
            test ExitSuccess lintSettings "stdin" contents
          (Test, UseFiles files) -> do
            foldLuaFiles
              options.optsConfigFile
              options.optsOverridden
              ExitSuccess
              files
              $ \exitCode lintSettings filepath contents ->
                test exitCode lintSettings filepath contents
          (PrintVersion, _) -> do
            putStrLnStdOut version
            pure ExitSuccess
  
  -- | Retrieves the contents of stdin and the settings that apply.
  getStdIn
    :: (Files :> es, Settings :> es)
    => Maybe SettingsPath
    -> OverriddenSettings
    -> Eff es (LintSettings, String)
  getStdIn mbSettingsPath overriddenSettings = do
    cwd <- getCurrentDirectory
    settings <- getSettingsForFile mbSettingsPath overriddenSettings cwd
    code <- readStdIn
    pure (settings, code)
  
  -- | Fold over all the Lua files. Recurses into directories, retrieves settings and passes file
  -- contents to the fold function.
  foldLuaFiles
    :: forall es a
     . (Files :> es, Interruptible :> es, Settings :> es)
    => Maybe SettingsPath
    -> OverriddenSettings
    -> a
    -> [FilePath]
    -> (a -> LintSettings -> FilePath -> String -> Eff es a)
    -> Eff es a
  foldLuaFiles mbSettingsPath overriddenSettings initial files f =
    interruptibleFoldMStrict go initial files
    where
      go :: a -> FilePath -> Eff es a
      go acc file = do
        isDir <- isDirectory file
        lintSettings <- getSettingsForFile mbSettingsPath overriddenSettings file
        if isDir
          then do
            let
              ignoreFiles = IgnoreFiles $ lintSettings.lint_ignoreFiles
            recurseFiles <- findLuaFiles ignoreFiles file
            interruptibleFoldMStrict go acc recurseFiles
          else do
            contents <- readFile file
            f acc lintSettings file contents
  
  -- | Lint a file
  lint
    :: (Logging :> es, Eff.Environment :> es)
    => LintSettings
    -> FilePath
    -> String
    -> Eff es ExitCode
  lint lintSettings filepath contents = do
    logFormat <- getLogFormat lintSettings.log_format
    let
      sourceLint = Interface.sourceLint lintSettings filepath contents
    case Interface.lex lintSettings filepath contents of
      Left msgs -> do
        mapM_ (emitLintMessage logFormat) msgs
        pure $ ExitFailure 1
      Right tokens -> do
        let
          !lextLint = Interface.lexiconLint filepath lintSettings tokens
        case Interface.parse lintSettings filepath tokens of
          Left msgs -> do
            mapM_ (emitLintMessage logFormat) msgs
            pure $ ExitFailure 1
          Right ast -> do
            let
              astLint = Interface.astLint filepath lintSettings ast
              msgs = sortLintMessages $ sourceLint ++ lextLint ++ astLint
            mapM_ (emitLintMessage logFormat) msgs
            pure $ if null msgs then ExitSuccess else ExitFailure 1
  
  -- | Pretty print a file
  prettyprint
    :: LintSettings
    -> FilePath
    -> String
    -> Maybe String
  prettyprint lintSettings filepath contents =
    case eAst of
      Left _errors -> Nothing
      Right ast -> Just $ Interface.prettyprint lintSettings ast
    where
      eAst = Interface.lex lintSettings filepath contents >>= Interface.parse lintSettings filepath
  
  -- | Test glualint itself against a file. TODO: Refactor this into a nicer command
  test
    :: (Logging :> es, Eff.Environment :> es)
    => ExitCode
    -> LintSettings
    -> FilePath
    -> String
    -> Eff es ExitCode
  test exitCode lintSettings filepath contents = do
    putStrLnStdOut $ "Testing " <> filepath
  
    logFormat <- getLogFormat lintSettings.log_format
  
    case Interface.lex lintSettings filepath contents of
      Left msgs -> do
        mapM_ (emitLintMessage logFormat) msgs
        pure $ ExitFailure 1
      Right tokens ->
        case Interface.parse lintSettings filepath tokens of
          Left msgs -> do
            putStrLnStdOut $
              "Errors when trying to parse '" ++ filepath
            mapM_ (emitLintMessage logFormat) msgs
            pure $ ExitFailure 1
          Right ast -> do
            let
              prettyprinted = Interface.prettyprint lintSettings ast
  
            case Parser.parseGLuaFromString prettyprinted of
              Left err -> do
                putStrLnStdOut $
                  "Errors when trying to parse '" ++ filepath ++ "' after pretty print!"
  
                putStrLnStdOut $ show err
                pure $ ExitFailure 1
              Right _ast -> pure exitCode
  
  -- | Function to easily parse a file's contents into an AST. This will log any parse failures and
  -- give an AST if it can.
  withParsed
    :: (Logging :> es, Eff.Environment :> es)
    => LintSettings
    -> FilePath
    -> String
    -> a
    -> (AST -> Eff es a)
    -> Eff es a
  withParsed lintSettings filepath contents defaultValue f = do
    lexicon <- getLexicon lintSettings filepath contents
    case lexicon of
      Nothing -> pure defaultValue
      Just tokens -> do
        logFormat <- getLogFormat lintSettings.log_format
        case Interface.parse lintSettings filepath tokens of
          Left msgs -> do
            mapM_ (emitLintMessage logFormat) msgs
            pure defaultValue
          Right ast -> f ast
  
  -- | Function to parse a file's contents into MTokens. This will log any parse failures and give
  -- MTokens if it can.
  getLexicon :: Logging :> es => LintSettings -> FilePath -> String -> Eff es (Maybe [MToken])
  getLexicon lintSettings filepath contents = do
    logFormat <- getLogFormat lintSettings.log_format
    case Interface.lex lintSettings filepath contents of
      Left msgs -> do
        mapM_ (emitLintMessage logFormat) msgs
        pure Nothing
      Right tokens -> do
        pure $ Just tokens
  
  -- | Takes the worst of the two exit codes.
  worstExitCode :: ExitCode -> ExitCode -> ExitCode
  worstExitCode e1 e2 = case (e1, e2) of
    (ExitSuccess, ExitSuccess) -> ExitSuccess
    (ExitFailure code, _) -> ExitFailure code
    (_, ExitFailure code) -> ExitFailure code
  