{-# LANGUAGE OverloadedLists #-}

-- | CLI parsing for ConsoleLoggingArgs
module Shrun.Configuration.Args.Parsing.ConsoleLogging
  ( consoleLoggingParser,
  )
where

import Options.Applicative (Parser)
import Options.Applicative qualified as OA
import Shrun.Configuration.Args.Parsing.Utils qualified as Utils
import Shrun.Configuration.Data.ConsoleLogging
  ( ConsoleLogCmdSwitch (MkConsoleLogCmdSwitch),
    ConsoleLoggingArgs,
    ConsoleLoggingP
      ( MkConsoleLoggingP,
        commandLogging,
        commandNameTrunc,
        lineTrunc,
        stripControl,
        timerFormat
      ),
  )
import Shrun.Configuration.Data.ConsoleLogging.TimerFormat (TimerFormat)
import Shrun.Configuration.Data.ConsoleLogging.TimerFormat qualified as TimerFormat
import Shrun.Configuration.Data.StripControl (ConsoleLogStripControl)
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
import Shrun.Utils qualified as SUtils

consoleLoggingParser :: Parser ConsoleLoggingArgs
consoleLoggingParser :: Parser ConsoleLoggingArgs
consoleLoggingParser = do
  Maybe ConsoleLogCmdSwitch
commandLogging <- Parser (Maybe ConsoleLogCmdSwitch)
commandLoggingParser
  Maybe (WithDisabled (Truncation 'TruncCommandName))
commandNameTrunc <- Parser (Maybe (WithDisabled (Truncation 'TruncCommandName)))
commandNameTruncParser
  Maybe (WithDisabled LineTruncation)
lineTrunc <- Parser (Maybe (WithDisabled LineTruncation))
lineTruncParser
  Maybe (StripControl 'StripControlConsoleLog)
stripControl <- Parser (Maybe (StripControl 'StripControlConsoleLog))
stripControlParser
  Maybe TimerFormat
timerFormat <- Parser (Maybe TimerFormat)
timerFormatParser

  pure
    $ MkConsoleLoggingP
      { Maybe ConsoleLogCmdSwitch
SwitchF 'ConfigPhaseArgs ConsoleLogCmdSwitch
commandLogging :: SwitchF 'ConfigPhaseArgs ConsoleLogCmdSwitch
commandLogging :: Maybe ConsoleLogCmdSwitch
commandLogging,
        Maybe (WithDisabled (Truncation 'TruncCommandName))
ConfigPhaseDisabledMaybeF
  'ConfigPhaseArgs (Truncation 'TruncCommandName)
commandNameTrunc :: ConfigPhaseDisabledMaybeF
  'ConfigPhaseArgs (Truncation 'TruncCommandName)
commandNameTrunc :: Maybe (WithDisabled (Truncation 'TruncCommandName))
commandNameTrunc,
        Maybe (WithDisabled LineTruncation)
LineTruncF 'ConfigPhaseArgs
lineTrunc :: LineTruncF 'ConfigPhaseArgs
lineTrunc :: Maybe (WithDisabled LineTruncation)
lineTrunc,
        Maybe (StripControl 'StripControlConsoleLog)
ConfigPhaseF
  'ConfigPhaseArgs (StripControl 'StripControlConsoleLog)
stripControl :: ConfigPhaseF
  'ConfigPhaseArgs (StripControl 'StripControlConsoleLog)
stripControl :: Maybe (StripControl 'StripControlConsoleLog)
stripControl,
        Maybe TimerFormat
ConfigPhaseF 'ConfigPhaseArgs TimerFormat
timerFormat :: ConfigPhaseF 'ConfigPhaseArgs TimerFormat
timerFormat :: Maybe TimerFormat
timerFormat
      }

commandLoggingParser :: Parser (Maybe ConsoleLogCmdSwitch)
commandLoggingParser :: Parser (Maybe ConsoleLogCmdSwitch)
commandLoggingParser = (Bool -> ConsoleLogCmdSwitch)
-> String -> String -> Parser (Maybe ConsoleLogCmdSwitch)
forall a. (Bool -> a) -> String -> String -> Parser (Maybe a)
Utils.switchParser Bool -> ConsoleLogCmdSwitch
MkConsoleLogCmdSwitch String
"console-log-command" String
helpTxt
  where
    helpTxt :: String
helpTxt =
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
Item [String]
"This flag gives each command a console region in which its 'command' ",
          String
Item [String]
"logs will be printed, as opposed to swallowing command logs. Only the ",
          String
Item [String]
"latest log per region is shown at a given time. Defaults to 'on'."
        ]

commandNameTruncParser :: Parser (Maybe (WithDisabled (Truncation TruncCommandName)))
commandNameTruncParser :: Parser (Maybe (WithDisabled (Truncation 'TruncCommandName)))
commandNameTruncParser =
  ReadM (Truncation 'TruncCommandName)
-> [Mod OptionFields (WithDisabled (Truncation 'TruncCommandName))]
-> (Bool, [String])
-> Parser (Maybe (WithDisabled (Truncation 'TruncCommandName)))
forall a.
ReadM a
-> [Mod OptionFields (WithDisabled a)]
-> (Bool, [String])
-> Parser (Maybe (WithDisabled a))
Utils.mWithDisabledParser
    (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 (WithDisabled (Truncation 'TruncCommandName))]
opts
    (Bool
True, [String
Item [String]
"NATURAL"])
  where
    opts :: [Mod OptionFields (WithDisabled (Truncation 'TruncCommandName))]
opts =
      [ String
-> Mod OptionFields (WithDisabled (Truncation 'TruncCommandName))
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"console-log-command-name-trunc",
        String
-> Mod OptionFields (WithDisabled (Truncation 'TruncCommandName))
forall (f :: Type -> Type) a. String -> Mod f a
Utils.mkHelp String
helpTxt
      ]
    helpTxt :: String
helpTxt =
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
Item [String]
"Non-negative integer that limits the length of commands/key-names ",
          String
Item [String]
"in the console logs. Defaults to no truncation."
        ]

lineTruncParser :: Parser (Maybe (WithDisabled LineTruncation))
lineTruncParser :: Parser (Maybe (WithDisabled LineTruncation))
lineTruncParser =
  ReadM LineTruncation
-> [Mod OptionFields (WithDisabled LineTruncation)]
-> (Bool, [String])
-> Parser (Maybe (WithDisabled LineTruncation))
forall a.
ReadM a
-> [Mod OptionFields (WithDisabled a)]
-> (Bool, [String])
-> Parser (Maybe (WithDisabled a))
Utils.mWithDisabledParser
    (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 (WithDisabled LineTruncation)]
opts
    (Bool, [String])
forall a. IsString a => (Bool, [a])
Trunc.lineTruncMeta
  where
    opts :: [Mod OptionFields (WithDisabled LineTruncation)]
opts =
      [ String -> Mod OptionFields (WithDisabled LineTruncation)
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"console-log-line-trunc",
        [String] -> Mod OptionFields (WithDisabled LineTruncation)
forall (f :: Type -> Type) a. HasCompleter f => [String] -> Mod f a
OA.completeWith [String
Item [String]
"detect"],
        String -> Mod OptionFields (WithDisabled LineTruncation)
forall (f :: Type -> Type) a. String -> Mod f a
Utils.mkHelp String
helpTxt
      ]
    helpTxt :: String
helpTxt =
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
Item [String]
"Non-negative integer that limits the length of console logs. Can ",
          String
Item [String]
"also be the string literal 'detect', to detect the terminal size ",
          String
Item [String]
"automatically. Defaults to 'detect' if --console-log-command is on. ",
          String
Item [String]
"Note that \"log prefixes\" (e.g. labels like [Success], timestamps) ",
          String
Item [String]
"are counted towards the total length but are never truncated."
        ]

stripControlParser :: Parser (Maybe ConsoleLogStripControl)
stripControlParser :: Parser (Maybe (StripControl 'StripControlConsoleLog))
stripControlParser = Parser (Maybe (StripControl 'StripControlConsoleLog))
mainParser
  where
    mainParser :: Parser (Maybe (StripControl 'StripControlConsoleLog))
mainParser =
      Parser (StripControl 'StripControlConsoleLog)
-> Parser (Maybe (StripControl 'StripControlConsoleLog))
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
OA.optional
        (Parser (StripControl 'StripControlConsoleLog)
 -> Parser (Maybe (StripControl 'StripControlConsoleLog)))
-> Parser (StripControl 'StripControlConsoleLog)
-> Parser (Maybe (StripControl 'StripControlConsoleLog))
forall a b. (a -> b) -> a -> b
$ ReadM (StripControl 'StripControlConsoleLog)
-> Mod OptionFields (StripControl 'StripControlConsoleLog)
-> Parser (StripControl 'StripControlConsoleLog)
forall a. ReadM a -> Mod OptionFields a -> Parser a
OA.option
          (ReadM Text -> ReadM (StripControl 'StripControlConsoleLog)
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 'StripControlConsoleLog)]
-> Mod OptionFields (StripControl 'StripControlConsoleLog)
forall a. Monoid a => [a] -> a
mconcat
              [ String -> Mod OptionFields (StripControl 'StripControlConsoleLog)
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"console-log-strip-control",
                [String] -> Mod OptionFields (StripControl 'StripControlConsoleLog)
forall (f :: Type -> Type) a. HasCompleter f => [String] -> Mod f a
OA.completeWith [String
Item [String]
"all", String
Item [String]
"smart", String
Item [String]
"off"],
                Item [Mod OptionFields (StripControl 'StripControlConsoleLog)]
Mod OptionFields (StripControl 'StripControlConsoleLog)
helpTxt,
                String -> Mod OptionFields (StripControl 'StripControlConsoleLog)
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
OA.metavar ((Bool, [String]) -> String
forall a. (IsString a, Monoid a) => (Bool, [a]) -> a
SUtils.mkMetaStr (Bool, [String])
forall a. IsString a => (Bool, [a])
StripControl.stripControlMeta)
              ]
          )

    helpTxt :: Mod OptionFields (StripControl 'StripControlConsoleLog)
helpTxt =
      NESeq String
-> Mod OptionFields (StripControl 'StripControlConsoleLog)
forall a. NESeq String -> Mod OptionFields a
Utils.itemize
        (NESeq String
 -> Mod OptionFields (StripControl 'StripControlConsoleLog))
-> NESeq String
-> Mod OptionFields (StripControl 'StripControlConsoleLog)
forall a b. (a -> b) -> a -> b
$ String
intro
        String -> Seq String -> NESeq String
forall a. a -> Seq a -> NESeq a
:<|| [ String
Item (Seq String)
hall,
               String
Item (Seq String)
hsmart
             ]

    intro :: String
intro =
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
Item [String]
"Control characters can wreak layout havoc, hence this option for ",
          String
Item [String]
"stripping such characters."
        ]

    hall :: String
hall = String
"all: Strips all such chars."
    hsmart :: String
hsmart =
      [String] -> String
forall a. Monoid a => [a] -> a
mconcat
        [ String
Item [String]
"smart: The default. Attempts to strip only the control chars that ",
          String
Item [String]
"affect layout (e.g. cursor movements) and leaves others unaffected ",
          String
Item [String]
"(e.g. colors). This has the potential to be the 'prettiest' though ",
          String
Item [String]
"it is possible to miss some chars."
        ]

timerFormatParser :: Parser (Maybe TimerFormat)
timerFormatParser :: Parser (Maybe TimerFormat)
timerFormatParser = Parser (Maybe TimerFormat)
mainParser
  where
    mainParser :: Parser (Maybe TimerFormat)
mainParser =
      Parser TimerFormat -> Parser (Maybe TimerFormat)
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
OA.optional
        (Parser TimerFormat -> Parser (Maybe TimerFormat))
-> Parser TimerFormat -> Parser (Maybe TimerFormat)
forall a b. (a -> b) -> a -> b
$ ReadM TimerFormat
-> Mod OptionFields TimerFormat -> Parser TimerFormat
forall a. ReadM a -> Mod OptionFields a -> Parser a
OA.option (ReadM Text -> ReadM TimerFormat
forall (m :: Type -> Type). MonadFail m => m Text -> m TimerFormat
TimerFormat.parseTimerFormat ReadM Text
forall s. IsString s => ReadM s
OA.str)
        (Mod OptionFields TimerFormat -> Parser TimerFormat)
-> Mod OptionFields TimerFormat -> Parser TimerFormat
forall a b. (a -> b) -> a -> b
$ [Mod OptionFields TimerFormat] -> Mod OptionFields TimerFormat
forall a. Monoid a => [a] -> a
mconcat
          [ String -> Mod OptionFields TimerFormat
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"console-log-timer-format",
            [String] -> Mod OptionFields TimerFormat
forall (f :: Type -> Type) a. HasCompleter f => [String] -> Mod f a
OA.completeWith [String
Item [String]
"digital_compact", String
Item [String]
"digital_full", String
Item [String]
"prose_compact", String
Item [String]
"prose_full"],
            String -> Mod OptionFields TimerFormat
forall (f :: Type -> Type) a. HasMetavar f => String -> Mod f a
OA.metavar String
"TIME_FMT",
            Item [Mod OptionFields TimerFormat]
Mod OptionFields TimerFormat
helpTxt
          ]
    helpTxt :: Mod OptionFields TimerFormat
helpTxt =
      NESeq String -> Mod OptionFields TimerFormat
forall a. NESeq String -> Mod OptionFields a
Utils.itemizeNoLine
        (NESeq String -> Mod OptionFields TimerFormat)
-> NESeq String -> Mod OptionFields TimerFormat
forall a b. (a -> b) -> a -> b
$ String
intro
        String -> Seq String -> NESeq String
forall a. a -> Seq a -> NESeq a
:<|| [ String
Item (Seq String)
hdc,
               String
Item (Seq String)
hdf,
               String
Item (Seq String)
hpc,
               String
Item (Seq String)
hpf
             ]

    intro :: String
intro = String
"How to format the timer. Options:"

    hdc :: String
hdc = String
"digital_compact: e.g. '02:00:03'."
    hdf :: String
hdf = String
"digital_full: e.g. '00:02:00:03'."
    hpc :: String
hpc = String
"prose_compact: The default e.g. '2 hours, 3 seconds'."
    hpf :: String
hpf = String
"prose_full: e.g. '0 days, 2 hours, 0 minutes, 3 seconds'."