imp:lib:Hledger.Utils.Debug: simpler, more consistent dbg* names

hledger-lib/Hledger/Data/Journal.hs

@@ -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

hledger-lib/Hledger/Data/Valuation.hs

@@ -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") $
+            (dbg2Msg (msg++" using forward prices") $
-             traceOrLogAt 2 ("forward prices:\n" <> showMarketPrices forwardprices) $
+             dbg2Msg ("forward prices:\n" <> showMarketPrices forwardprices) $
              pricesShortestPath from to forwardprices)
             <|>
-            (traceOrLogAt 2 (msg++" using forward and reverse prices") $
+            (dbg2Msg (msg++" using forward and reverse prices") $
-             traceOrLogAt 2 ("forward and reverse prices:\n" <> showMarketPrices allprices) $
+             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:
+          -- Print a non-fatal warning to stderr, something we usually avoid.
-          -- 1. A warning, not an error, which we usually avoid
+          warn ("gave up searching for a price chain at length "++show maxpathlength++", please report a bug")
-          -- 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")
           Nothing
           where 
             pathlength = 2 + maybe 0 (length . fst) (headMay paths)

hledger-lib/Hledger/Read.hs

@@ -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

hledger-lib/Hledger/Read/Common.hs

@@ -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: ")

hledger-lib/Hledger/Read/JournalReader.hs

@@ -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

hledger-lib/Hledger/Reports/AccountTransactionsReport.hs

@@ -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)
+        . dbg3Msg ("thisacctq: "++show thisacctq)
-        $ traceOrLogAtWith 5 (("ts1:\n"++).pshowTransactions.jtxns)
+        $ 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)

hledger-lib/Hledger/Utils/Debug.hs

@@ -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
+- short, memorable, greppable function names
-- reasonably short and memorable function names
+- pretty-printing of haskell values, using pretty-simple
-- pretty-printing haskell values, with or without colour, using pretty-simple
+- optional ANSI colour
 - enabling/disabling debug output with --debug
-- multiple debug verbosity levels, from 1 to 9
+- debug output levels from 1 to 9, selected by --debug N option
-- sending debug output to stderr or to a log file
+- --debug detected with unsafePerformIO for easy use in pure/IO/startup code
-- enabling logging based on program name
+- debug output can be logged instead (for TUI apps)
-
-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.
 
 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
+  -- These print to stderr.
-  ,traceAt
+  -- This output will be interleaved with the program's normal output,
-  ,traceAtWith
+  -- which can be helpful for understanding code execution.
-  ,ptrace
+  --
-  ,ptraceAt
+  -- ,traceWith
-  ,ptraceAtIO
+  -- ,traceAt
+  -- ,traceAtWith
+  -- ,ptrace
+  -- ,ptraceAt
+  -- ,ptraceAtIO
 
-  -- * Logging to PROGNAME.log
+  -- * Logging to a log file
-  ,traceLog
+  -- These append to a PROGRAM.log file in the current directory.
-  ,traceLogAt
+  -- PROGRAM is normally the name of the executable, but it can change
-  ,traceLogIO
+  -- eg when running in GHCI. So when using these, you should call
-  ,traceLogAtIO
+  -- @withProgName@ to ensure a stable program name.
-  ,traceLogWith
+  -- Eg: @main = withProgName "PROGRAM" $ do ...@.
-  ,traceLogAtWith
+  --
-  ,ptraceLogAt
+  -- ,log'
-  ,ptraceLogAtIO
+  -- ,logAt
+  -- ,logIO
+  -- ,logAtIO
+  -- ,logWith
+  -- ,logAtWith
+  -- ,plogAt
+  -- ,plogAtIO
 
-  -- * Tracing or logging based on shouldLog
+  -- All @dbg*@ functions normally trace to stderr,
-  ,traceOrLog
+  -- but they will log to PROGRAM.log instead if the (internal) program name ends with ".log".
-  ,traceOrLogAt
+  -- Eg: @main = withProgName "PROGRAM.log" $ do ...@.
-  ,ptraceOrLogAt
+  -- This is intended for TUI programs where stderr output is hard to see.
-  ,ptraceOrLogAtIO
+  --
-  ,traceOrLogAtWith
+  -- 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.
+-- | Trace (print to stderr) a string if the program debug level is at
--- 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
 -- 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
+-- | Like ptraceAt, but sequences properly in IO.
--- enforces monadic sequencing.
 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
+log' :: String -> a -> a
-traceLog s x = unsafePerformIO $ do
+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
+logAt :: Int -> String -> a -> a
-traceLogAt level str
+logAt level str
   | level > 0 && debugLevel < level = id
-  | otherwise = traceLog str
+  | otherwise = log' str
 
--- | Like traceLog but sequences properly in IO.
+-- | Like log' but sequences properly in IO.
-traceLogIO :: MonadIO m => String -> m ()
+logIO :: MonadIO m => String -> m ()
-traceLogIO s = do
+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.
+-- | Like logAt, but convenient to use in IO.
-traceLogAtIO :: MonadIO m => Int -> String -> m ()
+logAtIO :: (MonadIO m) => Int -> String -> m ()
-traceLogAtIO level str
+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.
+-- -- | Log a value to the debug log with the given show function before returning it.
-traceLogWith :: (a -> String) -> a -> a
+-- logWith :: (a -> String) -> a -> a
-traceLogWith f a = traceLog (f 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
+logAtWith :: Int -> (a -> String) -> a -> a
-traceLogAtWith level f a = traceLogAt level (f 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
+plogAt :: (Show a) => Int -> String -> a -> a
-ptraceLogAt level
+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
+-- | Like ptraceAt, but sequences properly in IO.
--- enforces monadic sequencing.
+plogAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
-ptraceLogAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
+plogAtIO level label a =
-ptraceLogAtIO 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,
+-- | Should dbg* log to a file instead of tracing to stderr ?
--- when global debug level is at or above the specified level,
+-- True if the (internal) program name ends with ".log".
--- before returning the second argument.
+shouldLog :: Bool
-traceOrLogAt :: Int -> String -> a -> a
+shouldLog = ".log" `isSuffixOf` modifiedProgName
-traceOrLogAt = if shouldLog then traceLogAt else traceAt
 
--- | 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.
+-- | Trace or log a string if the program debug level is at or above the specified level,
-ptraceOrLogAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
+-- then return the second argument.
-ptraceOrLogAtIO = if shouldLog then ptraceLogAtIO else ptraceAtIO
+dbgMsg :: Int -> String -> a -> a
+dbgMsg = if shouldLog then logAt else traceAt
 
--- | Trace or log, with a show function, depending on shouldLog.
+dbg0Msg :: String -> a -> a
-traceOrLogAtWith :: Int -> (a -> String) -> a -> a
+dbg0Msg = dbgMsg 0
-traceOrLogAtWith = if shouldLog then traceLogAtWith else traceAtWith
+
+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" #-}

hledger-lib/Hledger/Utils/Parse.hs

@@ -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 ()
+dbgparse :: Int -> String -> TextParser m ()
-traceOrLogParse msg = do
+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
 

hledger-ui/Hledger/UI/Main.hs

@@ -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
 

hledger-ui/Hledger/UI/UIUtils.hs

@@ -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.

hledger/Hledger/Cli.hs

@@ -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`;
+    dbgio :: Show a => String -> a -> IO ()
-    -- that's ok as conf is a hledger cli feature for now.
+    dbgio  = dbgIO verboseDebugLevel
-    dbgIO, dbgIO1, dbgIO2 :: Show a => String -> a -> IO ()  -- this signature is needed
+
-    dbgIO  = ptraceAtIO verboseDebugLevel
+  dbgio "running" prognameandversion
-    dbgIO1 = ptraceAtIO 1
-    dbgIO2 = ptraceAtIO 2
-  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 command argument found" clicmdarg
-  dbgIO "cli args before command"    cliargsbeforecmd
+  dbgio "cli args before command"    cliargsbeforecmd
-  dbgIO "cli args after command"     cliargsaftercmd
+  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" ()
+  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
+      dbg1IO "using command name argument from config file" confcmdarg
-  dbgIO "cli args with command first and no cli-specific opts" cliargswithcmdfirstwithoutclispecific
+  dbgio "cli args with command first and no cli-specific opts" cliargswithcmdfirstwithoutclispecific
-  dbgIO1 "command found" cmdname
+  dbg1IO "command found" cmdname
-  dbgIO "no command provided" nocmdprovided
+  dbgio "no command provided" nocmdprovided
-  dbgIO "bad command provided" badcmdprovided
+  dbgio "bad command provided" badcmdprovided
-  dbgIO "is addon command" isaddoncmd
+  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
+      dbg1IO "excluded general args from config file, not supported by this command" excludedgenargsfromconf
-    dbgIO1 "using subcommand args from config file" confcmdargs
+    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
+  dbg2IO "processed opts" opts
-  dbgIO "period from opts" (period_ . _rsReportOpts $ reportspec_ opts)
+  dbgio "period from opts" (period_ . _rsReportOpts $ reportspec_ opts)
-  dbgIO "interval from opts" (interval_ . _rsReportOpts $ reportspec_ opts)
+  dbgio "interval from opts" (interval_ . _rsReportOpts $ reportspec_ opts)
-  dbgIO "query from opts & args" (_rsQuery $ 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 selected" cmdname
-        dbgIO "addon command arguments after removing cli-specific opts" (map quoteIfNeeded addonargs)
+        dbgio "addon command arguments after removing cli-specific opts" (map quoteIfNeeded addonargs)
-        dbgIO1 "running addon" shellcmd
+        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])
+        2 -> dbgMsg lvl ("moving 2: "<>a<>" "<>b) $ moveFlagAndVal (cs, moved++[a,b])
-        1 -> traceOrLogAt lvl ("moving 1: "<>a) $ moveFlagAndVal (b:cs, moved++[a])
+        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

hledger/Hledger/Cli/Conf.hs

@@ -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)