imp: lib: move hledger-specific things out of Hledger.Utils.Debug

Moved from Hledger.Utils.Debug to Hledger.Utils.Parse:
traceParse
traceParseAt
dbgparse

hledger-lib/Hledger/Utils/Debug.hs

@@ -2,17 +2,19 @@
 
 Helpers for debug logging to console or file.
 This module also exports Debug.Trace and (from the breakpoint package) Debug.Breakpoint.
+Uses Hledger.Utils.Print. See also additional helpers in Hledger.Utils.Parse,
+Hledger.UI.UIUtils etc.
 
 @dbg0@-@dbg9@ will pretty-print values to stderr
 if the program was run with a sufficiently high @--debug=N@ argument. 
 (@--debug@ with no argument means @--debug=1@; @dbg0@ always prints).
 
-The @debugLevel@ global is set once at startup using unsafePerformIO. 
+Uses unsafePerformIO for simple program-wide read-only access to the debug level
-In GHCI, this happens only on the first run of :main, so if you want
+set by the --debug command-line flag. The @debugLevel@ global is set once at startup,
-to change the debug level without restarting GHCI,
+so in GHCI if you want to change it you must save this file and :reload.
-save a dummy change in Debug.hs and do a :reload.
+(Sometimes it's more convenient to temporarily add dbg0's in your code and :reload.)
-(Sometimes it's more convenient to temporarily add dbg0's and :reload.)
 
+Debug level is a number from 1 (least output) to 9 (most output).
 In hledger, debug levels are used as follows:
 
 Debug level:  What to show:
@@ -35,6 +37,7 @@ Debug level:  What to show:
 -- http://hackage.haskell.org/packages/archive/trace-call/0.1/doc/html/Debug-TraceCall.html
 -- 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
+-- https://hackage.haskell.org/package/debug
 
 module Hledger.Utils.Debug (
   -- * Tracing
@@ -82,9 +85,6 @@ module Hledger.Utils.Debug (
   ,dbg7IO
   ,dbg8IO
   ,dbg9IO
-  -- ** Trace the state of hledger parsers
-  ,traceParse
-  ,dbgparse
   -- ** Debug-logging to a file
   ,dlogTrace
   ,dlogTraceAt
@@ -105,23 +105,20 @@ module Hledger.Utils.Debug (
   )
 where
 
-import           Control.DeepSeq (force)
+import Control.DeepSeq (force)
-import           Control.Monad (when)
+import Control.Monad.IO.Class
-import           Control.Monad.IO.Class
+import Data.List hiding (uncons)
-import           Data.List hiding (uncons)
+import Debug.Breakpoint
-import qualified Data.Text as T
+import Debug.Trace
-import           Debug.Breakpoint
+import Safe (readDef)
-import           Debug.Trace
+import System.Environment (getArgs)
-import           Safe (readDef)
+import System.Exit
-import           System.Environment (getArgs)
+import System.IO.Unsafe (unsafePerformIO)
-import           System.Exit
-import           System.IO.Unsafe (unsafePerformIO)
-import           Text.Megaparsec
-import           Text.Printf
 import Control.Exception (evaluate)
 
-import Hledger.Utils.Parse
+-- import Hledger.Utils.Parse
 import Hledger.Utils.Print
+-- import Text.Megaparsec (MonadParsec)
 
 -- XXX some of the below can be improved with pretty-simple, https://github.com/cdepillabout/pretty-simple#readme
 
@@ -371,28 +368,3 @@ dlog8 = dlogAt 8
 
 dlog9 :: Show a => String -> a -> a
 dlog9 = dlogAt 9
-
--- | Print the provided label (if non-null) and current parser state
--- (position and next input) to the console. See also megaparsec's dbg.
-traceParse :: String -> TextParser m ()
-traceParse 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 ()
-  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
-dbgparse :: Int -> String -> TextParser m ()
-dbgparse = traceParseAt
-

hledger-lib/Hledger/Utils/Parse.hs

@@ -37,6 +37,11 @@ module Hledger.Utils.Parse (
   skipNonNewlineSpaces1,
   skipNonNewlineSpaces',
 
+  -- ** Trace the state of hledger parsers
+  traceParse,
+  traceParseAt,
+  dbgparse,
+
   -- * re-exports
   HledgerParseErrors,
   HledgerParseErrorData,
@@ -44,16 +49,20 @@ module Hledger.Utils.Parse (
 )
 where
 
+import Control.Monad (when)
+import qualified Data.Text as T
+import Text.Megaparsec
+import Text.Printf
 import Control.Monad.State.Strict (StateT, evalStateT)
 import Data.Char
 import Data.Functor (void)
 import Data.Functor.Identity (Identity(..))
 import Data.List
 import Data.Text (Text)
-import Text.Megaparsec
 import Text.Megaparsec.Char
 import Text.Megaparsec.Custom
-import Text.Printf
+import Debug.Trace (trace)
+import Hledger.Utils.Debug (debugLevel)
 
 -- | A parser of string to some type.
 type SimpleStringParser a = Parsec HledgerParseErrorData String a
@@ -64,6 +73,32 @@ 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
+-- (position and next input) to the console. See also megaparsec's dbg.
+-- traceParse :: String -> TextParser m ()
+traceParse 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 ()
+  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 ()
+dbgparse :: Int -> String -> TextParser m ()
+dbgparse = traceParseAt
+
 -- | Render a pair of source positions in human-readable form, only displaying the range of lines.
 sourcePosPairPretty :: (SourcePos, SourcePos) -> String
 sourcePosPairPretty (SourcePos fp l1 _, SourcePos _ l2 c2) =
@@ -150,12 +185,12 @@ restofline = anySingle `manyTill` eolof
 
 -- Skip many non-newline spaces.
 skipNonNewlineSpaces :: (Stream s, Token s ~ Char) => ParsecT HledgerParseErrorData s m ()
-skipNonNewlineSpaces = () <$ takeWhileP Nothing isNonNewlineSpace
+skipNonNewlineSpaces = void $ takeWhileP Nothing isNonNewlineSpace
 {-# INLINABLE skipNonNewlineSpaces #-}
 
 -- Skip many non-newline spaces, failing if there are none.
 skipNonNewlineSpaces1 :: (Stream s, Token s ~ Char) => ParsecT HledgerParseErrorData s m ()
-skipNonNewlineSpaces1 = () <$ takeWhile1P Nothing isNonNewlineSpace
+skipNonNewlineSpaces1 = void $ takeWhile1P Nothing isNonNewlineSpace
 {-# INLINABLE skipNonNewlineSpaces1 #-}
 
 -- Skip many non-newline spaces, returning True if any have been skipped.
@@ -163,6 +198,5 @@ skipNonNewlineSpaces' :: (Stream s, Token s ~ Char) => ParsecT HledgerParseError
 skipNonNewlineSpaces' = True <$ skipNonNewlineSpaces1 <|> pure False
 {-# INLINABLE skipNonNewlineSpaces' #-}
 
-
 eolof :: TextParser m ()
 eolof = void newline <|> eof

hledger-lib/Hledger/Utils/Print.hs

@@ -1,6 +1,8 @@
 {- | 
 Helpers for pretty-formatting haskell values, pretty-printing to console,
 deciding if ANSI colour should be used, and detecting an -o/--output-file option.
+Uses unsafePerformIO for simple program-wide read-only access to some common
+command-line flags/environment variables.
 
 Limitations:
 When running in GHCI, this module must be reloaded to see a change (because of unsafePerformIO).