mirror of
https://github.com/simonmichael/hledger.git
synced 2024-09-19 18:29:36 +03:00
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:
parent
fd82fa48c9
commit
ddb3ea777e
@ -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
|
||||
|
||||
|
@ -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
|
||||
|
@ -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).
|
||||
|
Loading…
Reference in New Issue
Block a user