fix: cli: move pre-command --debug option more carefully; cleanup

hledger/Hledger/Cli.hs

@@ -64,10 +64,9 @@ etc.
 
 -}
 
-{-# LANGUAGE LambdaCase #-}
-
 {-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
 {-# HLINT ignore "Unused LANGUAGE pragma" #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MultiWayIf #-}
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE TupleSections #-}
@@ -90,8 +89,15 @@ module Hledger.Cli (
 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
@@ -100,6 +106,8 @@ import System.Environment
 import System.Exit
 import System.FilePath
 import System.Process
+import Text.Megaparsec (optional, takeWhile1P)
+import Text.Megaparsec.Char (char)
 import Text.Printf
 
 import Hledger
@@ -109,10 +117,6 @@ import Hledger.Cli.Commands
 import Hledger.Cli.DocFiles
 import Hledger.Cli.Utils
 import Hledger.Cli.Version
-import Data.Bifunctor (second)
-import Data.Function ((&))
-import Data.Functor ((<&>))
-import Data.Maybe (isJust)
 
 
 verboseDebugLevel = 8
@@ -460,29 +464,33 @@ moveFlagsAfterCommand args =
   where
     moveFlagArgs :: ([String], [String]) -> ([String], [String])
     moveFlagArgs ((a:b:cs), moved)
-      | isMovableFlagArg a == 2 = moveFlagArgs (cs, moved++[a,b])
+      | isMovableFlagArg a b == 2 = moveFlagArgs (cs, moved++[a,b])
-      | isMovableFlagArg a == 1 = moveFlagArgs (b:cs, moved++[a])
+      | isMovableFlagArg a b == 1 = moveFlagArgs (b:cs, moved++[a])
-      | otherwise               = (a:b:cs, moved)
+      | otherwise                 = (a:b:cs, moved)
       where
         -- 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)
+        -- 0 (not a flag; don't move this argument)
-        -- 1 (single flag, maybe with joined argument; or multiple joined short flags)
+        -- 1 (a valueless flag, or a long flag with joined argument, or multiple joined valueless short flags; move this argument)
-        -- 2 (flag with value in the next argument).
+        -- 2 (a short or long flag with a value in the next argument; move this and next argument).
-        isMovableFlagArg :: String -> Int
+        isMovableFlagArg :: String -> String -> Int
-        isMovableFlagArg a1
+        isMovableFlagArg a1 a2
           | a1 `elem` noValFlagArgs  = 1  -- short or long no-val flag
-          | a1 `elem` reqValFlagArgs, not $ "--debug" `isPrefixOf` a1 = 2
+          | a1 == "--debug" && not (isDebugValue a2) = 1  --debug without a value
-              -- short or long req-val flag, value is in next argument
+          | a1 `elem` reqValFlagArgs = 2  -- short or long req-val flag (or --debug) with a separate value
-              -- --debug is really optional-value (see CliOptions), assume it has no value or joined value
           | a1 `elem` optValFlagArgs = 1  -- long (or short ?) opt-val flag, assume no value
-          | any (`isPrefixOf` a1) shortReqValFlagArgs = 1  -- short req-val flag, value is joined
+          | any (`isPrefixOf` a1) shortReqValFlagArgs = 1  -- short req-val flag with a joined value
-          | any (`isPrefixOf` a1) longReqValFlagArgs_ = 1  -- long req-val flag, value is joined with =
+               -- or possibly multiple joined valueless short flags, we won't move those correctly
-          | any (`isPrefixOf` a1) longOptValFlagArgs_ = 1  -- long opt-val flag, value is joined with =
+          | 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
+          where
+            -- Is this string a valid --debug value ?
+            isDebugValue s = isRight $ parsewith isdebugvalp $ pack s
+              where isdebugvalp = optional (char '-') >> takeWhile1P Nothing isDigit :: TextParser m Text
     moveFlagArgs (as, moved)       = (as, moved)
 
 -- Flag arguments are command line arguments beginning with - or --

hledger/Hledger/Cli/CliOptions.hs

@@ -243,10 +243,8 @@ helpflags = [
  ,flagNone ["info"]     (setboolopt "info")    "show the manual with info"
  ,flagNone ["man"]      (setboolopt "man")     "show the manual with man"
  ,flagNone ["version"]  (setboolopt "version") "show version information"
-  -- ,flagOpt "1" ["debug"] (\s opts -> Right $ setopt "debug" s opts) "LVL" "show debug output (levels 1-9, default: 1)"
+  -- flagOpt would be more correct for --debug, showing --debug[=LVL] rather than --debug=[LVL] in help.
-  -- flagOpt would be more correct for --debug, showing --debug[=LVL] rather than --debug=[LVL].
+  -- But flagReq plus special handling in Cli.hs makes the = optional, removing a source of confusion.
-  -- But because we handle --debug specially, flagReq also works, and it does not need =, removing a source of confusion.
-  -- (This involves specially adding the flag value if missing in Cli.hs.)
  ,flagReq  ["debug"]    (\s opts -> Right $ setopt "debug" s opts) "[1-9]" "show this much debug output (default: 1)"
  ]
 -- XXX why are these duplicated in defCommandMode below ?

hledger/test/cli/cli.test

@@ -114,9 +114,25 @@ $ hledger --no-conf check -f/dev/null
 # ** 15. --conf CONFFILE works with builtin commands.
 $ hledger --conf /dev/null check -f/dev/null
 
-# ** 16. when moving options written before the command name:
+# ** 16. When moving options written before the command name:
 # if the flag name is used in general options and also one or more commands,
 # the general option's arity determines whether a value is expected.
 # Here -p is a help command flag taking no value, but also a general option requiring a value,
 # so the value ("today") is detected.
 $ hledger -p today check -f/dev/null
+
+# ** 17. The specially-handled --debug option is also moved properly, with no value:
+$ hledger --debug check -f/dev/null
+>2 //
+
+# ** 18. a joined value:
+$ hledger --debug=1 check -f/dev/null
+>2 //
+
+# ** 19. or a separate value:
+$ hledger --debug 1 check -f/dev/null
+>2 //
+
+# ** 20. A short flag with joined value, or multiple valueless short flags joined together, are moved properly.
+$ hledger -f/dev/null -BI check
+>2 //