{-# 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
  ,pprint'
  ,pshow
  ,pshow'
  ,useColorOnStdout
  ,useColorOnStderr
  -- * 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 the state of hledger parsers
  ,traceParse
  ,dbgparse
  -- ** Debug-logging to a file
  ,dlogTrace
  ,dlogTraceAt
  ,dlogAt
  ,dlog0
  ,dlog1
  ,dlog2
  ,dlog3
  ,dlog4
  ,dlog5
  ,dlog6
  ,dlog7
  ,dlog8
  ,dlog9
  -- ** Re-exports
  ,module Debug.Breakpoint
  ,module Debug.Trace
  )
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 qualified Data.Text.Lazy as TL
import           Debug.Breakpoint
import           Debug.Trace
import           Hledger.Utils.Parse
import           Safe (readDef)
import           System.Environment (getArgs, lookupEnv)
import           System.Exit
import           System.IO.Unsafe (unsafePerformIO)
import           Text.Megaparsec
import           Text.Printf
import           Text.Pretty.Simple  -- (defaultOutputOptionsDarkBg, OutputOptions(..), pShowOpt, pPrintOpt)
import Data.Maybe (isJust)
import System.Console.ANSI (hSupportsANSIColor)
import System.IO (stdout, Handle, stderr)
import Control.Exception (evaluate)

-- | pretty-simple options with colour enabled if allowed.
prettyopts :: OutputOptions
prettyopts = 
  (if Bool
useColorOnStderr then OutputOptions
defaultOutputOptionsDarkBg else OutputOptions
defaultOutputOptionsNoColor)
    { outputOptionsIndentAmount :: Int
outputOptionsIndentAmount=Int
2
    , outputOptionsCompact :: Bool
outputOptionsCompact=Bool
True
    }

-- | pretty-simple options with colour disabled.
prettyopts' :: OutputOptions
prettyopts' =
  OutputOptions
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 :: forall a. Show a => a -> IO ()
pprint = forall (m :: * -> *) a.
(MonadIO m, Show a) =>
CheckColorTty -> OutputOptions -> a -> m ()
pPrintOpt CheckColorTty
CheckColorTty OutputOptions
prettyopts

-- | Monochrome version of pprint.
pprint' :: Show a => a -> IO ()
pprint' :: forall a. Show a => a -> IO ()
pprint' = 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 :: forall a. Show a => a -> String
pshow = Text -> String
TL.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => OutputOptions -> a -> Text
pShowOpt OutputOptions
prettyopts

-- | Monochrome version of pshow.
pshow' :: Show a => a -> String
pshow' :: forall a. Show a => a -> String
pshow' = Text -> String
TL.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Show a => a -> a
ptrace = forall a. Show a => (a -> String) -> a -> a
traceWith 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 :: forall a. Show a => (a -> String) -> a -> a
traceWith a -> String
f a
a = forall a. String -> a -> a
trace (a -> String
f a
a) a
a

-- | Global debug level, which controls the verbosity of debug errput
-- on the console. The default is 0 meaning no debug errput. 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 #-}
-- Avoid using dbg* in this function (infinite loop).
debugLevel :: Int
debugLevel :: Int
debugLevel = case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=String
"--debug") [String]
args of
               [String
"--debug"]   -> Int
1
               String
"--debug":String
n:[String]
_ -> forall a. Read a => a -> String -> a
readDef Int
1 String
n
               [String]
_             ->
                 case forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--debug" 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] -> forall a. Read a => a -> String -> a
readDef Int
1 String
v
                   [String]
_                                   -> Int
0

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

-- Avoid using dbg*, pshow etc. in this function (infinite loop).
-- | Check the IO environment to see if ANSI colour codes should be used on stdout.
-- This is done using unsafePerformIO so it can be used anywhere, eg in
-- low-level debug utilities, which should be ok since we are just reading.
-- The logic is: use color if
-- the program was started with --color=yes|always
-- or (
--   the program was not started with --color=no|never
--   and a NO_COLOR environment variable is not defined
--   and stdout supports ANSI color and -o/--output-file was not used or is "-"
-- ).
-- Caveats:
-- When running code in GHCI, this module must be reloaded to see a change.
-- {-# OPTIONS_GHC -fno-cse #-}
-- {-# NOINLINE useColorOnStdout #-}
useColorOnStdout :: Bool
useColorOnStdout :: Bool
useColorOnStdout = Bool -> Bool
not Bool
hasOutputFile Bool -> Bool -> Bool
&& Handle -> Bool
useColorOnHandle Handle
stdout

-- Avoid using dbg*, pshow etc. in this function (infinite loop).
-- | Like useColorOnStdout, but checks for ANSI color support on stderr,
-- and is not affected by -o/--output-file.
-- {-# OPTIONS_GHC -fno-cse #-}
-- {-# NOINLINE useColorOnStdout #-}
useColorOnStderr :: Bool
useColorOnStderr :: Bool
useColorOnStderr = Handle -> Bool
useColorOnHandle Handle
stderr

-- Avoid using dbg*, pshow etc. in this function (infinite loop).
-- XXX sorry, I'm just cargo-culting these pragmas:
-- {-# OPTIONS_GHC -fno-cse #-}
-- {-# NOINLINE useColorOnHandle #-}
useColorOnHandle :: Handle -> Bool
useColorOnHandle :: Handle -> Bool
useColorOnHandle Handle
h = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  Bool
no_color       <- forall a. Maybe a -> Bool
isJust forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO (Maybe String)
lookupEnv String
"NO_COLOR"
  Bool
supports_color <- Handle -> IO Bool
hSupportsANSIColor Handle
h
  let coloroption :: String
coloroption = String
colorOption
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String
coloroption forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [String
"always",String
"yes"]
       Bool -> Bool -> Bool
|| (String
coloroption forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
"never",String
"no"] Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
no_color Bool -> Bool -> Bool
&& Bool
supports_color)

-- Keep synced with color/colour flag definition in hledger:CliOptions.
-- Avoid using dbg*, pshow etc. in this function (infinite loop).
-- | Read the value of the --color or --colour command line option provided at program startup
-- using unsafePerformIO. If this option was not provided, returns the empty string.
-- (When running code in GHCI, this module must be reloaded to see a change.)
-- {-# OPTIONS_GHC -fno-cse #-}
-- {-# NOINLINE colorOption #-}
colorOption :: String
colorOption :: String
colorOption = 
  -- similar to debugLevel
  let args :: [String]
args = forall a. IO a -> a
unsafePerformIO IO [String]
getArgs in
  case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=String
"--color") [String]
args of
    -- --color ARG
    String
"--color":String
v:[String]
_ -> String
v
    [String]
_ ->
      case forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--color=" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
args of
        -- --color=ARG
        [Char
'-':Char
'-':Char
'c':Char
'o':Char
'l':Char
'o':Char
'r':Char
'=':String
v] -> String
v
        [String]
_ ->
          case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=String
"--colour") [String]
args of
            -- --colour ARG
            String
"--colour":String
v:[String]
_ -> String
v
            [String]
_ ->
              case forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--colour=" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
args of
                -- --colour=ARG
                [Char
'-':Char
'-':Char
'c':Char
'o':Char
'l':Char
'o':Char
'u':Char
'r':Char
'=':String
v] -> String
v
                [String]
_ -> String
""

-- Avoid using dbg*, pshow etc. in this function (infinite loop).
-- | Check whether the -o/--output-file option has been used at program startup
-- with an argument other than "-", using unsafePerformIO.
-- {-# OPTIONS_GHC -fno-cse #-}
-- {-# NOINLINE hasOutputFile #-}
hasOutputFile :: Bool
hasOutputFile :: Bool
hasOutputFile = Maybe String
outputFileOption forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [forall a. Maybe a
Nothing, forall a. a -> Maybe a
Just String
"-"]

-- Keep synced with output-file flag definition in hledger:CliOptions.
-- Avoid using dbg*, pshow etc. in this function (infinite loop).
-- | Read the value of the -o/--output-file command line option provided at program startup,
-- if any, using unsafePerformIO.
-- (When running code in GHCI, this module must be reloaded to see a change.)
-- {-# OPTIONS_GHC -fno-cse #-}
-- {-# NOINLINE outputFileOption #-}
outputFileOption :: Maybe String
outputFileOption :: Maybe String
outputFileOption = 
  let args :: [String]
args = forall a. IO a -> a
unsafePerformIO IO [String]
getArgs in
  case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"-o" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`)) [String]
args of
    -- -oARG
    (Char
'-':Char
'o':v :: String
v@(Char
_:String
_)):[String]
_ -> forall a. a -> Maybe a
Just String
v
    -- -o ARG
    String
"-o":String
v:[String]
_ -> forall a. a -> Maybe a
Just String
v
    [String]
_ ->
      case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=String
"--output-file") [String]
args of
        -- --output-file ARG
        String
"--output-file":String
v:[String]
_ -> forall a. a -> Maybe a
Just String
v
        [String]
_ ->
          case forall a. Int -> [a] -> [a]
take Int
1 forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
filter (String
"--output-file=" forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf`) [String]
args of
            -- --output=file=ARG
            [Char
'-':Char
'-':Char
'o':Char
'u':Char
't':Char
'p':Char
'u':Char
't':Char
'-':Char
'f':Char
'i':Char
'l':Char
'e':Char
'=':String
v] -> forall a. a -> Maybe a
Just String
v
            [String]
_ -> forall a. Maybe a
Nothing

-- | 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 :: forall a. Int -> String -> a -> a
traceAt Int
level
    | Int
level forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
debugLevel forall a. Ord a => a -> a -> Bool
< Int
level = forall a b. a -> b -> a
const forall a. a -> a
id
    | Bool
otherwise = 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 :: forall a. Int -> (a -> String) -> a -> a
traceAtWith Int
level a -> String
f 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 :: forall a. Show a => Int -> String -> a -> a
ptraceAt Int
level
    | Int
level forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
debugLevel forall a. Ord a => a -> a -> Bool
< Int
level = forall a b. a -> b -> a
const forall a. a -> a
id
    | Bool
otherwise = \String
s a
a -> let ls :: [String]
ls = String -> [String]
lines forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
pshow a
a
                              nlorspace :: String
nlorspace | forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls forall a. Ord a => a -> a -> Bool
> Int
1 = String
"\n"
                                        | Bool
otherwise     = forall a. Int -> a -> [a]
replicate (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ Int
11 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
s) Char
' '
                              ls' :: [String]
ls' | forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls forall a. Ord a => a -> a -> Bool
> Int
1 = forall a b. (a -> b) -> [a] -> [b]
map (Char
' 'forall a. a -> [a] -> [a]
:) [String]
ls
                                  | Bool
otherwise     = [String]
ls
                          in forall a. String -> a -> a
trace (String
sforall a. [a] -> [a] -> [a]
++String
":"forall a. [a] -> [a] -> [a]
++String
nlorspaceforall a. [a] -> [a] -> [a]
++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 :: forall a. Show a => Int -> (a -> String) -> a -> a
ptraceAtWith Int
level a -> String
f
    | Int
level forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
debugLevel forall a. Ord a => a -> a -> Bool
< Int
level = 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 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 :: forall a. Show a => String -> a -> a
dbg0 = 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 :: forall a. Show a => String -> a -> a
dbg1 = forall a. Show a => Int -> String -> a -> a
ptraceAt Int
1

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

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

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

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

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

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

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

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

-- | Like dbg0, but also exit the program. Uses unsafePerformIO.
-- {-# NOINLINE dbgExit #-}
dbgExit :: Show a => String -> a -> a
dbgExit :: forall a. Show a => String -> a -> a
dbgExit String
msg = forall a b. a -> b -> a
const (forall a. IO a -> a
unsafePerformIO forall a. IO a
exitFailure) forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: forall a. Show a => (a -> String) -> a -> a
dbg0With = forall a. Show a => Int -> (a -> String) -> a -> a
ptraceAtWith Int
0

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

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

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

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

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

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

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

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

dbg9With :: Show a => (a -> String) -> a -> a
dbg9With :: forall a. Show a => (a -> String) -> a -> a
dbg9With = 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 :: forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
lvl String
lbl a
x = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. Show a => Int -> String -> a -> a
ptraceAt Int
lvl String
lbl a
x seq :: forall a b. a -> b -> b
`seq` 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 :: forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg0IO = forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
0

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

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

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

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

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

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

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

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

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

-- | Log a string to ./debug.log before returning the second argument.
-- Uses unsafePerformIO.
-- {-# NOINLINE dlogTrace #-}
dlogTrace :: String -> a -> a
dlogTrace :: forall a. String -> a -> a
dlogTrace String
s a
x = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ do
  forall a. a -> IO a
evaluate (forall a. NFData a => a -> a
force String
s)  -- to complete any previous logging before we attempt more
  String -> String -> IO ()
appendFile String
"debug.log" (String
s forall a. [a] -> [a] -> [a]
++ String
"\n")
  forall (m :: * -> *) a. Monad m => a -> m a
return a
x

-- | Log a string to ./debug.log before returning the second argument,
-- if the global debug level is at or above the specified level.
-- At level 0, always logs. Otherwise, uses unsafePerformIO.
dlogTraceAt :: Int -> String -> a -> a
dlogTraceAt :: forall a. Int -> String -> a -> a
dlogTraceAt Int
level String
s
  | Int
level forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
debugLevel forall a. Ord a => a -> a -> Bool
< Int
level = forall a. a -> a
id
  | Bool
otherwise = forall a. String -> a -> a
dlogTrace String
s

-- | Log a label and pretty-printed showable value to "./debug.log",
-- if the global debug level is at or above the specified level.
-- At level 0, always prints. Otherwise, uses unsafePerformIO.
dlogAt :: Show a => Int -> String -> a -> a
dlogAt :: forall a. Show a => Int -> String -> a -> a
dlogAt Int
level
  | Int
level forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
debugLevel forall a. Ord a => a -> a -> Bool
< Int
level = forall a b. a -> b -> a
const forall a. a -> a
id
  | Bool
otherwise = \String
lbl a
a ->
    let 
      ls :: [String]
ls = String -> [String]
lines forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
pshow' a
a
      nlorspace :: String
nlorspace | forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls forall a. Ord a => a -> a -> Bool
> Int
1 = String
"\n"
                | Bool
otherwise     = forall a. Int -> a -> [a]
replicate (forall a. Ord a => a -> a -> a
max Int
1 forall a b. (a -> b) -> a -> b
$ Int
11 forall a. Num a => a -> a -> a
- forall (t :: * -> *) a. Foldable t => t a -> Int
length String
lbl) Char
' '
      ls' :: [String]
ls' | forall (t :: * -> *) a. Foldable t => t a -> Int
length [String]
ls forall a. Ord a => a -> a -> Bool
> Int
1 = forall a b. (a -> b) -> [a] -> [b]
map (Char
' 'forall a. a -> [a] -> [a]
:) [String]
ls
          | Bool
otherwise     = [String]
ls
    in forall a. String -> a -> a
dlogTrace (String
lblforall a. [a] -> [a] -> [a]
++String
":"forall a. [a] -> [a] -> [a]
++String
nlorspaceforall a. [a] -> [a] -> [a]
++forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
ls') a
a

-- | Pretty-print a label and the showable value to ./debug.log if at or above
-- a certain debug level, then return it.
dlog0 :: Show a => String -> a -> a
dlog0 :: forall a. Show a => String -> a -> a
dlog0 = forall a. Show a => Int -> String -> a -> a
dlogAt Int
0

dlog1 :: Show a => String -> a -> a
dlog1 :: forall a. Show a => String -> a -> a
dlog1 = forall a. Show a => Int -> String -> a -> a
dlogAt Int
1

dlog2 :: Show a => String -> a -> a
dlog2 :: forall a. Show a => String -> a -> a
dlog2 = forall a. Show a => Int -> String -> a -> a
dlogAt Int
2

dlog3 :: Show a => String -> a -> a
dlog3 :: forall a. Show a => String -> a -> a
dlog3 = forall a. Show a => Int -> String -> a -> a
dlogAt Int
3

dlog4 :: Show a => String -> a -> a
dlog4 :: forall a. Show a => String -> a -> a
dlog4 = forall a. Show a => Int -> String -> a -> a
dlogAt Int
4

dlog5 :: Show a => String -> a -> a
dlog5 :: forall a. Show a => String -> a -> a
dlog5 = forall a. Show a => Int -> String -> a -> a
dlogAt Int
5

dlog6 :: Show a => String -> a -> a
dlog6 :: forall a. Show a => String -> a -> a
dlog6 = forall a. Show a => Int -> String -> a -> a
dlogAt Int
6

dlog7 :: Show a => String -> a -> a
dlog7 :: forall a. Show a => String -> a -> a
dlog7 = forall a. Show a => Int -> String -> a -> a
dlogAt Int
7

dlog8 :: Show a => String -> a -> a
dlog8 :: forall a. Show a => String -> a -> a
dlog8 = forall a. Show a => Int -> String -> a -> a
dlogAt Int
8

dlog9 :: Show a => String -> a -> a
dlog9 :: forall a. Show a => String -> a -> a
dlog9 = forall a. Show a => Int -> String -> a -> a
dlogAt Int
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 :: forall (m :: * -> *). String -> TextParser m ()
traceParse String
msg = do
  SourcePos
pos <- forall s e (m :: * -> *).
(TraversableStream s, MonadParsec e s m) =>
m SourcePos
getSourcePos
  Text
next <- (Int -> Text -> Text
T.take Int
peeklength) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` 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  = forall r. PrintfType r => String -> r
printf String
"at line %2d col %2d: %s" (Pos -> Int
unPos Pos
l) (Pos -> Int
unPos Pos
c) (forall a. Show a => a -> String
show Text
next) :: String
      s' :: String
s' = forall r. PrintfType r => String -> r
printf (String
"%-"forall a. [a] -> [a] -> [a]
++forall a. Show a => a -> String
show (Int
peeklengthforall a. Num a => a -> a -> a
+Int
30)forall a. [a] -> [a] -> [a]
++String
"s") String
s forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ String
msg
  forall a. String -> a -> a
trace String
s' forall a b. (a -> b) -> a -> b
$ 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 :: forall (m :: * -> *). Int -> String -> TextParser m ()
traceParseAt Int
level String
msg = forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
level forall a. Ord a => a -> a -> Bool
<= Int
debugLevel) forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). String -> TextParser m ()
traceParse String
msg

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