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.

hledger/Hledger/Cli.hs

@@ -96,7 +96,7 @@ import Data.Function ((&))
 import Data.Functor ((<&>))
 import Data.List
 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.Time.Clock.POSIX (getPOSIXTime)
 import Safe
@@ -226,11 +226,11 @@ main = withGhcDebug' $ do
     cliargswithcmdfirstwithoutclispecific = dropCliSpecificOpts cliargswithcmdfirst
     (cliargsbeforecmd, cliargsaftercmd) = second (drop 1) $ break (==clicmdarg) 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 args before command"    cliargsbeforecmd
   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" ()
@@ -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,
 -- 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 short or long requires-value flag; move it and the following argument
@@ -487,37 +487,44 @@ cmdargsParse desc m args0 = process m (ensureDebugFlagHasVal args0)
 --
 moveFlagsAfterCommand :: [String] -> (String, [String], [String])
 moveFlagsAfterCommand args =
-  case moveFlagArgs (args, []) of
+  case moveFlagAndVal (args, []) of
     ([],as)                      -> ("", as, as)
     (unmoved@(('-':_):_), moved) -> ("", as, as) where as = unmoved<>moved
     (cmdarg:unmoved, moved)      -> (cmdarg, as, cmdarg:as) where as = unmoved<>moved
   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
+
-          | a1 `elem` noValFlagArgs  = 1  -- short or long no-val flag
+-- Is this a short or long flag argument that should be moved,
-          | a1 == "--debug" && not (isDebugValue a2) = 1  --debug without a value
+-- and is its following argument a value that also should be moved ?
-          | a1 `elem` reqValFlagArgs = 2  -- short or long req-val flag (or --debug) with a separate value
+-- Returns:
-          | a1 `elem` optValFlagArgs = 1  -- long (or short ?) opt-val flag, assume no value
+-- 0 (not a flag; don't move this argument)
-          | any (`isPrefixOf` a1) shortReqValFlagArgs = 1  -- short req-val flag with a joined value
+-- 1 (a valueless flag, or a long flag with joined argument, or multiple joined valueless short flags; move this argument)
-               -- or possibly multiple joined valueless short flags, we won't move those correctly
+-- 2 (a short or long flag with a value in the next argument; move this and next argument).
-          | any (`isPrefixOf` a1) longReqValFlagArgs_ = 1  -- long req-val flag (or --debug) with a joined value
+isMovableFlagArg :: String -> Maybe String -> Int
-          | any (`isPrefixOf` a1) longOptValFlagArgs_ = 1  -- long opt-val flag with a joined value
+isMovableFlagArg a1 ma2
-          -- | isLongFlagArg a1 && any (takeWhile (/='=') `isPrefixOf`) longReqValFlagArgs_ ... -- try to move abbreviated long flags ?
+  | a1 `elem` noValFlagArgs  = 1  -- short or long no-val flag
-          | isFlagArg a1 = 1    -- an addon flag (or mistyped flag) we don't know, assume no value or value is joined
+  | a1 == "--debug" && isJust ma2 && not (isDebugValue $ fromJust ma2) = 1  --debug without a value
-          | otherwise = 0    -- not a flag
+  | a1 `elem` reqValFlagArgs = 2  -- short or long req-val flag (or --debug) with a separate value
-    moveFlagArgs (as, moved)       = (as, moved)
+  | 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
+        -- or possibly multiple joined valueless short flags, we won't move those correctly
+  | any (`isPrefixOf` a1) longReqValFlagArgs_ = 1  -- long req-val flag (or --debug) with a joined value
+  | any (`isPrefixOf` a1) longOptValFlagArgs_ = 1  -- long opt-val flag with a joined value
+  -- | 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
+  | otherwise = 0    -- not a flag
 
 -- Is this string a valid --debug value ?
 isDebugValue s = isRight $ parsewith isdebugvalp $ pack s

hledger/test/cli/cli.test

@@ -148,3 +148,9 @@ $ hledger -f /dev/null --conf nosuchfile --no-conf check
 $ hledger -f /dev/null --no-conf --conf nosuchfile check
 >2 /nosuchfile does not exist/
 >=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/
+