update ptrace, add dbg, ppShow utilities

hledger-lib/Hledger/Utils.hs

@@ -22,7 +22,8 @@ module Hledger.Utils (---- provide these frequently used modules - or not, for c
                           module Hledger.Utils,
                           Debug.Trace.trace,
                           -- module Hledger.Utils.UTF8IOCompat
-                          SystemString,fromSystemString,toSystemString,error',userError'
+                          SystemString,fromSystemString,toSystemString,error',userError',
+                          ppShow
                           -- the rest need to be done in each module I think
                           )
 where
@@ -44,6 +45,7 @@ import Text.ParserCombinators.Parsec
 import Text.Printf
 import Text.Regex
 import Text.RegexPR
+import Text.Show.Pretty
 -- import qualified Data.Map as Map
 -- 
 -- import Prelude hiding (readFile,writeFile,appendFile,getContents,putStr,putStrLn)
@@ -354,24 +356,29 @@ tracewith :: (a -> String) -> a -> a
 tracewith f e = trace (f e) e
 
 -- | Parsec trace - show the current parsec position and next input,
--- prefixed by the specified label if it's non-null.
+-- and the provided string if it's non-null.
 ptrace :: String -> GenParser Char st ()
-ptrace label = do
+ptrace msg = do
-  let label' = if null label then "" else label ++ ": "
   pos <- getPosition
-  let (line,col) = (sourceLine pos, sourceColumn pos)
+  next <- take peeklength `fmap` getInput
-  next <- take 20 `fmap` getInput
+  let (l,c) = (sourceLine pos, sourceColumn pos)
-  mtrace (printf "%-10sat line %2d col %2d looking at >>>%s<<<" label' line col next :: String)
+      s  = printf "at line %2d col %2d: %s" l c (show next) :: String
-  return ()
+      s' = printf ("%-"++show (peeklength+30)++"s") s ++ " " ++ msg
+  trace s' $ return ()
+  where
+    peeklength = 30
 
-ptrace' :: (Show a) => String -> GenParser a st ()
+debugLevel = 0
-ptrace' label = do
+
-  let label' = if null label then "" else label ++ ": "
+-- | Print a message to the console if the global debugLevel is
-  pos <- getPosition
+-- greater than the level we are called with.
-  let (line,col) = (sourceLine pos, sourceColumn pos)
+dbg :: Monad m => Float -> String -> m ()
-  next <- take 20 `fmap` getInput
+dbg  level msg = when (level <= debugLevel) $ trace msg $ return ()
-  mtrace (printf "%-10sat line %2d col %2d looking at %s" label' line col (show next) :: String)
+
-  return ()
+-- | Print a message and parsec position info to the console if the
+-- global debugLevel is greater than the level we are called with.
+-- pdbg :: GenParser m => Float -> String -> m ()
+pdbg level msg = when (level <= debugLevel) $ ptrace msg
 
 -- parsing
 

hledger-lib/hledger-lib.cabal

@@ -66,6 +66,7 @@ library
                  ,old-locale
                  ,old-time
                  ,parsec
+                 ,pretty-show
                  ,regex-compat == 0.95.*
                  ,regexpr >= 0.5.1
                  ,safe >= 0.2