imp: debug logging improvements; hledger-ui logs to hledger-ui.log only

Hledger.Utils.Debug's "trace or log" functions are now controlled as
follows: to enable logging, append ",logging" to the program name at
startup (using withProgName). This also works when running in GHCI.
And they log to PROGNAME.log, not debug.log.

All (hopefully) debug logging in the hledger packages is now "trace or
log" capable.

This means that hledger-ui should now log all debug output to
./hledger-ui.log, with none of it appearing on the console.

hledger-lib/Hledger/Data/Amount.hs

@@ -141,7 +141,6 @@ module Hledger.Data.Amount (
   mixedAmountSetFullPrecision,
   canonicaliseMixedAmount,
   -- * misc.
-  ltraceamount,
   tests_Amount
 ) where
 
@@ -163,7 +162,6 @@ import Data.Word (Word8)
 import Safe (headDef, lastDef, lastMay)
 import System.Console.ANSI (Color(..),ColorIntensity(..))
 
-import Debug.Trace (trace)
 import Test.Tasty (testGroup)
 import Test.Tasty.HUnit ((@?=), assertBool, testCase)
 
@@ -948,10 +946,6 @@ maybeAppend :: Maybe a -> [a] -> [a]
 maybeAppend Nothing  = id
 maybeAppend (Just a) = (++[a])
 
--- | Compact labelled trace of a mixed amount, for debugging.
-ltraceamount :: String -> MixedAmount -> MixedAmount
-ltraceamount s a = trace (s ++ ": " ++ showMixedAmount a) a
-
 -- | Set the display precision in the amount's commodities.
 mixedAmountSetPrecision :: AmountPrecision -> MixedAmount -> MixedAmount
 mixedAmountSetPrecision p = mapMixedAmountUnsafe (amountSetPrecision p)

hledger-lib/Hledger/Data/Journal.hs

@@ -246,9 +246,8 @@ journalRenumberAccountDeclarations j = j{jdeclaredaccounts=jdas'}
 -- | Debug log the ordering of a journal's account declarations
 -- (at debug level 5+).
 dbgJournalAcctDeclOrder :: String -> Journal -> Journal
-dbgJournalAcctDeclOrder prefix
+dbgJournalAcctDeclOrder prefix =
-  | debugLevel >= 5 = traceWith ((prefix++) . showAcctDeclsSummary . jdeclaredaccounts)
+  traceOrLogAtWith 5 ((prefix++) . showAcctDeclsSummary . jdeclaredaccounts)
-  | otherwise       = id
   where
     showAcctDeclsSummary :: [(AccountName,AccountDeclarationInfo)] -> String
     showAcctDeclsSummary adis

hledger-lib/Hledger/Data/Valuation.hs

@@ -335,7 +335,7 @@ pricesShortestPath start end edges =
       case concatMap extend paths of
         [] -> Nothing 
         _ | pathlength > maxpathlength -> 
-          trace ("gave up searching for a price chain at length "++show maxpathlength++", please report a bug")
+          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

@@ -161,7 +161,7 @@ readJournalFile iopts prefixedfile = do
     iopts' = iopts{mformat_=asum [mfmt, mformat_ iopts]}
   liftIO $ requireJournalFileExists f
   t <-
-    traceAt 6 ("readJournalFile: "++takeFileName f) $
+    traceOrLogAt 6 ("readJournalFile: "++takeFileName f) $
     liftIO $ readFileOrStdinPortably f
     -- <- T.readFile f  -- or without line ending translation, for testing
   j <- readJournal iopts' (Just f) t

hledger-lib/Hledger/Read/Common.hs

@@ -327,7 +327,7 @@ journalFinalise iopts@InputOpts{..} f txt pj = do
       >>= journalBalanceTransactions balancingopts_                         -- Balance all transactions and maybe check balance assertions.
       <&> (if infer_equity_ then journalAddInferredEquityPostings else id)  -- Add inferred equity postings, after balancing and generating auto postings
       <&> journalInferMarketPricesFromTransactions       -- infer market prices from commodity-exchanging transactions
-      <&> traceAt 6 ("journalFinalise: " <> takeFileName f)  -- debug logging
+      <&> traceOrLogAt 6 ("journalFinalise: " <> takeFileName f)  -- debug logging
       <&> dbgJournalAcctDeclOrder ("journalFinalise: " <> takeFileName f <> "   acct decls           : ")
       <&> journalRenumberAccountDeclarations
       <&> dbgJournalAcctDeclOrder ("journalFinalise: " <> takeFileName f <> "   acct decls renumbered: ")

hledger-lib/Hledger/Utils/Debug.hs

@@ -1,18 +1,43 @@
 {- | 
 
-Convenient helpers for debug logging to stderr or a file.
+Here are fancier versions of Debug.Trace, with these features:
-The function names try to balance consistency, memorability, and ease of typing.
+
+- pretty-printing haskell values, with or without colour, using pretty-simple
+- 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
+- reasonably short and memorable function names
+- easy usage in pure code, IO code, and program startup code.
+
 This module also exports Debug.Trace and the breakpoint package's Debug.Breakpoint.
 
-The @dbgN*@ functions are intended to be added at points of interest in your code.
+The "trace" functions print to stderr.
-They will print labelled values to stderr, only if the program was run with a 
+This debug output will be interleaved with the program's normal output, which can be
-sufficiently high debug level. Debug level ranges from 0 (no output) to 9 (most output),
+useful for understanding when code executes.
-and is set by the @--debug[=N]@ command line option. (@--debug@ with no argument means 1).
+On most systems you can redirect stderr to a log file if you prefer (eg: @CMD 2>debug.log@).
 
-The command line is parsed for --debug using unsafePerformIO, for easy use of these helpers
+"traceLog" functions log to the program's debug log file.
-in existing code, or before normal command line parsing.
+That is @PROGNAME.log@ in the current directory,
-If you are working in GHCI, changing the debug level requires editing and reloading this file.
+where PROGNAME is  the executable name returned by @getProgName@.
-Sometimes it's more convenient to temporarily add dbg0's in your code and :reload.
+If using the logging feature you should ensure a stable program name
+by setting it explicitly with @withProgName@ at the start of your program
+(since otherwise it will change to "<interactive>" when you are testing in GHCI).
+Eg:
+@main = withProgName "MYPROG" $ do ...@.
+
+The "traceOrLog" and "dbg" functions normally print to stderr, but if the program name
+has been set to "MYPROG,logging" (ie, with a ",logging" suffix), they will log to
+MYPROG.log instead. This is useful eg for TUI programs (hledger-ui does this).
+
+The "dbgN*" functions are intended to be added at points of interest in your code.
+They (and the "*At*" functions) produce output only if the program was run with a 
+sufficiently high debug level. This ranges from 0 (no debug output) to 9 (most debug output),
+and it is set by the @--debug[=N]@ command line option. (@--debug@ with no argument means 1).
+
+Parsing the command line for --debug, detecting program name, and file logging is done with unsafePerformIO.
+If you are working in GHCI, changing the debug level requires editing and reloading this file
+(sometimes it's more convenient to add a dbg0 temporarily).
 
 In hledger, debug levels are used as follows:
 
@@ -39,22 +64,34 @@ Debug level:  What to show:
 -- https://hackage.haskell.org/package/debug
 
 module Hledger.Utils.Debug (
-  -- * Tracing to stderr
+ 
    debugLevel
+
+  -- * Tracing to stderr
   ,traceWith
   ,traceAt
   ,traceAtWith
   ,ptrace
   ,ptraceAt
   ,ptraceAtIO
-  -- * Logging to a file
+
-  -- ,debugLogLevel
+  -- * Logging to PROGNAME.log
   ,traceLog
   ,traceLogAt
-  -- ,ptraceLogAt
+  ,traceLogIO
-  -- ,ptraceLogAtWith
+  ,traceLogAtIO
-  -- ,ptraceLogAtIO
+  ,traceLogWith
-  -- * Convenient pretty tracing in pure code
+  ,traceLogAtWith
+  ,ptraceLogAt
+  ,ptraceLogAtIO
+
+  -- * Tracing or logging based on shouldLog
+  ,traceOrLog
+  ,traceOrLogAt
+  ,ptraceOrLogAt
+  ,traceOrLogAtWith
+
+  -- * Pretty tracing/logging in pure code
   ,dbg0
   ,dbg1
   ,dbg2
@@ -66,18 +103,8 @@ module Hledger.Utils.Debug (
   ,dbg8
   ,dbg9
   ,dbgExit
-  -- * Convenient tracing with a show function
+
-  ,dbg0With
+  -- * Pretty tracing/logging in IO
-  ,dbg1With
-  ,dbg2With
-  ,dbg3With
-  ,dbg4With
-  ,dbg5With
-  ,dbg6With
-  ,dbg7With
-  ,dbg8With
-  ,dbg9With
-  -- * Convenient pretty tracing in IO
   ,dbg0IO
   ,dbg1IO
   ,dbg2IO
@@ -88,9 +115,23 @@ module Hledger.Utils.Debug (
   ,dbg7IO
   ,dbg8IO
   ,dbg9IO
+
+  -- * Tracing/logging with a show function
+  ,dbg0With
+  ,dbg1With
+  ,dbg2With
+  ,dbg3With
+  ,dbg4With
+  ,dbg5With
+  ,dbg6With
+  ,dbg7With
+  ,dbg8With
+  ,dbg9With
+
   -- * Re-exports
   ,module Debug.Breakpoint
   ,module Debug.Trace
+
   )
 where
 
@@ -99,24 +140,13 @@ import Control.Exception (evaluate)
 import Control.Monad.IO.Class (MonadIO, liftIO)
 import Data.List hiding (uncons)
 import Debug.Breakpoint
-import Debug.Trace (trace)
+import Debug.Trace (trace, traceIO, traceShowId)
 import Safe (readDef)
-import System.Environment (getArgs)
+import System.Environment (getArgs, getProgName)
 import System.Exit (exitFailure)
 import System.IO.Unsafe (unsafePerformIO)
 
-import Hledger.Utils.Print (pshow)
+import Hledger.Utils.Print (pshow, pshow')
-
--- XXX some of the below can be improved with pretty-simple, https://github.com/cdepillabout/pretty-simple#readme
-
--- | Trace a showable value with the given show function before returning it.
-traceWith :: Show a => (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
 
 -- | Global debug output level. This is the requested verbosity of
 -- debug output printed to stderr. The default is 0 meaning no debug output.
@@ -138,6 +168,15 @@ debugLevel = case dropWhile (/="--debug") args of
     where
       args = unsafePerformIO getArgs
 
+-- | 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
 -- or above the specified level. At level 0, always prints. Otherwise,
 -- uses unsafePerformIO.
@@ -158,193 +197,232 @@ traceAtWith level f a = traceAt level (f a) a
 ptraceAt :: Show a => Int -> String -> a -> a
 ptraceAt level
     | level > 0 && debugLevel < level = const id
-    | otherwise = \s a -> let ls = lines $ pshow a
+    | otherwise = \lbl a -> trace (labelledPretty True lbl a) a
-                              nlorspace | length ls > 1 = "\n"
+    
-                                        | otherwise     = replicate (max 1 $ 11 - length s) ' '
+-- Pretty-print a showable value with a label, with or without allowing ANSI color.
-                              ls' | length ls > 1 = map (' ':) ls
+labelledPretty :: Show a => Bool -> String -> a -> String
-                                  | otherwise     = ls
+labelledPretty allowcolour lbl a = lbl ++ ":" ++ nlorspace ++ intercalate "\n" ls'
-                          in trace (s++":"++nlorspace++intercalate "\n" ls') a
+  where
+    ls = lines $ (if allowcolour then pshow else pshow') a
+    nlorspace | length ls > 1 = "\n"
+              | otherwise     = replicate (max 1 $ 11 - length lbl) ' '
+    ls' | length ls > 1 = map (' ':) ls
+        | otherwise     = ls
 
 -- | Like ptraceAt, but convenient to insert in an IO monad and
 -- enforces monadic sequencing.
--- XXX These have a bug; they should use
--- traceIO, not trace, otherwise GHC can occasionally over-optimise
--- (cf lpaste a few days ago where it killed/blocked a child thread).
 ptraceAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
-ptraceAtIO lvl lbl x = liftIO $ ptraceAt lvl lbl x `seq` return ()
+ptraceAtIO level label a =
+  if level > 0 && debugLevel < level
+  then return ()
+  else liftIO $ traceIO (labelledPretty True label a)
 
--- XXX separate file logging debug level and helpers - probably not needed
+-- | The program name, possibly ending with ",logging".
--- since you can just redirect stderr to a file, on unix at least.
+-- This should be set at program startup with @withProgName@,
+-- otherwise it will vary, eg "<interactive>" in GHCI.
+{-# NOINLINE modifiedProgName #-}
+modifiedProgName :: String
+modifiedProgName = unsafePerformIO getProgName
 
--- -- | Global debug log level. Like debugLevel, but controls verbosity
+-- | Should the "trace or log" functions output to a file instead of stderr ?
--- -- of debug output logged to the debug log file.
+-- True if the program name ends with ",logging".
--- -- {-# OPTIONS_GHC -fno-cse #-}
+shouldLog :: Bool
--- {-# NOINLINE debugLogLevel #-}
+shouldLog = ",logging" `isSuffixOf` modifiedProgName
--- debugLogLevel :: Int
--- debugLogLevel = case dropWhile (/="--debug") args of
---                ["--debug-log"]   -> 1
---                "--debug-log":n:_ -> readDef 1 n
---                _             ->
---                  case take 1 $ filter ("--debug-log" `isPrefixOf`) args of
---                    ['-':'-':'d':'e':'b':'u':'g':'-':'l':'o':'g':'=':v] -> readDef 1 v
---                    _                                   -> 0
---     where
---       args = unsafePerformIO getArgs
 
--- | Log a string to ./debug.log before returning the second argument.
+-- | The progam name, with any ",logging" suffix removed.
+progName :: String
+progName =
+  if ",logging" `isSuffixOf` modifiedProgName
+  then reverse $ drop 8 $ reverse modifiedProgName
+  else 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.
--- {-# NOINLINE traceLog #-}
+{-# NOINLINE traceLog #-}
 traceLog :: String -> a -> a
 traceLog s x = unsafePerformIO $ do
   evaluate (force s)  -- to complete any previous logging before we attempt more
-  appendFile "debug.log" (s ++ "\n")
+  appendFile debugLogFile (s ++ "\n")
   return x
 
--- | Log a string to ./debug.log before returning the second argument,
+-- | Log a string to the debug log before returning the second argument,
 -- if the global debug level is at or above the specified level.
 -- At level 0, always logs. Otherwise, uses unsafePerformIO.
 traceLogAt :: Int -> String -> a -> a
-traceLogAt level s
+traceLogAt level str
   | level > 0 && debugLevel < level = id
-  | otherwise = traceLog s
+  | otherwise = traceLog str
 
--- -- | Pretty-log a label and showable value to ./debug.log,
+-- | Like traceLog but sequences properly in IO.
--- -- if the global debug level is at or above the specified level.
+traceLogIO :: MonadIO m => String -> m ()
--- -- At level 0, always prints. Otherwise, uses unsafePerformIO.
+traceLogIO s = do
--- ptraceLogAt :: Show a => Int -> String -> a -> a
+  liftIO $ evaluate (force s)  -- to complete any previous logging before we attempt more
--- ptraceLogAt level
+  liftIO $ appendFile debugLogFile (s ++ "\n")
---   | level > 0 && debugLogLevel < level = const id
---   | otherwise = \lbl a ->
---     let 
---       ls = lines $ pshow' a
---       nlorspace | length ls > 1 = "\n"
---                 | otherwise     = replicate (max 1 $ 11 - length lbl) ' '
---       ls' | length ls > 1 = map (' ':) ls
---           | otherwise     = ls
---     in traceLog (lbl++":"++nlorspace++intercalate "\n" ls') a
 
--- -- | Like ptraceLogAt, but takes a custom show function instead of a label.
+-- | Like traceLogAt, but convenient to use in IO.
--- ptraceLogAtWith :: Show a => Int -> (a -> String) -> a -> a
+traceLogAtIO :: MonadIO m => Int -> String -> m ()
--- ptraceLogAtWith level f
+traceLogAtIO level str
---     | level > 0 && debugLevel < level = id
+  | level > 0 && debugLevel < level = return ()
---     | otherwise = \a -> let p = f a
+  | otherwise = traceLogIO str
---                             -- ls = lines p
---                             -- nlorspace | length ls > 1 = "\n"
---                             --           | otherwise     = " " ++ take (10 - length s) (repeat ' ')
---                             -- ls' | length ls > 1 = map (" "++) ls
---                             --     | otherwise     = ls
---                         -- in trace (s++":"++nlorspace++intercalate "\n" ls') a
---                         in trace p a
 
--- -- | Like ptraceAt, but convenient to insert in an IO monad and
+-- | Log a value to the debug log with the given show function before returning it.
--- -- enforces monadic sequencing.
+traceLogWith :: (a -> String) -> a -> a
--- -- XXX These have a bug; they should use
+traceLogWith f a = traceLog (f a) a
--- -- traceIO, not trace, otherwise GHC can occasionally over-optimise
--- -- (cf lpaste a few days ago where it killed/blocked a child thread).
--- ptraceLogAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
--- ptraceLogAtIO lvl lbl x = liftIO $ ptraceLogAt lvl lbl x `seq` return ()
 
--- | Pretty-trace and pretty-log a label and showable value
+-- | Log a string to the debug log before returning the second argument,
--- to stderr and the debug log, then return it.
+-- if the global 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 
+
+-- | Pretty-log a label and showable value to the debug log,
+-- if the global 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
+  | level > 0 && debugLevel < level = const id
+  | otherwise = \lbl a -> traceLog (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 =
+  if level > 0 && debugLevel < level
+  then return ()
+  else return $ traceLog (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 trace else traceLog
+
+-- 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
+
+-- 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, with a show function, depending on shouldLog.
+traceOrLogAtWith :: Int -> (a -> String) -> a -> a
+traceOrLogAtWith = if shouldLog then traceLogAtWith else traceAtWith
+
+-- | Pretty-trace to stderr (or log to debug log) a label and showable value,
+-- then return it.
 dbg0 :: Show a => String -> a -> a
-dbg0 = ptraceAt 0
+dbg0 = ptraceOrLogAt 0
 
--- | Pretty-trace a label and showable value to stderr if
+-- | Pretty-trace to stderr (or log to debug log) a label and showable value
--- --debug level is high enough,
+-- if the --debug level is high enough, then return the value.
--- and pretty-log to the debug log if --debug-log level is
--- high enough, then return the value.
 -- Uses unsafePerformIO.
 dbg1 :: Show a => String -> a -> a
-dbg1 = ptraceAt 1
+dbg1 = ptraceOrLogAt 1
 
 dbg2 :: Show a => String -> a -> a
-dbg2 = ptraceAt 2
+dbg2 = ptraceOrLogAt 2
 
 dbg3 :: Show a => String -> a -> a
-dbg3 = ptraceAt 3
+dbg3 = ptraceOrLogAt 3
 
 dbg4 :: Show a => String -> a -> a
-dbg4 = ptraceAt 4
+dbg4 = ptraceOrLogAt 4
 
 dbg5 :: Show a => String -> a -> a
-dbg5 = ptraceAt 5
+dbg5 = ptraceOrLogAt 5
 
 dbg6 :: Show a => String -> a -> a
-dbg6 = ptraceAt 6
+dbg6 = ptraceOrLogAt 6
 
 dbg7 :: Show a => String -> a -> a
-dbg7 = ptraceAt 7
+dbg7 = ptraceOrLogAt 7
 
 dbg8 :: Show a => String -> a -> a
-dbg8 = ptraceAt 8
+dbg8 = ptraceOrLogAt 8
 
 dbg9 :: Show a => String -> a -> a
-dbg9 = ptraceAt 9
+dbg9 = ptraceOrLogAt 9
 
 -- | Like dbg0, but also exit the program. Uses unsafePerformIO.
--- {-# NOINLINE dbgExit #-}
+{-# NOINLINE dbgExit #-}
 dbgExit :: Show a => String -> a -> a
-dbgExit msg = const (unsafePerformIO exitFailure) . dbg0 msg
+dbgExit label a = unsafePerformIO $ dbg0IO label a >> exitFailure
-
--- | Like dbgN, but taking a show function instead of a label.
-dbg0With :: Show a => (a -> String) -> a -> a
-dbg0With = traceAtWith 0
-
-dbg1With :: Show a => (a -> String) -> a -> a
-dbg1With = traceAtWith 1
-
-dbg2With :: Show a => (a -> String) -> a -> a
-dbg2With = traceAtWith 2
-
-dbg3With :: Show a => (a -> String) -> a -> a
-dbg3With = traceAtWith 3
-
-dbg4With :: Show a => (a -> String) -> a -> a
-dbg4With = traceAtWith 4
-
-dbg5With :: Show a => (a -> String) -> a -> a
-dbg5With = traceAtWith 5
-
-dbg6With :: Show a => (a -> String) -> a -> a
-dbg6With = traceAtWith 6
-
-dbg7With :: Show a => (a -> String) -> a -> a
-dbg7With = traceAtWith 7
-
-dbg8With :: Show a => (a -> String) -> a -> a
-dbg8With = traceAtWith 8
-
-dbg9With :: Show a => (a -> String) -> a -> a
-dbg9With = traceAtWith 9
 
 -- | Like dbgN, but convenient to use in IO.
 dbg0IO :: (MonadIO m, Show a) => String -> a -> m ()
-dbg0IO = ptraceAtIO 0
+dbg0IO = ptraceOrLogAtIO 0
 
 dbg1IO :: (MonadIO m, Show a) => String -> a -> m ()
-dbg1IO = ptraceAtIO 1
+dbg1IO = ptraceOrLogAtIO 1
 
 dbg2IO :: (MonadIO m, Show a) => String -> a -> m ()
-dbg2IO = ptraceAtIO 2
+dbg2IO = ptraceOrLogAtIO 2
 
 dbg3IO :: (MonadIO m, Show a) => String -> a -> m ()
-dbg3IO = ptraceAtIO 3
+dbg3IO = ptraceOrLogAtIO 3
 
 dbg4IO :: (MonadIO m, Show a) => String -> a -> m ()
-dbg4IO = ptraceAtIO 4
+dbg4IO = ptraceOrLogAtIO 4
 
 dbg5IO :: (MonadIO m, Show a) => String -> a -> m ()
-dbg5IO = ptraceAtIO 5
+dbg5IO = ptraceOrLogAtIO 5
 
 dbg6IO :: (MonadIO m, Show a) => String -> a -> m ()
-dbg6IO = ptraceAtIO 6
+dbg6IO = ptraceOrLogAtIO 6
 
 dbg7IO :: (MonadIO m, Show a) => String -> a -> m ()
-dbg7IO = ptraceAtIO 7
+dbg7IO = ptraceOrLogAtIO 7
 
 dbg8IO :: (MonadIO m, Show a) => String -> a -> m ()
-dbg8IO = ptraceAtIO 8
+dbg8IO = ptraceOrLogAtIO 8
 
 dbg9IO :: (MonadIO m, Show a) => String -> a -> m ()
-dbg9IO = ptraceAtIO 9
+dbg9IO = ptraceOrLogAtIO 9
+
+-- | Like dbgN, but taking a show function instead of a label.
+dbg0With :: (a -> String) -> a -> a
+dbg0With = traceOrLogAtWith 0
+
+dbg1With :: Show a => (a -> String) -> a -> a
+dbg1With = traceOrLogAtWith 1
+
+dbg2With :: Show a => (a -> String) -> a -> a
+dbg2With = traceOrLogAtWith 2
+
+dbg3With :: Show a => (a -> String) -> a -> a
+dbg3With = traceOrLogAtWith 3
+
+dbg4With :: Show a => (a -> String) -> a -> a
+dbg4With = traceOrLogAtWith 4
+
+dbg5With :: Show a => (a -> String) -> a -> a
+dbg5With = traceOrLogAtWith 5
+
+dbg6With :: Show a => (a -> String) -> a -> a
+dbg6With = traceOrLogAtWith 6
+
+dbg7With :: Show a => (a -> String) -> a -> a
+dbg7With = traceOrLogAtWith 7
+
+dbg8With :: Show a => (a -> String) -> a -> a
+dbg8With = traceOrLogAtWith 8
+
+dbg9With :: Show a => (a -> String) -> a -> a
+dbg9With = traceOrLogAtWith 9
 

hledger-lib/Hledger/Utils/Parse.hs

@@ -38,8 +38,7 @@ module Hledger.Utils.Parse (
   skipNonNewlineSpaces',
 
   -- ** Trace the state of hledger parsers
-  traceParse,
+  traceOrLogParse,
-  traceParseAt,
   dbgparse,
 
   -- * re-exports
@@ -61,8 +60,7 @@ import Data.List
 import Data.Text (Text)
 import Text.Megaparsec.Char
 import Text.Megaparsec.Custom
-import Debug.Trace (trace)
+import Hledger.Utils.Debug (debugLevel, traceOrLog)
-import Hledger.Utils.Debug (debugLevel)
 
 -- | A parser of string to some type.
 type SimpleStringParser a = Parsec HledgerParseErrorData String a
@@ -73,31 +71,30 @@ type SimpleTextParser = Parsec HledgerParseErrorData Text  -- XXX an "a" argumen
 -- | A parser of text that runs in some monad.
 type TextParser m a = ParsecT HledgerParseErrorData Text m a
 
--- | Print the provided label (if non-null) and current parser state
+-- | Trace to stderr or log to debug log the provided label (if non-null)
--- (position and next input) to the console. See also megaparsec's dbg.
+-- and current parser state (position and next input).
-traceParse :: String -> TextParser m ()
+-- See also: Hledger.Utils.Debug, megaparsec's dbg.
-traceParse msg = do
+-- Uses unsafePerformIO.
+traceOrLogParse :: String -> TextParser m ()
+traceOrLogParse msg = 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
-  trace s' $ return ()
+  traceOrLog s' $ return ()
   where
     peeklength = 30
 
--- | Print the provided label (if non-null) and current parser state
--- (position and next input) to the console if the global debug level
--- is at or above the specified level. Uses unsafePerformIO.
--- (See also megaparsec's dbg.)
-traceParseAt :: Int -> String -> TextParser m ()
-traceParseAt level msg = when (level <= debugLevel) $ traceParse msg
-
--- | Convenience alias for traceParseAt
 -- class (Stream s, MonadPlus m) => MonadParsec e s m 
 -- dbgparse :: (MonadPlus m, MonadParsec e String m) => Int -> String -> m ()
+
+-- | 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 = traceParseAt
+dbgparse level msg = when (level <= debugLevel) $ traceOrLogParse msg
 
 -- | Render a pair of source positions in human-readable form, only displaying the range of lines.
 sourcePosPairPretty :: (SourcePos, SourcePos) -> String

hledger-ui/Hledger/UI/ErrorScreen.hs

@@ -149,10 +149,10 @@ uiReloadJournal copts d ui = do
   ej <-
     let copts' = enableForecastPreservingPeriod ui copts
     in runExceptT $ journalReload copts'
-  -- dbguiIO $ ("uiReloadJournal before reload: "++) $ pshow' $ map tdescription $ jtxns $ ajournal ui
+  -- dbg1IO "uiReloadJournal before reload" (map tdescription $ jtxns $ ajournal ui)
   return $ case ej of
     Right j  ->
-      -- dbgui (("uiReloadJournal after reload: "++) $ pshow' $ map tdescription $ jtxns j) $
+      -- dbg1 "uiReloadJournal after reload" (map tdescription $ jtxns j) $
       regenerateScreens j d ui
     Left err ->
       case ui of

hledger-ui/Hledger/UI/Main.hs

@@ -33,7 +33,7 @@ import Hledger.UI.Theme
 import Hledger.UI.UIOptions
 import Hledger.UI.UITypes
 import Hledger.UI.UIState (uiState, getDepth)
-import Hledger.UI.UIUtils (dbguiEv, dbguiIO)
+import Hledger.UI.UIUtils (dbguiEv)
 import Hledger.UI.MenuScreen
 import Hledger.UI.AccountsScreen
 import Hledger.UI.BalancesheetScreen
@@ -41,6 +41,7 @@ import Hledger.UI.IncomestatementScreen
 import Hledger.UI.RegisterScreen
 import Hledger.UI.TransactionScreen
 import Hledger.UI.ErrorScreen
+import System.Environment (withProgName)
 
 ----------------------------------------------------------------------
 
@@ -52,7 +53,7 @@ writeChan = BC.writeBChan
 
 
 main :: IO ()
-main = do
+main = withProgName "hledger-ui,logging" $ do  -- force Hledger.Utils.Debug.* to log to hledger-ui.log
   opts@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=iopts,rawopts_=rawopts}} <- getHledgerUIOpts
   -- when (debug_ $ cliopts_ opts) $ printf "%s\n" prognameandversion >> printf "opts: %s\n" (show opts)
 
@@ -167,7 +168,7 @@ runBrickUi uopts0@UIOpts{uoCliOpts=copts@CliOpts{inputopts_=_iopts,reportspec_=r
       setMode (outputIface v) Mouse True
       return v
 
-  dbguiIO "\n\n==== hledger-ui start"
+  traceLogAtIO 1 "\n\n==== hledger-ui start"
 
   if not (uoWatch uopts)
   then do

hledger-ui/Hledger/UI/UIUtils.hs

@@ -33,7 +33,6 @@ module Hledger.UI.UIUtils (
   ,reportSpecSetFutureAndForecast
   ,listScrollPushingSelection
   ,dbgui
-  ,dbguiIO
   ,dbguiEv
   ,dbguiScreensEv
   ,screenRegisterDescriptions
@@ -438,29 +437,22 @@ listScrollPushingSelection name listheight scrollamt = do
         _ -> return list
     _ -> return list
 
--- Log hledger-ui events at this debug level and above.
+-- | A debug logging helper for hledger-ui code: at any debug level >= 1,
-uiDebugLevel :: Int
+-- logs the string to hledger-ui.log before returning the second argument.
-uiDebugLevel = 1
+-- Uses unsafePerformIO.
-
--- | A debug logging helper to use in hledger-ui code:
--- at any debug level >= 1, logs the string to ./debug.log before returning the second argument.
--- Like traceLogAt 1. Uses unsafePerformIO.
 dbgui :: String -> a -> a
-dbgui = traceLogAt uiDebugLevel
+dbgui = traceLogAt 1
 
--- | Like dbgui, but convenient in IO.
+-- | Like dbgui, but convenient to use in EventM handlers.
-dbguiIO :: String -> IO ()
-dbguiIO s = dbgui s $ return ()
-
--- | Like dbgui, but convenient in hledger EventM handlers.
 dbguiEv :: String -> EventM Name s ()
 dbguiEv s = dbgui s $ return ()
 
 -- | Like dbguiEv, but log a compact view of the current screen stack,
+-- adding the given postfix to the label (can be empty),
 -- from topmost screen to currently-viewed screen,
--- with each screen rendered by the given rendering function
+-- with each screen rendered by the given rendering function.
--- (and with the given extra label if any).
 -- Useful for inspecting states across the whole screen stack.
+-- Some screen rendering functions are @screenId@ and @screenRegisterDescriptions@.
 -- To just show the stack: @dbguiScreensEv "" screenId ui@
 dbguiScreensEv :: String -> (Screen -> String) -> UIState -> EventM Name UIState ()
 dbguiScreensEv postfix showscr ui =