dev: cli: refactor/clarify main procedure and command line processing
This commit is contained in:
Simon Michael
parent
204df22739
commit
570a5472e2
@ -68,6 +68,7 @@ etc.
|
|||||||
|
|
||||||
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
|
||||||
{-# HLINT ignore "Unused LANGUAGE pragma" #-}
|
{-# HLINT ignore "Unused LANGUAGE pragma" #-}
|
||||||
|
{-# LANGUAGE MultiWayIf #-}
|
||||||
|
|
||||||
module Hledger.Cli (
|
module Hledger.Cli (
|
||||||
main,
|
main,
|
||||||
@ -109,6 +110,8 @@ import Hledger.Cli.Version
|
|||||||
import Data.Bifunctor (second)
|
import Data.Bifunctor (second)
|
||||||
import Data.Function ((&))
|
import Data.Function ((&))
|
||||||
import Data.Functor ((<&>))
|
import Data.Functor ((<&>))
|
||||||
|
import Control.Monad.Extra (unless)
|
||||||
|
import Data.Char (isDigit)
|
||||||
|
|
||||||
|
|
||||||
-- | The overall cmdargs mode describing hledger's command-line options and subcommands.
|
-- | The overall cmdargs mode describing hledger's command-line options and subcommands.
|
||||||
@ -149,216 +152,257 @@ mainmode addons = defMode {
|
|||||||
-- ]
|
-- ]
|
||||||
}
|
}
|
||||||
|
|
||||||
-- | Let's go!
|
------------------------------------------------------------------------------
|
||||||
|
-- | hledger CLI's main procedure.
|
||||||
|
--
|
||||||
|
-- Here we will parse the command line, read any config file,
|
||||||
|
-- and search for hledger-* addon executables in the user's PATH,
|
||||||
|
-- then choose the appropriate builtin operation or addon operation to run,
|
||||||
|
-- then run it in the right way, usually reading input data (eg a journal) first.
|
||||||
|
--
|
||||||
|
-- Making the CLI usable and robust with main command, builtin subcommands,
|
||||||
|
-- and various kinds of addon commands, while balancing UX, environment, idioms,
|
||||||
|
-- legacy, and a language and libraries with their own requirements and limitations,
|
||||||
|
-- gets a bit complex. Try to keep this reasonably manageable/testable/clear.
|
||||||
|
-- See also: Hledger.Cli.CliOptions, cli.test, and the debug output below.
|
||||||
|
--
|
||||||
main :: IO ()
|
main :: IO ()
|
||||||
main = withGhcDebug' $ do
|
main = withGhcDebug' $ do
|
||||||
when (ghcDebugMode == GDPauseAtStart) $ ghcDebugPause'
|
|
||||||
|
-- let's go!
|
||||||
|
let
|
||||||
|
dbgIO :: Show a => String -> a -> IO () -- this signature is needed
|
||||||
|
dbgIO = ptraceAtIO 8
|
||||||
|
dbgIO "running" prognameandversion
|
||||||
|
|
||||||
starttime <- getPOSIXTime
|
starttime <- getPOSIXTime
|
||||||
|
|
||||||
-- try to encourage user's $PAGER to properly display ANSI
|
-- give ghc-debug a chance to take control
|
||||||
|
when (ghcDebugMode == GDPauseAtStart) $ ghcDebugPause'
|
||||||
|
|
||||||
|
-- try to encourage user's $PAGER to display ANSI when supported
|
||||||
when useColorOnStdout setupPager
|
when useColorOnStdout setupPager
|
||||||
|
|
||||||
-- Choose and run the appropriate internal or external command based
|
-- do some preliminary argument parsing to help cmdargs
|
||||||
-- on the raw command-line arguments, cmdarg's interpretation of
|
cliargs <- getArgs
|
||||||
-- same, and hledger-* executables in the user's PATH. A somewhat
|
>>= expandArgsAt -- interpolate @ARGFILEs
|
||||||
-- complex mishmash of cmdargs and custom processing, hence all the
|
<&> replaceNumericFlags -- convert -NUM to --depth=NUM
|
||||||
-- debugging support and tests. See also Hledger.Cli.CliOptions and
|
|
||||||
-- command-line.test.
|
|
||||||
|
|
||||||
-- some preliminary (imperfect) argument parsing to supplement cmdargs
|
|
||||||
rawcliargs <- getArgs >>= expandArgsAt
|
|
||||||
let
|
let
|
||||||
cliargswithcmdfirst = rawcliargs & replaceNumericFlags & moveFlagsAfterCommand
|
cliargswithcmdfirst = cliargs & moveFlagsAfterCommand
|
||||||
isNonEmptyNonFlag s = not $ null s || "-" `isPrefixOf` s
|
isNonEmptyNonFlag s = not $ null s || "-" `isPrefixOf` s
|
||||||
clicmdarg = headDef "" $ takeWhile isNonEmptyNonFlag cliargswithcmdfirst
|
clicmdarg = headDef "" $ takeWhile isNonEmptyNonFlag cliargswithcmdfirst
|
||||||
isNullCommand = null clicmdarg
|
nocmdprovided = null clicmdarg
|
||||||
(rawcliargsbeforecmd, rawcliargsaftercmd) = second (drop 1) $ break (==clicmdarg) rawcliargs
|
(cliargsbeforecmd, cliargsaftercmd) = second (drop 1) $ break (==clicmdarg) cliargs
|
||||||
dbgIO :: Show a => String -> a -> IO () -- type signature needed
|
|
||||||
dbgIO = ptraceAtIO 8
|
|
||||||
|
|
||||||
dbgIO "running" prognameandversion
|
dbgIO "cli args" cliargs
|
||||||
dbgIO "raw cli args" rawcliargs
|
dbgIO "cli args with command argument first, if any" cliargswithcmdfirst
|
||||||
dbgIO "raw args before command" rawcliargsbeforecmd
|
dbgIO "command argument found" clicmdarg
|
||||||
dbgIO "raw args after command" rawcliargsaftercmd
|
dbgIO "cli args before command" cliargsbeforecmd
|
||||||
dbgIO "raw cli args rearranged for cmdargs" cliargswithcmdfirst
|
dbgIO "cli args after command" cliargsaftercmd
|
||||||
dbgIO "command argument is probably" clicmdarg
|
|
||||||
|
|
||||||
-- search PATH for addon commands, excluding any that match builtin command names
|
-- Search PATH for addon commands. Exclude any that match builtin command names.
|
||||||
addons <- hledgerAddons <&> filter (not . (`elem` builtinCommandNames) . dropExtension)
|
addons <- hledgerAddons <&> filter (not . (`elem` builtinCommandNames) . dropExtension)
|
||||||
|
|
||||||
-- do a preliminary parse with cmdargs to identify the full command name
|
-- Now, so we can look for command-specific options in config files,
|
||||||
let cmd = stringopt "command" $ parseArgsWithCmdargs cliargswithcmdfirst addons
|
-- try to identify the command's full name (clicmdarg may be an abbreviation).
|
||||||
|
-- For this we do a preliminary parse of the user's arguments with cmdargs.
|
||||||
|
-- If no command was provided, or if the command line contains a bad flag
|
||||||
|
-- or a wrongly present/missing flag argument, cmd will be "".
|
||||||
|
let
|
||||||
|
cmd = parseArgsWithCmdargs cliargswithcmdfirst addons & either (const "") (stringopt "command")
|
||||||
|
badcmdprovided = null cmd && not nocmdprovided
|
||||||
|
isaddoncmd = not (null cmd) && cmd `elem` addons
|
||||||
|
-- isbuiltincmd = cmd `elem` builtinCommandNames
|
||||||
|
|
||||||
-- get any extra args/opts declared in a config file, both general and command-specific
|
dbgIO "nocmdprovided" nocmdprovided
|
||||||
|
dbgIO "badcmdprovided" badcmdprovided
|
||||||
|
dbgIO "cmd found" cmd
|
||||||
|
dbgIO "isaddoncmd" isaddoncmd
|
||||||
|
|
||||||
|
-- Read any extra general args/opts, and any command-specific ones, from a config file.
|
||||||
|
-- And insert them before the user's args, with adjustments, to get the final args.
|
||||||
conf <- getConf
|
conf <- getConf
|
||||||
let
|
let
|
||||||
genargsfromconf = confArgsFor "general" conf
|
genargsfromconf = confArgsFor "general" conf
|
||||||
cmdargsfromconf = confArgsFor cmd conf
|
cmdargsfromconf = if null cmd then [] else confArgsFor cmd conf
|
||||||
dbgIO ("extra general args from config file") genargsfromconf
|
argsfromcli = drop 1 cliargswithcmdfirst
|
||||||
dbgIO ("extra "<>cmd<>" args from config file") cmdargsfromconf
|
finalargs = -- (avoid breaking vs code haskell highlighting..)
|
||||||
|
if null clicmdarg then [] else [clicmdarg] <> genargsfromconf <> cmdargsfromconf <> argsfromcli
|
||||||
|
& replaceNumericFlags -- convert any -NUM opts from the config file
|
||||||
|
-- finalargs' <- expandArgsAt finalargs -- expand any @ARGFILEs from the config file ? don't bother
|
||||||
|
|
||||||
-- insert the config file args (before the others) and parse the lot with cmdargs
|
unless (null genargsfromconf) $ dbgIO ("extra general args from config file") genargsfromconf
|
||||||
let
|
unless (null cmdargsfromconf) $ dbgIO ("extra "<>cmd<>" args from config file") cmdargsfromconf
|
||||||
(clicmdarg',cliotherargs) = splitAt 1 cliargswithcmdfirst
|
dbgIO "final args" finalargs
|
||||||
allargswithcmdfirst = clicmdarg' <> genargsfromconf <> cmdargsfromconf <> cliotherargs & replaceNumericFlags
|
|
||||||
dbgIO "allargswithcmdfirst" allargswithcmdfirst
|
-- Now parse these in full, first to RawOpts with cmdargs, then to hledger CliOpts.
|
||||||
opts' <- argsToCliOpts allargswithcmdfirst addons
|
-- At this point a bad flag or flag argument will cause the program to exit with an error.
|
||||||
-- and save the start time
|
let rawopts = either usageError id $ parseArgsWithCmdargs finalargs addons
|
||||||
let opts = opts'{progstarttime_=starttime}
|
opts0 <- rawOptsToCliOpts rawopts
|
||||||
|
let opts = opts0{progstarttime_=starttime}
|
||||||
|
|
||||||
-- select an action and prepare to run it
|
|
||||||
let
|
|
||||||
isInternalCommand = cmd `elem` builtinCommandNames -- not (null cmd) && not (cmd `elem` addons)
|
|
||||||
isExternalCommand = not (null cmd) && cmd `elem` addons -- probably
|
|
||||||
isBadCommand = not (null clicmdarg) && null cmd
|
|
||||||
printUsage = pager $ showModeUsage (mainmode addons) ++ "\n"
|
|
||||||
badCommandError = error' ("command "++clicmdarg++" is not recognized, run with no command to see a list") >> exitFailure -- PARTIAL:
|
|
||||||
helpFlag = boolopt "help" $ rawopts_ opts
|
|
||||||
tldrFlag = boolopt "tldr" $ rawopts_ opts
|
|
||||||
infoFlag = boolopt "info" $ rawopts_ opts
|
|
||||||
manFlag = boolopt "man" $ rawopts_ opts
|
|
||||||
versionFlag = boolopt "version" $ rawopts_ opts
|
|
||||||
f `orShowHelp` mode1
|
|
||||||
| helpFlag = pager $ showModeUsage mode1 ++ "\n"
|
|
||||||
| tldrFlag = runTldrForPage $ maybe "hledger" (("hledger-"<>)) $ headMay $ modeNames mode1
|
|
||||||
| infoFlag = runInfoForTopic "hledger" (headMay $ modeNames mode1)
|
|
||||||
| manFlag = runManForTopic "hledger" (headMay $ modeNames mode1)
|
|
||||||
| otherwise = f
|
|
||||||
-- where
|
|
||||||
-- lastdocflag
|
|
||||||
dbgIO "processed opts" opts
|
dbgIO "processed opts" opts
|
||||||
dbgIO "command matched" cmd
|
|
||||||
dbgIO "isNullCommand" isNullCommand
|
|
||||||
dbgIO "isInternalCommand" isInternalCommand
|
|
||||||
dbgIO "isExternalCommand" isExternalCommand
|
|
||||||
dbgIO "isBadCommand" isBadCommand
|
|
||||||
dbgIO "period from opts" (period_ . _rsReportOpts $ reportspec_ opts)
|
dbgIO "period from opts" (period_ . _rsReportOpts $ reportspec_ opts)
|
||||||
dbgIO "interval from opts" (interval_ . _rsReportOpts $ reportspec_ opts)
|
dbgIO "interval from opts" (interval_ . _rsReportOpts $ reportspec_ opts)
|
||||||
dbgIO "query from opts & args" (_rsQuery $ reportspec_ opts)
|
dbgIO "query from opts & args" (_rsQuery $ reportspec_ opts)
|
||||||
|
|
||||||
|
-- Finally, select an action and run it.
|
||||||
|
|
||||||
|
-- Check for the help/doc/version flags first, since they are a high priority.
|
||||||
|
-- (A perfectionist might think they should be so high priority that adding -h
|
||||||
|
-- to an invalid command line would show help. But cmdargs tends to fail first,
|
||||||
|
-- preventing this, and trying to detect them without cmdargs, and always do the
|
||||||
|
-- right thing with builtin commands and addon commands, gets much too complicated.)
|
||||||
let
|
let
|
||||||
runHledgerCommand
|
helpFlag = boolopt "help" $ rawopts_ opts
|
||||||
-- high priority flags and situations. -h, then --help, then --tldr, then --info, then --man are highest priority.
|
tldrFlag = boolopt "tldr" $ rawopts_ opts
|
||||||
| isNullCommand && helpFlag = dbgIO "" "-h/--help with no command, showing general help" >> printUsage
|
infoFlag = boolopt "info" $ rawopts_ opts
|
||||||
| isNullCommand && tldrFlag = dbgIO "" "--tldr with no command, showing general tldr page" >> runTldrForPage "hledger"
|
manFlag = boolopt "man" $ rawopts_ opts
|
||||||
| isNullCommand && infoFlag = dbgIO "" "--info with no command, showing general info manual" >> runInfoForTopic "hledger" Nothing
|
versionFlag = boolopt "version" $ rawopts_ opts
|
||||||
| isNullCommand && manFlag = dbgIO "" "--man with no command, showing general man page" >> runManForTopic "hledger" Nothing
|
if
|
||||||
| versionFlag && not (isExternalCommand || helpFlag || tldrFlag || infoFlag || manFlag) = putStrLn prognameandversion
|
-- no command and a help/doc flag found - show general help/docs
|
||||||
| isNullCommand = dbgIO "" "no command, showing commands list" >> printCommandsList prognameandversion addons
|
| nocmdprovided && helpFlag -> pager $ showModeUsage (mainmode []) ++ "\n"
|
||||||
| isBadCommand = badCommandError
|
| nocmdprovided && tldrFlag -> runTldrForPage "hledger"
|
||||||
|
| nocmdprovided && infoFlag -> runInfoForTopic "hledger" Nothing
|
||||||
|
| nocmdprovided && manFlag -> runManForTopic "hledger" Nothing
|
||||||
|
|
||||||
-- builtin commands
|
-- --version flag found and none of these other conditions - show version
|
||||||
| Just (cmdmode, cmdaction) <- findBuiltinCommand cmd =
|
| versionFlag && not (isaddoncmd || helpFlag || tldrFlag || infoFlag || manFlag) -> putStrLn prognameandversion
|
||||||
(case True of
|
|
||||||
-- these commands should not require or read the journal
|
|
||||||
_ | cmd `elem` ["demo","help","test"] ->
|
|
||||||
cmdaction opts $ error' $ cmd++" tried to read the journal but is not supposed to"
|
|
||||||
-- these commands should create the journal if missing
|
|
||||||
_ | cmd `elem` ["add","import"] -> do
|
|
||||||
ensureJournalFileExists . NE.head =<< journalFilePathFromOpts opts
|
|
||||||
withJournalDo opts (cmdaction opts)
|
|
||||||
-- other commands read the journal and should fail if it's missing
|
|
||||||
_ -> withJournalDo opts (cmdaction opts)
|
|
||||||
)
|
|
||||||
`orShowHelp` cmdmode
|
|
||||||
|
|
||||||
-- addon commands
|
-- there's a command argument, but it's bad - show error
|
||||||
| isExternalCommand = do
|
| badcmdprovided -> error' $ "command "++clicmdarg++" is not recognized, run with no command to see a list"
|
||||||
let externalargs = rawcliargsbeforecmd ++ filter (/="--") rawcliargsaftercmd
|
|
||||||
let shellcmd = printf "%s-%s %s" progname cmd (unwords' externalargs) :: String
|
|
||||||
dbgIO "external command selected" cmd
|
|
||||||
dbgIO "external command arguments" (map quoteIfNeeded externalargs)
|
|
||||||
dbgIO "running shell command" shellcmd
|
|
||||||
system shellcmd >>= exitWith
|
|
||||||
|
|
||||||
-- deprecated commands
|
-- no command found, nothing else to do - show the commands list
|
||||||
-- cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure
|
| nocmdprovided -> dbgIO "" "no command, showing commands list" >> printCommandsList prognameandversion addons
|
||||||
|
|
||||||
-- XXX shouldn't/doesn't reach here, but this output might be helpful
|
-- builtin command found
|
||||||
| otherwise = usageError $
|
| Just (cmdmode, cmdaction) <- findBuiltinCommand cmd,
|
||||||
"could not understand the arguments "++show allargswithcmdfirst
|
let mcmdname = headMay $ modeNames cmdmode,
|
||||||
<> if null genargsfromconf then "" else "\ngeneral arguments added from config file: "++show genargsfromconf
|
let tldrpagename = maybe "hledger" (("hledger-"<>)) mcmdname ->
|
||||||
<> if null cmdargsfromconf then "" else "\ncommand "<>cmd<>" arguments added from config file: "++show cmdargsfromconf
|
if
|
||||||
|
-- help/doc flag - show command help/docs
|
||||||
|
| helpFlag -> pager $ showModeUsage cmdmode ++ "\n"
|
||||||
|
| tldrFlag -> runTldrForPage tldrpagename
|
||||||
|
| infoFlag -> runInfoForTopic "hledger" mcmdname
|
||||||
|
| manFlag -> runManForTopic "hledger" mcmdname
|
||||||
|
|
||||||
-- do it
|
-- builtin command which should not require or read the journal - run it
|
||||||
runHledgerCommand
|
| cmd `elem` ["demo","help","test"] ->
|
||||||
|
cmdaction opts $ error' $ cmd++" tried to read the journal but is not supposed to"
|
||||||
|
|
||||||
|
-- builtin command which should create the journal if missing - do that and run it
|
||||||
|
| cmd `elem` ["add","import"] -> do
|
||||||
|
ensureJournalFileExists . NE.head =<< journalFilePathFromOpts opts
|
||||||
|
withJournalDo opts (cmdaction opts)
|
||||||
|
|
||||||
|
-- all other builtin commands - read the journal and if successful run the command with it
|
||||||
|
| otherwise -> withJournalDo opts (cmdaction opts)
|
||||||
|
|
||||||
|
-- addon command found - run it, passing along all arguments except the command name.
|
||||||
|
-- It will process args and read the journal itself as needed.
|
||||||
|
| isaddoncmd -> do
|
||||||
|
let addonargs = cliargsbeforecmd ++ filter (/="--") cliargsaftercmd
|
||||||
|
let shellcmd = printf "%s-%s %s" progname cmd (unwords' addonargs) :: String
|
||||||
|
dbgIO "addon command selected" cmd
|
||||||
|
dbgIO "addon command arguments" (map quoteIfNeeded addonargs)
|
||||||
|
dbgIO "running shell command" shellcmd
|
||||||
|
system shellcmd >>= exitWith
|
||||||
|
|
||||||
|
-- deprecated command found
|
||||||
|
-- cmd == "convert" = error' (modeHelp oldconvertmode) >> exitFailure
|
||||||
|
|
||||||
|
-- something else (shouldn't happen ?) - show an error
|
||||||
|
| otherwise -> usageError $
|
||||||
|
"could not understand the arguments "++show finalargs
|
||||||
|
<> if null genargsfromconf then "" else "\ngeneral arguments added from config file: "++show genargsfromconf
|
||||||
|
<> if null cmdargsfromconf then "" else "\ncommand "<>cmd<>" arguments added from config file: "++show cmdargsfromconf
|
||||||
|
|
||||||
|
-- And we're done.
|
||||||
|
-- Give ghc-debug a final chance to take control.
|
||||||
when (ghcDebugMode == GDPauseAtEnd) $ ghcDebugPause'
|
when (ghcDebugMode == GDPauseAtEnd) $ ghcDebugPause'
|
||||||
|
|
||||||
-- | Parse hledger CLI options from these command line arguments and add-on command names.
|
------------------------------------------------------------------------------
|
||||||
-- Or if it fails, exit the program with usageError.
|
|
||||||
|
|
||||||
|
|
||||||
|
-- | A helper for addons/scripts: this parses hledger CliOpts from these
|
||||||
|
-- command line arguments and add-on command names, roughly how hledger main does.
|
||||||
|
-- If option parsing/validating fails, it exits the program with usageError.
|
||||||
|
-- Unlike main, this does not read extra args from a config file
|
||||||
|
-- or search for addons; to do those things, mimic the code in main for now.
|
||||||
argsToCliOpts :: [String] -> [String] -> IO CliOpts
|
argsToCliOpts :: [String] -> [String] -> IO CliOpts
|
||||||
argsToCliOpts rawargs addons = do
|
argsToCliOpts args addons = do
|
||||||
-- Try to ensure the command argument is first, and rewrite -NUM flags
|
let args' = args & moveFlagsAfterCommand & replaceNumericFlags
|
||||||
-- which cmdargs doesn't support. This is already done in main but
|
let rawopts = either usageError id $ parseArgsWithCmdargs args' addons
|
||||||
-- perhaps there are other users of this function.
|
rawOptsToCliOpts rawopts
|
||||||
let args = moveFlagsAfterCommand $ replaceNumericFlags rawargs
|
|
||||||
rawOptsToCliOpts $ parseArgsWithCmdargs args addons
|
|
||||||
|
|
||||||
-- | Parse these command line arguments/options with cmdargs using mainmode.
|
-- | Parse these command line arguments/options with cmdargs using mainmode.
|
||||||
-- The names of known addon commands are provided so they too can be recognised.
|
-- The names of known addon commands are provided so they too can be recognised.
|
||||||
-- If it fails, exit the program with usageError.
|
-- If it fails, exit the program with usageError.
|
||||||
parseArgsWithCmdargs :: [String] -> [String] -> RawOpts
|
parseArgsWithCmdargs :: [String] -> [String] -> Either String RawOpts
|
||||||
parseArgsWithCmdargs args addons =
|
parseArgsWithCmdargs args addons = CmdArgs.process (mainmode addons) args
|
||||||
either usageError id $ CmdArgs.process (mainmode addons) args
|
|
||||||
|
|
||||||
-- | A hacky workaround for cmdargs not accepting flags before the
|
-- | cmdargs does not allow flags to appear before the subcommand name.
|
||||||
-- subcommand name: try to detect and move such flags after the
|
-- We would like to hide this restriction from the user, making the CLI more forgiving.
|
||||||
-- command. This allows the user to put them in either position.
|
-- So this tries to move flags, and their values, after the command name.
|
||||||
-- The order of options is not preserved, but that should be ok.
|
-- It's tricky because flags can have an argument following a space, and flags can have optional arguments.
|
||||||
|
-- We don't parse as precisely as cmdargs here, but we make a reasonable attempt like so:
|
||||||
|
--
|
||||||
|
-- - ensure the optional-argument --debug flag has an argument
|
||||||
|
-- (XXX Now there are more optional-arg flags for which this should be done, like --forecast, but that's harder)
|
||||||
|
--
|
||||||
|
-- - move all no-argument input/report/help flags
|
||||||
|
--
|
||||||
|
-- - move all required-argument input/report/help flags and their values, whether space-separated or not
|
||||||
|
--
|
||||||
|
-- - try not to confuse things further or cause misleading errors.
|
||||||
|
--
|
||||||
|
-- Note this currently only moves general flags, not command flags.
|
||||||
|
-- So the manual says only "General options can be written either before or after the command name".
|
||||||
--
|
--
|
||||||
-- Since we're not parsing flags as precisely as cmdargs here, this is
|
|
||||||
-- imperfect. We make a decent effort to:
|
|
||||||
-- - move all no-argument help/input/report flags
|
|
||||||
-- - move all required-argument help/input/report flags along with their values, space-separated or not
|
|
||||||
-- - ensure --debug has an argument (because.. "or this all goes to hell")
|
|
||||||
-- - not confuse things further or cause misleading errors.
|
|
||||||
moveFlagsAfterCommand :: [String] -> [String]
|
moveFlagsAfterCommand :: [String] -> [String]
|
||||||
moveFlagsAfterCommand args = moveArgs $ ensureDebugHasArg args
|
moveFlagsAfterCommand args = moveArgs $ ensureDebugHasArg args
|
||||||
where
|
where
|
||||||
|
ensureDebugHasArg as = case break (=="--debug") as of
|
||||||
|
(bs,"--debug":c:cs) | null c || not (all isDigit c) -> bs++"--debug=1":c:cs
|
||||||
|
(bs,["--debug"]) -> bs++["--debug=1"]
|
||||||
|
_ -> as
|
||||||
|
|
||||||
moveArgs args1 = insertFlagsAfterCommand $ moveArgs' (args1, [])
|
moveArgs args1 = insertFlagsAfterCommand $ moveArgs' (args1, [])
|
||||||
|
|
||||||
|
moveArgs' ((f:v:a:as), flags) | isMovableReqArgFlag f, isValue v = moveArgs' (a:as, flags ++ [f,v]) -- -f FILE ..., --alias ALIAS ...
|
||||||
|
moveArgs' ((fv:a:as), flags) | isMovableFlagAndValue fv = moveArgs' (a:as, flags ++ [fv]) -- -fFILE ..., --alias=ALIAS ...
|
||||||
|
moveArgs' ((f:a:as), flags) | isMovableReqArgFlag f, not (isValue a) = moveArgs' (a:as, flags ++ [f]) -- -f(missing arg)
|
||||||
|
moveArgs' ((f:a:as), flags) | isMovableNoArgFlag f = moveArgs' (a:as, flags ++ [f]) -- -h ..., --version ...
|
||||||
|
moveArgs' (as, flags) = (as, flags) -- anything else
|
||||||
|
|
||||||
|
insertFlagsAfterCommand ([], flags) = flags
|
||||||
|
insertFlagsAfterCommand (command1:args2, flags) = [command1] ++ flags ++ args2
|
||||||
|
|
||||||
|
movableflags = inputflags ++ reportflags ++ helpflags
|
||||||
|
noargmovableflags = concatMap flagNames (filter ((==FlagNone).flagInfo) movableflags) ++ ["tl", "tld"]
|
||||||
|
-- include --tldr abbreviations (other help flags have no unambiguous abbreviations)
|
||||||
|
reqargmovableflags = concatMap flagNames $ filter ((==FlagReq ).flagInfo) movableflags
|
||||||
|
optargmovableflags = concatMap flagNames $ filter (isoptargflag.flagInfo) movableflags
|
||||||
where
|
where
|
||||||
-- -f FILE ..., --alias ALIAS ...
|
isoptargflag = \case
|
||||||
moveArgs' ((f:v:a:as), flags) | isMovableReqArgFlag f, isValue v = moveArgs' (a:as, flags ++ [f,v])
|
FlagOpt _ -> True
|
||||||
-- -fFILE ..., --alias=ALIAS ...
|
FlagOptRare _ -> True
|
||||||
moveArgs' ((fv:a:as), flags) | isMovableArgFlagAndValue fv = moveArgs' (a:as, flags ++ [fv])
|
_ -> False
|
||||||
-- -f(missing arg)
|
|
||||||
moveArgs' ((f:a:as), flags) | isMovableReqArgFlag f, not (isValue a) = moveArgs' (a:as, flags ++ [f])
|
|
||||||
-- -h ..., --version ...
|
|
||||||
moveArgs' ((f:a:as), flags) | isMovableNoArgFlag f = moveArgs' (a:as, flags ++ [f])
|
|
||||||
-- anything else
|
|
||||||
moveArgs' (as, flags) = (as, flags)
|
|
||||||
|
|
||||||
insertFlagsAfterCommand ([], flags) = flags
|
isMovableNoArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` optargmovableflags ++ noargmovableflags
|
||||||
insertFlagsAfterCommand (command1:args2, flags) = [command1] ++ flags ++ args2
|
|
||||||
|
|
||||||
isMovableNoArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` optargflagstomove ++ noargflagstomove
|
isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargmovableflags
|
||||||
|
|
||||||
isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargflagstomove
|
isMovableFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of
|
||||||
|
(f:fs,_:_) -> (f:fs) `elem` optargmovableflags ++ reqargmovableflags
|
||||||
|
_ -> False
|
||||||
|
isMovableFlagAndValue ('-':shortflag:_:_) = [shortflag] `elem` reqargmovableflags
|
||||||
|
isMovableFlagAndValue _ = False
|
||||||
|
|
||||||
isMovableArgFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of
|
isValue "-" = True
|
||||||
(f:fs,_:_) -> (f:fs) `elem` optargflagstomove ++ reqargflagstomove
|
isValue ('-':_) = False
|
||||||
_ -> False
|
isValue _ = True
|
||||||
isMovableArgFlagAndValue ('-':shortflag:_:_) = [shortflag] `elem` reqargflagstomove
|
|
||||||
isMovableArgFlagAndValue _ = False
|
|
||||||
|
|
||||||
isValue "-" = True
|
|
||||||
isValue ('-':_) = False
|
|
||||||
isValue _ = True
|
|
||||||
|
|
||||||
flagstomove = inputflags ++ reportflags ++ helpflags
|
|
||||||
noargflagstomove = concatMap flagNames (filter ((==FlagNone).flagInfo) flagstomove)
|
|
||||||
-- silly special case: if someone is abbreviating --tldr, make sure it works right when written before COMMAND
|
|
||||||
-- (not needed for --info, --man, --version since their abbreviations are ambiguous)
|
|
||||||
++ ["tl", "tld"]
|
|
||||||
reqargflagstomove = -- filter (/= "debug") $
|
|
||||||
concatMap flagNames $ filter ((==FlagReq ).flagInfo) flagstomove
|
|
||||||
optargflagstomove = concatMap flagNames $ filter (isFlagOpt .flagInfo) flagstomove
|
|
||||||
where
|
|
||||||
isFlagOpt = \case
|
|
||||||
FlagOpt _ -> True
|
|
||||||
FlagOptRare _ -> True
|
|
||||||
_ -> False
|
|
||||||
|
|
||||||
|
|
||||||
-- unit tests (tests_Hledger_Cli) are defined in Hledger.Cli.Commands
|
-- unit tests (tests_Hledger_Cli) are defined in Hledger.Cli.Commands
|
||||||
|
|||||||
@ -48,7 +48,6 @@ module Hledger.Cli.CliOptions (
|
|||||||
withAliases,
|
withAliases,
|
||||||
likelyExecutablesInPath,
|
likelyExecutablesInPath,
|
||||||
hledgerExecutablesInPath,
|
hledgerExecutablesInPath,
|
||||||
ensureDebugHasArg,
|
|
||||||
|
|
||||||
-- * CLI options
|
-- * CLI options
|
||||||
CliOpts(..),
|
CliOpts(..),
|
||||||
@ -901,9 +900,3 @@ instance HasReportOptsNoUpdate CliOpts where
|
|||||||
instance HasReportOpts CliOpts where
|
instance HasReportOpts CliOpts where
|
||||||
reportOpts = reportSpec.reportOpts
|
reportOpts = reportSpec.reportOpts
|
||||||
|
|
||||||
-- | Convert an argument-less --debug flag to --debug=1 in the given arguments list.
|
|
||||||
-- Used by hledger/ui/web to make their command line parsing easier somehow.
|
|
||||||
ensureDebugHasArg as = case break (=="--debug") as of
|
|
||||||
(bs,"--debug":c:cs) | null c || not (all isDigit c) -> bs++"--debug=1":c:cs
|
|
||||||
(bs,["--debug"]) -> bs++["--debug=1"]
|
|
||||||
_ -> as
|
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user