{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
{- | Debugging helpers.

You can enable increasingly verbose debug output by adding --debug [1-9]
to a hledger command line. --debug with no argument means --debug 1.
This is implemented by calling dbgN or similar helpers, defined below.
These calls can be found throughout hledger code; they have been added
organically where it seemed likely they would be needed again.
The choice of debug level has not been very systematic.
202006 Here's a start at some guidelines, not yet applied project-wide:

Debug level:  What to show:
------------  ---------------------------------------------------------
0             normal command output only (no warnings, eg)
1 (--debug)   useful warnings, most common troubleshooting info, eg valuation
2             common troubleshooting info, more detail
3             report options selection
4             report generation
5             report generation, more detail
6             input file reading
7             input file reading, more detail
8             command line parsing
9             any other rarely needed / more in-depth info

Tip: when debugging with GHCI, the first run after loading Debug.hs sets the
debug level. If you need to change it, you must touch Debug.hs, :reload in GHCI,
then run the command with a new --debug value. Or, often it's more convenient
to add a temporary dbg0 and :reload (dbg0 always prints).

-}

-- more:
-- http://hackage.haskell.org/packages/archive/TraceUtils/0.1.0.2/doc/html/Debug-TraceUtils.html
-- 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

module Hledger.Utils.Debug (
   pprint
  ,pshow
  ,ptrace
  ,traceWith
  ,traceAt
  ,traceAtWith
  ,debugLevel
  ,ptraceAt
  ,ptraceAtWith
  ,dbg0
  ,dbg1
  ,dbg2
  ,dbg3
  ,dbg4
  ,dbg5
  ,dbg6
  ,dbg7
  ,dbg8
  ,dbg9
  ,dbg0With
  ,dbg1With
  ,dbg2With
  ,dbg3With
  ,dbg4With
  ,dbg5With
  ,dbg6With
  ,dbg7With
  ,dbg8With
  ,dbg9With
  ,dbgExit
  ,ptraceAtIO
  ,dbg0IO
  ,dbg1IO
  ,dbg2IO
  ,dbg3IO
  ,dbg4IO
  ,dbg5IO
  ,dbg6IO
  ,dbg7IO
  ,dbg8IO
  ,dbg9IO
  ,plog
  ,plogAt
  ,traceParse
  ,dbgparse
  ,module Debug.Trace
)
where

import           Control.Monad (when)
import           Control.Monad.IO.Class
import           Data.List hiding (uncons)
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import           Debug.Trace
import           Hledger.Utils.Parse
import           Safe (readDef)
import           System.Environment (getArgs)
import           System.Exit
import           System.IO.Unsafe (unsafePerformIO)
import           Text.Megaparsec
import           Text.Printf
import           Text.Pretty.Simple  -- (defaultOutputOptionsDarkBg, OutputOptions(..), pShowOpt, pPrintOpt)

prettyopts :: OutputOptions
prettyopts = 
    OutputOptions
defaultOutputOptionsDarkBg
    -- defaultOutputOptionsLightBg
    -- defaultOutputOptionsNoColor
    { outputOptionsIndentAmount :: Int
outputOptionsIndentAmount=Int
2
    , outputOptionsCompact :: Bool
outputOptionsCompact=Bool
True
    }

-- | Pretty print. Generic alias for pretty-simple's pPrint.
pprint :: Show a => a -> IO ()
pprint :: a -> IO ()
pprint = CheckColorTty -> OutputOptions -> a -> IO ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
CheckColorTty -> OutputOptions -> a -> m ()
pPrintOpt CheckColorTty
CheckColorTty OutputOptions
prettyopts

-- | Pretty show. Generic alias for pretty-simple's pShow.
pshow :: Show a => a -> String
pshow :: a -> String
pshow = Text -> String
TL.unpack (Text -> String) -> (a -> Text) -> a -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OutputOptions -> a -> Text
forall a. Show a => OutputOptions -> a -> Text
pShowOpt OutputOptions
prettyopts

-- XXX some of the below can be improved with pretty-simple, https://github.com/cdepillabout/pretty-simple#readme

-- | Pretty trace. Easier alias for traceShowId + pShow.
ptrace :: Show a => a -> a
ptrace :: a -> a
ptrace = (a -> String) -> a -> a
forall a. Show a => (a -> String) -> a -> a
traceWith a -> String
forall a. Show a => a -> String
pshow

-- | Like traceShowId, but uses a custom show function to render the value.
-- traceShowIdWith was too much of a mouthful.
traceWith :: Show a => (a -> String) -> a -> a
traceWith :: (a -> String) -> a -> a
traceWith a -> String
f a
a = String -> a -> a
forall a. String -> a -> a
trace (a -> String
f a
a) a
a

-- | 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@ for some reason).  This uses
-- unsafePerformIO and can be accessed from anywhere and before normal
-- command-line processing. When running with :main in GHCI, you must
-- touch and reload this module to see the effect of a new --debug option.
-- After command-line processing, it is also available as the @debug_@
-- field of 'Hledger.Cli.CliOptions.CliOpts'.
-- {-# OPTIONS_GHC -fno-cse #-}
-- {-# NOINLINE debugLevel #-}
debugLevel :: Int
debugLevel :: Int
debugLevel = case ([String], [String]) -> [String]
forall a b. (a, b) -> b
snd (([String], [String]) -> [String])
-> ([String], [String]) -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> ([String], [String])
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
==String
"--debug") [String]
args of
               String
"--debug":[]  -> Int
1
               String
"--debug":String
n:[String]
_ -> Int -> String -> Int
forall a. Read a => a -> String -> a
readDef Int
1 String
n
               [String]
_             ->
                 case Int -> [String] -> [String]
forall a. Int -> [a] -> [a]
take Int
1 ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--debug" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
args of
                   [Char
'-':Char
'-':Char
'd':Char
'e':Char
'b':Char
'u':Char
'g':Char
'=':String
v] -> Int -> String -> Int
forall a. Read a => a -> String -> a
readDef Int
1 String
v
                   [String]
_                                   -> Int
0

    where
      args :: [String]
args = IO [String] -> [String]
forall a. IO a -> a
unsafePerformIO IO [String]
getArgs

-- | Trace (print to stderr) a string if the global debug level is at
-- or above the specified level. At level 0, always prints. Otherwise,
-- uses unsafePerformIO.
traceAt :: Int -> String -> a -> a
traceAt :: Int -> String -> a -> a
traceAt Int
level
    | Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
debugLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
level = (a -> String -> a) -> String -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> String -> a
forall a b. a -> b -> a
const
    | Bool
otherwise = String -> a -> a
forall a. String -> a -> a
trace

-- | Trace (print to stderr) a showable value using a custom show function.
traceAtWith :: (a -> String) -> a -> a
traceAtWith :: (a -> String) -> a -> a
traceAtWith a -> String
f a
a = String -> a -> a
forall a. String -> a -> a
trace (a -> String
f a
a) a
a

-- | Pretty-print a label and a showable value to the console
-- if the global debug level is at or above the specified level.
-- At level 0, always prints. Otherwise, uses unsafePerformIO.
ptraceAt :: Show a => Int -> String -> a -> a
ptraceAt :: Int -> String -> a -> a
ptraceAt Int
level
    | Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
debugLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
level = (a -> String -> a) -> String -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> String -> a
forall a b. a -> b -> a
const
    | Bool
otherwise = \String
s a
a -> let p :: String
p = a -> String
forall a. Show a => a -> String
pshow a
a
                              ls :: [String]
ls = String -> [String]
lines String
p
                              nlorspace :: String
nlorspace | [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = String
"\n"
                                        | Bool
otherwise     = String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) (Char -> String
forall a. a -> [a]
repeat Char
' ')
                              ls' :: [String]
ls' | [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
ls
                                  | Bool
otherwise     = [String]
ls
                          in String -> a -> a
forall a. String -> a -> a
trace (String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
":"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nlorspaceString -> String -> String
forall a. [a] -> [a] -> [a]
++String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
ls') a
a

-- | Like ptraceAt, but takes a custom show function instead of a label.
ptraceAtWith :: Show a => Int -> (a -> String) -> a -> a
ptraceAtWith :: Int -> (a -> String) -> a -> a
ptraceAtWith Int
level a -> String
f
    | Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
debugLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
level = a -> a
forall a. a -> a
id
    | Bool
otherwise = \a
a -> let p :: String
p = a -> String
f a
a
                            -- ls = lines p
                            -- nlorspace | length ls > 1 = "\n"
                            --           | otherwise     = " " ++ take (10 - length s) (repeat ' ')
                            -- ls' | length ls > 1 = map (" "++) ls
                            --     | otherwise     = ls
                        -- in trace (s++":"++nlorspace++intercalate "\n" ls') a
                        in String -> a -> a
forall a. String -> a -> a
trace String
p a
a

-- "dbg" would clash with megaparsec.
-- | Pretty-print a label and the showable value to the console, then return it.
dbg0 :: Show a => String -> a -> a
dbg0 :: String -> a -> a
dbg0 = Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
ptraceAt Int
0

-- | Pretty-print a label and the showable value to the console when the global debug level is >= 1, then return it.
-- Uses unsafePerformIO.
dbg1 :: Show a => String -> a -> a
dbg1 :: String -> a -> a
dbg1 = Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
ptraceAt Int
1

dbg2 :: Show a => String -> a -> a
dbg2 :: String -> a -> a
dbg2 = Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
ptraceAt Int
2

dbg3 :: Show a => String -> a -> a
dbg3 :: String -> a -> a
dbg3 = Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
ptraceAt Int
3

dbg4 :: Show a => String -> a -> a
dbg4 :: String -> a -> a
dbg4 = Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
ptraceAt Int
4

dbg5 :: Show a => String -> a -> a
dbg5 :: String -> a -> a
dbg5 = Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
ptraceAt Int
5

dbg6 :: Show a => String -> a -> a
dbg6 :: String -> a -> a
dbg6 = Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
ptraceAt Int
6

dbg7 :: Show a => String -> a -> a
dbg7 :: String -> a -> a
dbg7 = Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
ptraceAt Int
7

dbg8 :: Show a => String -> a -> a
dbg8 :: String -> a -> a
dbg8 = Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
ptraceAt Int
8

dbg9 :: Show a => String -> a -> a
dbg9 :: String -> a -> a
dbg9 = Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
ptraceAt Int
9

-- | Like dbg0, but takes a custom show function instead of a label.
dbg0With :: Show a => (a -> String) -> a -> a
dbg0With :: (a -> String) -> a -> a
dbg0With = Int -> (a -> String) -> a -> a
forall a. Show a => Int -> (a -> String) -> a -> a
ptraceAtWith Int
0

dbg1With :: Show a => (a -> String) -> a -> a
dbg1With :: (a -> String) -> a -> a
dbg1With = Int -> (a -> String) -> a -> a
forall a. Show a => Int -> (a -> String) -> a -> a
ptraceAtWith Int
1

dbg2With :: Show a => (a -> String) -> a -> a
dbg2With :: (a -> String) -> a -> a
dbg2With = Int -> (a -> String) -> a -> a
forall a. Show a => Int -> (a -> String) -> a -> a
ptraceAtWith Int
2

dbg3With :: Show a => (a -> String) -> a -> a
dbg3With :: (a -> String) -> a -> a
dbg3With = Int -> (a -> String) -> a -> a
forall a. Show a => Int -> (a -> String) -> a -> a
ptraceAtWith Int
3

dbg4With :: Show a => (a -> String) -> a -> a
dbg4With :: (a -> String) -> a -> a
dbg4With = Int -> (a -> String) -> a -> a
forall a. Show a => Int -> (a -> String) -> a -> a
ptraceAtWith Int
4

dbg5With :: Show a => (a -> String) -> a -> a
dbg5With :: (a -> String) -> a -> a
dbg5With = Int -> (a -> String) -> a -> a
forall a. Show a => Int -> (a -> String) -> a -> a
ptraceAtWith Int
5

dbg6With :: Show a => (a -> String) -> a -> a
dbg6With :: (a -> String) -> a -> a
dbg6With = Int -> (a -> String) -> a -> a
forall a. Show a => Int -> (a -> String) -> a -> a
ptraceAtWith Int
6

dbg7With :: Show a => (a -> String) -> a -> a
dbg7With :: (a -> String) -> a -> a
dbg7With = Int -> (a -> String) -> a -> a
forall a. Show a => Int -> (a -> String) -> a -> a
ptraceAtWith Int
7

dbg8With :: Show a => (a -> String) -> a -> a
dbg8With :: (a -> String) -> a -> a
dbg8With = Int -> (a -> String) -> a -> a
forall a. Show a => Int -> (a -> String) -> a -> a
ptraceAtWith Int
8

dbg9With :: Show a => (a -> String) -> a -> a
dbg9With :: (a -> String) -> a -> a
dbg9With = Int -> (a -> String) -> a -> a
forall a. Show a => Int -> (a -> String) -> a -> a
ptraceAtWith Int
9

-- | Like dbg0, but also exit the program. Uses unsafePerformIO.
dbgExit :: Show a => String -> a -> a
dbgExit :: String -> a -> a
dbgExit String
msg = a -> a -> a
forall a b. a -> b -> a
const (IO a -> a
forall a. IO a -> a
unsafePerformIO IO a
forall a. IO a
exitFailure) (a -> a) -> (a -> a) -> a -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> a -> a
forall a. Show a => String -> a -> a
dbg0 String
msg

-- | Like ptraceAt, but convenient to insert in an IO monad and
-- enforces monadic sequencing (plus convenience aliases).
-- XXX These have a bug; they should use
-- traceIO, not trace, otherwise GHC can occasionally over-optimise
-- (cf lpaste a few days ago where it killed/blocked a child thread).
ptraceAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
ptraceAtIO :: Int -> String -> a -> m ()
ptraceAtIO Int
lvl String
lbl a
x = IO () -> m ()
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
ptraceAt Int
lvl String
lbl a
x a -> IO () -> IO ()
`seq` () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- XXX Could not deduce (a ~ ())
-- ptraceAtM :: (Monad m, Show a) => Int -> String -> a -> m a
-- ptraceAtM lvl lbl x = ptraceAt lvl lbl x `seq` return x

dbg0IO :: (MonadIO m, Show a) => String -> a -> m ()
dbg0IO :: String -> a -> m ()
dbg0IO = Int -> String -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
0

dbg1IO :: (MonadIO m, Show a) => String -> a -> m ()
dbg1IO :: String -> a -> m ()
dbg1IO = Int -> String -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
1

dbg2IO :: (MonadIO m, Show a) => String -> a -> m ()
dbg2IO :: String -> a -> m ()
dbg2IO = Int -> String -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
2

dbg3IO :: (MonadIO m, Show a) => String -> a -> m ()
dbg3IO :: String -> a -> m ()
dbg3IO = Int -> String -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
3

dbg4IO :: (MonadIO m, Show a) => String -> a -> m ()
dbg4IO :: String -> a -> m ()
dbg4IO = Int -> String -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
4

dbg5IO :: (MonadIO m, Show a) => String -> a -> m ()
dbg5IO :: String -> a -> m ()
dbg5IO = Int -> String -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
5

dbg6IO :: (MonadIO m, Show a) => String -> a -> m ()
dbg6IO :: String -> a -> m ()
dbg6IO = Int -> String -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
6

dbg7IO :: (MonadIO m, Show a) => String -> a -> m ()
dbg7IO :: String -> a -> m ()
dbg7IO = Int -> String -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
7

dbg8IO :: (MonadIO m, Show a) => String -> a -> m ()
dbg8IO :: String -> a -> m ()
dbg8IO = Int -> String -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
8

dbg9IO :: (MonadIO m, Show a) => String -> a -> m ()
dbg9IO :: String -> a -> m ()
dbg9IO = Int -> String -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
9

-- | Log a label and a pretty-printed showable value to ./debug.log, then return it.
-- Can fail, see plogAt.
plog :: Show a => String -> a -> a
plog :: String -> a -> a
plog = Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
plogAt Int
0

-- | Log a label and a pretty-printed showable value to ./debug.log,
-- if the global debug level is at or above the specified level.
-- At level 0, always logs. Otherwise, uses unsafePerformIO.
-- Tends to fail if called more than once, at least when built with -threaded
-- (Exception: debug.log: openFile: resource busy (file is locked)).
plogAt :: Show a => Int -> String -> a -> a
plogAt :: Int -> String -> a -> a
plogAt Int
lvl
    | Int
lvl Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
debugLevel Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
lvl = (a -> String -> a) -> String -> a -> a
forall a b c. (a -> b -> c) -> b -> a -> c
flip a -> String -> a
forall a b. a -> b -> a
const
    | Bool
otherwise = \String
s a
a ->
        let p :: String
p = a -> String
forall a. Show a => a -> String
pshow a
a
            ls :: [String]
ls = String -> [String]
lines String
p
            nlorspace :: String
nlorspace | [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = String
"\n"
                      | Bool
otherwise     = String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String -> String
forall a. Int -> [a] -> [a]
take (Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) (Char -> String
forall a. a -> [a]
repeat Char
' ')
            ls' :: [String]
ls' | [String] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 = (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (String
" "String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
ls
                | Bool
otherwise     = [String]
ls
            output :: String
output = String
sString -> String -> String
forall a. [a] -> [a] -> [a]
++String
":"String -> String -> String
forall a. [a] -> [a] -> [a]
++String
nlorspaceString -> String -> String
forall a. [a] -> [a] -> [a]
++String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
ls'String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\n"
        in IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
appendFile String
"debug.log" String
output IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- XXX redundant ? More/less robust than plogAt ?
-- -- | Like dbg, but writes the output to "debug.log" in the current directory.
-- dbglog :: Show a => String -> a -> a
-- dbglog label a =
--   (unsafePerformIO $
--     appendFile "debug.log" $ label ++ ": " ++ ppShow a ++ "\n")
--   `seq` 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 :: String -> TextParser m ()
traceParse String
msg = do
  SourcePos
pos <- ParsecT CustomErr Text m SourcePos
forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  Text
next <- (Int -> Text -> Text
T.take Int
peeklength) (Text -> Text)
-> ParsecT CustomErr Text m Text -> ParsecT CustomErr Text m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` ParsecT CustomErr Text m Text
forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
  let (Pos
l,Pos
c) = (SourcePos -> Pos
sourceLine SourcePos
pos, SourcePos -> Pos
sourceColumn SourcePos
pos)
      s :: String
s  = String -> Int -> Int -> String -> String
forall r. PrintfType r => String -> r
printf String
"at line %2d col %2d: %s" (Pos -> Int
unPos Pos
l) (Pos -> Int
unPos Pos
c) (Text -> String
forall a. Show a => a -> String
show Text
next) :: String
      s' :: String
s' = String -> String -> String
forall r. PrintfType r => String -> r
printf (String
"%-"String -> String -> String
forall a. [a] -> [a] -> [a]
++Int -> String
forall a. Show a => a -> String
show (Int
peeklengthInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
30)String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"s") String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
msg
  String -> TextParser m () -> TextParser m ()
forall a. String -> a -> a
trace String
s' (TextParser m () -> TextParser m ())
-> TextParser m () -> TextParser m ()
forall a b. (a -> b) -> a -> b
$ () -> TextParser m ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  where
    peeklength :: Int
peeklength = Int
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 :: Int -> String -> TextParser m ()
traceParseAt Int
level String
msg = Bool -> TextParser m () -> TextParser m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
level Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
debugLevel) (TextParser m () -> TextParser m ())
-> TextParser m () -> TextParser m ()
forall a b. (a -> b) -> a -> b
$ String -> TextParser m ()
forall (m :: * -> *). String -> TextParser m ()
traceParse String
msg

-- | Convenience alias for traceParseAt
dbgparse :: Int -> String -> TextParser m ()
dbgparse :: Int -> String -> TextParser m ()
dbgparse Int
level String
msg = Int -> String -> TextParser m ()
forall (m :: * -> *). Int -> String -> TextParser m ()
traceParseAt Int
level String
msg