Cli.hs

{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedRecordDot #-}

-- | CLI interface of the glualint executable
module GLuaFixer.Cli (SettingsPath (..), Options (..), Command (..), OverriddenSettings (..), overrideSettings, runParse, legacyCliParser) where

import Control.Applicative ((<**>), (<|>))
import Data.Maybe (fromMaybe)
import GLuaFixer.LintMessage (LogFormat (..), LogFormatChoice (..))
import GLuaFixer.LintSettings (Indentation (..), LintSettings (..), StdInOrFiles (..))
import Options.Applicative (optional)
import qualified Options.Applicative as Opt

newtype SettingsPath = SettingsPath FilePath
  deriving newtype (Show)

-- | Command line options of glualint
data Options = Options
  { optsConfigFile :: Maybe SettingsPath
  , optsOverridden :: OverriddenSettings
  , optsCommand :: Command
  , optsFiles :: StdInOrFiles
  , optsDebug :: Bool
  }
  deriving (Show)

-- | Available subcommands
data Command
  = Lint
  | PrettyPrint
  | AnalyseGlobals
  | DumpLexicon
  | DumpAst
  | Test
  | PrintVersion
  deriving (Show)

-- | Settings in the config file that can be overridden through the command line.
data OverriddenSettings = OverriddenSettings
  { indentation :: Maybe Indentation
  , outputFormat :: Maybe LogFormatChoice
  }
  deriving (Show)

-- | Override settings with the options passed on the command line
overrideSettings :: OverriddenSettings -> LintSettings -> LintSettings
overrideSettings overridden settings =
  settings
    { prettyprint_indentation =
        maybe settings.prettyprint_indentation unIndentation overridden.indentation
    , log_format = fromMaybe settings.log_format overridden.outputFormat
    }

-- | Run the parser against arguments
runParse :: [String] -> Opt.ParserResult Options
runParse = Opt.execParserPure cliPreferences cliParserInfo

-- | Preferences passed to optparse-applicative
cliPreferences :: Opt.ParserPrefs
cliPreferences = Opt.defaultPrefs{Opt.prefShowHelpOnEmpty = True}

-- | Metadata of the application
cliParserInfo :: Opt.ParserInfo Options
cliParserInfo =
  Opt.info
    (cliParser <**> Opt.helper)
    ( Opt.fullDesc
        <> Opt.progDesc "Linter and pretty printer for Garry's mod's flavour of Lua."
        <> Opt.header "glualint - lint and pretty print GLua files."
    )

-- | Defines the command line interface parser
cliParser :: Opt.Parser Options
cliParser =
  Options
    <$> configOption
    <*> (OverriddenSettings <$> indentOption <*> outputFormatOption)
    <*> commandParser
    <*> parseStdInOrFiles
    <*> parseDebug
  where
    configOption :: Opt.Parser (Maybe SettingsPath)
    configOption =
      optional $
        SettingsPath
          <$> Opt.strOption
            ( Opt.long "config"
                <> Opt.metavar "PATH"
                <> Opt.help "Explicitly define config file location. By default it will search for it."
            )

    indentOption :: Opt.Parser (Maybe Indentation)
    indentOption =
      optional $
        Opt.strOption
          ( Opt.long "indentation"
              <> Opt.metavar "STR"
              <> Opt.help "What to use for indentation when pretty printing, 4 spaces by default."
          )

    outputFormatOption :: Opt.Parser (Maybe LogFormatChoice)
    outputFormatOption =
      optional $
        Opt.option
          outputFormatReader
          ( Opt.long "output-format"
              <> Opt.metavar "FORMAT"
              <> Opt.help "Logging format, either 'auto', 'standard' or 'github', defaults to 'standard'"
          )

    outputFormatReader :: Opt.ReadM LogFormatChoice
    outputFormatReader = Opt.eitherReader $ \case
      "standard" -> Right $ LogFormatChoice StandardLogFormat
      "github" -> Right $ LogFormatChoice GithubLogFormat
      "auto" -> Right AutoLogFormatChoice
      val -> Left $ "Bad output format '" <> val <> "', must be either 'auto', 'standard' or 'github'."

    parseDebug :: Opt.Parser Bool
    parseDebug =
      Opt.switch
        ( Opt.long "debug"
            <> Opt.help "Whether to enable some debug prints."
        )

    commandParser :: Opt.Parser Command
    commandParser =
      Opt.hsubparser
        ( Opt.command
            "lint"
            ( Opt.info (pure Lint) $
                Opt.progDesc "Lint the given files. Directories will be traversed recursively."
            )
            <> Opt.command
              "pretty-print"
              ( Opt.info (pure PrettyPrint) $
                  Opt.progDesc "Pretty print the given files, replacing their contents with the pretty printed code."
              )
            <> Opt.command
              "analyse-globals"
              ( Opt.info (pure AnalyseGlobals) $
                  Opt.progDesc "Print a list of all globals used and defined in the given files/directories."
              )
            <> Opt.command
              "dump-lexicon"
              ( Opt.info (pure DumpLexicon) $
                  Opt.progDesc "Debug command to dump the tokens parsed in the Lua code."
              )
            <> Opt.command
              "dump-ast"
              ( Opt.info (pure DumpAst) $
                  Opt.progDesc "Debug command to dump the internal Abstract Syntax Tree of the Lua code."
              )
            <> Opt.command
              "test"
              ( Opt.info (pure Test) $
                  Opt.progDesc "Run tests on the given files. Use for testing/debugging glualint."
              )
            <> Opt.command
              "version"
              ( Opt.info (pure PrintVersion) $
                  Opt.progDesc "Print the version of glualint and exit."
              )
        )

    parseStdInOrFiles :: Opt.Parser StdInOrFiles
    parseStdInOrFiles =
      Opt.flag'
        UseStdIn
        ( Opt.long "stdin"
            <> Opt.help "Use stdin instead of files."
        )
        <|> UseFiles <$> filesArgument

    filesArgument :: Opt.Parser [FilePath]
    filesArgument = Opt.many (Opt.argument Opt.str $ Opt.metavar "FILES")

--
-- Legacy
--

-- | Deprecated and naive command line interface, kept in place for backwards
-- compatibility.
legacyCliParser :: [String] -> Maybe Options
legacyCliParser args = case go False emptyOptions args of
  (False, _) -> Nothing
  (True, opts@Options{optsCommand = Lint, optsFiles = files}) -> case files of
    UseFiles [] -> Nothing
    _ -> Just opts
  (True, opts) -> Just opts
  where
    emptyOptions =
      Options
        { optsConfigFile = Nothing
        , optsOverridden = OverriddenSettings Nothing Nothing
        , optsCommand = Lint
        , optsFiles = UseFiles []
        , optsDebug = False
        }

    go hasSuccessfulParse options = \case
      ["--config"] -> (False, options)
      -- fail when a subcommand of the new parser is given as argument
      "lint" : _ -> (False, options)
      "pretty-print" : _ -> (False, options)
      "analyse-globals" : _ -> (False, options)
      "dump-ast" : _ -> (False, options)
      "test" : _ -> (False, options)
      "version" : _ -> (False, options)
      "--bash-completion-script" : _ -> (False, options)
      "--fish-completion-script" : _ -> (False, options)
      "--zsh-completion-script" : _ -> (False, options)
      -- End of recursion case
      [] -> (hasSuccessfulParse, options)
      "--debug" : xs -> go True options{optsDebug = True} xs
      "--pretty-print-files" : xs -> go True options{optsCommand = PrettyPrint} xs
      "--pretty-print" : xs -> go True options{optsCommand = PrettyPrint, optsFiles = UseStdIn} xs
      "--analyse-globals" : xs -> go True options{optsCommand = AnalyseGlobals} xs
      "--dump-ast" : xs -> go True options{optsCommand = DumpAst} xs
      "--version" : xs -> go True options{optsCommand = PrintVersion} xs
      "--test" : xs -> go True options{optsCommand = Test} xs
      "--stdin" : xs -> go True options{optsFiles = UseStdIn} xs
      "--config" : f : xs -> go True options{optsConfigFile = Just $ SettingsPath f} xs
      ('-' : '-' : 'i' : 'n' : 'd' : 'e' : 'n' : 't' : 'a' : 't' : 'i' : 'o' : 'n' : '=' : '\'' : ind') : xs ->
        go True options{optsOverridden = options.optsOverridden{indentation = Just $ Indentation ind'}} xs
      ('-' : '-' : 'i' : 'n' : 'd' : 'e' : 'n' : 't' : 'a' : 't' : 'i' : 'o' : 'n' : '=' : ind') : xs ->
        go True options{optsOverridden = options.optsOverridden{indentation = Just $ Indentation ind'}} xs
      f : xs -> case optsFiles options of
        UseStdIn -> go True options{optsFiles = UseFiles [f]} xs
        UseFiles fs -> go True options{optsFiles = UseFiles $ f : fs} xs