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

Moved from Hledger.Utils.Debug to Hledger.Utils.Parse:
traceParse
traceParseAt
dbgparse
This commit is contained in:
Simon Michael 2022-10-29 12:54:03 -10:00
parent fd82fa48c9
commit ddb3ea777e
3 changed files with 60 additions and 52 deletions

View File

@ -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.
In GHCI, this happens only on the first run of :main, so if you want
to change the debug level without restarting GHCI,
save a dummy change in Debug.hs and do a :reload.
(Sometimes it's more convenient to temporarily add dbg0's and :reload.)
Uses unsafePerformIO for simple program-wide read-only access to the debug level
set by the --debug command-line flag. The @debugLevel@ global is set once at startup,
so in GHCI if you want to change it you must save this file and :reload.
(Sometimes it's more convenient to temporarily add dbg0's in your code 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
@ -106,22 +106,19 @@ module Hledger.Utils.Debug (
where
import Control.DeepSeq (force)
import Control.Monad (when)
import Control.Monad.IO.Class
import Data.List hiding (uncons)
import qualified Data.Text as T
import Debug.Breakpoint
import Debug.Trace
import Safe (readDef)
import System.Environment (getArgs)
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

View File

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

View File

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