-- | CLI parsing for FileLoggingArgs
module Shrun.Configuration.Args.Parsing.FileLogging
  ( fileLoggingParser,
  )
where

import Options.Applicative (Parser)
import Options.Applicative qualified as OA
import Shrun.Configuration.Args.Parsing.Utils qualified as Utils
import Shrun.Configuration.Data.FileLogging
  ( FileLogInitP
      ( MkFileLogInitP,
        mode,
        path,
        sizeMode
      ),
    FileLoggingArgs,
    FileLoggingP
      ( MkFileLoggingP,
        commandNameTrunc,
        deleteOnSuccess,
        file,
        lineTrunc,
        stripControl
      ),
  )
import Shrun.Configuration.Data.FileLogging.FileMode (FileMode)
import Shrun.Configuration.Data.FileLogging.FileMode qualified as FileMode
import Shrun.Configuration.Data.FileLogging.FilePathDefault (FilePathDefault)
import Shrun.Configuration.Data.FileLogging.FilePathDefault qualified as FilePathDefault
import Shrun.Configuration.Data.FileLogging.FileSizeMode (FileSizeMode)
import Shrun.Configuration.Data.FileLogging.FileSizeMode qualified as FileSizeMode
import Shrun.Configuration.Data.StripControl (FileLogStripControl)
import Shrun.Configuration.Data.StripControl qualified as StripControl
import Shrun.Configuration.Data.Truncation
  ( LineTruncation,
    TruncRegion (TruncCommandName),
    Truncation,
  )
import Shrun.Configuration.Data.Truncation qualified as Trunc
import Shrun.Configuration.Data.WithDisabled (WithDisabled)
import Shrun.Prelude

fileLoggingParser :: Parser FileLoggingArgs
fileLoggingParser :: Parser FileLoggingArgs
fileLoggingParser = do
  WithDisabled FilePathDefault
path <- Parser (WithDisabled FilePathDefault)
fileLogParser
  WithDisabled (Truncation 'TruncCommandName)
commandNameTrunc <- Parser (WithDisabled (Truncation 'TruncCommandName))
fileLogCommandNameTruncParser
  WithDisabled ()
deleteOnSuccess <- Parser (WithDisabled ())
deleteOnSuccessParser
  WithDisabled LineTruncation
lineTrunc <- Parser (WithDisabled LineTruncation)
lineTruncParser
  WithDisabled FileMode
mode <- Parser (WithDisabled FileMode)
fileLogModeParser
  WithDisabled FileSizeMode
sizeMode <- Parser (WithDisabled FileSizeMode)
fileLogSizeModeParser
  WithDisabled (StripControl 'StripControlFileLog)
stripControl <- Parser (WithDisabled (StripControl 'StripControlFileLog))
fileLogStripControlParser

  pure
    $ MkFileLoggingP
      { file :: FileLogFileF 'ConfigPhaseArgs
file =
          MkFileLogInitP
            { WithDisabled FileMode
ConfigPhaseF 'ConfigPhaseArgs FileMode
mode :: ConfigPhaseF 'ConfigPhaseArgs FileMode
mode :: WithDisabled FileMode
mode,
              WithDisabled FilePathDefault
FileLogPathF 'ConfigPhaseArgs
path :: FileLogPathF 'ConfigPhaseArgs
path :: WithDisabled FilePathDefault
path,
              WithDisabled FileSizeMode
ConfigPhaseF 'ConfigPhaseArgs FileSizeMode
sizeMode :: ConfigPhaseF 'ConfigPhaseArgs FileSizeMode
sizeMode :: WithDisabled FileSizeMode
sizeMode
            },
        WithDisabled (Truncation 'TruncCommandName)
ConfigPhaseMaybeF 'ConfigPhaseArgs (Truncation 'TruncCommandName)
commandNameTrunc :: ConfigPhaseMaybeF 'ConfigPhaseArgs (Truncation 'TruncCommandName)
commandNameTrunc :: WithDisabled (Truncation 'TruncCommandName)
commandNameTrunc,
        WithDisabled ()
SwitchF 'ConfigPhaseArgs DeleteOnSuccessSwitch
deleteOnSuccess :: SwitchF 'ConfigPhaseArgs DeleteOnSuccessSwitch
deleteOnSuccess :: WithDisabled ()
deleteOnSuccess,
        WithDisabled LineTruncation
LineTruncF 'ConfigPhaseArgs
lineTrunc :: LineTruncF 'ConfigPhaseArgs
lineTrunc :: WithDisabled LineTruncation
lineTrunc,
        WithDisabled (StripControl 'StripControlFileLog)
ConfigPhaseF 'ConfigPhaseArgs (StripControl 'StripControlFileLog)
stripControl :: ConfigPhaseF 'ConfigPhaseArgs (StripControl 'StripControlFileLog)
stripControl :: WithDisabled (StripControl 'StripControlFileLog)
stripControl
      }

fileLogParser :: Parser (WithDisabled FilePathDefault)
fileLogParser :: Parser (WithDisabled FilePathDefault)
fileLogParser = Parser (Maybe FilePathDefault)
-> String -> Parser (WithDisabled FilePathDefault)
forall a. Parser (Maybe a) -> String -> Parser (WithDisabled a)
Utils.withDisabledParser Parser (Maybe FilePathDefault)
mainParser String
"file-log"
  where
    mainParser :: Parser (Maybe FilePathDefault)
mainParser =
      Parser FilePathDefault -> Parser (Maybe FilePathDefault)
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
OA.optional
        (Parser FilePathDefault -> Parser (Maybe FilePathDefault))
-> Parser FilePathDefault -> Parser (Maybe FilePathDefault)
forall a b. (a -> b) -> a -> b
$ ReadM FilePathDefault
-> Mod OptionFields FilePathDefault -> Parser FilePathDefault
forall a. ReadM a -> Mod OptionFields a -> Parser a
OA.option
          (ReadM Text -> ReadM FilePathDefault
forall (m :: Type -> Type).
MonadFail m =>
m Text -> m FilePathDefault
FilePathDefault.parseFilePathDefault ReadM Text
forall s. IsString s => ReadM s
OA.str)
          ( [Mod OptionFields FilePathDefault]
-> Mod OptionFields FilePathDefault
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields FilePathDefault
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"file-log",
                Char -> Mod OptionFields FilePathDefault
forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
OA.short Char
'f',
                String -> Mod OptionFields FilePathDefault
forall (f :: Type -> Type) a. String -> Mod f a
Utils.mkHelp String
helpTxt,
                String -> Mod OptionFields FilePathDefault
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
OA.metavar String
"(default | PATH)"
              ]
          )
    helpTxt :: String
helpTxt =
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"If a path is supplied, all logs will additionally be written to ",
          String
"the supplied file. Furthermore, command logs will be written to ",
          String
"the file irrespective of --console-log-command. Console logging is ",
          String
"unaffected. This can be useful for investigating command failures. ",
          String
"If the string 'default' is given, then we write to the XDG state ",
          String
"directory e.g. ~/.local/state/shrun/shrun.log."
        ]

fileLogCommandNameTruncParser :: Parser (WithDisabled (Truncation TruncCommandName))
fileLogCommandNameTruncParser :: Parser (WithDisabled (Truncation 'TruncCommandName))
fileLogCommandNameTruncParser =
  Parser (Maybe (Truncation 'TruncCommandName))
-> String -> Parser (WithDisabled (Truncation 'TruncCommandName))
forall a. Parser (Maybe a) -> String -> Parser (WithDisabled a)
Utils.withDisabledParser Parser (Maybe (Truncation 'TruncCommandName))
mainParser String
"file-log-command-name-trunc"
  where
    mainParser :: Parser (Maybe (Truncation 'TruncCommandName))
mainParser =
      Parser (Truncation 'TruncCommandName)
-> Parser (Maybe (Truncation 'TruncCommandName))
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
OA.optional
        (Parser (Truncation 'TruncCommandName)
 -> Parser (Maybe (Truncation 'TruncCommandName)))
-> Parser (Truncation 'TruncCommandName)
-> Parser (Maybe (Truncation 'TruncCommandName))
forall a b. (a -> b) -> a -> b
$ ReadM (Truncation 'TruncCommandName)
-> Mod OptionFields (Truncation 'TruncCommandName)
-> Parser (Truncation 'TruncCommandName)
forall a. ReadM a -> Mod OptionFields a -> Parser a
OA.option
          (ReadM Natural -> ReadM (Truncation 'TruncCommandName)
forall (m :: Type -> Type) (r :: TruncRegion).
MonadFail m =>
m Natural -> m (Truncation r)
Trunc.parseTruncation ReadM Natural
forall a. Read a => ReadM a
Utils.autoStripUnderscores)
          ( [Mod OptionFields (Truncation 'TruncCommandName)]
-> Mod OptionFields (Truncation 'TruncCommandName)
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields (Truncation 'TruncCommandName)
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"file-log-command-name-trunc",
                String -> Mod OptionFields (Truncation 'TruncCommandName)
forall (f :: Type -> Type) a. String -> Mod f a
Utils.mkHelp String
helpTxt,
                String -> Mod OptionFields (Truncation 'TruncCommandName)
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
OA.metavar String
"NATURAL"
              ]
          )
    helpTxt :: String
helpTxt = String
"Like --console-log-command-name-trunc, but for --file-logs."

deleteOnSuccessParser :: Parser (WithDisabled ())
deleteOnSuccessParser :: Parser (WithDisabled ())
deleteOnSuccessParser = Parser (Maybe ()) -> String -> Parser (WithDisabled ())
forall a. Parser (Maybe a) -> String -> Parser (WithDisabled a)
Utils.withDisabledParser Parser (Maybe ())
mainParser String
"file-log-delete-on-success"
  where
    switchParser :: Parser Bool
switchParser =
      Mod FlagFields Bool -> Parser Bool
OA.switch
        ( [Mod FlagFields Bool] -> Mod FlagFields Bool
forall a. Monoid a => [a] -> a
mconcat
            [ String -> Mod FlagFields Bool
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"file-log-delete-on-success",
              String -> Mod FlagFields Bool
forall (f :: Type -> Type) a. String -> Mod f a
Utils.mkHelp String
helpTxt
            ]
        )
    mainParser :: Parser (Maybe ())
mainParser = do
      Bool
b <- Parser Bool
switchParser
      pure
        $ if Bool
b
          then () -> Maybe ()
forall a. a -> Maybe a
Just ()
          else Maybe ()
forall a. Maybe a
Nothing
    helpTxt :: String
helpTxt =
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"If --file-log is active, deletes the file on a successful exit. ",
          String
"Does not delete the file if shrun exited via failure."
        ]

lineTruncParser :: Parser (WithDisabled LineTruncation)
lineTruncParser :: Parser (WithDisabled LineTruncation)
lineTruncParser = Parser (Maybe LineTruncation)
-> String -> Parser (WithDisabled LineTruncation)
forall a. Parser (Maybe a) -> String -> Parser (WithDisabled a)
Utils.withDisabledParser Parser (Maybe LineTruncation)
mainParser String
"file-log-line-trunc"
  where
    mainParser :: Parser (Maybe LineTruncation)
mainParser =
      Parser LineTruncation -> Parser (Maybe LineTruncation)
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
OA.optional
        (Parser LineTruncation -> Parser (Maybe LineTruncation))
-> Parser LineTruncation -> Parser (Maybe LineTruncation)
forall a b. (a -> b) -> a -> b
$ ReadM LineTruncation
-> Mod OptionFields LineTruncation -> Parser LineTruncation
forall a. ReadM a -> Mod OptionFields a -> Parser a
OA.option
          (ReadM Natural -> ReadM Text -> ReadM LineTruncation
forall (m :: Type -> Type).
(Alternative m, MonadFail m) =>
m Natural -> m Text -> m LineTruncation
Trunc.parseLineTruncation ReadM Natural
forall a. Read a => ReadM a
Utils.autoStripUnderscores ReadM Text
forall s. IsString s => ReadM s
OA.str)
          ( [Mod OptionFields LineTruncation]
-> Mod OptionFields LineTruncation
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields LineTruncation
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"file-log-line-trunc",
                String -> Mod OptionFields LineTruncation
forall (f :: Type -> Type) a. String -> Mod f a
Utils.mkHelp String
helpTxt,
                String -> Mod OptionFields LineTruncation
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
OA.metavar String
"(NATURAL | detect)"
              ]
          )
    helpTxt :: String
helpTxt = String
"Like --console-log-line-trunc, but for --file-log."

fileLogStripControlParser :: Parser (WithDisabled FileLogStripControl)
fileLogStripControlParser :: Parser (WithDisabled (StripControl 'StripControlFileLog))
fileLogStripControlParser =
  Parser (Maybe (StripControl 'StripControlFileLog))
-> String
-> Parser (WithDisabled (StripControl 'StripControlFileLog))
forall a. Parser (Maybe a) -> String -> Parser (WithDisabled a)
Utils.withDisabledParser Parser (Maybe (StripControl 'StripControlFileLog))
mainParser String
"file-log-strip-control"
  where
    mainParser :: Parser (Maybe (StripControl 'StripControlFileLog))
mainParser =
      Parser (StripControl 'StripControlFileLog)
-> Parser (Maybe (StripControl 'StripControlFileLog))
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
OA.optional
        (Parser (StripControl 'StripControlFileLog)
 -> Parser (Maybe (StripControl 'StripControlFileLog)))
-> Parser (StripControl 'StripControlFileLog)
-> Parser (Maybe (StripControl 'StripControlFileLog))
forall a b. (a -> b) -> a -> b
$ ReadM (StripControl 'StripControlFileLog)
-> Mod OptionFields (StripControl 'StripControlFileLog)
-> Parser (StripControl 'StripControlFileLog)
forall a. ReadM a -> Mod OptionFields a -> Parser a
OA.option
          (ReadM Text -> ReadM (StripControl 'StripControlFileLog)
forall (m :: Type -> Type) (t :: StripControlType).
MonadFail m =>
m Text -> m (StripControl t)
StripControl.parseStripControl ReadM Text
forall s. IsString s => ReadM s
OA.str)
          ( [Mod OptionFields (StripControl 'StripControlFileLog)]
-> Mod OptionFields (StripControl 'StripControlFileLog)
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields (StripControl 'StripControlFileLog)
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"file-log-strip-control",
                String -> Mod OptionFields (StripControl 'StripControlFileLog)
forall (f :: Type -> Type) a. String -> Mod f a
Utils.mkHelp String
helpTxt,
                String -> Mod OptionFields (StripControl 'StripControlFileLog)
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
OA.metavar String
"(all | smart | none)"
              ]
          )
    helpTxt :: String
helpTxt =
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"--console-log-strip-control for file logs created with --file-log. ",
          String
"Defaults to all."
        ]

fileLogModeParser :: Parser (WithDisabled FileMode)
fileLogModeParser :: Parser (WithDisabled FileMode)
fileLogModeParser = Parser (Maybe FileMode) -> String -> Parser (WithDisabled FileMode)
forall a. Parser (Maybe a) -> String -> Parser (WithDisabled a)
Utils.withDisabledParser Parser (Maybe FileMode)
mainParser String
"file-log-mode"
  where
    mainParser :: Parser (Maybe FileMode)
mainParser =
      Parser FileMode -> Parser (Maybe FileMode)
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
OA.optional
        (Parser FileMode -> Parser (Maybe FileMode))
-> Parser FileMode -> Parser (Maybe FileMode)
forall a b. (a -> b) -> a -> b
$ ReadM FileMode -> Mod OptionFields FileMode -> Parser FileMode
forall a. ReadM a -> Mod OptionFields a -> Parser a
OA.option
          (ReadM Text -> ReadM FileMode
forall (m :: Type -> Type). MonadFail m => m Text -> m FileMode
FileMode.parseFileMode ReadM Text
forall s. IsString s => ReadM s
OA.str)
          ( [Mod OptionFields FileMode] -> Mod OptionFields FileMode
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields FileMode
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"file-log-mode",
                String -> Mod OptionFields FileMode
forall (f :: Type -> Type) a. String -> Mod f a
Utils.mkHelp String
helpTxt,
                String -> Mod OptionFields FileMode
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
OA.metavar String
"(append | write)"
              ]
          )
    helpTxt :: String
helpTxt = String
"Mode in which to open the log file. Defaults to write."

fileLogSizeModeParser :: Parser (WithDisabled FileSizeMode)
fileLogSizeModeParser :: Parser (WithDisabled FileSizeMode)
fileLogSizeModeParser = Parser (Maybe FileSizeMode)
-> String -> Parser (WithDisabled FileSizeMode)
forall a. Parser (Maybe a) -> String -> Parser (WithDisabled a)
Utils.withDisabledParser Parser (Maybe FileSizeMode)
mainParser String
"file-log-size-mode"
  where
    mainParser :: Parser (Maybe FileSizeMode)
mainParser =
      Parser FileSizeMode -> Parser (Maybe FileSizeMode)
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
OA.optional
        (Parser FileSizeMode -> Parser (Maybe FileSizeMode))
-> Parser FileSizeMode -> Parser (Maybe FileSizeMode)
forall a b. (a -> b) -> a -> b
$ ReadM FileSizeMode
-> Mod OptionFields FileSizeMode -> Parser FileSizeMode
forall a. ReadM a -> Mod OptionFields a -> Parser a
OA.option
          (ReadM Text -> ReadM FileSizeMode
forall (m :: Type -> Type). MonadFail m => m Text -> m FileSizeMode
FileSizeMode.parseFileSizeMode ReadM Text
forall s. IsString s => ReadM s
OA.str)
          ( [Mod OptionFields FileSizeMode] -> Mod OptionFields FileSizeMode
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields FileSizeMode
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"file-log-size-mode",
                String -> Mod OptionFields FileSizeMode
forall (f :: Type -> Type) a. String -> Mod f a
Utils.mkHelp String
helpTxt,
                String -> Mod OptionFields FileSizeMode
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
OA.metavar String
FileSizeMode.expectedStr
              ]
          )
    helpTxt :: String
helpTxt =
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
"Sets a threshold for the file log size, upon which we either ",
          String
"print a warning or delete the file, if it is exceeded. ",
          String
"The BYTES should include the value and units e.g. ",
          String
"warn 10 mb, warn 5 gigabytes, delete 20.5B. Defaults to warning ",
          String
"at 50 mb."
        ]