{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Unused LANGUAGE pragma" #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TupleSections #-}
module Hledger.Cli (
main,
mainmode,
argsToCliOpts,
module Hledger.Cli.CliOptions,
module Hledger.Cli.Conf,
module Hledger.Cli.Commands,
module Hledger.Cli.DocFiles,
module Hledger.Cli.Utils,
module Hledger.Cli.Version,
module Hledger,
module CmdArgsWithoutName
)
where
import Control.Monad (when, unless)
import Data.Bifunctor (second)
import Data.Char (isDigit)
import Data.Either (isRight)
import Data.Function ((&))
import Data.Functor ((<&>))
import Data.List
import qualified Data.List.NonEmpty as NE
import Data.Maybe (isJust)
import Data.Text (pack, Text)
import Data.Time.Clock.POSIX (getPOSIXTime)
import Safe
import System.Console.CmdArgs.Explicit
import System.Console.CmdArgs.Explicit as CmdArgsWithoutName hiding (Name)
import System.Environment
import System.Exit
import System.FilePath
import System.Process
import Text.Megaparsec (optional, takeWhile1P, eof)
import Text.Megaparsec.Char (char)
import Text.Printf
import Hledger
import Hledger.Cli.CliOptions
import Hledger.Cli.Conf
import Hledger.Cli.Commands
import Hledger.Cli.DocFiles
import Hledger.Cli.Utils
import Hledger.Cli.Version
verboseDebugLevel :: Int
verboseDebugLevel = Int
8
mainmode :: [String] -> Mode RawOpts
mainmode [String]
addons = Mode RawOpts
defMode {
modeNames = [progname ++ " [COMMAND]"]
,modeArgs = ([], Just $ argsFlag "[ARGS]")
,modeHelp = unlines ["hledger's main command line interface. Run with no ARGS to list commands."]
,modeGroupModes = Group {
groupUnnamed = [
]
,groupNamed = [
]
,groupHidden = map fst builtinCommands ++ map addonCommandMode addons
}
,modeGroupFlags = Group {
groupNamed = cligeneralflagsgroups1
,groupUnnamed = confflags
,groupHidden = hiddenflagsformainmode
}
,modeHelpSuffix = []
}
confflagsmode :: Mode RawOpts
confflagsmode = Mode RawOpts
defMode{
modeGroupFlags=Group [] confflags []
,modeArgs = ([], Just $ argsFlag "")
}
main :: IO ()
main :: IO ()
main = IO () -> IO ()
forall {a}. a -> a
withGhcDebug' (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
let
dbgIO, dbgIO1, dbgIO2 :: Show a => String -> a -> IO ()
dbgIO :: forall a. Show a => String -> a -> IO ()
dbgIO = Int -> String -> a -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
verboseDebugLevel
dbgIO1 :: forall a. Show a => String -> a -> IO ()
dbgIO1 = Int -> String -> a -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
1
dbgIO2 :: forall a. Show a => String -> a -> IO ()
dbgIO2 = Int -> String -> a -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
2
String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"running" String
prognameandversion
POSIXTime
starttime <- IO POSIXTime
getPOSIXTime
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GhcDebugMode
ghcDebugMode GhcDebugMode -> GhcDebugMode -> Bool
forall a. Eq a => a -> a -> Bool
== GhcDebugMode
GDPauseAtStart) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ()
ghcDebugPause'
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
useColorOnStdout IO ()
setupPager
[String]
addons <- IO [String]
hledgerAddons IO [String] -> ([String] -> [String]) -> IO [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (String -> Bool) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
builtinCommandNames) (String -> Bool) -> (String -> String) -> String -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropExtension)
[String]
cliargs <- IO [String]
getArgs
IO [String] -> ([String] -> IO [String]) -> IO [String]
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= [String] -> IO [String]
expandArgsAt
IO [String] -> ([String] -> [String]) -> IO [String]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [String] -> [String]
replaceNumericFlags
let
(String
clicmdarg, [String]
cliargswithoutcmd, [String]
cliargswithcmdfirst) = [String] -> (String, [String], [String])
moveFlagsAfterCommand [String]
cliargs
cliargswithcmdfirstwithoutclispecific :: [String]
cliargswithcmdfirstwithoutclispecific = [String] -> [String]
dropCliSpecificOpts [String]
cliargswithcmdfirst
([String]
cliargsbeforecmd, [String]
cliargsaftercmd) = ([String] -> [String])
-> ([String], [String]) -> ([String], [String])
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1) (([String], [String]) -> ([String], [String]))
-> ([String], [String]) -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
clicmdarg) [String]
cliargs
String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"cli args" [String]
cliargs
String -> [String] -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg1IO String
"cli args with command first, if any" [String]
cliargswithcmdfirst
String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"command argument found" String
clicmdarg
String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"cli args before command" [String]
cliargsbeforecmd
String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"cli args after command" [String]
cliargsaftercmd
let
rawopts0 :: RawOpts
rawopts0 = String -> Mode RawOpts -> [String] -> RawOpts
cmdargsParse
String
"to get command name"
([String] -> Mode RawOpts
mainmode [String]
addons)
[String]
cliargswithcmdfirstwithoutclispecific
cmd :: String
cmd = String -> RawOpts -> String
stringopt String
"command" RawOpts
rawopts0
nocmdprovided :: Bool
nocmdprovided = String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
clicmdarg
badcmdprovided :: Bool
badcmdprovided = String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cmd Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
nocmdprovided
isaddoncmd :: Bool
isaddoncmd = Bool -> Bool
not (String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cmd) Bool -> Bool -> Bool
&& String
cmd String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
addons
mcmdmodeaction :: Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
mcmdmodeaction = String -> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
findBuiltinCommand String
cmd
effectivemode :: Mode RawOpts
effectivemode = Mode RawOpts
-> ((Mode RawOpts, CliOpts -> Journal -> IO ()) -> Mode RawOpts)
-> Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
-> Mode RawOpts
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ([String] -> Mode RawOpts
mainmode []) (Mode RawOpts, CliOpts -> Journal -> IO ()) -> Mode RawOpts
forall a b. (a, b) -> a
fst Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
mcmdmodeaction
String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"cli args with command first and no cli-specific opts" [String]
cliargswithcmdfirstwithoutclispecific
String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO1 String
"command found" String
cmd
String -> Bool -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"no command provided" Bool
nocmdprovided
String -> Bool -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"bad command provided" Bool
badcmdprovided
String -> Bool -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"is addon command" Bool
isaddoncmd
let cliconfargs :: [String]
cliconfargs = Mode RawOpts -> [String] -> [String]
dropUnsupportedOpts Mode RawOpts
confflagsmode [String]
cliargswithoutcmd
String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"cli args without command" [String]
cliargswithoutcmd
let rawopts1 :: RawOpts
rawopts1 = String -> Mode RawOpts -> [String] -> RawOpts
cmdargsParse String
"to get conf file" Mode RawOpts
confflagsmode [String]
cliconfargs
(Conf
conf, Maybe String
mconffile) <- RawOpts -> IO (Conf, Maybe String)
getConf RawOpts
rawopts1
let
genargsfromconf :: [String]
genargsfromconf = String -> Conf -> [String]
confLookup String
"general" Conf
conf
addoncmdssupportinggenopts :: [String]
addoncmdssupportinggenopts = [String
"ui", String
"web"]
supportedgenargsfromconf :: [String]
supportedgenargsfromconf
| String
cmd String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
addoncmdssupportinggenopts =
[String
a | String
a <- [String]
genargsfromconf, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a) [String]
addoncmdssupportinggenopts]
| Bool
isaddoncmd = []
| Bool
otherwise = Mode RawOpts -> [String] -> [String]
dropUnsupportedOpts Mode RawOpts
effectivemode [String]
genargsfromconf
excludedgenargsfromconf :: [String]
excludedgenargsfromconf = [String]
genargsfromconf [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
supportedgenargsfromconf
cmdargsfromconf :: [String]
cmdargsfromconf
| String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
cmd = []
| Bool
otherwise = String -> Conf -> [String]
confLookup String
cmd Conf
conf [String] -> ([String] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& if Bool
isaddoncmd then (String
"--"String -> [String] -> [String]
forall a. a -> [a] -> [a]
:) else [String] -> [String]
forall {a}. a -> a
id
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe String -> Bool
forall a. Maybe a -> Bool
isJust Maybe String
mconffile) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO1 String
"using extra general args from config file" [String]
genargsfromconf
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
excludedgenargsfromconf) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO1 String
"excluded general args from config file, not supported by this command" [String]
excludedgenargsfromconf
String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO1 String
"using extra command args from config file" [String]
cmdargsfromconf
let
finalargs :: [String]
finalargs =
(if String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
clicmdarg then [] else [String
clicmdarg]) [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
supportedgenargsfromconf [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
cmdargsfromconf [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
cliargswithoutcmd
[String] -> ([String] -> [String]) -> [String]
forall a b. a -> (a -> b) -> b
& [String] -> [String]
replaceNumericFlags
let rawopts :: RawOpts
rawopts = String -> Mode RawOpts -> [String] -> RawOpts
cmdargsParse String
"to get options" ([String] -> Mode RawOpts
mainmode [String]
addons) [String]
finalargs
let
helpFlag :: Bool
helpFlag = String -> RawOpts -> Bool
boolopt String
"help" RawOpts
rawopts
tldrFlag :: Bool
tldrFlag = String -> RawOpts -> Bool
boolopt String
"tldr" RawOpts
rawopts
infoFlag :: Bool
infoFlag = String -> RawOpts -> Bool
boolopt String
"info" RawOpts
rawopts
manFlag :: Bool
manFlag = String -> RawOpts -> Bool
boolopt String
"man" RawOpts
rawopts
versionFlag :: Bool
versionFlag = String -> RawOpts -> Bool
boolopt String
"version" RawOpts
rawopts
if
| Bool
nocmdprovided Bool -> Bool -> Bool
&& Bool
helpFlag -> String -> IO ()
pager (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> String
forall a. Mode a -> String
showModeUsage ([String] -> Mode RawOpts
mainmode []) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
| Bool
nocmdprovided Bool -> Bool -> Bool
&& Bool
tldrFlag -> String -> IO ()
runTldrForPage String
"hledger"
| Bool
nocmdprovided Bool -> Bool -> Bool
&& Bool
infoFlag -> String -> Maybe String -> IO ()
runInfoForTopic String
"hledger" Maybe String
forall a. Maybe a
Nothing
| Bool
nocmdprovided Bool -> Bool -> Bool
&& Bool
manFlag -> String -> Maybe String -> IO ()
runManForTopic String
"hledger" Maybe String
forall a. Maybe a
Nothing
| Bool
versionFlag Bool -> Bool -> Bool
&& Bool -> Bool
not (Bool
isaddoncmd Bool -> Bool -> Bool
|| Bool
helpFlag Bool -> Bool -> Bool
|| Bool
tldrFlag Bool -> Bool -> Bool
|| Bool
infoFlag Bool -> Bool -> Bool
|| Bool
manFlag) -> String -> IO ()
putStrLn String
prognameandversion
| Bool
badcmdprovided -> String -> IO ()
forall a. String -> a
error' (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"command "String -> String -> String
forall a. [a] -> [a] -> [a]
++String
clicmdargString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" is not recognized, run with no command to see a list"
| Bool
nocmdprovided -> String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"" String
"no command, showing commands list" IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> [String] -> IO ()
printCommandsList String
prognameandversion [String]
addons
| Just (Mode RawOpts
cmdmode, CliOpts -> Journal -> IO ()
cmdaction) <- Maybe (Mode RawOpts, CliOpts -> Journal -> IO ())
mcmdmodeaction -> do
CliOpts
opts <- RawOpts -> IO CliOpts
rawOptsToCliOpts RawOpts
rawopts IO CliOpts -> (CliOpts -> IO CliOpts) -> IO CliOpts
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CliOpts
opts0 -> CliOpts -> IO CliOpts
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return CliOpts
opts0{progstarttime_=starttime}
String -> CliOpts -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO2 String
"processed opts" CliOpts
opts
String -> Period -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"period from opts" (ReportOpts -> Period
period_ (ReportOpts -> Period)
-> (ReportSpec -> ReportOpts) -> ReportSpec -> Period
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> ReportOpts
_rsReportOpts (ReportSpec -> Period) -> ReportSpec -> Period
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)
String -> Interval -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"interval from opts" (ReportOpts -> Interval
interval_ (ReportOpts -> Interval)
-> (ReportSpec -> ReportOpts) -> ReportSpec -> Interval
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ReportSpec -> ReportOpts
_rsReportOpts (ReportSpec -> Interval) -> ReportSpec -> Interval
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)
String -> Query -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"query from opts & args" (ReportSpec -> Query
_rsQuery (ReportSpec -> Query) -> ReportSpec -> Query
forall a b. (a -> b) -> a -> b
$ CliOpts -> ReportSpec
reportspec_ CliOpts
opts)
let
mcmdname :: Maybe String
mcmdname = [String] -> Maybe String
forall a. [a] -> Maybe a
headMay ([String] -> Maybe String) -> [String] -> Maybe String
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> [String]
forall a. Mode a -> [String]
modeNames Mode RawOpts
cmdmode
tldrpagename :: String
tldrpagename = String -> (String -> String) -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"hledger" ((String
"hledger-"String -> String -> String
forall a. Semigroup a => a -> a -> a
<>)) Maybe String
mcmdname
if
| Bool
helpFlag -> String -> IO ()
pager (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ Mode RawOpts -> String
forall a. Mode a -> String
showModeUsage Mode RawOpts
cmdmode String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n"
| Bool
tldrFlag -> String -> IO ()
runTldrForPage String
tldrpagename
| Bool
infoFlag -> String -> Maybe String -> IO ()
runInfoForTopic String
"hledger" Maybe String
mcmdname
| Bool
manFlag -> String -> Maybe String -> IO ()
runManForTopic String
"hledger" Maybe String
mcmdname
| String
cmd String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"demo",String
"help",String
"test"] ->
CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts (Journal -> IO ()) -> Journal -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> Journal
forall a. String -> a
error' (String -> Journal) -> String -> Journal
forall a b. (a -> b) -> a -> b
$ String
cmdString -> String -> String
forall a. [a] -> [a] -> [a]
++String
" tried to read the journal but is not supposed to"
| String
cmd String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"add",String
"import"] -> do
String -> IO ()
ensureJournalFileExists (String -> IO ())
-> (NonEmpty String -> String) -> NonEmpty String -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty String -> String
forall a. NonEmpty a -> a
NE.head (NonEmpty String -> IO ()) -> IO (NonEmpty String) -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CliOpts -> IO (NonEmpty String)
journalFilePathFromOpts CliOpts
opts
CliOpts -> (Journal -> IO ()) -> IO ()
forall a. CliOpts -> (Journal -> IO a) -> IO a
withJournalDo CliOpts
opts (CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts)
| Bool
otherwise -> CliOpts -> (Journal -> IO ()) -> IO ()
forall a. CliOpts -> (Journal -> IO a) -> IO a
withJournalDo CliOpts
opts ((Journal -> IO ()) -> IO ()) -> (Journal -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ CliOpts -> Journal -> IO ()
cmdaction CliOpts
opts
| Bool
isaddoncmd -> do
let
addonargs0 :: [String]
addonargs0 = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
"--") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
supportedgenargsfromconf [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
cmdargsfromconf [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
cliargswithoutcmd
addonargs :: [String]
addonargs = [String] -> [String]
dropCliSpecificOpts [String]
addonargs0
shellcmd :: String
shellcmd = String -> String -> String -> String -> String
forall r. PrintfType r => String -> r
printf String
"%s-%s %s" String
progname String
cmd ([String] -> String
unwords' [String]
addonargs) :: String
String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"addon command selected" String
cmd
String -> [String] -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO String
"addon command arguments after removing cli-specific opts" ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
quoteIfNeeded [String]
addonargs)
String -> String -> IO ()
forall a. Show a => String -> a -> IO ()
dbgIO1 String
"running addon" String
shellcmd
String -> IO ExitCode
system String
shellcmd IO ExitCode -> (ExitCode -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith
| Bool
otherwise -> String -> IO ()
forall a. String -> a
usageError (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$
String
"could not understand the arguments "String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
forall a. Show a => a -> String
show [String]
finalargs
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
genargsfromconf then String
"" else String
"\ngeneral arguments added from config file: "String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
forall a. Show a => a -> String
show [String]
genargsfromconf
String -> String -> String
forall a. Semigroup a => a -> a -> a
<> if [String] -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
cmdargsfromconf then String
"" else String
"\ncommand arguments added from config file: "String -> String -> String
forall a. [a] -> [a] -> [a]
++[String] -> String
forall a. Show a => a -> String
show [String]
cmdargsfromconf
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (GhcDebugMode
ghcDebugMode GhcDebugMode -> GhcDebugMode -> Bool
forall a. Eq a => a -> a -> Bool
== GhcDebugMode
GDPauseAtEnd) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IO ()
ghcDebugPause'
argsToCliOpts :: [String] -> [String] -> IO CliOpts
argsToCliOpts :: [String] -> [String] -> IO CliOpts
argsToCliOpts [String]
args [String]
addons = do
let
(String
_, [String]
_, [String]
args0) = [String] -> (String, [String], [String])
moveFlagsAfterCommand [String]
args
args1 :: [String]
args1 = [String] -> [String]
replaceNumericFlags [String]
args0
rawopts :: RawOpts
rawopts = String -> Mode RawOpts -> [String] -> RawOpts
cmdargsParse String
"to get options" ([String] -> Mode RawOpts
mainmode [String]
addons) [String]
args1
RawOpts -> IO CliOpts
rawOptsToCliOpts RawOpts
rawopts
cmdargsParse :: String -> Mode RawOpts -> [String] -> RawOpts
cmdargsParse :: String -> Mode RawOpts -> [String] -> RawOpts
cmdargsParse String
desc Mode RawOpts
m [String]
args0 = Mode RawOpts -> [String] -> Either String RawOpts
forall a. Mode a -> [String] -> Either String a
process Mode RawOpts
m ([String] -> [String]
ensureDebugFlagHasVal [String]
args0)
Either String RawOpts
-> (Either String RawOpts -> RawOpts) -> RawOpts
forall a b. a -> (a -> b) -> b
& (String -> RawOpts)
-> (RawOpts -> RawOpts) -> Either String RawOpts -> RawOpts
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
(\String
e -> String -> RawOpts
forall a. String -> a
error' (String -> RawOpts) -> String -> RawOpts
forall a b. (a -> b) -> a -> b
$ String
e String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" while parsing these args " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
desc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
quoteIfNeeded [String]
args0))
(Int -> String -> RawOpts -> RawOpts
forall a. Int -> String -> a -> a
traceOrLogAt Int
verboseDebugLevel (String
"cmdargs: parsing " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
desc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [String] -> String
forall a. Show a => a -> String
show [String]
args0))
moveFlagsAfterCommand :: [String] -> (String, [String], [String])
moveFlagsAfterCommand :: [String] -> (String, [String], [String])
moveFlagsAfterCommand [String]
args =
case ([String], [String]) -> ([String], [String])
moveFlagArgs ([String]
args, []) of
([],[String]
as) -> (String
"", [String]
as, [String]
as)
(unmoved :: [String]
unmoved@((Char
'-':String
_):[String]
_), [String]
moved) -> (String
"", [String]
as, [String]
as) where as :: [String]
as = [String]
unmoved[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>[String]
moved
(String
cmdarg:[String]
unmoved, [String]
moved) -> (String
cmdarg, [String]
as, String
cmdargString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
as) where as :: [String]
as = [String]
unmoved[String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<>[String]
moved
where
moveFlagArgs :: ([String], [String]) -> ([String], [String])
moveFlagArgs :: ([String], [String]) -> ([String], [String])
moveFlagArgs ((String
a:String
b:[String]
cs), [String]
moved)
| String -> String -> Int
isMovableFlagArg String
a String
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 = ([String], [String]) -> ([String], [String])
moveFlagArgs ([String]
cs, [String]
moved[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
a,String
b])
| String -> String -> Int
isMovableFlagArg String
a String
b Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = ([String], [String]) -> ([String], [String])
moveFlagArgs (String
bString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
cs, [String]
moved[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++[String
a])
| Bool
otherwise = (String
aString -> [String] -> [String]
forall a. a -> [a] -> [a]
:String
bString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
cs, [String]
moved)
where
isMovableFlagArg :: String -> String -> Int
isMovableFlagArg :: String -> String -> Int
isMovableFlagArg String
a1 String
a2
| String
a1 String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
noValFlagArgs = Int
1
| String
a1 String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
"--debug" Bool -> Bool -> Bool
&& Bool -> Bool
not (String -> Bool
isDebugValue String
a2) = Int
1
| String
a1 String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reqValFlagArgs = Int
2
| String
a1 String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
optValFlagArgs = Int
1
| (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a1) [String]
shortReqValFlagArgs = Int
1
| (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a1) [String]
longReqValFlagArgs_ = Int
1
| (String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a1) [String]
longOptValFlagArgs_ = Int
1
| String -> Bool
isFlagArg String
a1 = Int
1
| Bool
otherwise = Int
0
moveFlagArgs ([String]
as, [String]
moved) = ([String]
as, [String]
moved)
isDebugValue :: String -> Bool
isDebugValue String
s = Either (ParseErrorBundle Text HledgerParseErrorData) Text -> Bool
forall a b. Either a b -> Bool
isRight (Either (ParseErrorBundle Text HledgerParseErrorData) Text -> Bool)
-> Either (ParseErrorBundle Text HledgerParseErrorData) Text
-> Bool
forall a b. (a -> b) -> a -> b
$ Parsec HledgerParseErrorData Text Text
-> Text
-> Either (ParseErrorBundle Text HledgerParseErrorData) Text
forall e a.
Parsec e Text a -> Text -> Either (ParseErrorBundle Text e) a
parsewith Parsec HledgerParseErrorData Text Text
forall {m :: * -> *}. TextParser m Text
isdebugvalp (Text -> Either (ParseErrorBundle Text HledgerParseErrorData) Text)
-> Text
-> Either (ParseErrorBundle Text HledgerParseErrorData) Text
forall a b. (a -> b) -> a -> b
$ String -> Text
pack String
s
where isdebugvalp :: TextParser m Text
isdebugvalp = ParsecT HledgerParseErrorData Text m Char
-> ParsecT HledgerParseErrorData Text m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT HledgerParseErrorData Text m (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-') ParsecT HledgerParseErrorData Text m (Maybe Char)
-> ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m Text
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Maybe String
-> (Token Text -> Bool)
-> ParsecT HledgerParseErrorData Text m (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P Maybe String
forall a. Maybe a
Nothing Char -> Bool
Token Text -> Bool
isDigit ParsecT HledgerParseErrorData Text m Text
-> ParsecT HledgerParseErrorData Text m ()
-> ParsecT HledgerParseErrorData Text m Text
forall a b.
ParsecT HledgerParseErrorData Text m a
-> ParsecT HledgerParseErrorData Text m b
-> ParsecT HledgerParseErrorData Text m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT HledgerParseErrorData Text m ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof :: TextParser m Text
isFlagArg, isShortFlagArg, isLongFlagArg :: String -> Bool
isFlagArg :: String -> Bool
isFlagArg String
a = String -> Bool
isShortFlagArg String
a Bool -> Bool -> Bool
|| String -> Bool
isLongFlagArg String
a
isShortFlagArg :: String -> Bool
isShortFlagArg (Char
'-':Char
c:String
_) = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'-'
isShortFlagArg String
_ = Bool
False
isLongFlagArg :: String -> Bool
isLongFlagArg (Char
'-':Char
'-':Char
_:String
_) = Bool
True
isLongFlagArg String
_ = Bool
False
toFlagArg :: Name -> String
toFlagArg :: String -> String
toFlagArg String
f = if String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
f Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then String
"-"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
f else String
"--"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
f
toFlagInfos :: Flag RawOpts -> [(Name, FlagInfo)]
toFlagInfos :: Flag RawOpts -> [(String, FlagInfo)]
toFlagInfos Flag RawOpts
f = [(String
n,FlagInfo
i) | let i :: FlagInfo
i = Flag RawOpts -> FlagInfo
forall a. Flag a -> FlagInfo
flagInfo Flag RawOpts
f, String
n <- Flag RawOpts -> [String]
forall a. Flag a -> [String]
flagNames Flag RawOpts
f]
isOptVal :: FlagInfo -> Bool
isOptVal :: FlagInfo -> Bool
isOptVal = \case
FlagOpt String
_ -> Bool
True
FlagOptRare String
_ -> Bool
True
FlagInfo
_ -> Bool
False
generalFlags :: [Flag RawOpts]
generalFlags :: [Flag RawOpts]
generalFlags = ((String, [Flag RawOpts]) -> [Flag RawOpts])
-> [(String, [Flag RawOpts])] -> [Flag RawOpts]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [Flag RawOpts]) -> [Flag RawOpts]
forall a b. (a, b) -> b
snd [(String, [Flag RawOpts])]
groupNamed [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. Semigroup a => a -> a -> a
<> [Flag RawOpts]
groupHidden [Flag RawOpts] -> [Flag RawOpts] -> [Flag RawOpts]
forall a. Semigroup a => a -> a -> a
<> [Flag RawOpts]
groupUnnamed
where Group{[(String, [Flag RawOpts])]
[Flag RawOpts]
groupUnnamed :: forall a. Group a -> [a]
groupNamed :: forall a. Group a -> [(String, [a])]
groupHidden :: forall a. Group a -> [a]
groupNamed :: [(String, [Flag RawOpts])]
groupHidden :: [Flag RawOpts]
groupUnnamed :: [Flag RawOpts]
..} = Mode RawOpts -> Group (Flag RawOpts)
forall a. Mode a -> Group (Flag a)
modeGroupFlags (Mode RawOpts -> Group (Flag RawOpts))
-> Mode RawOpts -> Group (Flag RawOpts)
forall a b. (a -> b) -> a -> b
$ [String] -> Mode RawOpts
mainmode []
generalFlagNames :: [Name]
generalFlagNames :: [String]
generalFlagNames = (Flag RawOpts -> [String]) -> [Flag RawOpts] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [String]
forall a. Flag a -> [String]
flagNames [Flag RawOpts]
generalFlags
commandFlags :: [Flag RawOpts]
commandFlags :: [Flag RawOpts]
commandFlags = (Mode RawOpts -> [Flag RawOpts])
-> [Mode RawOpts] -> [Flag RawOpts]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Group (Flag RawOpts) -> [Flag RawOpts]
forall a. Group a -> [a]
groupUnnamed(Group (Flag RawOpts) -> [Flag RawOpts])
-> (Mode RawOpts -> Group (Flag RawOpts))
-> Mode RawOpts
-> [Flag RawOpts]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.Mode RawOpts -> Group (Flag RawOpts)
forall a. Mode a -> Group (Flag a)
modeGroupFlags) [Mode RawOpts]
commandModes
where
commandModes :: [Mode RawOpts]
commandModes = ((String, [Mode RawOpts]) -> [Mode RawOpts])
-> [(String, [Mode RawOpts])] -> [Mode RawOpts]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [Mode RawOpts]) -> [Mode RawOpts]
forall a b. (a, b) -> b
snd [(String, [Mode RawOpts])]
groupNamed [Mode RawOpts] -> [Mode RawOpts] -> [Mode RawOpts]
forall a. Semigroup a => a -> a -> a
<> [Mode RawOpts]
groupUnnamed [Mode RawOpts] -> [Mode RawOpts] -> [Mode RawOpts]
forall a. Semigroup a => a -> a -> a
<> [Mode RawOpts]
groupHidden
where Group{[(String, [Mode RawOpts])]
[Mode RawOpts]
groupUnnamed :: forall a. Group a -> [a]
groupNamed :: forall a. Group a -> [(String, [a])]
groupHidden :: forall a. Group a -> [a]
groupNamed :: [(String, [Mode RawOpts])]
groupUnnamed :: [Mode RawOpts]
groupHidden :: [Mode RawOpts]
..} = Mode RawOpts -> Group (Mode RawOpts)
forall a. Mode a -> Group (Mode a)
modeGroupModes (Mode RawOpts -> Group (Mode RawOpts))
-> Mode RawOpts -> Group (Mode RawOpts)
forall a b. (a -> b) -> a -> b
$ [String] -> Mode RawOpts
mainmode []
noValGeneralFlagNames, reqValGeneralFlagNames, optValGeneralFlagNames :: [Name]
noValGeneralFlagNames :: [String]
noValGeneralFlagNames = [String
f | (String
f,FlagInfo
i) <- (Flag RawOpts -> [(String, FlagInfo)])
-> [Flag RawOpts] -> [(String, FlagInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [(String, FlagInfo)]
toFlagInfos [Flag RawOpts]
generalFlags, FlagInfo
i FlagInfo -> FlagInfo -> Bool
forall a. Eq a => a -> a -> Bool
== FlagInfo
FlagNone]
reqValGeneralFlagNames :: [String]
reqValGeneralFlagNames = [String
f | (String
f,FlagInfo
i) <- (Flag RawOpts -> [(String, FlagInfo)])
-> [Flag RawOpts] -> [(String, FlagInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [(String, FlagInfo)]
toFlagInfos [Flag RawOpts]
generalFlags, FlagInfo
i FlagInfo -> FlagInfo -> Bool
forall a. Eq a => a -> a -> Bool
== FlagInfo
FlagReq]
optValGeneralFlagNames :: [String]
optValGeneralFlagNames = [String
f | (String
f,FlagInfo
i) <- (Flag RawOpts -> [(String, FlagInfo)])
-> [Flag RawOpts] -> [(String, FlagInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [(String, FlagInfo)]
toFlagInfos [Flag RawOpts]
generalFlags, FlagInfo -> Bool
isOptVal FlagInfo
i]
noValCommandFlagNames, reqValCommandFlagNames, optValCommandFlagNames :: [Name]
noValCommandFlagNames :: [String]
noValCommandFlagNames = [String
f | (String
f,FlagInfo
i) <- (Flag RawOpts -> [(String, FlagInfo)])
-> [Flag RawOpts] -> [(String, FlagInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [(String, FlagInfo)]
toFlagInfos [Flag RawOpts]
commandFlags, FlagInfo
i FlagInfo -> FlagInfo -> Bool
forall a. Eq a => a -> a -> Bool
== FlagInfo
FlagNone]
reqValCommandFlagNames :: [String]
reqValCommandFlagNames = [String
f | (String
f,FlagInfo
i) <- (Flag RawOpts -> [(String, FlagInfo)])
-> [Flag RawOpts] -> [(String, FlagInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [(String, FlagInfo)]
toFlagInfos [Flag RawOpts]
commandFlags, FlagInfo
i FlagInfo -> FlagInfo -> Bool
forall a. Eq a => a -> a -> Bool
== FlagInfo
FlagReq]
optValCommandFlagNames :: [String]
optValCommandFlagNames = [String
f | (String
f,FlagInfo
i) <- (Flag RawOpts -> [(String, FlagInfo)])
-> [Flag RawOpts] -> [(String, FlagInfo)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag RawOpts -> [(String, FlagInfo)]
toFlagInfos [Flag RawOpts]
commandFlags, FlagInfo -> Bool
isOptVal FlagInfo
i]
noValFlagArgs :: [String]
noValFlagArgs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
toFlagArg ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
noValGeneralFlagNames [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`union` ([String]
noValCommandFlagNames [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
generalFlagNames)
reqValFlagArgs :: [String]
reqValFlagArgs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
toFlagArg ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
reqValGeneralFlagNames [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`union` ([String]
reqValCommandFlagNames [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
generalFlagNames)
optValFlagArgs :: [String]
optValFlagArgs = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
toFlagArg ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ [String]
optValGeneralFlagNames [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
`union` ([String]
optValCommandFlagNames [String] -> [String] -> [String]
forall a. Eq a => [a] -> [a] -> [a]
\\ [String]
generalFlagNames)
shortReqValFlagArgs :: [String]
shortReqValFlagArgs = (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isShortFlagArg [String]
reqValFlagArgs
longReqValFlagArgs_ :: [String]
longReqValFlagArgs_ = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"=") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isLongFlagArg [String]
reqValFlagArgs
longOptValFlagArgs_ :: [String]
longOptValFlagArgs_ = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"=") ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter String -> Bool
isLongFlagArg [String]
optValFlagArgs [String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String
"--debug"]
dropCliSpecificOpts :: [String] -> [String]
dropCliSpecificOpts :: [String] -> [String]
dropCliSpecificOpts = \case
String
"--conf":String
_:[String]
as -> [String] -> [String]
dropCliSpecificOpts [String]
as
String
a:[String]
as | String
"--conf=" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` String
a -> [String] -> [String]
dropCliSpecificOpts [String]
as
String
"--no-conf":[String]
as -> [String] -> [String]
dropCliSpecificOpts [String]
as
String
"-n":[String]
as -> [String] -> [String]
dropCliSpecificOpts [String]
as
String
a:[String]
as -> String
aString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String] -> [String]
dropCliSpecificOpts [String]
as
[] -> []
dropUnsupportedOpts :: Mode RawOpts -> [String] -> [String]
dropUnsupportedOpts :: Mode RawOpts -> [String] -> [String]
dropUnsupportedOpts Mode RawOpts
m = \case
[] -> []
String
"--debug":String
a:[String]
as | Bool -> Bool
not (Mode RawOpts
m Mode RawOpts -> String -> Bool
forall {a}. Mode a -> String -> Bool
`supportsFlag` String
"debug") ->
[String] -> [String]
go ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ if String -> Bool
isDebugValue String
a then [String]
as else String
aString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
as
String
a:[String]
as -> if
| String -> Bool
isLongFlagArg String
a,
let f :: String
f = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/=Char
'=') String
a,
let as' :: [String]
as' = if String -> Bool
isReqValFlagArg String
f Bool -> Bool -> Bool
&& Char
'=' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` String
a then Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
as else [String]
as
-> if Mode RawOpts
m Mode RawOpts -> String -> Bool
forall {a}. Mode a -> String -> Bool
`supportsFlag` String
f then String
a String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
go [String]
as else [String] -> [String]
go [String]
as'
| String -> Bool
isShortFlagArg String
a,
let f :: String
f = Int -> String -> String
forall a. Int -> [a] -> [a]
take Int
2 String
a,
let as' :: [String]
as' = if String -> Bool
isReqValFlagArg String
f Bool -> Bool -> Bool
&& String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
a Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
2 then Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
drop Int
1 [String]
as else [String]
as
-> if Mode RawOpts
m Mode RawOpts -> String -> Bool
forall {a}. Mode a -> String -> Bool
`supportsFlag` String
f then String
a String -> [String] -> [String]
forall a. a -> [a] -> [a]
: [String] -> [String]
go [String]
as else [String] -> [String]
go [String]
as'
| Bool
otherwise -> String
a String -> [String] -> [String]
forall a. a -> [a] -> [a]
: Mode RawOpts -> [String] -> [String]
dropUnsupportedOpts Mode RawOpts
m [String]
as
where
go :: [String] -> [String]
go = Mode RawOpts -> [String] -> [String]
dropUnsupportedOpts Mode RawOpts
m
isReqValFlagArg :: String -> Bool
isReqValFlagArg = (String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String]
reqValFlagArgs)
supportsFlag :: Mode a -> String -> Bool
supportsFlag Mode a
m1 String
flagarg = String -> [String] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem String
flagarg ([String] -> Bool) -> [String] -> Bool
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
toFlagArg ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (Flag a -> [String]) -> [Flag a] -> [String]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Flag a -> [String]
forall a. Flag a -> [String]
flagNames ([Flag a] -> [String]) -> [Flag a] -> [String]
forall a b. (a -> b) -> a -> b
$ Mode a -> [Flag a]
forall a. Mode a -> [Flag a]
modeAndSubmodeFlags Mode a
m1
modeAndSubmodeFlags :: Mode a -> [Flag a]
modeAndSubmodeFlags :: forall a. Mode a -> [Flag a]
modeAndSubmodeFlags m :: Mode a
m@Mode{modeGroupModes :: forall a. Mode a -> Group (Mode a)
modeGroupModes=Group{[(String, [Mode a])]
[Mode a]
groupUnnamed :: forall a. Group a -> [a]
groupNamed :: forall a. Group a -> [(String, [a])]
groupHidden :: forall a. Group a -> [a]
groupUnnamed :: [Mode a]
groupHidden :: [Mode a]
groupNamed :: [(String, [Mode a])]
..}} =
Mode a -> [Flag a]
forall a. Mode a -> [Flag a]
modeFlags Mode a
m [Flag a] -> [Flag a] -> [Flag a]
forall a. Semigroup a => a -> a -> a
<> (Mode a -> [Flag a]) -> [Mode a] -> [Flag a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Mode a -> [Flag a]
forall a. Mode a -> [Flag a]
modeFlags (((String, [Mode a]) -> [Mode a])
-> [(String, [Mode a])] -> [Mode a]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (String, [Mode a]) -> [Mode a]
forall a b. (a, b) -> b
snd [(String, [Mode a])]
groupNamed [Mode a] -> [Mode a] -> [Mode a]
forall a. Semigroup a => a -> a -> a
<> [Mode a]
groupUnnamed [Mode a] -> [Mode a] -> [Mode a]
forall a. Semigroup a => a -> a -> a
<> [Mode a]
groupHidden)