mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-20 02:37:12 +03:00
three fixes to handle --debug=N like --debug
This commit is contained in:
parent
8bbd22d7ed
commit
8261ac0f56
@ -379,15 +379,19 @@ ptrace msg = do
|
||||
-- | Global debug level, which controls the verbosity of debug output
|
||||
-- on the console. The default is 0 meaning no debug output. The
|
||||
-- @--debug@ command line flag sets it to 1, or @--debug=N@ sets it to
|
||||
-- a higher value (note: not @--debug N@). This uses unsafePerformIO
|
||||
-- and can be accessed from anywhere and before normal command-line
|
||||
-- processing. After command-line processing, it is also available as
|
||||
-- the @debug_@ field of 'Hledger.Cli.Options.CliOpts'.
|
||||
-- a higher value (note: not @--debug N@ for some reason). This uses
|
||||
-- unsafePerformIO and can be accessed from anywhere and before normal
|
||||
-- command-line processing. After command-line processing, it is also
|
||||
-- available as the @debug_@ field of 'Hledger.Cli.Options.CliOpts'.
|
||||
debugLevel :: Int
|
||||
debugLevel = case snd $ break (=="--debug") args of
|
||||
"--debug":[] -> 1
|
||||
"--debug":n:_ -> readDef 1 n
|
||||
_ -> 0
|
||||
_ ->
|
||||
case take 1 $ filter ("--debug" `isPrefixOf`) args of
|
||||
['-':'-':'d':'e':'b':'u':'g':'=':v] -> readDef 1 v
|
||||
_ -> 0
|
||||
|
||||
where
|
||||
args = unsafePerformIO getArgs
|
||||
|
||||
|
@ -86,7 +86,7 @@ main = do
|
||||
isNullCommand = null rawcmd
|
||||
(argsbeforecmd, argsaftercmd') = break (==rawcmd) args
|
||||
argsaftercmd = drop 1 argsaftercmd'
|
||||
when ("--debug" `elem` args) $ do
|
||||
when (debugLevel > 0) $ do
|
||||
printf "running: %s\n" prognameandversion
|
||||
printf "raw args: %s\n" (show args)
|
||||
printf "raw args rearranged for cmdargs: %s\n" (show args')
|
||||
|
@ -510,6 +510,7 @@ moveFlagsAfterCommand args = move args
|
||||
move (fv:a:as) | isMovableReqArgFlagAndValue fv = (move $ a:as) ++ [fv]
|
||||
move ("--debug":v:a:as) | not (null v) && all isDigit v = (move $ a:as) ++ ["--debug",v]
|
||||
move ("--debug":a:as) = (move $ a:as) ++ ["--debug"]
|
||||
move (fv@('-':'-':'d':'e':'b':'u':'g':'=':_):a:as) = (move $ a:as) ++ [fv]
|
||||
move as = as
|
||||
|
||||
isMovableNoArgFlag a = "-" `isPrefixOf` a && dropWhile (=='-') a `elem` noargflagstomove
|
||||
|
Loading…
Reference in New Issue
Block a user