{-# LANGUAGE FlexibleContexts, TypeFamilies #-}
{- | 

Helpers for debug output and pretty-printing 
(using pretty-simple, with which there may be some overlap).
This module also exports Debug.Trace.

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

In hledger, debug levels are used as follows:

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

-}

-- 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 (
  -- * Pretty printing
   pprint
  ,pshow
  -- * Tracing
  ,traceWith
  -- * Pretty tracing
  ,ptrace
  -- ** Debug-level-aware tracing
  ,debugLevel
  ,traceAt
  ,traceAtWith
  ,ptraceAt
  ,ptraceAtWith
  -- ** Easiest form (recommended)
  ,dbg0
  ,dbg1
  ,dbg2
  ,dbg3
  ,dbg4
  ,dbg5
  ,dbg6
  ,dbg7
  ,dbg8
  ,dbg9
  ,dbgExit
  -- ** More control
  ,dbg0With
  ,dbg1With
  ,dbg2With
  ,dbg3With
  ,dbg4With
  ,dbg5With
  ,dbg6With
  ,dbg7With
  ,dbg8With
  ,dbg9With
  -- ** For standalone lines in IO blocks
  ,ptraceAtIO
  ,dbg0IO
  ,dbg1IO
  ,dbg2IO
  ,dbg3IO
  ,dbg4IO
  ,dbg5IO
  ,dbg6IO
  ,dbg7IO
  ,dbg8IO
  ,dbg9IO
  -- ** Trace to a file
  ,plog
  ,plogAt
  -- ** Trace the state of hledger parsers
  ,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.
-- {-# 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,
-- if the global debug level is at or above the specified level.
-- At level 0, always prints. Otherwise, uses unsafePerformIO.
traceAtWith :: Int -> (a -> String) -> a -> a
traceAtWith :: Int -> (a -> String) -> a -> a
traceAtWith Int
level a -> String
f a
a = Int -> String -> a -> a
forall a. Int -> String -> a -> a
traceAt Int
level (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 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 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 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 too quickly, 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