fix:cli: order of last flag could be lost, disrupting --no-conf eg

Move pre-command flags more carefully, including the last one,
so that the relative order of options is preserved.
(This caused --conf foo --no-conf to sometimes ignore the --no-conf.)
Debug output has also been improved.
This commit is contained in:
Simon Michael 2024-10-12 13:23:49 -10:00
parent 21e27a0283
commit e2599e85a4
2 changed files with 46 additions and 33 deletions

View File

@ -96,7 +96,7 @@ import Data.Function ((&))
import Data.Functor ((<&>)) import Data.Functor ((<&>))
import Data.List import Data.List
import qualified Data.List.NonEmpty as NE import qualified Data.List.NonEmpty as NE
import Data.Maybe (isJust, fromMaybe) import Data.Maybe (isJust, fromMaybe, fromJust)
import Data.Text (pack, Text) import Data.Text (pack, Text)
import Data.Time.Clock.POSIX (getPOSIXTime) import Data.Time.Clock.POSIX (getPOSIXTime)
import Safe import Safe
@ -226,11 +226,11 @@ main = withGhcDebug' $ do
cliargswithcmdfirstwithoutclispecific = dropCliSpecificOpts cliargswithcmdfirst cliargswithcmdfirstwithoutclispecific = dropCliSpecificOpts cliargswithcmdfirst
(cliargsbeforecmd, cliargsaftercmd) = second (drop 1) $ break (==clicmdarg) cliargs (cliargsbeforecmd, cliargsaftercmd) = second (drop 1) $ break (==clicmdarg) cliargs
dbgIO "cli args" cliargs dbgIO "cli args" cliargs
dbg1IO "cli args with command first, if any" cliargswithcmdfirst dbg1IO "cli args with options moved after command, if any" cliargswithcmdfirst
dbgIO "cli command argument found" clicmdarg dbgIO "cli command argument found" clicmdarg
dbgIO "cli args before command" cliargsbeforecmd dbgIO "cli args before command" cliargsbeforecmd
dbgIO "cli args after command" cliargsaftercmd dbgIO "cli args after command" cliargsaftercmd
dbgIO "cli args without command" cliargswithoutcmd -- dbgIO "cli args without command" cliargswithoutcmd
--------------------------------------------------------------- ---------------------------------------------------------------
dbgIO "\n2. Read the config file if any" () dbgIO "\n2. Read the config file if any" ()
@ -458,9 +458,9 @@ cmdargsParse desc m args0 = process m (ensureDebugFlagHasVal args0)
-- Short flags can be joined together, some flags can have a value or no value, -- Short flags can be joined together, some flags can have a value or no value,
-- flags and values can be separated by =, a space, or nothing, etc. -- flags and values can be separated by =, a space, or nothing, etc.
-- --
-- We make a best-effort attempt like so: -- In this context, a "flag" is an argument beginning with - or --, followed by one or more non-space characters.
-- whether a flag argument (- or -- followed by a non-space character and zero or more others), -- We decide if a flag, and possibly its subsequent value argument, are movable
-- and its following argument, are movable, falls into these cases, to be checked in this order: -- by checking these cases in order:
-- --
-- - it exactly matches a known short or long no-value flag; move it -- - it exactly matches a known short or long no-value flag; move it
-- - it exactly matches a short or long requires-value flag; move it and the following argument -- - it exactly matches a short or long requires-value flag; move it and the following argument
@ -487,27 +487,35 @@ cmdargsParse desc m args0 = process m (ensureDebugFlagHasVal args0)
-- --
moveFlagsAfterCommand :: [String] -> (String, [String], [String]) moveFlagsAfterCommand :: [String] -> (String, [String], [String])
moveFlagsAfterCommand args = moveFlagsAfterCommand args =
case moveFlagArgs (args, []) of case moveFlagAndVal (args, []) of
([],as) -> ("", as, as) ([],as) -> ("", as, as)
(unmoved@(('-':_):_), moved) -> ("", as, as) where as = unmoved<>moved (unmoved@(('-':_):_), moved) -> ("", as, as) where as = unmoved<>moved
(cmdarg:unmoved, moved) -> (cmdarg, as, cmdarg:as) where as = unmoved<>moved (cmdarg:unmoved, moved) -> (cmdarg, as, cmdarg:as) where as = unmoved<>moved
where where
moveFlagArgs :: ([String], [String]) -> ([String], [String]) -- Move the next argument to the end if it is a movable flag, along with its subsequent value argument if any.
moveFlagArgs ((a:b:cs), moved) moveFlagAndVal :: ([String], [String]) -> ([String], [String])
| isMovableFlagArg a b == 2 = moveFlagArgs (cs, moved++[a,b]) moveFlagAndVal ((a:b:cs), moved) =
| isMovableFlagArg a b == 1 = moveFlagArgs (b:cs, moved++[a]) case isMovableFlagArg a (Just b) of
| otherwise = (a:b:cs, moved) 2 -> traceOrLogAt lvl ("moving 2: "<>a<>" "<>b) $ moveFlagAndVal (cs, moved++[a,b])
where 1 -> traceOrLogAt lvl ("moving 1: "<>a) $ moveFlagAndVal (b:cs, moved++[a])
-- Is this a short or long flag argument that should be moved, _ -> traceOrLogAt lvl ("found unmovable: "<>a) (a:b:cs, moved)
-- and is its following argument a value that also should be moved ? moveFlagAndVal ([a], moved) =
-- Returns: case isMovableFlagArg a Nothing of
-- 0 (not a flag; don't move this argument) 1 -> traceOrLogAt lvl ("moving 1: "<>a) ([], moved++[a])
-- 1 (a valueless flag, or a long flag with joined argument, or multiple joined valueless short flags; move this argument) _ -> traceOrLogAt lvl ("found unmovable: "<>a) ([a], moved)
-- 2 (a short or long flag with a value in the next argument; move this and next argument). moveFlagAndVal ([], moved) = ptraceOrLogAt lvl "moved all" ([], moved)
isMovableFlagArg :: String -> String -> Int lvl = 8
isMovableFlagArg a1 a2
-- Is this a short or long flag argument that should be moved,
-- and is its following argument a value that also should be moved ?
-- Returns:
-- 0 (not a flag; don't move this argument)
-- 1 (a valueless flag, or a long flag with joined argument, or multiple joined valueless short flags; move this argument)
-- 2 (a short or long flag with a value in the next argument; move this and next argument).
isMovableFlagArg :: String -> Maybe String -> Int
isMovableFlagArg a1 ma2
| a1 `elem` noValFlagArgs = 1 -- short or long no-val flag | a1 `elem` noValFlagArgs = 1 -- short or long no-val flag
| a1 == "--debug" && not (isDebugValue a2) = 1 --debug without a value | a1 == "--debug" && isJust ma2 && not (isDebugValue $ fromJust ma2) = 1 --debug without a value
| a1 `elem` reqValFlagArgs = 2 -- short or long req-val flag (or --debug) with a separate value | a1 `elem` reqValFlagArgs = 2 -- short or long req-val flag (or --debug) with a separate value
| a1 `elem` optValFlagArgs = 1 -- long (or short ?) opt-val flag, assume no value | a1 `elem` optValFlagArgs = 1 -- long (or short ?) opt-val flag, assume no value
| any (`isPrefixOf` a1) shortReqValFlagArgs = 1 -- short req-val flag with a joined value | any (`isPrefixOf` a1) shortReqValFlagArgs = 1 -- short req-val flag with a joined value
@ -517,7 +525,6 @@ moveFlagsAfterCommand args =
-- | isLongFlagArg a1 && any (takeWhile (/='=') `isPrefixOf`) longReqValFlagArgs_ ... -- try to move abbreviated long flags ? -- | isLongFlagArg a1 && any (takeWhile (/='=') `isPrefixOf`) longReqValFlagArgs_ ... -- try to move abbreviated long flags ?
| isFlagArg a1 = 1 -- an addon flag (or mistyped flag) we don't know, assume no value or value is joined | isFlagArg a1 = 1 -- an addon flag (or mistyped flag) we don't know, assume no value or value is joined
| otherwise = 0 -- not a flag | otherwise = 0 -- not a flag
moveFlagArgs (as, moved) = (as, moved)
-- Is this string a valid --debug value ? -- Is this string a valid --debug value ?
isDebugValue s = isRight $ parsewith isdebugvalp $ pack s isDebugValue s = isRight $ parsewith isdebugvalp $ pack s

View File

@ -148,3 +148,9 @@ $ hledger -f /dev/null --conf nosuchfile --no-conf check
$ hledger -f /dev/null --no-conf --conf nosuchfile check $ hledger -f /dev/null --no-conf --conf nosuchfile check
>2 /nosuchfile does not exist/ >2 /nosuchfile does not exist/
>=1 >=1
# ** 24. --debug doesn't disturb the order of --conf and --no-conf.
# This is a hard one to reproduce in GHCI.
$ hledger --debug -f /dev/null --conf /dev/null --no-conf >/dev/null
>2 /ignoring config files/