{-# LANGUAGE OverloadedLists #-}
module Shrun.Configuration.Args.Parsing.Core
( coreParser,
)
where
import Options.Applicative (Parser)
import Options.Applicative qualified as OA
import Shrun.Configuration.Args.Parsing.CommandLogging qualified as CommandLogging
import Shrun.Configuration.Args.Parsing.CommonLogging qualified as CommonLogging
import Shrun.Configuration.Args.Parsing.ConsoleLogging qualified as ConsoleLogging
import Shrun.Configuration.Args.Parsing.FileLogging qualified as FileLogging
import Shrun.Configuration.Args.Parsing.Notify qualified as Notify
import Shrun.Configuration.Args.Parsing.Utils qualified as Utils
import Shrun.Configuration.Data.Core
( CoreConfigArgs,
CoreConfigP
( MkCoreConfigP,
commandLogging,
commonLogging,
consoleLogging,
fileLogging,
init,
legendKeysCache,
notifications,
timeout
),
)
import Shrun.Configuration.Data.Core.Timeout (Timeout)
import Shrun.Configuration.Data.Core.Timeout qualified as Timeout
import Shrun.Configuration.Data.LegendKeysCache (LegendKeysCache)
import Shrun.Configuration.Data.LegendKeysCache qualified as LKS
import Shrun.Configuration.Data.WithDisabled (WithDisabled)
import Shrun.Prelude
import Shrun.Utils qualified as ShrunUtils
coreParser :: Parser (CoreConfigArgs m)
coreParser :: forall m. Parser (CoreConfigArgs m)
coreParser = do
Maybe (WithDisabled Text)
init <- Parser (Maybe (WithDisabled Text))
initParser
Maybe LegendKeysCache
legendKeysCache <- Parser (Maybe LegendKeysCache)
legendKeysCacheParser
Maybe (WithDisabled Timeout)
timeout <- Parser (Maybe (WithDisabled Timeout))
timeoutParser
CommonLoggingArgs
commonLogging <-
String -> Parser CommonLoggingArgs -> Parser CommonLoggingArgs
forall a. String -> Parser a -> Parser a
OA.parserOptionGroup String
"Common Logging options:" Parser CommonLoggingArgs
CommonLogging.commonLoggingParser
CommandLoggingArgs
commandLogging <-
String -> Parser CommandLoggingArgs -> Parser CommandLoggingArgs
forall a. String -> Parser a -> Parser a
OA.parserOptionGroup String
"Command Logging options:" Parser CommandLoggingArgs
CommandLogging.commandLoggingParser
ConsoleLoggingArgs
consoleLogging <-
String -> Parser ConsoleLoggingArgs -> Parser ConsoleLoggingArgs
forall a. String -> Parser a -> Parser a
OA.parserOptionGroup String
"Console Logging options:" Parser ConsoleLoggingArgs
ConsoleLogging.consoleLoggingParser
FileLoggingArgs
fileLogging <-
String -> Parser FileLoggingArgs -> Parser FileLoggingArgs
forall a. String -> Parser a -> Parser a
OA.parserOptionGroup String
"File Logging options:" Parser FileLoggingArgs
FileLogging.fileLoggingParser
NotifyArgs m
notifications <- String -> Parser (NotifyArgs m) -> Parser (NotifyArgs m)
forall a. String -> Parser a -> Parser a
OA.parserOptionGroup String
"Notifications options:" Parser (NotifyArgs m)
forall r. Parser (NotifyArgs r)
Notify.notifyParser
pure
$ MkCoreConfigP
{ Maybe (WithDisabled Timeout)
TimeoutF 'ConfigPhaseArgs
timeout :: TimeoutF 'ConfigPhaseArgs
timeout :: Maybe (WithDisabled Timeout)
timeout,
Maybe (WithDisabled Text)
ConfigPhaseDisabledMaybeF 'ConfigPhaseArgs Text
init :: ConfigPhaseDisabledMaybeF 'ConfigPhaseArgs Text
init :: Maybe (WithDisabled Text)
init,
Maybe LegendKeysCache
LegendKeysCacheF 'ConfigPhaseArgs
legendKeysCache :: LegendKeysCacheF 'ConfigPhaseArgs
legendKeysCache :: Maybe LegendKeysCache
legendKeysCache,
CommonLoggingArgs
TomlOptF 'ConfigPhaseArgs CommonLoggingArgs
commonLogging :: TomlOptF 'ConfigPhaseArgs CommonLoggingArgs
commonLogging :: CommonLoggingArgs
commonLogging,
ConsoleLoggingArgs
TomlOptF 'ConfigPhaseArgs ConsoleLoggingArgs
consoleLogging :: TomlOptF 'ConfigPhaseArgs ConsoleLoggingArgs
consoleLogging :: ConsoleLoggingArgs
consoleLogging,
CommandLoggingArgs
TomlOptF 'ConfigPhaseArgs CommandLoggingArgs
commandLogging :: TomlOptF 'ConfigPhaseArgs CommandLoggingArgs
commandLogging :: CommandLoggingArgs
commandLogging,
FileLoggingArgs
ArgsOnlyDetF 'ConfigPhaseArgs FileLoggingArgs
fileLogging :: ArgsOnlyDetF 'ConfigPhaseArgs FileLoggingArgs
fileLogging :: FileLoggingArgs
fileLogging,
NotifyArgs m
ArgsOnlyDetF 'ConfigPhaseArgs (NotifyArgs m)
notifications :: ArgsOnlyDetF 'ConfigPhaseArgs (NotifyArgs m)
notifications :: NotifyArgs m
notifications
}
timeoutParser :: Parser (Maybe (WithDisabled Timeout))
timeoutParser :: Parser (Maybe (WithDisabled Timeout))
timeoutParser =
ReadM Timeout
-> [Mod OptionFields (WithDisabled Timeout)]
-> (Bool, [String])
-> Parser (Maybe (WithDisabled Timeout))
forall a.
ReadM a
-> [Mod OptionFields (WithDisabled a)]
-> (Bool, [String])
-> Parser (Maybe (WithDisabled a))
Utils.mWithDisabledParser
(ReadM Natural -> ReadM Text -> ReadM Timeout
forall (f :: Type -> Type).
(Alternative f, MonadFail f) =>
f Natural -> f Text -> f Timeout
Timeout.parseTimeout ReadM Natural
forall a. Read a => ReadM a
Utils.autoStripUnderscores ReadM Text
forall s. IsString s => ReadM s
OA.str)
[Mod OptionFields (WithDisabled Timeout)]
opts
(Bool, [String])
forall a. IsString a => (Bool, [a])
Timeout.timeoutMeta
where
opts :: [Mod OptionFields (WithDisabled Timeout)]
opts =
[ String -> Mod OptionFields (WithDisabled Timeout)
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"timeout",
Char -> Mod OptionFields (WithDisabled Timeout)
forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
OA.short Char
't',
String -> Mod OptionFields (WithDisabled Timeout)
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 setting a timeout. Can either be a raw number ",
String
Item [String]
"(interpreted as seconds), or a \"time string\" e.g. 1d2h3m4s or ",
String
Item [String]
"2h3s. Defaults to no timeout."
]
initParser :: Parser (Maybe (WithDisabled Text))
initParser :: Parser (Maybe (WithDisabled Text))
initParser =
ReadM Text
-> [Mod OptionFields (WithDisabled Text)]
-> (Bool, [String])
-> Parser (Maybe (WithDisabled Text))
forall a.
ReadM a
-> [Mod OptionFields (WithDisabled a)]
-> (Bool, [String])
-> Parser (Maybe (WithDisabled a))
Utils.mWithDisabledParser
ReadM Text
forall s. IsString s => ReadM s
OA.str
[Mod OptionFields (WithDisabled Text)]
opts
(Bool
True, [String
Item [String]
"STRING"])
where
opts :: [Mod OptionFields (WithDisabled Text)]
opts =
[ String -> Mod OptionFields (WithDisabled Text)
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"init",
Char -> Mod OptionFields (WithDisabled Text)
forall (f :: Type -> Type) a. HasName f => Char -> Mod f a
OA.short Char
'i',
String -> Mod OptionFields (WithDisabled Text)
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]
"If given, init is run before each command. That is, ",
String
Item [String]
"'shrun --init \". ~/.bashrc\" foo bar' is equivalent ",
String
Item [String]
"to 'shrun \". ~/.bashrc && foo\" \". ~/.bashrc && bar\"'."
]
legendKeysCacheParser :: Parser (Maybe LegendKeysCache)
legendKeysCacheParser :: Parser (Maybe LegendKeysCache)
legendKeysCacheParser =
Parser LegendKeysCache -> Parser (Maybe LegendKeysCache)
forall (f :: Type -> Type) a. Alternative f => f a -> f (Maybe a)
OA.optional
(Parser LegendKeysCache -> Parser (Maybe LegendKeysCache))
-> Parser LegendKeysCache -> Parser (Maybe LegendKeysCache)
forall a b. (a -> b) -> a -> b
$ ReadM LegendKeysCache
-> Mod OptionFields LegendKeysCache -> Parser LegendKeysCache
forall a. ReadM a -> Mod OptionFields a -> Parser a
OA.option
(ReadM Text -> ReadM LegendKeysCache
forall (m :: Type -> Type).
MonadFail m =>
m Text -> m LegendKeysCache
LKS.parseLegendKeysCache ReadM Text
forall s. IsString s => ReadM s
OA.str)
Mod OptionFields LegendKeysCache
opts
where
opts :: Mod OptionFields LegendKeysCache
opts =
[Mod OptionFields LegendKeysCache]
-> Mod OptionFields LegendKeysCache
forall a. Monoid a => [a] -> a
mconcat
[ String -> Mod OptionFields LegendKeysCache
forall (f :: Type -> Type) a. HasName f => String -> Mod f a
OA.long String
"legend-keys-cache",
[String] -> Mod OptionFields LegendKeysCache
forall (f :: Type -> Type) a. HasCompleter f => [String] -> Mod f a
OA.completeWith [String
Item [String]
"add", String
Item [String]
"clear", String
Item [String]
"write", String
Item [String]
"off"],
String -> Mod OptionFields LegendKeysCache
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
ShrunUtils.mkMetaStr (Bool, [String])
forall a. IsString a => (Bool, [a])
LKS.lksMeta),
Item [Mod OptionFields LegendKeysCache]
Mod OptionFields LegendKeysCache
helpTxt
]
helpTxt :: Mod OptionFields LegendKeysCache
helpTxt =
NESeq String -> Mod OptionFields LegendKeysCache
forall a. NESeq String -> Mod OptionFields a
Utils.itemize
(NESeq String -> Mod OptionFields LegendKeysCache)
-> NESeq String -> Mod OptionFields LegendKeysCache
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)
add,
String
Item (Seq String)
clear,
String
Item (Seq String)
write
]
intro :: String
intro =
[String] -> String
forall a. Monoid a => [a] -> a
mconcat
[ String
Item [String]
"Shrun allows saving legend keys from the current config file so ",
String
Item [String]
"that we can get tab-completions on the next run."
]
add :: String
add = String
"add: The default. Combines keys from this run with the prior run(s)."
write :: String
write = String
"write: Saves keys from this run only."
clear :: String
clear = String
"clear: Deletes the keys cache, if it exists."