new debug helpers; --debug=N sets debugLevel

The debug level set by `--debug[=N]` is now available to pure and
startup code as debugLevel, using unsafePerformIO.

`dbg LABEL ...` is now the go-to helper for tracing values on the
console; it produces output when the debug level is non-zero. `dbgExit`
is similar but exits immediately, avoiding further output. The
`dbgshow`, `dbgppshow` and `dbgpprint` variants allow control over the
pretty-printing method and required debug level, allowing more control
over what is displayed when.

Other cleanups: lstrace -> ltrace, pdbgAt -> pdbg, tracewith -> traceWith.

hledger-lib/Hledger/Read/CsvReader.hs

@@ -85,7 +85,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
 
   -- parse csv
   records <- (either throwerr id . validateCsv) `fmap` parseCsv csvfile csvdata
-  dbg 1 $ ppShow $ take 3 records
+  return $ dbg "" $ take 3 records
 
   -- identify header lines
   -- let (headerlines, datalines) = identifyHeaderLines records
@@ -98,7 +98,7 @@ readJournalFromCsv mrulesfile csvfile csvdata =
    then hPrintf stderr "creating default conversion rules file %s, edit this file for better results\n" rulesfile
    else hPrintf stderr "using conversion rules file %s\n" rulesfile
   rules <- either (throwerr.show) id `fmap` parseRulesFile rulesfile
-  dbg 1 $ ppShow rules
+  return $ dbg "" rules
 
   -- apply skip directive
   let headerlines = maybe 0 oneorerror $ getDirective "skip" rules

hledger-lib/Hledger/Utils.hs

@@ -21,6 +21,7 @@ module Hledger.Utils (---- provide these frequently used modules - or not, for c
                           ---- all of this one:
                           module Hledger.Utils,
                           Debug.Trace.trace,
+                          module Data.PPrint,
                           -- module Hledger.Utils.UTF8IOCompat
                           SystemString,fromSystemString,toSystemString,error',userError',
                           ppShow
@@ -31,16 +32,22 @@ import Control.Monad (liftM, when)
 import Control.Monad.Error (MonadIO)
 import Control.Monad.IO.Class (liftIO)
 import Data.Char
+import Data.Data
 import Data.List
 import qualified Data.Map as M
 import Data.Maybe
+import Data.PPrint
 import Data.Time.Clock
 import Data.Time.LocalTime
 import Data.Tree
 import Debug.Trace
+import Safe (readDef)
 import System.Directory (getHomeDirectory)
+import System.Environment (getArgs)
+import System.Exit
 import System.FilePath((</>), isRelative)
 import System.IO
+import System.IO.Unsafe (unsafePerformIO)
 import Test.HUnit
 import Text.ParserCombinators.Parsec
 import Text.Printf
@@ -339,25 +346,25 @@ treeFromPaths = foldl' mergeTrees emptyTree . map treeFromPath
 -- http://hackage.haskell.org/packages/archive/htrace/0.1/doc/html/Debug-HTrace.html
 -- http://hackage.haskell.org/packages/archive/traced/2009.7.20/doc/html/Debug-Traced.html
 
--- | trace (print on stdout at runtime) a showable expression
+-- | Trace (print on stdout at runtime) a showable value.
 -- (for easily tracing in the middle of a complex expression)
 strace :: Show a => a -> a
 strace a = trace (show a) a
 
--- | labelled trace showable - like strace, with a label prepended
+-- | Labelled trace - like strace, with a label prepended.
-lstrace :: Show a => String -> a -> a
+ltrace :: Show a => String -> a -> a
-lstrace l a = trace (l ++ ": " ++ show a) a
+ltrace l a = trace (l ++ ": " ++ show a) a
 
--- | monadic trace - like strace, but works as a standalone line in a monad
+-- | Monadic trace - like strace, but works as a standalone line in a monad.
 mtrace :: (Monad m, Show a) => a -> m a
 mtrace a = strace a `seq` return a
 
--- | trace an expression using a custom show function
+-- | Custom trace - like strace, with a custom show function.
-tracewith :: (a -> String) -> a -> a
+traceWith :: (a -> String) -> a -> a
-tracewith f e = trace (f e) e
+traceWith f e = trace (f e) e
 
 -- | Parsec trace - show the current parsec position and next input,
--- and the provided string if it's non-null.
+-- and the provided label if it's non-null.
 ptrace :: String -> GenParser Char st ()
 ptrace msg = do
   pos <- getPosition
@@ -369,18 +376,69 @@ ptrace msg = do
   where
     peeklength = 30
 
-debugLevel = 0
+-- | Global debug level, which controls the verbosity of debug output
+-- on the console. The default is 0 meaning no debug output. The
+-- @--debug@ command line flag sets it to 1, or @--debug=N@ sets it to
+-- a higher value (note: not @--debug N@).  This uses unsafePerformIO
+-- and can be accessed from anywhere and before normal command-line
+-- processing. After command-line processing, it is also available as
+-- the @debug_@ field of 'Hledger.Cli.Options.CliOpts'.
+debugLevel :: Int
+debugLevel = case snd $ break (=="--debug") args of
+               "--debug":[]  -> 1
+               "--debug":n:_ -> readDef 1 n
+               _             -> 0
+    where
+      args = unsafePerformIO getArgs
 
--- | Print a message to the console if the global debugLevel is
+-- | Print a message and a showable value to the console if the global
--- greater than the level we are called with.
+-- debug level is non-zero.  Uses unsafePerformIO.
-dbg :: Monad m => Float -> String -> m ()
+dbg :: Show a => String -> a -> a
-dbg  level msg = when (level <= debugLevel) $ trace msg $ return ()
+dbg = dbgppshow 1
 
--- | Print a message and parsec position info to the console if the
+-- | Print a showable value to the console, with a message, if the
--- global debugLevel is greater than the level we are called with.
+-- debug level is at or above the specified level (uses
--- pdbg :: GenParser m => Float -> String -> m ()
+-- unsafePerformIO).
+-- Values are displayed with show, all on one line, which is hard to read.
+dbgshow :: Show a => Int -> String -> a -> a
+dbgshow level
+    | debugLevel >= level = ltrace
+    | otherwise           = flip const
+
+-- | Print a showable value to the console, with a message, if the
+-- debug level is at or above the specified level (uses
+-- unsafePerformIO).
+-- Values are displayed with ppShow, each field/constructor on its own line.
+dbgppshow :: Show a => Int -> String -> a -> a
+dbgppshow level
+    | debugLevel >= level = \s -> traceWith (((s++": ")++) . ppShow)
+    | otherwise           = flip const
+
+-- | Print a showable value to the console, with a message, if the
+-- debug level is at or above the specified level (uses
+-- unsafePerformIO).
+-- Values are displayed with pprint. Field names are not shown, but the
+-- output is compact with smart line wrapping, long data elided,
+-- and slow calculations timed out.
+dbgpprint :: Data a => Int -> String -> a -> a
+dbgpprint level msg a
+    | debugLevel >= level = unsafePerformIO $ do
+                              pprint a >>= putStrLn . ((msg++": \n") ++) . show
+                              return a
+    | otherwise           = a
+
+
+-- | Like dbg, then exit the program. Uses unsafePerformIO.
+dbgExit :: Show a => String -> a -> a
+dbgExit msg = const (unsafePerformIO exitFailure) . dbg msg
+
+-- | Print a message and parsec debug info (parse position and next
+-- input) to the console when the debug level is at or above
+-- this level. Uses unsafePerformIO.
+-- pdbgAt :: GenParser m => Float -> String -> m ()
 pdbg level msg = when (level <= debugLevel) $ ptrace msg
 
+
 -- parsing
 
 -- | Backtracking choice, use this when alternatives share a prefix.