{-# LANGUAGE ApplicativeDo #-}

{- |
Copyright: (c) 2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

CLI commands and options for @stan@.
-}

module Stan.Cli
    ( StanCommand (..)
    , StanArgs (..)
    , ReportArgs (..)
    , InspectionArgs (..)
    , TomlToCliArgs (..)
    , CliToTomlArgs (..)
    , runStanCli
    , stanParserPrefs
    , stanCliParser
    ) where

import Colourista (blue, bold, formatWith, reset, yellow)
import Colourista.Short (b)
import Data.Char (toUpper)
import Options.Applicative (CommandFields, Mod, Parser, ParserInfo (..), ParserPrefs, auto, columns,
                            command, commandGroup, customExecParser, flag, flag', fullDesc, help,
                            helpLongEquals, helper, hidden, hsubparser, info, infoOption, internal,
                            long, metavar, multiSuffix, option, prefs, progDesc, short,
                            showDefaultWith, showHelpOnEmpty, showHelpOnError, strArgument,
                            strOption, subparserInline, switch, value)
import Options.Applicative.Help.Chunk (stringChunk)
import Trial (TaggedTrial, fiascoOnEmpty)
import Trial.OptparseApplicative (taggedTrialParser)

import Stan.Category (Category (..))
import Stan.Config (Check (..), CheckFilter (..), CheckType (..), ConfigP (..), PartialConfig,
                    Scope (..))
import Stan.Core.Id (Id (..))
import Stan.Info (prettyStanVersion, stanSystem, stanVersion)
import Stan.Inspection (Inspection)
import Stan.Observation (Observation)
import Stan.Report.Settings (OutputSettings (..), ToggleSolution (..), Verbosity (..))


-- | Commands used in Stan CLI.
data StanCommand
    = Stan !StanArgs  -- ^ Just @stan@ with its options.
    | StanInspection !InspectionArgs  -- ^ @stan inspection@.
    | StanTomlToCli !TomlToCliArgs  -- ^ @stan toml-to-cli@
    | StanCliToToml !CliToTomlArgs  -- ^ @stan cli-to-toml@
    | StanInspectionsToMd  -- ^ @stan inspections-to-md@

-- | Options used for the main @stan@ command.
data StanArgs = StanArgs
    { StanArgs -> FilePath
stanArgsHiedir               :: !FilePath  -- ^ Directory with HIE files
    , StanArgs -> [FilePath]
stanArgsCabalFilePath        :: ![FilePath]  -- ^ Path to @.cabal@ files.
    , StanArgs -> OutputSettings
stanArgsOutputSettings       :: !OutputSettings  -- ^ Settings for output terminal report
    , StanArgs -> Maybe ReportArgs
stanArgsReport               :: !(Maybe ReportArgs)  -- ^ @HTML@ report settings
    , StanArgs -> TaggedTrial Text Bool
stanArgsUseDefaultConfigFile :: !(TaggedTrial Text Bool)  -- ^ Use default @.stan.toml@ file
    , StanArgs -> Maybe FilePath
stanArgsConfigFile           :: !(Maybe FilePath)  -- ^ Path to a custom configurations file.
    , StanArgs -> PartialConfig
stanArgsConfig               :: !PartialConfig
    , StanArgs -> Bool
stanArgsJsonOut              :: !Bool  -- ^ Output the machine-readable output in JSON format instead.
    }

newtype ReportArgs = ReportArgs
    { ReportArgs -> Bool
reportArgsBrowse :: Bool  -- ^ Open HTML report in a browser
    }

-- | Options used for the @stan inspection@ command.
newtype InspectionArgs = InspectionArgs
    { InspectionArgs -> Maybe (Id Inspection)
inspectionArgsId :: Maybe (Id Inspection)
    }

-- | Options used for the @stan toml-to-cli@ command.
newtype TomlToCliArgs = TomlToCliArgs
    { TomlToCliArgs -> Maybe FilePath
tomlToCliArgsFilePath :: Maybe FilePath
    }

-- | Options used for the @stan cli-to-toml@ command.
data CliToTomlArgs = CliToTomlArgs
    { CliToTomlArgs -> Maybe FilePath
cliToTomlArgsFilePath :: !(Maybe FilePath)
    , CliToTomlArgs -> PartialConfig
cliToTomlArgsConfig   :: !PartialConfig
    }

-- | Run main parser of the @stan@ command line tool.
runStanCli :: IO StanCommand
runStanCli :: IO StanCommand
runStanCli = ParserPrefs -> ParserInfo StanCommand -> IO StanCommand
forall a. ParserPrefs -> ParserInfo a -> IO a
customExecParser ParserPrefs
stanParserPrefs ParserInfo StanCommand
stanCliParser

-- | To turn on some special options.
stanParserPrefs :: ParserPrefs
stanParserPrefs :: ParserPrefs
stanParserPrefs = PrefsMod -> ParserPrefs
prefs (PrefsMod -> ParserPrefs) -> PrefsMod -> ParserPrefs
forall a b. (a -> b) -> a -> b
$ [PrefsMod] -> PrefsMod
forall a. Monoid a => [a] -> a
mconcat
    [ PrefsMod
helpLongEquals
    , PrefsMod
showHelpOnEmpty
    , PrefsMod
showHelpOnError
    , PrefsMod
subparserInline
    , FilePath -> PrefsMod
multiSuffix "s"
    , Int -> PrefsMod
columns 100
    ]

stanCliParser :: ParserInfo StanCommand
stanCliParser :: ParserInfo StanCommand
stanCliParser = ParserInfo StanCommand -> ParserInfo StanCommand
forall a. ParserInfo a -> ParserInfo a
modifyHeader (ParserInfo StanCommand -> ParserInfo StanCommand)
-> ParserInfo StanCommand -> ParserInfo StanCommand
forall a b. (a -> b) -> a -> b
$ Parser StanCommand -> InfoMod StanCommand -> ParserInfo StanCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (Parser ((StanCommand -> StanCommand) -> StanCommand -> StanCommand)
forall a. Parser (a -> a)
helper Parser ((StanCommand -> StanCommand) -> StanCommand -> StanCommand)
-> Parser (StanCommand -> StanCommand)
-> Parser (StanCommand -> StanCommand)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (StanCommand -> StanCommand)
forall a. Parser (a -> a)
versionP Parser (StanCommand -> StanCommand)
-> Parser StanCommand -> Parser StanCommand
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser StanCommand
stan) InfoMod StanCommand
forall a. InfoMod a
fullDesc

{- | Stan tool parser. It either uses the named commands or the main @stan@
command.
-}
stan :: Parser StanCommand
stan :: Parser StanCommand
stan =  Parser StanCommand
stanInspectionP
    Parser StanCommand -> Parser StanCommand -> Parser StanCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser StanCommand
stanTomlToCliP
    Parser StanCommand -> Parser StanCommand -> Parser StanCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser StanCommand
stanCliToTomlP
    Parser StanCommand -> Parser StanCommand -> Parser StanCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser StanCommand
stanInspectionsToMd
    Parser StanCommand -> Parser StanCommand -> Parser StanCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser StanCommand
stanP

-- | @stan@ command parser.
stanP :: Parser StanCommand
stanP :: Parser StanCommand
stanP = do
    PartialConfig
stanArgsConfig <- Parser PartialConfig
configP
    Maybe ReportArgs
stanArgsReport <- Parser (Maybe ReportArgs)
reportP
    FilePath
stanArgsHiedir <- Parser FilePath
hiedirP
    [FilePath]
stanArgsCabalFilePath <- Parser [FilePath]
cabalFilePathP
    Maybe FilePath
stanArgsConfigFile <- Parser (Maybe FilePath)
configFileP
    TaggedTrial Text Bool
stanArgsUseDefaultConfigFile <- Parser (TaggedTrial Text Bool)
useDefaultConfigFileP
    OutputSettings
stanArgsOutputSettings <- Parser OutputSettings
outputSettingsP
    Bool
stanArgsJsonOut <- Parser Bool
jsonOutputP
    pure $ StanArgs -> StanCommand
Stan $WStanArgs :: FilePath
-> [FilePath]
-> OutputSettings
-> Maybe ReportArgs
-> TaggedTrial Text Bool
-> Maybe FilePath
-> PartialConfig
-> Bool
-> StanArgs
StanArgs{..}

-- | @stan inspection@ command parser.
stanInspectionP :: Parser StanCommand
stanInspectionP :: Parser StanCommand
stanInspectionP = Mod CommandFields StanCommand -> Parser StanCommand
forall a. Mod CommandFields a -> Parser a
hsubparser (Mod CommandFields StanCommand -> Parser StanCommand)
-> Mod CommandFields StanCommand -> Parser StanCommand
forall a b. (a -> b) -> a -> b
$
    FilePath -> ParserInfo StanCommand -> Mod CommandFields StanCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "inspection" (Parser StanCommand -> InfoMod StanCommand -> ParserInfo StanCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser StanCommand
inspectionP (FilePath -> InfoMod StanCommand
forall a. FilePath -> InfoMod a
progDesc "Show all Inspections"))
    Mod CommandFields StanCommand
-> Mod CommandFields StanCommand -> Mod CommandFields StanCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod CommandFields StanCommand
forall a. FilePath -> Mod CommandFields a
commandVar "INSPECTION"
    Mod CommandFields StanCommand
-> Mod CommandFields StanCommand -> Mod CommandFields StanCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod CommandFields StanCommand
forall (f :: * -> *) a. FilePath -> Mod f a
help "Command to show all or specific inspection"
  where
    inspectionP :: Parser StanCommand
    inspectionP :: Parser StanCommand
inspectionP = do
        Maybe (Id Inspection)
inspectionArgsId <- Text -> Id Inspection
forall a. Text -> Id a
Id (Text -> Id Inspection)
-> Parser (Maybe Text) -> Parser (Maybe (Id Inspection))
forall (f :: * -> *) (g :: * -> *) a b.
(Functor f, Functor g) =>
(a -> b) -> f (g a) -> f (g b)
<<$>> Parser Text -> Parser (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ( Mod ArgumentFields Text -> Parser Text
forall s. IsString s => Mod ArgumentFields s -> Parser s
strArgument
            (FilePath -> Mod ArgumentFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "INSPECTION_ID" Mod ArgumentFields Text
-> Mod ArgumentFields Text -> Mod ArgumentFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod ArgumentFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help "Show specific Inspection information"))
        pure $ InspectionArgs -> StanCommand
StanInspection InspectionArgs :: Maybe (Id Inspection) -> InspectionArgs
InspectionArgs{..}

stanTomlToCliP :: Parser StanCommand
stanTomlToCliP :: Parser StanCommand
stanTomlToCliP = Mod CommandFields StanCommand -> Parser StanCommand
forall a. Mod CommandFields a -> Parser a
hsubparser (Mod CommandFields StanCommand -> Parser StanCommand)
-> Mod CommandFields StanCommand -> Parser StanCommand
forall a b. (a -> b) -> a -> b
$ FilePath -> Mod CommandFields StanCommand
forall a. FilePath -> Mod CommandFields a
commandGroup "TOML Configurations"
    Mod CommandFields StanCommand
-> Mod CommandFields StanCommand -> Mod CommandFields StanCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo StanCommand -> Mod CommandFields StanCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "toml-to-cli"
        ( Parser StanCommand -> InfoMod StanCommand -> ParserInfo StanCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser StanCommand
tomlToCliP
            (FilePath -> InfoMod StanCommand
forall a. FilePath -> InfoMod a
progDesc "Convert TOML configuration file into stan CLI command")
        )
    Mod CommandFields StanCommand
-> Mod CommandFields StanCommand -> Mod CommandFields StanCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod CommandFields StanCommand
forall a. FilePath -> Mod CommandFields a
commandVar "TOML-TO-CLI"
    Mod CommandFields StanCommand
-> Mod CommandFields StanCommand -> Mod CommandFields StanCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod CommandFields StanCommand
forall (f :: * -> *) a. FilePath -> Mod f a
help "Command to convert TOML configurations to CLI"
  where
    tomlToCliP :: Parser StanCommand
    tomlToCliP :: Parser StanCommand
tomlToCliP = do
        Maybe FilePath
tomlToCliArgsFilePath <- Parser (Maybe FilePath)
configFileP
        pure $ TomlToCliArgs -> StanCommand
StanTomlToCli TomlToCliArgs :: Maybe FilePath -> TomlToCliArgs
TomlToCliArgs{..}

stanCliToTomlP :: Parser StanCommand
stanCliToTomlP :: Parser StanCommand
stanCliToTomlP = Mod CommandFields StanCommand -> Parser StanCommand
forall a. Mod CommandFields a -> Parser a
hsubparser (Mod CommandFields StanCommand -> Parser StanCommand)
-> Mod CommandFields StanCommand -> Parser StanCommand
forall a b. (a -> b) -> a -> b
$ FilePath -> Mod CommandFields StanCommand
forall a. FilePath -> Mod CommandFields a
commandGroup "TOML Configurations"
    Mod CommandFields StanCommand
-> Mod CommandFields StanCommand -> Mod CommandFields StanCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> ParserInfo StanCommand -> Mod CommandFields StanCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "cli-to-toml"
        ( Parser StanCommand -> InfoMod StanCommand -> ParserInfo StanCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser StanCommand
cliToTomlP
            (FilePath -> InfoMod StanCommand
forall a. FilePath -> InfoMod a
progDesc "Convert CLI arguments into stan TOML configuration")
        )
    Mod CommandFields StanCommand
-> Mod CommandFields StanCommand -> Mod CommandFields StanCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod CommandFields StanCommand
forall a. FilePath -> Mod CommandFields a
commandVar "CLI-TO-TOML"
    Mod CommandFields StanCommand
-> Mod CommandFields StanCommand -> Mod CommandFields StanCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod CommandFields StanCommand
forall (f :: * -> *) a. FilePath -> Mod f a
help "Command to convert CLI configurations to TOML"
  where
    cliToTomlP :: Parser StanCommand
    cliToTomlP :: Parser StanCommand
cliToTomlP = do
        Maybe FilePath
cliToTomlArgsFilePath <- Parser (Maybe FilePath)
configFileP
        PartialConfig
cliToTomlArgsConfig   <- Parser PartialConfig
configP
        pure $ CliToTomlArgs -> StanCommand
StanCliToToml $WCliToTomlArgs :: Maybe FilePath -> PartialConfig -> CliToTomlArgs
CliToTomlArgs{..}

stanInspectionsToMd :: Parser StanCommand
stanInspectionsToMd :: Parser StanCommand
stanInspectionsToMd = Mod CommandFields StanCommand -> Parser StanCommand
forall a. Mod CommandFields a -> Parser a
hsubparser
    (Mod CommandFields StanCommand -> Parser StanCommand)
-> Mod CommandFields StanCommand -> Parser StanCommand
forall a b. (a -> b) -> a -> b
$  FilePath -> ParserInfo StanCommand -> Mod CommandFields StanCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "inspections-to-md"
        (Parser StanCommand -> InfoMod StanCommand -> ParserInfo StanCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (StanCommand -> Parser StanCommand
forall (f :: * -> *) a. Applicative f => a -> f a
pure StanCommand
StanInspectionsToMd)
             (FilePath -> InfoMod StanCommand
forall a. FilePath -> InfoMod a
progDesc "Create md with all inspections info")
        )
    Mod CommandFields StanCommand
-> Mod CommandFields StanCommand -> Mod CommandFields StanCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod CommandFields StanCommand
forall (f :: * -> *) a. FilePath -> Mod f a
help "Create md with all inspections info"
    Mod CommandFields StanCommand
-> Mod CommandFields StanCommand -> Mod CommandFields StanCommand
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields StanCommand
forall (f :: * -> *) a. Mod f a
hidden Mod CommandFields StanCommand
-> Mod CommandFields StanCommand -> Mod CommandFields StanCommand
forall a. Semigroup a => a -> a -> a
<> Mod CommandFields StanCommand
forall (f :: * -> *) a. Mod f a
internal

hiedirP :: Parser FilePath
hiedirP :: Parser FilePath
hiedirP = Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "hiedir"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "DIR_PATH"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasValue f => a -> Mod f a
value ".hie"
    , (FilePath -> FilePath) -> Mod OptionFields FilePath
forall a (f :: * -> *). (a -> FilePath) -> Mod f a
showDefaultWith ([FilePath] -> FilePath -> FilePath
forall str. (IsString str, Semigroup str) => [str] -> str -> str
formatWith [FilePath
forall str. IsString str => str
blue, FilePath
forall str. IsString str => str
bold])
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help "Relative path to the directory with HIE files"
    ]

cabalFilePathP :: Parser [FilePath]
cabalFilePathP :: Parser [FilePath]
cabalFilePathP = Parser FilePath -> Parser [FilePath]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser FilePath -> Parser [FilePath])
-> Parser FilePath -> Parser [FilePath]
forall a b. (a -> b) -> a -> b
$ Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "cabal-file-path"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "FILE_PATH"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help "Relative path to the .cabal file (can specify many of this option)"
    ]

configFileP :: Parser (Maybe FilePath)
configFileP :: Parser (Maybe FilePath)
configFileP = Parser FilePath -> Parser (Maybe FilePath)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser FilePath -> Parser (Maybe FilePath))
-> Parser FilePath -> Parser (Maybe FilePath)
forall a b. (a -> b) -> a -> b
$ Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption (Mod OptionFields FilePath -> Parser FilePath)
-> Mod OptionFields FilePath -> Parser FilePath
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields FilePath] -> Mod OptionFields FilePath
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "config-file"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "FILE_PATH"
    , FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help "Relative path to the .toml configurations file"
    ]

useDefaultConfigFileP :: Parser (TaggedTrial Text Bool)
useDefaultConfigFileP :: Parser (TaggedTrial Text Bool)
useDefaultConfigFileP = FilePath -> Parser Bool -> Parser (TaggedTrial Text Bool)
forall e a.
(Semigroup e, IsString e) =>
FilePath -> Parser a -> Parser (TaggedTrial e a)
taggedTrialParser "no-default" (Parser Bool -> Parser (TaggedTrial Text Bool))
-> Parser Bool -> Parser (TaggedTrial Text Bool)
forall a b. (a -> b) -> a -> b
$ Bool -> Mod FlagFields Bool -> Parser Bool
forall a. a -> Mod FlagFields a -> Parser a
flag' Bool
False (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "no-default"
    , FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help "Ignore local .stan.toml configuration file"
    ]

jsonOutputP :: Parser Bool
jsonOutputP :: Parser Bool
jsonOutputP = Mod FlagFields Bool -> Parser Bool
switch (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "json-output"
    , FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help "Output the machine-readable output in JSON format instead"
    ]

reportP :: Parser (Maybe ReportArgs)
reportP :: Parser (Maybe ReportArgs)
reportP = Parser ReportArgs -> Parser (Maybe ReportArgs)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
    (Parser ReportArgs -> Parser (Maybe ReportArgs))
-> Parser ReportArgs -> Parser (Maybe ReportArgs)
forall a b. (a -> b) -> a -> b
$  Mod CommandFields ReportArgs -> Parser ReportArgs
forall a. Mod CommandFields a -> Parser a
hsubparser
    (Mod CommandFields ReportArgs -> Parser ReportArgs)
-> Mod CommandFields ReportArgs -> Parser ReportArgs
forall a b. (a -> b) -> a -> b
$  FilePath -> ParserInfo ReportArgs -> Mod CommandFields ReportArgs
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command "report" (Parser ReportArgs -> InfoMod ReportArgs -> ParserInfo ReportArgs
forall a. Parser a -> InfoMod a -> ParserInfo a
info Parser ReportArgs
reportArgsP (FilePath -> InfoMod ReportArgs
forall a. FilePath -> InfoMod a
progDesc "Generate HTML Report"))
    Mod CommandFields ReportArgs
-> Mod CommandFields ReportArgs -> Mod CommandFields ReportArgs
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod CommandFields ReportArgs
forall a. FilePath -> Mod CommandFields a
commandGroup "Reporting"
    Mod CommandFields ReportArgs
-> Mod CommandFields ReportArgs -> Mod CommandFields ReportArgs
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod CommandFields ReportArgs
forall a. FilePath -> Mod CommandFields a
commandVar "REPORT"
    Mod CommandFields ReportArgs
-> Mod CommandFields ReportArgs -> Mod CommandFields ReportArgs
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod CommandFields ReportArgs
forall (f :: * -> *) a. FilePath -> Mod f a
help "Command to generate an HTML Report"
  where
    reportArgsP :: Parser ReportArgs
    reportArgsP :: Parser ReportArgs
reportArgsP = do
        Bool
reportArgsBrowse <- Parser Bool
browseP
        pure ReportArgs :: Bool -> ReportArgs
ReportArgs{..}

    browseP :: Parser Bool
    browseP :: Parser Bool
browseP = Mod FlagFields Bool -> Parser Bool
switch
        (Mod FlagFields Bool -> Parser Bool)
-> Mod FlagFields Bool -> Parser Bool
forall a b. (a -> b) -> a -> b
$  FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "browse"
        Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'b'
        Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
help "Open report in a browser"

outputSettingsP :: Parser OutputSettings
outputSettingsP :: Parser OutputSettings
outputSettingsP = do
    Verbosity
outputSettingsVerbosity <- Parser Verbosity
verbosityP
    ToggleSolution
outputSettingsSolutionVerbosity <- Parser ToggleSolution
toggleSolutionP
    pure $WOutputSettings :: Verbosity -> ToggleSolution -> OutputSettings
OutputSettings{..}

-- | The solution is shown by default and gets hidden when option is specified.
toggleSolutionP :: Parser ToggleSolution
toggleSolutionP :: Parser ToggleSolution
toggleSolutionP = ToggleSolution
-> ToggleSolution
-> Mod FlagFields ToggleSolution
-> Parser ToggleSolution
forall a. a -> a -> Mod FlagFields a -> Parser a
flag ToggleSolution
ShowSolution ToggleSolution
HideSolution (Mod FlagFields ToggleSolution -> Parser ToggleSolution)
-> Mod FlagFields ToggleSolution -> Parser ToggleSolution
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields ToggleSolution] -> Mod FlagFields ToggleSolution
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields ToggleSolution
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "hide-solution"
    , FilePath -> Mod FlagFields ToggleSolution
forall (f :: * -> *) a. FilePath -> Mod f a
help "Hide verbose solution information for observations"
    ]

-- | The 'Observation' is shown juicy by default and gets shortened when option is specified.
verbosityP :: Parser Verbosity
verbosityP :: Parser Verbosity
verbosityP = Verbosity
-> Verbosity -> Mod FlagFields Verbosity -> Parser Verbosity
forall a. a -> a -> Mod FlagFields a -> Parser a
flag Verbosity
Verbose Verbosity
NonVerbose (Mod FlagFields Verbosity -> Parser Verbosity)
-> Mod FlagFields Verbosity -> Parser Verbosity
forall a b. (a -> b) -> a -> b
$ [Mod FlagFields Verbosity] -> Mod FlagFields Verbosity
forall a. Monoid a => [a] -> a
mconcat
    [ FilePath -> Mod FlagFields Verbosity
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "short"
    , Char -> Mod FlagFields Verbosity
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 's'
    , FilePath -> Mod FlagFields Verbosity
forall (f :: * -> *) a. FilePath -> Mod f a
help "Hide verbose output information for observations"
    ]

data ConfigCommand
    = CheckCommand !Check
    | RemoveCommand !Scope
    | IgnoreCommand !(Id Observation)

partitionCommands :: [ConfigCommand] -> ([Check], [Scope], [Id Observation])
partitionCommands :: [ConfigCommand] -> ([Check], [Scope], [Id Observation])
partitionCommands [] = ([], [], [])
partitionCommands (cmd :: ConfigCommand
cmd : rest :: [ConfigCommand]
rest) =
    let (check :: [Check]
check, remove :: [Scope]
remove, obs :: [Id Observation]
obs) = [ConfigCommand] -> ([Check], [Scope], [Id Observation])
partitionCommands [ConfigCommand]
rest
    in case ConfigCommand
cmd of
        CheckCommand ch :: Check
ch -> (Check
chCheck -> [Check] -> [Check]
forall a. a -> [a] -> [a]
:[Check]
check, [Scope]
remove, [Id Observation]
obs)
        RemoveCommand r :: Scope
r -> ([Check]
check, Scope
rScope -> [Scope] -> [Scope]
forall a. a -> [a] -> [a]
:[Scope]
remove, [Id Observation]
obs)
        IgnoreCommand o :: Id Observation
o -> ([Check]
check, [Scope]
remove, Id Observation
oId Observation -> [Id Observation] -> [Id Observation]
forall a. a -> [a] -> [a]
:[Id Observation]
obs)

configP :: Parser PartialConfig
configP :: Parser PartialConfig
configP = do
    [ConfigCommand]
res <- Parser ConfigCommand -> Parser [ConfigCommand]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser ConfigCommand -> Parser [ConfigCommand])
-> Parser ConfigCommand -> Parser [ConfigCommand]
forall a b. (a -> b) -> a -> b
$
        FilePath
-> FilePath
-> (Check -> ConfigCommand)
-> Parser Check
-> Parser ConfigCommand
forall a.
FilePath
-> FilePath
-> (a -> ConfigCommand)
-> Parser a
-> Parser ConfigCommand
cmd "check" "Specify list of checks" Check -> ConfigCommand
CheckCommand Parser Check
checkP
        Parser ConfigCommand
-> Parser ConfigCommand -> Parser ConfigCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath
-> FilePath
-> (Scope -> ConfigCommand)
-> Parser Scope
-> Parser ConfigCommand
forall a.
FilePath
-> FilePath
-> (a -> ConfigCommand)
-> Parser a
-> Parser ConfigCommand
cmd "remove" "Specify scope to be removed" Scope -> ConfigCommand
RemoveCommand Parser Scope
scopeP
        Parser ConfigCommand
-> Parser ConfigCommand -> Parser ConfigCommand
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath
-> FilePath
-> (Id Observation -> ConfigCommand)
-> Parser (Id Observation)
-> Parser ConfigCommand
forall a.
FilePath
-> FilePath
-> (a -> ConfigCommand)
-> Parser a
-> Parser ConfigCommand
cmd "ignore" "Specify list of what needs to be ignored" Id Observation -> ConfigCommand
IgnoreCommand (FilePath -> Parser (Id Observation)
forall a. FilePath -> Parser (Id a)
idP "Observations")
    pure $
        let (checks :: [Check]
checks, removed :: [Scope]
removed, ignored :: [Id Observation]
ignored) = [ConfigCommand] -> ([Check], [Scope], [Id Observation])
partitionCommands [ConfigCommand]
res
        in $WConfigP :: forall (p :: Phase Text).
(p ::- [Check])
-> (p ::- [Scope]) -> (p ::- [Id Observation]) -> ConfigP p
ConfigP
            { configChecks :: 'Partial ::- [Check]
configChecks  = Text -> Text -> [Check] -> TaggedTrial Text [Check]
forall tag (f :: * -> *) a.
(IsString tag, Semigroup tag, Foldable f) =>
tag -> tag -> f a -> TaggedTrial tag (f a)
fiascoOnEmpty "CLI" "checks" [Check]
checks
            , configRemoved :: 'Partial ::- [Scope]
configRemoved = Text -> Text -> [Scope] -> TaggedTrial Text [Scope]
forall tag (f :: * -> *) a.
(IsString tag, Semigroup tag, Foldable f) =>
tag -> tag -> f a -> TaggedTrial tag (f a)
fiascoOnEmpty "CLI" "remove" [Scope]
removed
            , configIgnored :: 'Partial ::- [Id Observation]
configIgnored = Text
-> Text -> [Id Observation] -> TaggedTrial Text [Id Observation]
forall tag (f :: * -> *) a.
(IsString tag, Semigroup tag, Foldable f) =>
tag -> tag -> f a -> TaggedTrial tag (f a)
fiascoOnEmpty "CLI" "ignore" [Id Observation]
ignored
            }
  where
    cmd :: String -> String -> (a -> ConfigCommand) -> Parser a -> Parser ConfigCommand
    cmd :: FilePath
-> FilePath
-> (a -> ConfigCommand)
-> Parser a
-> Parser ConfigCommand
cmd name :: FilePath
name h :: FilePath
h cc :: a -> ConfigCommand
cc p :: Parser a
p = Mod CommandFields ConfigCommand -> Parser ConfigCommand
forall a. Mod CommandFields a -> Parser a
hsubparser
        ( FilePath
-> ParserInfo ConfigCommand -> Mod CommandFields ConfigCommand
forall a. FilePath -> ParserInfo a -> Mod CommandFields a
command FilePath
name
            (Parser ConfigCommand
-> InfoMod ConfigCommand -> ParserInfo ConfigCommand
forall a. Parser a -> InfoMod a -> ParserInfo a
info (a -> ConfigCommand
cc (a -> ConfigCommand) -> Parser a -> Parser ConfigCommand
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p) (FilePath -> InfoMod ConfigCommand
forall a. FilePath -> InfoMod a
progDesc FilePath
h))
        Mod CommandFields ConfigCommand
-> Mod CommandFields ConfigCommand
-> Mod CommandFields ConfigCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod CommandFields ConfigCommand
forall a. FilePath -> Mod CommandFields a
commandVar ((Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper FilePath
name)
        Mod CommandFields ConfigCommand
-> Mod CommandFields ConfigCommand
-> Mod CommandFields ConfigCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod CommandFields ConfigCommand
forall (f :: * -> *) a. FilePath -> Mod f a
help ("Command to " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath
h)
        Mod CommandFields ConfigCommand
-> Mod CommandFields ConfigCommand
-> Mod CommandFields ConfigCommand
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod CommandFields ConfigCommand
forall a. FilePath -> Mod CommandFields a
commandGroup "CLI Configurations"
        )

-- | Parser of an 'Id'. Receives a string to specify in Help what kind of ID is this.
idP :: String -> Parser (Id a)
idP :: FilePath -> Parser (Id a)
idP name :: FilePath
name = Text -> Id a
forall a. Text -> Id a
Id (Text -> Id a) -> Parser Text -> Parser (Id a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
    (FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "id"
    Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar ((Char -> Char) -> FilePath -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
toUpper FilePath
name FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> "_ID")
    Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help (FilePath
name FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> " ID to be used"))

checkP :: Parser Check
checkP :: Parser Check
checkP = do
    CheckType
checkType <- Parser CheckType
checkTypeP
    CheckFilter
checkFilter <- Parser CheckFilter
checkFilterP
    Scope
checkScope  <- Parser Scope
scopeP
    pure $WCheck :: CheckType -> CheckFilter -> Scope -> Check
Check{..}

checkTypeP :: Parser CheckType
checkTypeP :: Parser CheckType
checkTypeP =
    -- QUESTION: is it better than --type=Exclude or --type=Include
        CheckType -> Mod FlagFields CheckType -> Parser CheckType
forall a. a -> Mod FlagFields a -> Parser a
flag' CheckType
Include (FilePath -> Mod FlagFields CheckType
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "include" Mod FlagFields CheckType
-> Mod FlagFields CheckType -> Mod FlagFields CheckType
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields CheckType
forall (f :: * -> *) a. FilePath -> Mod f a
help "Include check")
    Parser CheckType -> Parser CheckType -> Parser CheckType
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CheckType -> Mod FlagFields CheckType -> Parser CheckType
forall a. a -> Mod FlagFields a -> Parser a
flag' CheckType
Exclude (FilePath -> Mod FlagFields CheckType
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "exclude" Mod FlagFields CheckType
-> Mod FlagFields CheckType -> Mod FlagFields CheckType
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields CheckType
forall (f :: * -> *) a. FilePath -> Mod f a
help "Exclude check")

checkFilterP :: Parser CheckFilter
checkFilterP :: Parser CheckFilter
checkFilterP =
        Id Inspection -> CheckFilter
CheckInspection (Id Inspection -> CheckFilter)
-> Parser (Id Inspection) -> Parser CheckFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> Parser (Id Inspection)
forall a. FilePath -> Parser (Id a)
idP "Inspection"
    Parser CheckFilter -> Parser CheckFilter -> Parser CheckFilter
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Severity -> CheckFilter
CheckSeverity (Severity -> CheckFilter) -> Parser Severity -> Parser CheckFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadM Severity -> Mod OptionFields Severity -> Parser Severity
forall a. ReadM a -> Mod OptionFields a -> Parser a
option ReadM Severity
forall a. Read a => ReadM a
auto
        -- TODO: how to specify all possible values here in help?
        (FilePath -> Mod OptionFields Severity
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "severity"
        Mod OptionFields Severity
-> Mod OptionFields Severity -> Mod OptionFields Severity
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Severity
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "SEVERITY"
        Mod OptionFields Severity
-> Mod OptionFields Severity -> Mod OptionFields Severity
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Severity
forall (f :: * -> *) a. FilePath -> Mod f a
help "Inspection Severity to exclude or include")
    Parser CheckFilter -> Parser CheckFilter -> Parser CheckFilter
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Category -> CheckFilter
CheckCategory (Category -> CheckFilter)
-> (Text -> Category) -> Text -> CheckFilter
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Category
Category (Text -> CheckFilter) -> Parser Text -> Parser CheckFilter
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields Text -> Parser Text
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "category"
        Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "CATEGORY"
        Mod OptionFields Text
-> Mod OptionFields Text -> Mod OptionFields Text
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields Text
forall (f :: * -> *) a. FilePath -> Mod f a
help "Inspection Category to exclude or include")
    Parser CheckFilter -> Parser CheckFilter -> Parser CheckFilter
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> CheckFilter -> Mod FlagFields CheckFilter -> Parser CheckFilter
forall a. a -> Mod FlagFields a -> Parser a
flag' CheckFilter
CheckAll
        (FilePath -> Mod FlagFields CheckFilter
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "filter-all"
        Mod FlagFields CheckFilter
-> Mod FlagFields CheckFilter -> Mod FlagFields CheckFilter
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields CheckFilter
forall (f :: * -> *) a. FilePath -> Mod f a
help "Exclude or include ALL inspections")

scopeP :: Parser Scope
scopeP :: Parser Scope
scopeP =
        FilePath -> Scope
ScopeFile (FilePath -> Scope) -> Parser FilePath -> Parser Scope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "file"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "FILE_PATH"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help "File to exclude or include")
    Parser Scope -> Parser Scope -> Parser Scope
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> FilePath -> Scope
ScopeDirectory (FilePath -> Scope) -> Parser FilePath -> Parser Scope
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Mod OptionFields FilePath -> Parser FilePath
forall s. IsString s => Mod OptionFields s -> Parser s
strOption
        (FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "directory"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar "DIRECTORY_PATH"
        Mod OptionFields FilePath
-> Mod OptionFields FilePath -> Mod OptionFields FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
help "Directory to exclude or include")
    Parser Scope -> Parser Scope -> Parser Scope
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Scope -> Mod FlagFields Scope -> Parser Scope
forall a. a -> Mod FlagFields a -> Parser a
flag' Scope
ScopeAll
        (FilePath -> Mod FlagFields Scope
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "scope-all"
        Mod FlagFields Scope
-> Mod FlagFields Scope -> Mod FlagFields Scope
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod FlagFields Scope
forall (f :: * -> *) a. FilePath -> Mod f a
help "Apply check to all files")

-- | Show the version of the tool.
versionP :: Parser (a -> a)
versionP :: Parser (a -> a)
versionP = FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
infoOption (StanVersion -> StanSystem -> FilePath
prettyStanVersion StanVersion
stanVersion StanSystem
stanSystem)
    (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$  FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
long "version"
    Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
short 'v'
    Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. FilePath -> Mod f a
help "Show Stan's version"
    Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<> Mod OptionFields (a -> a)
forall (f :: * -> *) a. Mod f a
hidden

-- to put custom header which doesn't cut all spaces
modifyHeader :: ParserInfo a -> ParserInfo a
modifyHeader :: ParserInfo a -> ParserInfo a
modifyHeader p :: ParserInfo a
p = ParserInfo a
p { infoHeader :: Chunk Doc
infoHeader = FilePath -> Chunk Doc
stringChunk (FilePath -> Chunk Doc) -> FilePath -> Chunk Doc
forall a b. (a -> b) -> a -> b
$ Text -> FilePath
forall a. ToString a => a -> FilePath
toString Text
header }

header :: Text
header :: Text
header = [Text] -> Text
forall t. IsText t "unlines" => [t] -> t
unlines
    [ Text
forall str. IsString str => str
yellow
    , "     ______________    _   __"
    , "    / ___/_  __/   |  / | / /"
    , "    \\__ \\ / / / /| | /  |/ / "
    , "   ___/ // / / ___ |/ /|  /  "
    , "  /____//_/ /_/  |_/_/ |_/   "
    , Text
forall str. IsString str => str
reset
    , "  Haskell " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b "ST" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "atic " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall str. (IsString str, Semigroup str) => str -> str
b "AN" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "alyser"
    ]

commandVar :: String -> Mod CommandFields a
commandVar :: FilePath -> Mod CommandFields a
commandVar = FilePath -> Mod CommandFields a
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
metavar (FilePath -> Mod CommandFields a)
-> (FilePath -> FilePath) -> FilePath -> Mod CommandFields a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall str. (IsString str, Semigroup str) => str -> str
b