imp:lib:Hledger.Utils.Debug: simpler, more consistent dbg* names
This commit is contained in:
Simon Michael
parent
a0204404c9
commit
820a44eb07
@ -311,7 +311,7 @@ journalRenumberAccountDeclarations j = j{jdeclaredaccounts=jdas'}
|
||||
-- (at debug level 5+).
|
||||
dbgJournalAcctDeclOrder :: String -> Journal -> Journal
|
||||
dbgJournalAcctDeclOrder prefix =
|
||||
traceOrLogAtWith 5 ((prefix++) . showAcctDeclsSummary . jdeclaredaccounts)
|
||||
dbg5With ((prefix++) . showAcctDeclsSummary . jdeclaredaccounts)
|
||||
where
|
||||
showAcctDeclsSummary :: [(AccountName,AccountDeclarationInfo)] -> String
|
||||
showAcctDeclsSummary adis
|
||||
|
||||
@ -97,7 +97,7 @@ journalPriceOracle infer Journal{jpricedirectives, jinferredmarketprices} =
|
||||
declaredprices = map priceDirectiveToMarketPrice jpricedirectives
|
||||
inferredprices =
|
||||
(if infer then jinferredmarketprices else [])
|
||||
& traceOrLogAt 2 ("use prices inferred from costs? " <> if infer then "yes" else "no")
|
||||
& dbg2Msg ("use prices inferred from costs? " <> if infer then "yes" else "no")
|
||||
makepricegraph = memo $ makePriceGraph declaredprices inferredprices
|
||||
in
|
||||
memo $ uncurry3 $ priceLookup makepricegraph
|
||||
@ -264,7 +264,7 @@ priceLookup makepricegraph d from mto =
|
||||
,pgEdgesRev=allprices
|
||||
,pgDefaultValuationCommodities=defaultdests
|
||||
} =
|
||||
traceOrLogAt 1 ("valuation date: "++show d) $ makepricegraph d
|
||||
dbg1Msg ("valuation date: "++show d) $ makepricegraph d
|
||||
mto' = mto <|> mdefaultto
|
||||
where
|
||||
mdefaultto = dbg1 ("default valuation commodity for "++T.unpack from) $
|
||||
@ -279,12 +279,12 @@ priceLookup makepricegraph d from mto =
|
||||
let
|
||||
msg = printf "seeking %s to %s price" (showCommoditySymbol from) (showCommoditySymbol to)
|
||||
prices =
|
||||
(traceOrLogAt 2 (msg++" using forward prices") $
|
||||
traceOrLogAt 2 ("forward prices:\n" <> showMarketPrices forwardprices) $
|
||||
(dbg2Msg (msg++" using forward prices") $
|
||||
dbg2Msg ("forward prices:\n" <> showMarketPrices forwardprices) $
|
||||
pricesShortestPath from to forwardprices)
|
||||
<|>
|
||||
(traceOrLogAt 2 (msg++" using forward and reverse prices") $
|
||||
traceOrLogAt 2 ("forward and reverse prices:\n" <> showMarketPrices allprices) $
|
||||
(dbg2Msg (msg++" using forward and reverse prices") $
|
||||
dbg2Msg ("forward and reverse prices:\n" <> showMarketPrices allprices) $
|
||||
pricesShortestPath from to $ dbg5 "all forward and reverse prices" allprices)
|
||||
in case prices of
|
||||
Nothing -> Nothing
|
||||
@ -375,13 +375,8 @@ pricesShortestPath start end edges =
|
||||
case concatMap extend paths of
|
||||
[] -> Nothing
|
||||
_ | pathlength > maxpathlength ->
|
||||
-- XXX This is unusual:
|
||||
-- 1. A warning, not an error, which we usually avoid
|
||||
-- 2. Not a debug message (when triggered, we always print it)
|
||||
-- 3. Printed either to stdout or (eg in hledger-ui) to the debug log file.
|
||||
-- This is the only place we use traceOrLog like this.
|
||||
-- Also before 1.32.2, traceOrLog was doing the opposite of what it should [#2134].
|
||||
traceOrLog ("gave up searching for a price chain at length "++show maxpathlength++", please report a bug")
|
||||
-- Print a non-fatal warning to stderr, something we usually avoid.
|
||||
warn ("gave up searching for a price chain at length "++show maxpathlength++", please report a bug")
|
||||
Nothing
|
||||
where
|
||||
pathlength = 2 + maybe 0 (length . fst) (headMay paths)
|
||||
|
||||
@ -299,7 +299,7 @@ readJournalFileAndLatestDates iopts prefixedfile = do
|
||||
iopts' = iopts{mformat_=asum [mfmt, mformat_ iopts]}
|
||||
liftIO $ requireJournalFileExists f
|
||||
h <-
|
||||
traceOrLogAt 6 ("readJournalFile: "++takeFileName f) $
|
||||
dbg6Msg ("readJournalFile: "++takeFileName f) $
|
||||
liftIO $ openFileOrStdin f
|
||||
-- <- T.readFile f -- or without line ending translation, for testing
|
||||
j <- readJournal iopts' (Just f) h
|
||||
@ -331,7 +331,7 @@ readJournalFiles :: InputOpts -> [PrefixedFilePath] -> ExceptT String IO Journal
|
||||
readJournalFiles iopts@InputOpts{strict_, new_, new_save_} prefixedfiles = do
|
||||
let iopts' = iopts{_defer=True}
|
||||
(j, latestdatesforfiles) <-
|
||||
traceOrLogAt 6 ("readJournalFiles: "++show prefixedfiles) $
|
||||
dbg6Msg ("readJournalFiles: "++show prefixedfiles) $
|
||||
readJournalFilesAndLatestDates iopts' prefixedfiles
|
||||
when strict_ $ liftEither $ journalStrictChecks j
|
||||
when (new_ && new_save_) $ liftIO $ saveLatestDatesForFiles latestdatesforfiles
|
||||
|
||||
@ -386,7 +386,7 @@ journalFinalise iopts@InputOpts{auto_,balancingopts_,infer_costs_,infer_equity_,
|
||||
<&> (if infer_equity_ then journalInferEquityFromCosts verbose_tags_ else id) -- With --infer-equity, infer equity postings from costs where possible
|
||||
<&> dbg9With (lbl "amounts after equity-inferring".showJournalAmountsDebug)
|
||||
<&> journalInferMarketPricesFromTransactions -- infer market prices from commodity-exchanging transactions
|
||||
-- <&> traceOrLogAt 6 fname -- debug logging
|
||||
-- <&> dbg6Msg fname -- debug logging
|
||||
<&> dbgJournalAcctDeclOrder (fname <> ": acct decls : ")
|
||||
<&> journalRenumberAccountDeclarations
|
||||
<&> dbgJournalAcctDeclOrder (fname <> ": acct decls renumbered: ")
|
||||
|
||||
@ -338,7 +338,7 @@ includedirectivep = do
|
||||
Fail.fail ("Cyclic include: " ++ filepath)
|
||||
|
||||
childInput <-
|
||||
traceOrLogAt 6 ("parseChild: "++takeFileName filepath) $
|
||||
dbg6Msg ("parseChild: "++takeFileName filepath) $
|
||||
lift $ readFilePortably filepath
|
||||
`orRethrowIOError` (show parentpos ++ " reading " ++ filepath)
|
||||
let initChildj = newJournalWithParseStateFrom filepath parentj
|
||||
|
||||
@ -125,16 +125,16 @@ accountTransactionsReport rspec@ReportSpec{_rsReportOpts=ropts} j thisacctq = it
|
||||
-- want to keep prices around, so we can toggle between cost and no cost quickly. We can use
|
||||
-- the show_costs_ flag to be efficient when we can, and detailed when we have to.
|
||||
(if show_costs_ ropts then id else journalMapPostingAmounts mixedAmountStripCosts)
|
||||
. traceOrLogAtWith 5 (("ts3:\n"++).pshowTransactions.jtxns)
|
||||
. dbg5With (("ts3:\n"++).pshowTransactions.jtxns)
|
||||
-- maybe convert these transactions to cost or value
|
||||
. journalApplyValuationFromOpts rspec
|
||||
. traceOrLogAtWith 5 (("ts2:\n"++).pshowTransactions.jtxns)
|
||||
. dbg5With (("ts2:\n"++).pshowTransactions.jtxns)
|
||||
-- apply any cur: or amt: filters in reportq
|
||||
. (if queryIsNull amtq then id else filterJournalAmounts amtq)
|
||||
-- only consider transactions which match thisacctq (possibly excluding postings
|
||||
-- which are not real or have the wrong status)
|
||||
. traceOrLogAt 3 ("thisacctq: "++show thisacctq)
|
||||
$ traceOrLogAtWith 5 (("ts1:\n"++).pshowTransactions.jtxns)
|
||||
. dbg3Msg ("thisacctq: "++show thisacctq)
|
||||
$ dbg5With (("ts1:\n"++).pshowTransactions.jtxns)
|
||||
j{jtxns = filter (matchesTransaction thisacctq . relevantPostings) $ jtxns j}
|
||||
where
|
||||
relevantPostings
|
||||
@ -159,7 +159,7 @@ accountTransactionsReport rspec@ReportSpec{_rsReportOpts=ropts} j thisacctq = it
|
||||
items =
|
||||
accountTransactionsReportItems reportq thisacctq startbal maNegate (journalAccountType j)
|
||||
-- sort by the transaction's register date, then index, for accurate starting balance
|
||||
. traceAtWith 5 (("ts4:\n"++).pshowTransactions.map snd)
|
||||
. dbg5With (("ts4:\n"++).pshowTransactions.map snd)
|
||||
. sortBy (comparing (Down . fst) <> comparing (Down . tindex . snd))
|
||||
. map (\t -> (transactionRegisterDate wd reportq thisacctq t, t))
|
||||
. map (if invert_ ropts then (\t -> t{tpostings = map postingNegateMainAmount $ tpostings t}) else id)
|
||||
|
||||
@ -2,42 +2,13 @@
|
||||
|
||||
Here are fancier versions of Debug.Trace, with these features:
|
||||
|
||||
- unsafePerformIO-based for easy usage in pure code, IO code, and program startup code
|
||||
- reasonably short and memorable function names
|
||||
- pretty-printing haskell values, with or without colour, using pretty-simple
|
||||
- short, memorable, greppable function names
|
||||
- pretty-printing of haskell values, using pretty-simple
|
||||
- optional ANSI colour
|
||||
- enabling/disabling debug output with --debug
|
||||
- multiple debug verbosity levels, from 1 to 9
|
||||
- sending debug output to stderr or to a log file
|
||||
- enabling logging based on program name
|
||||
|
||||
The basic "trace" functions print to stderr.
|
||||
This debug output will be interleaved with the program's normal output, which can be
|
||||
useful for understanding when code executes.
|
||||
|
||||
The "Log" functions log to a file instead.
|
||||
The need for these is arguable, since a technically savvy user can redirect
|
||||
stderr output to a log file, eg: @CMD 2>debug.log@.
|
||||
But here is how they currently work:
|
||||
|
||||
The "traceLog" functions log to the program's debug log file,
|
||||
which is @PROGNAME.log@ in the current directory,
|
||||
where PROGNAME is the program name returned by @getProgName@.
|
||||
When using this logging feature you should call @withProgName@ explicitly
|
||||
at the start of your program to ensure a stable program name,
|
||||
otherwise it can change to "<interactive>" eg when running in GHCI.
|
||||
Eg: @main = withProgName "MYPROG" $ do ...@.
|
||||
|
||||
The "OrLog" functions can either print to stderr or log to a file.
|
||||
|
||||
- By default, they print to stderr.
|
||||
|
||||
- If the program name has been set (with @withProgName) to something ending with ".log", they log to that file instead.
|
||||
This can be useful for programs which should never print to stderr, eg TUI programs like hledger-ui.
|
||||
|
||||
The "At" functions produce output only when the program was run with a
|
||||
sufficiently high debug level, as set by a @--debug[=N]@ command line option.
|
||||
N ranges from 1 (least debug output) to 9 (most debug output),
|
||||
@--debug@ with no argument means 1.
|
||||
- debug output levels from 1 to 9, selected by --debug N option
|
||||
- --debug detected with unsafePerformIO for easy use in pure/IO/startup code
|
||||
- debug output can be logged instead (for TUI apps)
|
||||
|
||||
The "dbgN*" functions are intended to be the most convenient API, to be embedded
|
||||
at points of interest in your code. They combine the conditional output of "At",
|
||||
@ -98,34 +69,79 @@ val
|
||||
|
||||
module Hledger.Utils.Debug (
|
||||
|
||||
debugLevel
|
||||
-- * The program's debug level, from 0 (least debug output) to 9 (most).
|
||||
-- This is parsed from a command line --debug N option, or --debug meaning 1.
|
||||
-- The command line is read (once) by unsafePerformIO, allowing this to be used
|
||||
-- easily anywhere in your program.
|
||||
debugLevel
|
||||
|
||||
-- * Tracing to stderr
|
||||
,traceWith
|
||||
,traceAt
|
||||
,traceAtWith
|
||||
,ptrace
|
||||
,ptraceAt
|
||||
,ptraceAtIO
|
||||
-- These print to stderr.
|
||||
-- This output will be interleaved with the program's normal output,
|
||||
-- which can be helpful for understanding code execution.
|
||||
--
|
||||
-- ,traceWith
|
||||
-- ,traceAt
|
||||
-- ,traceAtWith
|
||||
-- ,ptrace
|
||||
-- ,ptraceAt
|
||||
-- ,ptraceAtIO
|
||||
|
||||
-- * Logging to PROGNAME.log
|
||||
,traceLog
|
||||
,traceLogAt
|
||||
,traceLogIO
|
||||
,traceLogAtIO
|
||||
,traceLogWith
|
||||
,traceLogAtWith
|
||||
,ptraceLogAt
|
||||
,ptraceLogAtIO
|
||||
-- * Logging to a log file
|
||||
-- These append to a PROGRAM.log file in the current directory.
|
||||
-- PROGRAM is normally the name of the executable, but it can change
|
||||
-- eg when running in GHCI. So when using these, you should call
|
||||
-- @withProgName@ to ensure a stable program name.
|
||||
-- Eg: @main = withProgName "PROGRAM" $ do ...@.
|
||||
--
|
||||
-- ,log'
|
||||
-- ,logAt
|
||||
-- ,logIO
|
||||
-- ,logAtIO
|
||||
-- ,logWith
|
||||
-- ,logAtWith
|
||||
-- ,plogAt
|
||||
-- ,plogAtIO
|
||||
|
||||
-- * Tracing or logging based on shouldLog
|
||||
,traceOrLog
|
||||
,traceOrLogAt
|
||||
,ptraceOrLogAt
|
||||
,ptraceOrLogAtIO
|
||||
,traceOrLogAtWith
|
||||
-- All @dbg*@ functions normally trace to stderr,
|
||||
-- but they will log to PROGRAM.log instead if the (internal) program name ends with ".log".
|
||||
-- Eg: @main = withProgName "PROGRAM.log" $ do ...@.
|
||||
-- This is intended for TUI programs where stderr output is hard to see.
|
||||
--
|
||||
-- They have an effect only when the program's debug level is at or above the
|
||||
-- level specified by an argument or by the function name.
|
||||
-- The many variants follow a consistent pattern and aim to reduce typing and cognitive load.
|
||||
|
||||
-- * Pretty tracing/logging in pure code
|
||||
-- * Trace/log a string
|
||||
,dbgMsg
|
||||
,dbg0Msg
|
||||
,dbg1Msg
|
||||
,dbg2Msg
|
||||
,dbg3Msg
|
||||
,dbg4Msg
|
||||
,dbg5Msg
|
||||
,dbg6Msg
|
||||
,dbg7Msg
|
||||
,dbg8Msg
|
||||
,dbg9Msg
|
||||
|
||||
-- * In IO
|
||||
,dbgMsgIO
|
||||
,dbg0MsgIO
|
||||
,dbg1MsgIO
|
||||
,dbg2MsgIO
|
||||
,dbg3MsgIO
|
||||
,dbg4MsgIO
|
||||
,dbg5MsgIO
|
||||
,dbg6MsgIO
|
||||
,dbg7MsgIO
|
||||
,dbg8MsgIO
|
||||
,dbg9MsgIO
|
||||
|
||||
-- * Trace/log a showable value, pretty-printed
|
||||
-- @dbg@ here clashes with Text.Megaparsec.Debug (dbg), so that module or this one
|
||||
-- should be imported qualified if you are using both.
|
||||
,dbg
|
||||
,dbg0
|
||||
,dbg1
|
||||
,dbg2
|
||||
@ -136,9 +152,9 @@ module Hledger.Utils.Debug (
|
||||
,dbg7
|
||||
,dbg8
|
||||
,dbg9
|
||||
,dbgExit
|
||||
|
||||
-- * Pretty tracing/logging in IO
|
||||
-- * In IO
|
||||
,dbgIO
|
||||
,dbg0IO
|
||||
,dbg1IO
|
||||
,dbg2IO
|
||||
@ -150,7 +166,8 @@ module Hledger.Utils.Debug (
|
||||
,dbg8IO
|
||||
,dbg9IO
|
||||
|
||||
-- * Tracing/logging with a show function
|
||||
-- * With a custom show function
|
||||
,dbgWith
|
||||
,dbg0With
|
||||
,dbg1With
|
||||
,dbg2With
|
||||
@ -162,12 +179,14 @@ module Hledger.Utils.Debug (
|
||||
,dbg8With
|
||||
,dbg9With
|
||||
|
||||
-- * Utilities
|
||||
-- * Utilities, ghc-debug
|
||||
,ghcDebugSupportedInLib
|
||||
,GhcDebugMode(..)
|
||||
,ghcDebugMode
|
||||
,withGhcDebug'
|
||||
,ghcDebugPause'
|
||||
|
||||
-- * Utilities, other
|
||||
,lbl_
|
||||
,progName
|
||||
|
||||
@ -182,14 +201,13 @@ import Control.DeepSeq (force)
|
||||
import Control.Exception (evaluate)
|
||||
import Control.Monad.IO.Class (MonadIO, liftIO)
|
||||
import Data.List hiding (uncons)
|
||||
-- import Debug.Breakpoint
|
||||
import Debug.Trace (trace, traceIO, traceShowId)
|
||||
#ifdef GHCDEBUG
|
||||
import GHC.Debug.Stub (pause, withGhcDebug)
|
||||
#endif
|
||||
import Safe (readDef)
|
||||
import System.Environment (getProgName)
|
||||
import System.Exit (exitFailure)
|
||||
-- import System.Exit (exitFailure)
|
||||
import System.IO.Unsafe (unsafePerformIO)
|
||||
|
||||
import Hledger.Utils.IO (progArgs, pshow, pshow')
|
||||
@ -285,16 +303,8 @@ ghcDebugPause' =
|
||||
return ()
|
||||
#endif
|
||||
|
||||
-- | Trace a value with the given show function before returning it.
|
||||
traceWith :: (a -> String) -> a -> a
|
||||
traceWith f a = trace (f a) a
|
||||
|
||||
-- | Pretty-trace a showable value before returning it.
|
||||
-- Like Debug.Trace.traceShowId, but pretty-printing and easier to type.
|
||||
ptrace :: Show a => a -> a
|
||||
ptrace = traceWith pshow
|
||||
|
||||
-- | Trace (print to stderr) a string if the global debug level is at
|
||||
-- | Trace (print to stderr) a string if the program debug level is at
|
||||
-- or above the specified level. At level 0, always prints. Otherwise,
|
||||
-- uses unsafePerformIO.
|
||||
traceAt :: Int -> String -> a -> a
|
||||
@ -302,14 +312,30 @@ traceAt level
|
||||
| level > 0 && debugLevel < level = const id
|
||||
| otherwise = trace
|
||||
|
||||
-- | Like traceAt, but sequences properly in IO.
|
||||
traceAtIO :: (MonadIO m) => Int -> String -> m ()
|
||||
traceAtIO level msg =
|
||||
if level > 0 && debugLevel < level
|
||||
then return ()
|
||||
else liftIO $ traceIO msg
|
||||
|
||||
-- -- | Trace a value with the given show function before returning it.
|
||||
-- traceWith :: (a -> String) -> a -> a
|
||||
-- traceWith f a = trace (f a) a
|
||||
|
||||
-- | Trace (print to stderr) a showable value using a custom show function,
|
||||
-- if the global debug level is at or above the specified level.
|
||||
-- if the program debug level is at or above the specified level.
|
||||
-- At level 0, always prints. Otherwise, uses unsafePerformIO.
|
||||
traceAtWith :: Int -> (a -> String) -> a -> a
|
||||
traceAtWith level f a = traceAt level (f a) a
|
||||
|
||||
-- -- | Pretty-trace a showable value before returning it.
|
||||
-- -- Like Debug.Trace.traceShowId, but pretty-printing and easier to type.
|
||||
-- ptrace :: Show a => a -> a
|
||||
-- ptrace = traceWith pshow
|
||||
|
||||
-- | Pretty-print a label and a showable value to the console
|
||||
-- if the global debug level is at or above the specified level.
|
||||
-- if the program debug level is at or above the specified level.
|
||||
-- At level 0, always prints. Otherwise, uses unsafePerformIO.
|
||||
ptraceAt :: Show a => Int -> String -> a -> a
|
||||
ptraceAt level
|
||||
@ -326,206 +352,257 @@ labelledPretty allowcolour lbl a = lbl ++ ":" ++ nlorspace ++ intercalate "\n" l
|
||||
ls' | length ls > 1 = map (' ':) ls
|
||||
| otherwise = ls
|
||||
|
||||
-- | Like ptraceAt, but convenient to insert in an IO monad and
|
||||
-- enforces monadic sequencing.
|
||||
-- | Like ptraceAt, but sequences properly in IO.
|
||||
ptraceAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
|
||||
ptraceAtIO level label a =
|
||||
if level > 0 && debugLevel < level
|
||||
then return ()
|
||||
else liftIO $ traceIO (labelledPretty True label a)
|
||||
|
||||
-- | Should the "trace or log" functions output to a file instead of stderr ?
|
||||
-- True if the program name ends with ".log".
|
||||
shouldLog :: Bool
|
||||
shouldLog = ".log" `isSuffixOf` modifiedProgName
|
||||
|
||||
-- | The debug log file: PROGNAME.log in the current directory.
|
||||
-- See modifiedProgName.
|
||||
debugLogFile :: FilePath
|
||||
debugLogFile = progName ++ ".log"
|
||||
|
||||
-- -- | The debug log file: debug.log in the current directory.
|
||||
-- debugLogFile :: FilePath
|
||||
-- debugLogFile = "debug.log"
|
||||
|
||||
-- | Log a string to the debug log before returning the second argument.
|
||||
-- Uses unsafePerformIO.
|
||||
traceLog :: String -> a -> a
|
||||
traceLog s x = unsafePerformIO $ do
|
||||
log' :: String -> a -> a
|
||||
log' s x = unsafePerformIO $ do
|
||||
evaluate (force s) -- to complete any previous logging before we attempt more
|
||||
appendFile debugLogFile (s ++ "\n")
|
||||
return x
|
||||
|
||||
-- | Log a string to the debug log before returning the second argument,
|
||||
-- if the global debug level is at or above the specified level.
|
||||
-- if the program debug level is at or above the specified level.
|
||||
-- At level 0, always logs. Otherwise, uses unsafePerformIO.
|
||||
traceLogAt :: Int -> String -> a -> a
|
||||
traceLogAt level str
|
||||
logAt :: Int -> String -> a -> a
|
||||
logAt level str
|
||||
| level > 0 && debugLevel < level = id
|
||||
| otherwise = traceLog str
|
||||
| otherwise = log' str
|
||||
|
||||
-- | Like traceLog but sequences properly in IO.
|
||||
traceLogIO :: MonadIO m => String -> m ()
|
||||
traceLogIO s = do
|
||||
-- | Like log' but sequences properly in IO.
|
||||
logIO :: MonadIO m => String -> m ()
|
||||
logIO s = do
|
||||
liftIO $ evaluate (force s) -- to complete any previous logging before we attempt more
|
||||
liftIO $ appendFile debugLogFile (s ++ "\n")
|
||||
|
||||
-- | Like traceLogAt, but convenient to use in IO.
|
||||
traceLogAtIO :: MonadIO m => Int -> String -> m ()
|
||||
traceLogAtIO level str
|
||||
-- | Like logAt, but convenient to use in IO.
|
||||
logAtIO :: (MonadIO m) => Int -> String -> m ()
|
||||
logAtIO level str
|
||||
| level > 0 && debugLevel < level = return ()
|
||||
| otherwise = traceLogIO str
|
||||
| otherwise = logIO str
|
||||
|
||||
-- | Log a value to the debug log with the given show function before returning it.
|
||||
traceLogWith :: (a -> String) -> a -> a
|
||||
traceLogWith f a = traceLog (f a) a
|
||||
-- -- | Log a value to the debug log with the given show function before returning it.
|
||||
-- logWith :: (a -> String) -> a -> a
|
||||
-- logWith f a = log' (f a) a
|
||||
|
||||
-- | Log a string to the debug log before returning the second argument,
|
||||
-- if the global debug level is at or above the specified level.
|
||||
-- if the program debug level is at or above the specified level.
|
||||
-- At level 0, always logs. Otherwise, uses unsafePerformIO.
|
||||
traceLogAtWith :: Int -> (a -> String) -> a -> a
|
||||
traceLogAtWith level f a = traceLogAt level (f a) a
|
||||
logAtWith :: Int -> (a -> String) -> a -> a
|
||||
logAtWith level f a = logAt level (f a) a
|
||||
|
||||
-- | Pretty-log a label and showable value to the debug log,
|
||||
-- if the global debug level is at or above the specified level.
|
||||
-- if the program debug level is at or above the specified level.
|
||||
-- At level 0, always prints. Otherwise, uses unsafePerformIO.
|
||||
ptraceLogAt :: Show a => Int -> String -> a -> a
|
||||
ptraceLogAt level
|
||||
plogAt :: (Show a) => Int -> String -> a -> a
|
||||
plogAt level
|
||||
| level > 0 && debugLevel < level = const id
|
||||
| otherwise = \lbl a -> traceLog (labelledPretty False lbl a) a
|
||||
| otherwise = \lbl a -> log' (labelledPretty False lbl a) a
|
||||
|
||||
-- | Like ptraceAt, but convenient to insert in an IO monad and
|
||||
-- enforces monadic sequencing.
|
||||
ptraceLogAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
|
||||
ptraceLogAtIO level label a =
|
||||
-- | Like ptraceAt, but sequences properly in IO.
|
||||
plogAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
|
||||
plogAtIO level label a =
|
||||
if level > 0 && debugLevel < level
|
||||
then return ()
|
||||
else traceLogIO (labelledPretty False label a)
|
||||
else logIO (labelledPretty False label a)
|
||||
|
||||
-- | Trace or log a string depending on shouldLog,
|
||||
-- before returning the second argument.
|
||||
traceOrLog :: String -> a -> a
|
||||
traceOrLog = if shouldLog then traceLog else trace
|
||||
|
||||
-- | Trace or log a string depending on shouldLog,
|
||||
-- when global debug level is at or above the specified level,
|
||||
-- before returning the second argument.
|
||||
traceOrLogAt :: Int -> String -> a -> a
|
||||
traceOrLogAt = if shouldLog then traceLogAt else traceAt
|
||||
-- | Should dbg* log to a file instead of tracing to stderr ?
|
||||
-- True if the (internal) program name ends with ".log".
|
||||
shouldLog :: Bool
|
||||
shouldLog = ".log" `isSuffixOf` modifiedProgName
|
||||
|
||||
-- | Pretty-trace or log depending on shouldLog, when global debug level
|
||||
-- is at or above the specified level.
|
||||
ptraceOrLogAt :: Show a => Int -> String -> a -> a
|
||||
ptraceOrLogAt = if shouldLog then ptraceLogAt else ptraceAt
|
||||
|
||||
-- | Like ptraceOrLogAt, but convenient in IO.
|
||||
ptraceOrLogAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
|
||||
ptraceOrLogAtIO = if shouldLog then ptraceLogAtIO else ptraceAtIO
|
||||
-- | Trace or log a string if the program debug level is at or above the specified level,
|
||||
-- then return the second argument.
|
||||
dbgMsg :: Int -> String -> a -> a
|
||||
dbgMsg = if shouldLog then logAt else traceAt
|
||||
|
||||
-- | Trace or log, with a show function, depending on shouldLog.
|
||||
traceOrLogAtWith :: Int -> (a -> String) -> a -> a
|
||||
traceOrLogAtWith = if shouldLog then traceLogAtWith else traceAtWith
|
||||
dbg0Msg :: String -> a -> a
|
||||
dbg0Msg = dbgMsg 0
|
||||
|
||||
dbg1Msg :: String -> a -> a
|
||||
dbg1Msg = dbgMsg 1
|
||||
|
||||
dbg2Msg :: String -> a -> a
|
||||
dbg2Msg = dbgMsg 2
|
||||
|
||||
dbg3Msg :: String -> a -> a
|
||||
dbg3Msg = dbgMsg 3
|
||||
|
||||
dbg4Msg :: String -> a -> a
|
||||
dbg4Msg = dbgMsg 4
|
||||
|
||||
dbg5Msg :: String -> a -> a
|
||||
dbg5Msg = dbgMsg 5
|
||||
|
||||
dbg6Msg :: String -> a -> a
|
||||
dbg6Msg = dbgMsg 6
|
||||
|
||||
dbg7Msg :: String -> a -> a
|
||||
dbg7Msg = dbgMsg 7
|
||||
|
||||
dbg8Msg :: String -> a -> a
|
||||
dbg8Msg = dbgMsg 8
|
||||
|
||||
dbg9Msg :: String -> a -> a
|
||||
dbg9Msg = dbgMsg 9
|
||||
|
||||
|
||||
-- | Like dbgMsg, but sequences properly in IO.
|
||||
dbgMsgIO :: (MonadIO m) => Int -> String -> m ()
|
||||
dbgMsgIO = if shouldLog then logAtIO else traceAtIO
|
||||
|
||||
dbg0MsgIO :: (MonadIO m) => String -> m ()
|
||||
dbg0MsgIO = dbgMsgIO 0
|
||||
|
||||
dbg1MsgIO :: (MonadIO m) => String -> m ()
|
||||
dbg1MsgIO = dbgMsgIO 1
|
||||
|
||||
dbg2MsgIO :: (MonadIO m) => String -> m ()
|
||||
dbg2MsgIO = dbgMsgIO 2
|
||||
|
||||
dbg3MsgIO :: (MonadIO m) => String -> m ()
|
||||
dbg3MsgIO = dbgMsgIO 3
|
||||
|
||||
dbg4MsgIO :: (MonadIO m) => String -> m ()
|
||||
dbg4MsgIO = dbgMsgIO 4
|
||||
|
||||
dbg5MsgIO :: (MonadIO m) => String -> m ()
|
||||
dbg5MsgIO = dbgMsgIO 5
|
||||
|
||||
dbg6MsgIO :: (MonadIO m) => String -> m ()
|
||||
dbg6MsgIO = dbgMsgIO 6
|
||||
|
||||
dbg7MsgIO :: (MonadIO m) => String -> m ()
|
||||
dbg7MsgIO = dbgMsgIO 7
|
||||
|
||||
dbg8MsgIO :: (MonadIO m) => String -> m ()
|
||||
dbg8MsgIO = dbgMsgIO 8
|
||||
|
||||
dbg9MsgIO :: (MonadIO m) => String -> m ()
|
||||
dbg9MsgIO = dbgMsgIO 9
|
||||
|
||||
|
||||
-- | Trace or log a label and showable value, pretty-printed,
|
||||
-- if the program debug level is at or above the specified level;
|
||||
-- then return the value.
|
||||
-- Traces to stderr or logs to a file depending on shouldLog.
|
||||
dbg :: (Show a) => Int -> String -> a -> a
|
||||
dbg = if shouldLog then plogAt else ptraceAt
|
||||
|
||||
-- | Pretty-trace to stderr (or log to debug log) a label and showable value,
|
||||
-- then return it.
|
||||
dbg0 :: Show a => String -> a -> a
|
||||
dbg0 = ptraceOrLogAt 0
|
||||
dbg0 = dbg 0
|
||||
|
||||
-- | Pretty-trace to stderr (or log to debug log) a label and showable value
|
||||
-- if the --debug level is high enough, then return the value.
|
||||
-- Uses unsafePerformIO.
|
||||
dbg1 :: Show a => String -> a -> a
|
||||
dbg1 = ptraceOrLogAt 1
|
||||
dbg1 = dbg 1
|
||||
|
||||
dbg2 :: Show a => String -> a -> a
|
||||
dbg2 = ptraceOrLogAt 2
|
||||
dbg2 = dbg 2
|
||||
|
||||
dbg3 :: Show a => String -> a -> a
|
||||
dbg3 = ptraceOrLogAt 3
|
||||
dbg3 = dbg 3
|
||||
|
||||
dbg4 :: Show a => String -> a -> a
|
||||
dbg4 = ptraceOrLogAt 4
|
||||
dbg4 = dbg 4
|
||||
|
||||
dbg5 :: Show a => String -> a -> a
|
||||
dbg5 = ptraceOrLogAt 5
|
||||
dbg5 = dbg 5
|
||||
|
||||
dbg6 :: Show a => String -> a -> a
|
||||
dbg6 = ptraceOrLogAt 6
|
||||
dbg6 = dbg 6
|
||||
|
||||
dbg7 :: Show a => String -> a -> a
|
||||
dbg7 = ptraceOrLogAt 7
|
||||
dbg7 = dbg 7
|
||||
|
||||
dbg8 :: Show a => String -> a -> a
|
||||
dbg8 = ptraceOrLogAt 8
|
||||
dbg8 = dbg 8
|
||||
|
||||
dbg9 :: Show a => String -> a -> a
|
||||
dbg9 = ptraceOrLogAt 9
|
||||
dbg9 = dbg 9
|
||||
|
||||
-- | Like dbg0, but also exit the program. Uses unsafePerformIO.
|
||||
dbgExit :: Show a => String -> a -> a
|
||||
dbgExit label a = unsafePerformIO $ dbg0IO label a >> exitFailure
|
||||
|
||||
-- | Like dbgN, but convenient to use in IO.
|
||||
-- | Like dbg, but sequences properly in IO.
|
||||
dbgIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
|
||||
dbgIO = if shouldLog then plogAtIO else ptraceAtIO
|
||||
|
||||
dbg0IO :: (MonadIO m, Show a) => String -> a -> m ()
|
||||
dbg0IO = ptraceOrLogAtIO 0
|
||||
dbg0IO = dbgIO 0
|
||||
|
||||
dbg1IO :: (MonadIO m, Show a) => String -> a -> m ()
|
||||
dbg1IO = ptraceOrLogAtIO 1
|
||||
dbg1IO = dbgIO 1
|
||||
|
||||
dbg2IO :: (MonadIO m, Show a) => String -> a -> m ()
|
||||
dbg2IO = ptraceOrLogAtIO 2
|
||||
dbg2IO = dbgIO 2
|
||||
|
||||
dbg3IO :: (MonadIO m, Show a) => String -> a -> m ()
|
||||
dbg3IO = ptraceOrLogAtIO 3
|
||||
dbg3IO = dbgIO 3
|
||||
|
||||
dbg4IO :: (MonadIO m, Show a) => String -> a -> m ()
|
||||
dbg4IO = ptraceOrLogAtIO 4
|
||||
dbg4IO = dbgIO 4
|
||||
|
||||
dbg5IO :: (MonadIO m, Show a) => String -> a -> m ()
|
||||
dbg5IO = ptraceOrLogAtIO 5
|
||||
dbg5IO = dbgIO 5
|
||||
|
||||
dbg6IO :: (MonadIO m, Show a) => String -> a -> m ()
|
||||
dbg6IO = ptraceOrLogAtIO 6
|
||||
dbg6IO = dbgIO 6
|
||||
|
||||
dbg7IO :: (MonadIO m, Show a) => String -> a -> m ()
|
||||
dbg7IO = ptraceOrLogAtIO 7
|
||||
dbg7IO = dbgIO 7
|
||||
|
||||
dbg8IO :: (MonadIO m, Show a) => String -> a -> m ()
|
||||
dbg8IO = ptraceOrLogAtIO 8
|
||||
dbg8IO = dbgIO 8
|
||||
|
||||
dbg9IO :: (MonadIO m, Show a) => String -> a -> m ()
|
||||
dbg9IO = ptraceOrLogAtIO 9
|
||||
dbg9IO = dbgIO 9
|
||||
|
||||
|
||||
-- | Like dbgWith, but with a custom show function.
|
||||
dbgWith :: Int -> (a -> String) -> a -> a
|
||||
dbgWith = if shouldLog then logAtWith else traceAtWith
|
||||
|
||||
-- | Like dbgN, but taking a show function instead of a label.
|
||||
dbg0With :: (a -> String) -> a -> a
|
||||
dbg0With = traceOrLogAtWith 0
|
||||
dbg0With = dbgWith 0
|
||||
|
||||
dbg1With :: Show a => (a -> String) -> a -> a
|
||||
dbg1With = traceOrLogAtWith 1
|
||||
dbg1With = dbgWith 1
|
||||
|
||||
dbg2With :: Show a => (a -> String) -> a -> a
|
||||
dbg2With = traceOrLogAtWith 2
|
||||
dbg2With = dbgWith 2
|
||||
|
||||
dbg3With :: Show a => (a -> String) -> a -> a
|
||||
dbg3With = traceOrLogAtWith 3
|
||||
dbg3With = dbgWith 3
|
||||
|
||||
dbg4With :: Show a => (a -> String) -> a -> a
|
||||
dbg4With = traceOrLogAtWith 4
|
||||
dbg4With = dbgWith 4
|
||||
|
||||
dbg5With :: Show a => (a -> String) -> a -> a
|
||||
dbg5With = traceOrLogAtWith 5
|
||||
dbg5With = dbgWith 5
|
||||
|
||||
dbg6With :: Show a => (a -> String) -> a -> a
|
||||
dbg6With = traceOrLogAtWith 6
|
||||
dbg6With = dbgWith 6
|
||||
|
||||
dbg7With :: Show a => (a -> String) -> a -> a
|
||||
dbg7With = traceOrLogAtWith 7
|
||||
dbg7With = dbgWith 7
|
||||
|
||||
dbg8With :: Show a => (a -> String) -> a -> a
|
||||
dbg8With = traceOrLogAtWith 8
|
||||
dbg8With = dbgWith 8
|
||||
|
||||
dbg9With :: Show a => (a -> String) -> a -> a
|
||||
dbg9With = traceOrLogAtWith 9
|
||||
dbg9With = dbgWith 9
|
||||
|
||||
-- | Helper for producing debug messages:
|
||||
-- concatenates a name (eg a function name),
|
||||
@ -547,5 +624,5 @@ lbl_ name desc val = name <> ": " <> desc <> ":" <> " " <> val
|
||||
-- dbg_ :: forall a. Show a => Int -> String -> (String -> (a -> String) -> a -> a)
|
||||
-- dbg_ level topic =
|
||||
-- \desc showfn val ->
|
||||
-- traceOrLogAtWith level (lbl_ topic desc . showfn) val
|
||||
-- dbgWith level (lbl_ topic desc . showfn) val
|
||||
-- {-# HLINT ignore "Redundant lambda" #-}
|
||||
|
||||
@ -47,7 +47,6 @@ module Hledger.Utils.Parse (
|
||||
|
||||
-- ** Trace the state of hledger parsers
|
||||
dbgparse,
|
||||
traceOrLogParse,
|
||||
|
||||
-- * More helpers, previously in Text.Megaparsec.Custom
|
||||
|
||||
@ -111,7 +110,7 @@ import qualified Data.List.NonEmpty as NE
|
||||
import Data.Monoid (Alt(..))
|
||||
import qualified Data.Set as S
|
||||
|
||||
import Hledger.Utils.Debug (debugLevel, traceOrLog)
|
||||
import Hledger.Utils.Debug (debugLevel, dbg0Msg)
|
||||
|
||||
-- | A parser of string to some type.
|
||||
type SimpleStringParser a = Parsec HledgerParseErrorData String a
|
||||
@ -128,23 +127,17 @@ type TextParser m a = ParsecT HledgerParseErrorData Text m a
|
||||
-- | Trace to stderr or log to debug log the provided label (if non-null)
|
||||
-- and current parser state (position and next input),
|
||||
-- if the global debug level is at or above the specified level.
|
||||
-- Uses unsafePerformIO.
|
||||
dbgparse :: Int -> String -> TextParser m ()
|
||||
dbgparse level msg = when (level <= debugLevel) $ traceOrLogParse msg
|
||||
|
||||
-- | Trace to stderr or log to debug log the provided label (if non-null)
|
||||
-- and current parser state (position and next input).
|
||||
-- See also: Hledger.Utils.Debug, megaparsec's dbg.
|
||||
-- Uses unsafePerformIO.
|
||||
-- XXX Can be hard to make this evaluate.
|
||||
traceOrLogParse :: String -> TextParser m ()
|
||||
traceOrLogParse msg = do
|
||||
dbgparse :: Int -> String -> TextParser m ()
|
||||
dbgparse level msg = when (level <= debugLevel) $ do
|
||||
pos <- getSourcePos
|
||||
next <- (T.take peeklength) `fmap` getInput
|
||||
let (l,c) = (sourceLine pos, sourceColumn pos)
|
||||
s = printf "at line %2d col %2d: %s" (unPos l) (unPos c) (show next) :: String
|
||||
s' = printf ("%-"++show (peeklength+30)++"s") s ++ " " ++ msg
|
||||
traceOrLog s' $ return ()
|
||||
dbg0Msg s' $ return ()
|
||||
where
|
||||
peeklength = 30
|
||||
|
||||
|
||||
@ -92,7 +92,7 @@ hledgerUiMain = exitOnError $ withGhcDebug' $ withProgName "hledger-ui.log" $ do
|
||||
#endif
|
||||
#endif
|
||||
|
||||
traceLogAtIO 1 "\n\n\n\n==== hledger-ui start"
|
||||
dbg1MsgIO "\n\n\n\n==== hledger-ui start"
|
||||
dbg1IO "args" progArgs
|
||||
dbg1IO "debugLevel" debugLevel
|
||||
|
||||
|
||||
@ -451,15 +451,15 @@ listScrollPushingSelection name listheight scrollamt = do
|
||||
-- logs the string to hledger-ui.log before returning the second argument.
|
||||
-- Uses unsafePerformIO.
|
||||
dbgui :: String -> a -> a
|
||||
dbgui = traceLogAt 1
|
||||
dbgui = dbg1Msg
|
||||
|
||||
-- | Like dbgui, but convenient to use in IO.
|
||||
dbguiIO :: String -> IO ()
|
||||
dbguiIO = traceLogAtIO 1
|
||||
dbguiIO = dbg1MsgIO
|
||||
|
||||
-- | Like dbgui, but convenient to use in EventM handlers.
|
||||
dbguiEv :: String -> EventM Name s ()
|
||||
dbguiEv s = dbgui s $ return ()
|
||||
dbguiEv s = dbg1Msg s $ return ()
|
||||
|
||||
-- | Like dbguiEv, but log a compact view of the current screen stack.
|
||||
-- See showScreenStack.
|
||||
|
||||
@ -218,13 +218,10 @@ main = exitOnError $ withGhcDebug' $ do
|
||||
-- 0. let's go!
|
||||
|
||||
let
|
||||
-- Trace helpers. These always trace to stderr, even when running `hledger ui`;
|
||||
-- that's ok as conf is a hledger cli feature for now.
|
||||
dbgIO, dbgIO1, dbgIO2 :: Show a => String -> a -> IO () -- this signature is needed
|
||||
dbgIO = ptraceAtIO verboseDebugLevel
|
||||
dbgIO1 = ptraceAtIO 1
|
||||
dbgIO2 = ptraceAtIO 2
|
||||
dbgIO "running" prognameandversion
|
||||
dbgio :: Show a => String -> a -> IO ()
|
||||
dbgio = dbgIO verboseDebugLevel
|
||||
|
||||
dbgio "running" prognameandversion
|
||||
starttime <- getPOSIXTime
|
||||
-- give ghc-debug a chance to take control
|
||||
when (ghcDebugMode == GDPauseAtStart) $ ghcDebugPause'
|
||||
@ -235,7 +232,7 @@ main = exitOnError $ withGhcDebug' $ do
|
||||
addons <- addonCommandNames
|
||||
|
||||
---------------------------------------------------------------
|
||||
dbgIO "\n1. Preliminary command line parsing" ()
|
||||
dbgio "\n1. Preliminary command line parsing" ()
|
||||
|
||||
-- Naming notes:
|
||||
-- "arg" often has the most general meaning, including things like: -f, --flag, flagvalue, arg, >file, &, etc.
|
||||
@ -252,15 +249,15 @@ main = exitOnError $ withGhcDebug' $ do
|
||||
(clicmdarg, cliargswithoutcmd, cliargswithcmdfirst) = moveFlagsAfterCommand cliargs
|
||||
cliargswithcmdfirstwithoutclispecific = dropCliSpecificOpts cliargswithcmdfirst
|
||||
(cliargsbeforecmd, cliargsaftercmd) = second (drop 1) $ break (==clicmdarg) cliargs
|
||||
dbgIO "cli args with preprocessing" cliargs
|
||||
dbgio "cli args with preprocessing" cliargs
|
||||
dbg1IO "cli args with preprocessing and options moved after command" 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 command argument found" clicmdarg
|
||||
dbgio "cli args before command" cliargsbeforecmd
|
||||
dbgio "cli args after command" cliargsaftercmd
|
||||
-- dbgio "cli args without command" cliargswithoutcmd
|
||||
|
||||
---------------------------------------------------------------
|
||||
dbgIO "\n2. Read the config file if any" ()
|
||||
dbgio "\n2. Read the config file if any" ()
|
||||
|
||||
-- Identify any --conf/--no-conf options.
|
||||
-- Run cmdargs on just the args that look conf-related.
|
||||
@ -276,7 +273,7 @@ main = exitOnError $ withGhcDebug' $ do
|
||||
else getConf' cliconfrawopts
|
||||
|
||||
---------------------------------------------------------------
|
||||
dbgIO "\n3. Identify a command name from config file or command line" ()
|
||||
dbgio "\n3. Identify a command name from config file or command line" ()
|
||||
|
||||
-- Try to identify the subcommand name,
|
||||
-- from the first non-flag general argument in the config file,
|
||||
@ -310,15 +307,15 @@ main = exitOnError $ withGhcDebug' $ do
|
||||
|
||||
when (isJust mconffile) $ do
|
||||
unless (null confcmdarg) $
|
||||
dbgIO1 "using command name argument from config file" confcmdarg
|
||||
dbgIO "cli args with command first and no cli-specific opts" cliargswithcmdfirstwithoutclispecific
|
||||
dbgIO1 "command found" cmdname
|
||||
dbgIO "no command provided" nocmdprovided
|
||||
dbgIO "bad command provided" badcmdprovided
|
||||
dbgIO "is addon command" isaddoncmd
|
||||
dbg1IO "using command name argument from config file" confcmdarg
|
||||
dbgio "cli args with command first and no cli-specific opts" cliargswithcmdfirstwithoutclispecific
|
||||
dbg1IO "command found" cmdname
|
||||
dbgio "no command provided" nocmdprovided
|
||||
dbgio "bad command provided" badcmdprovided
|
||||
dbgio "is addon command" isaddoncmd
|
||||
|
||||
---------------------------------------------------------------
|
||||
dbgIO "\n4. Get applicable options/arguments from config file" ()
|
||||
dbgio "\n4. Get applicable options/arguments from config file" ()
|
||||
|
||||
-- Ignore any general opts or cli-specific opts not known to be supported by the command.
|
||||
let
|
||||
@ -337,13 +334,13 @@ main = exitOnError $ withGhcDebug' $ do
|
||||
& if isaddoncmd then ("--":) else id
|
||||
|
||||
when (isJust mconffile) $ do
|
||||
dbgIO1 "using general args from config file" confothergenargs
|
||||
dbg1IO "using general args from config file" confothergenargs
|
||||
unless (null excludedgenargsfromconf) $
|
||||
dbgIO1 "excluded general args from config file, not supported by this command" excludedgenargsfromconf
|
||||
dbgIO1 "using subcommand args from config file" confcmdargs
|
||||
dbg1IO "excluded general args from config file, not supported by this command" excludedgenargsfromconf
|
||||
dbg1IO "using subcommand args from config file" confcmdargs
|
||||
|
||||
---------------------------------------------------------------
|
||||
dbgIO "\n5. Combine config file and command line args" ()
|
||||
dbgio "\n5. Combine config file and command line args" ()
|
||||
|
||||
let
|
||||
finalargs =
|
||||
@ -355,7 +352,7 @@ main = exitOnError $ withGhcDebug' $ do
|
||||
& replaceNumericFlags -- convert any -NUM opts from the config file
|
||||
|
||||
-- finalargs' <- expandArgsAt finalargs -- expand @ARGFILEs in the config file ? don't bother
|
||||
dbgIO1 "final args" finalargs
|
||||
dbg1IO "final args" finalargs
|
||||
|
||||
-- Run cmdargs on command name + supported conf general args + conf subcommand args + cli args to get the final options.
|
||||
-- A bad flag or flag argument will cause the program to exit with an error here.
|
||||
@ -363,7 +360,7 @@ main = exitOnError $ withGhcDebug' $ do
|
||||
|
||||
---------------------------------------------------------------
|
||||
seq rawopts $ -- order debug output
|
||||
dbgIO "\n6. Select an action and run it" ()
|
||||
dbgio "\n6. Select an action and run it" ()
|
||||
|
||||
-- We check for the help/doc/version flags first, since they are a high priority.
|
||||
-- (A perfectionist might think they should be so high priority that adding -h
|
||||
@ -381,10 +378,10 @@ main = exitOnError $ withGhcDebug' $ do
|
||||
|
||||
-- validate opts/args more and convert to CliOpts
|
||||
opts <- rawOptsToCliOpts rawopts >>= \opts0 -> return opts0{progstarttime_=starttime}
|
||||
dbgIO2 "processed opts" opts
|
||||
dbgIO "period from opts" (period_ . _rsReportOpts $ reportspec_ opts)
|
||||
dbgIO "interval from opts" (interval_ . _rsReportOpts $ reportspec_ opts)
|
||||
dbgIO "query from opts & args" (_rsQuery $ reportspec_ opts)
|
||||
dbg2IO "processed opts" opts
|
||||
dbgio "period from opts" (period_ . _rsReportOpts $ reportspec_ opts)
|
||||
dbgio "interval from opts" (interval_ . _rsReportOpts $ reportspec_ opts)
|
||||
dbgio "query from opts & args" (_rsQuery $ reportspec_ opts)
|
||||
|
||||
-- Ensure that anything calling getArgs later will see all args, including config file args.
|
||||
-- Some things (--color, --debug, some checks in journalFinalise) are detected by unsafePerformIO,
|
||||
@ -406,13 +403,13 @@ main = exitOnError $ withGhcDebug' $ do
|
||||
|
||||
-- 6.4. no command found, nothing else to do - show the commands list
|
||||
| nocmdprovided -> do
|
||||
dbgIO1 "no command, showing commands list" ()
|
||||
dbg1IO "no command, showing commands list" ()
|
||||
commands opts (ignoredjournal "commands")
|
||||
|
||||
-- 6.5. builtin command found
|
||||
| Just (cmdmode, cmdaction) <- mbuiltincmdaction -> do
|
||||
let mmodecmdname = headMay $ modeNames cmdmode
|
||||
dbgIO1 "running builtin command mode" $ fromMaybe "" mmodecmdname
|
||||
dbg1IO "running builtin command mode" $ fromMaybe "" mmodecmdname
|
||||
|
||||
-- run the builtin command according to its type
|
||||
if
|
||||
@ -453,9 +450,9 @@ main = exitOnError $ withGhcDebug' $ do
|
||||
addonargs0 = filter (/="--") $ supportedgenargsfromconf <> confcmdargs <> cliargswithoutcmd
|
||||
addonargs = dropCliSpecificOpts addonargs0
|
||||
shellcmd = printf "%s-%s %s" progname cmdname (unwords' addonargs) :: String
|
||||
dbgIO "addon command selected" cmdname
|
||||
dbgIO "addon command arguments after removing cli-specific opts" (map quoteIfNeeded addonargs)
|
||||
dbgIO1 "running addon" shellcmd
|
||||
dbgio "addon command selected" cmdname
|
||||
dbgio "addon command arguments after removing cli-specific opts" (map quoteIfNeeded addonargs)
|
||||
dbg1IO "running addon" shellcmd
|
||||
system shellcmd >>= exitWith
|
||||
|
||||
-- deprecated command found
|
||||
@ -496,7 +493,7 @@ cmdargsParse :: String -> Mode RawOpts -> [String] -> RawOpts
|
||||
cmdargsParse desc m args0 = process m (ensureDebugFlagHasVal args0)
|
||||
& either
|
||||
(\e -> error' $ e <> "\n* while parsing the following args, " <> desc <> ":\n* " <> unwords (map quoteIfNeeded args0))
|
||||
(traceOrLogAt verboseDebugLevel ("cmdargs: parsing " <> desc <> ": " <> show args0))
|
||||
(dbgMsg verboseDebugLevel ("cmdargs: parsing " <> desc <> ": " <> show args0))
|
||||
-- XXX better error message when cmdargs fails (eg spaced/quoted/malformed flag values) ?
|
||||
|
||||
-- | cmdargs does not allow options to appear before the subcommand argument.
|
||||
@ -558,12 +555,12 @@ moveFlagsAfterCommand args =
|
||||
moveFlagAndVal :: ([String], [String]) -> ([String], [String])
|
||||
moveFlagAndVal ((a:b:cs), moved) =
|
||||
case isMovableFlagArg a (Just b) of
|
||||
2 -> traceOrLogAt lvl ("moving 2: "<>a<>" "<>b) $ moveFlagAndVal (cs, moved++[a,b])
|
||||
1 -> traceOrLogAt lvl ("moving 1: "<>a) $ moveFlagAndVal (b:cs, moved++[a])
|
||||
2 -> dbgMsg lvl ("moving 2: "<>a<>" "<>b) $ moveFlagAndVal (cs, moved++[a,b])
|
||||
1 -> dbgMsg lvl ("moving 1: "<>a) $ moveFlagAndVal (b:cs, moved++[a])
|
||||
_ -> (a:b:cs, moved)
|
||||
moveFlagAndVal ([a], moved) =
|
||||
case isMovableFlagArg a Nothing of
|
||||
1 -> traceOrLogAt lvl ("moving 1: "<>a) ([], moved++[a])
|
||||
1 -> dbgMsg lvl ("moving 1: "<>a) ([], moved++[a])
|
||||
_ -> ([a], moved)
|
||||
moveFlagAndVal ([], moved) = ([], moved)
|
||||
lvl = 8
|
||||
|
||||
@ -107,13 +107,13 @@ getConf rawopts = do
|
||||
-- As in Cli.hs, conf debug output always goes to stderr;
|
||||
-- that's ok as conf is a hledger cli feature for now.
|
||||
case confFileSpecFromRawOpts rawopts of
|
||||
NoConfFile -> return $ Right $ traceAt 1 "ignoring config files" (nullconf, Nothing)
|
||||
NoConfFile -> return $ Right $ dbg1Msg "ignoring config files" (nullconf, Nothing)
|
||||
SomeConfFile f -> getCurrentDirectory >>= flip expandPath f >>= readConfFile . dbg1 "using specified config file"
|
||||
AutoConfFile -> do
|
||||
fs <- confFiles
|
||||
case fs of
|
||||
f:_ -> dbg8IO "found config files" fs >> dbg1IO "using nearest config file" f >> readConfFile f
|
||||
[] -> return $ Right $ traceAt 1 "no config file found" (nullconf, Nothing)
|
||||
[] -> return $ Right $ dbg1Msg "no config file found" (nullconf, Nothing)
|
||||
|
||||
-- | Like getConf but throws an error on failure.
|
||||
getConf' :: RawOpts -> IO (Conf, Maybe FilePath)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user