cli: make argument-less --debug more robust

hledger/Hledger/Cli/CliOptions.hs

@@ -95,7 +95,7 @@ helpflags :: [Flag RawOpts]
 helpflags = [
   flagNone ["help","h"] (setboolopt "help") "show general help or (after command) command help"
  -- ,flagNone ["browse-args"] (setboolopt "browse-args") "use a web UI to select options and build up a command line"
- ,flagReq  ["debug"]    (\s opts -> Right $ setopt "debug" s opts) "N" "show debug output if N is 1-9 (default: 0)"
+ ,flagReq  ["debug"]    (\s opts -> Right $ setopt "debug" s opts) "N" "show increasing amounts of debug output if N is 1-9. With no argument, show level 1"
  ,flagNone ["version"] (setboolopt "version") "show version information"
  ]
 

hledger/Hledger/Cli/Main.hs

@@ -157,26 +157,38 @@ argsToCliOpts args addons = do
 -- - move all required-argument help and input flags along with their values, space-separated or not
 -- - not confuse things further or cause misleading errors.
 moveFlagsAfterCommand :: [String] -> [String]
-moveFlagsAfterCommand args = move args
+moveFlagsAfterCommand args = moveArgs $ ensureDebugHasArg args
   where
-    move (f:a:as)           | isMovableNoArgFlag f           = (move $ a:as) ++ [f]
+    -- quickly! make sure --debug has a numeric argument, or this all goes to hell
-    move (f:v:a:as)         | isMovableReqArgFlag f          = (move $ a:as) ++ [f,v]
+    ensureDebugHasArg as =
-    move (fv:a:as)          | isMovableReqArgFlagAndValue fv = (move $ a:as) ++ [fv]
+      case break (=="--debug") as of
-    move ("--debug":v:a:as) | not (null v) && all isDigit v  = (move $ a:as) ++ ["--debug",v]
+       (bs,"--debug":c:cs) | null c || not (all isDigit c) -> bs++"--debug=1":c:cs
-    move ("--debug":a:as)                                    = (move $ a:as) ++ ["--debug"]
+       (bs,"--debug":[])                                   -> bs++"--debug=1":[]
-    move (fv@('-':'-':'d':'e':'b':'u':'g':'=':_):a:as)       = (move $ a:as) ++ [fv]
+       _                                                   -> as
-    move as = as
 
-    isMovableNoArgFlag a  = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` noargflagstomove
+    -- -h ..., --version ...
-    isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargflagstomove
+    moveArgs (f:a:as)   | isMovableNoArgFlag f           = (moveArgs $ a:as) ++ [f]
-    isMovableReqArgFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of (f:fs,_) -> (f:fs) `elem` reqargflagstomove
+    -- -f FILE ..., --alias ALIAS ...
+    moveArgs (f:v:a:as) | isMovableReqArgFlag f
+                        , not (take 1 v == "-")          = (moveArgs $ a:as) ++ [f,v]
+    -- -fFILE ..., --alias=ALIAS ...
+    moveArgs (fv:a:as)  | isMovableReqArgFlagAndValue fv = (moveArgs $ a:as) ++ [fv]
+    -- anything else
+    moveArgs as = as
+
+isMovableNoArgFlag a  = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` noargflagstomove
+
+isMovableReqArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` reqargflagstomove
+
+isMovableReqArgFlagAndValue ('-':'-':a:as) = case break (== '=') (a:as) of (f:fs,_:_) -> (f:fs) `elem` reqargflagstomove
                                                                            _          -> False
-    isMovableReqArgFlagAndValue ('-':f:_:_) = [f] `elem` reqargflagstomove
+isMovableReqArgFlagAndValue ('-':shortflag:_:_) = [shortflag] `elem` reqargflagstomove
-    isMovableReqArgFlagAndValue _ = False
+isMovableReqArgFlagAndValue _ = False
 
-    noargflagstomove  = concatMap flagNames $ filter ((==FlagNone).flagInfo) flagstomove
+flagstomove = inputflags ++ helpflags
-    reqargflagstomove = concatMap flagNames $ filter ((==FlagReq ).flagInfo) flagstomove
+noargflagstomove  = concatMap flagNames $ filter ((==FlagNone).flagInfo) flagstomove
-    flagstomove = inputflags ++ helpflags
+reqargflagstomove = -- filter (/= "debug") $
+                    concatMap flagNames $ filter ((==FlagReq ).flagInfo) flagstomove
 
 -- | Let's go.
 main :: IO ()