{- | 

Here are debug tracing/logging helpers built on Debug.Trace, extracted from the hledger project.
Features:

- they can be built in to your program permanently, and activated by a --debug [LEVEL] option
- they can optionally log to a file instead of stderr (for TUI apps)
- they can be used in IO, pure, or startup code
- values are printed with a label, and pretty-printed (using pretty-simple)
- ANSI colour is used when appropriate.

Insert these @dbg*@ helpers at points of interest in your code,
either temporarily while debugging,
or permanently in production code, and activate them with @--debug [1-9]@ on the command line
(@--debug@ with no value means level 1).
For example, this expression:

> dbg4 "foo" foo

will pretty-print foo with a "foo:" label when it is evaluated, but only if --debug's value is 4 or greater.
In other words: use dbg1 for the most useful debug output, dbg9 for the most specialised/verbose.

They are intended to be easy to use and to find in your code, with a consistent naming scheme:

> dbg<LEVEL>Msg   STR    VAL  -- trace/log a string in pure code
> dbg<LEVEL>MsgIO STR         -- trace/log a string in IO
>
> dbg<LEVEL>      STR    VAL  -- trace/log a showable value in pure code
> dbg<LEVEL>IO    STR    VAL  -- trace/log a showable value in IO
>
> dbg<LEVEL>With  SHOWFN VAL  -- trace/log any value

Or if you prefer you can ignore the numbered variants and write an extra argument:

> dbgMsg   LEVEL  STR    VAL
> dbgMsgIO LEVEL  STR
>
> dbg      LEVEL  STR    VAL
> dbgIO    LEVEL  STR    VAL
>
> dbgWith  LEVEL  SHOWFN VAL

Haskell values will be pretty-printed by default, using pretty-simple.

ANSI color will also be used if appropriate,
respecting output capabilities, @NO_COLOR@, and/or a @--color [YNA]@ (or @--colour@) command line option.

These helpers normally print output on stderr, but can automatically log to a file instead,
which can be useful for TUI apps which are redrawing the screen.
To enable this logging mode, use @withProgName@ to add a ".log" suffix to the program name:

> main = withProgName "PROGRAM.log" $ do ...

Now all dbg calls will log to @PROGRAM.log@ in the current directory.

Logging, and reading the command line\/program name\/output context use unsafePerformIO,
so that these can be used anywhere, including early in your program before command line parsing is complete.
As a consequence, if you are testing in GHCI and want to change the debug level, you'll need to reload this module.

The @dbg@ function name clashes with the one in Text.Megaparsec.Debug, unfortunately; sorry about that.
If you are also using that, use qualified imports, or our @dbg_@ alias, to avoid the clash.

The meaning of debug levels is up to you. Eg hledger uses them as follows:

@
Debug level:  What to show:
------------  ---------------------------------------------------------
0             normal program output only
1             useful warnings, most common troubleshooting info
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
@

It's not yet possible to select debug output by topic; that would be useful.

-}

-- Disabled until 0.1.2.0 is released with windows support:
--  This module also exports Debug.Trace and the breakpoint package's Debug.Breakpoint.

-- 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
-- https://hackage.haskell.org/package/debug

-- internal helpers, currently not exported:

-- * Tracing to stderr
-- These print to stderr.
-- This output will be interleaved with the program's normal output,
-- which can be helpful for understanding code execution.
--
-- ,traceWith
-- ,traceAt
-- ,traceAtWith
-- ,ptrace
-- ,ptraceAt
-- ,ptraceAtIO

-- * Logging to a log file
-- These append to a PROGRAM.log file in the current directory.
-- PROGRAM is normally the name of the executable, but it can change
-- eg when running in GHCI. So when using these, you should call
-- @withProgName@ to ensure a stable program name.
-- Eg: @main = withProgName "PROGRAM" $ do ...@.
--
-- ,log'
-- ,logAt
-- ,logIO
-- ,logAtIO
-- ,logWith
-- ,logAtWith
-- ,plogAt
-- ,plogAtIO

{-# LANGUAGE CPP #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}

module Hledger.Utils.Debug (

  -- * Debug level
  debugLevel

  -- * Trace/log a string
  ,dbgMsg
  ,dbg0Msg
  ,dbg1Msg
  ,dbg2Msg
  ,dbg3Msg
  ,dbg4Msg
  ,dbg5Msg
  ,dbg6Msg
  ,dbg7Msg
  ,dbg8Msg
  ,dbg9Msg

  -- * Trace/log a string in IO
  ,dbgMsgIO
  ,dbg0MsgIO
  ,dbg1MsgIO
  ,dbg2MsgIO
  ,dbg3MsgIO
  ,dbg4MsgIO
  ,dbg5MsgIO
  ,dbg6MsgIO
  ,dbg7MsgIO
  ,dbg8MsgIO
  ,dbg9MsgIO

  -- * Trace/log a value
  ,dbg
  ,dbg_
  ,dbg0
  ,dbg1
  ,dbg2
  ,dbg3
  ,dbg4
  ,dbg5
  ,dbg6
  ,dbg7
  ,dbg8
  ,dbg9

  -- * Trace/log a value in IO
  ,dbgIO
  ,dbg0IO
  ,dbg1IO
  ,dbg2IO
  ,dbg3IO
  ,dbg4IO
  ,dbg5IO
  ,dbg6IO
  ,dbg7IO
  ,dbg8IO
  ,dbg9IO

  -- * Trace/log a value with a show function
  ,dbgWith
  ,dbg0With
  ,dbg1With
  ,dbg2With
  ,dbg3With
  ,dbg4With
  ,dbg5With
  ,dbg6With
  ,dbg7With
  ,dbg8With
  ,dbg9With

  -- * Utilities
  ,lbl_
  ,progName

  -- * ghc-debug helpers
  ,ghcDebugSupportedInLib
  ,GhcDebugMode(..)
  ,ghcDebugMode
  ,withGhcDebug'
  ,ghcDebugPause'

  -- * Re-exports: Debug.Trace
  -- ,module Debug.Breakpoint
  ,module Debug.Trace

  )
where

import Control.DeepSeq (force)
import Control.Exception (evaluate)
import Control.Monad.IO.Class (MonadIO, liftIO)
import Data.List hiding (uncons)
import Debug.Trace (trace, traceIO, traceShowId)
#ifdef GHCDEBUG
import GHC.Debug.Stub (pause, withGhcDebug)
#endif
import Safe (readDef)
import System.Environment (getProgName)
-- import System.Exit (exitFailure)
import System.IO.Unsafe (unsafePerformIO)

import Hledger.Utils.IO (progArgs, pshow, pshow')


-- | The program name as returned by @getProgName@.
-- It's best to set this explicitly at program startup with @withProgName@,
-- otherwise when running in GHCI (eg) it will change to "<interactive>".
-- Setting it with a ".log" suffix causes some functions below
-- to log instead of trace.
{-# NOINLINE modifiedProgName #-}
modifiedProgName :: String
modifiedProgName :: String
modifiedProgName = IO String -> String
forall a. IO a -> a
unsafePerformIO IO String
getProgName

-- | The progam name, with any ".log" suffix removed.
progName :: String
progName :: String
progName =
  if String
".log" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
modifiedProgName
  then String -> String
forall a. [a] -> [a]
reverse (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Int -> String -> String
forall a. Int -> [a] -> [a]
drop Int
4 (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String -> String
forall a. [a] -> [a]
reverse String
modifiedProgName
  else String
modifiedProgName

-- | The program's debug output verbosity, from 0 to 9.
-- The default is 0 meaning no debug output.
-- This can be overridden by running the program with a --debug [1-9] command line option;
-- a --debug flag with no value means 1.
-- Uses unsafePerformIO to read the command line.
-- When running in GHCI, changing this requires reloading this module.
debugLevel :: Int
debugLevel :: Int
debugLevel = case (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/=String
"--debug") [String]
progArgs 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]
progArgs 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

-- | Trace (print to stderr) a string if the program 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 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) -> String -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id
    | Bool
otherwise = String -> a -> a
forall a. String -> a -> a
trace

-- | Like traceAt, but sequences properly in IO.
traceAtIO :: (MonadIO m) => Int -> String -> m ()
traceAtIO :: forall (m :: * -> *). MonadIO m => Int -> String -> m ()
traceAtIO Int
level String
msg =
  if 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
  then () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  else IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
traceIO String
msg

-- -- | Trace a value with the given show function before returning it.
-- traceWith :: (a -> String) -> a -> a
-- traceWith f a = trace (f a) a

-- | Trace (print to stderr) a showable value using a custom show function,
-- if the program 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 = Int -> String -> a -> a
forall a. Int -> String -> a -> a
traceAt Int
level (a -> String
f a
a) a
a

-- -- | Pretty-trace a showable value before returning it.
-- -- Like Debug.Trace.traceShowId, but pretty-printing and easier to type.
-- ptrace :: Show a => a -> a
-- ptrace = traceWith pshow

-- | Pretty-print a label and a showable value to the console
-- if the program 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 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) -> String -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id
    | Bool
otherwise = \String
lbl a
a -> String -> a -> a
forall a. String -> a -> a
trace (Bool -> String -> a -> String
forall a. Show a => Bool -> String -> a -> String
labelledPretty Bool
True String
lbl a
a) a
a

-- Pretty-print a showable value with a label, with or without allowing ANSI color.
labelledPretty :: Show a => Bool -> String -> a -> String
labelledPretty :: forall a. Show a => Bool -> String -> a -> String
labelledPretty Bool
allowcolour String
lbl a
a = String
lbl String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
":" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
nlorspace String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
ls'
  where
    ls :: [String]
ls = String -> [String]
lines (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ (if Bool
allowcolour then a -> String
forall a. Show a => a -> String
pshow else a -> String
forall a. Show a => a -> String
pshow') a
a
    nlorspace :: String
nlorspace | [String] -> Int
forall a. [a] -> 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     = Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Int
11 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
lbl) Char
' '
    ls' :: [String]
ls' | [String] -> Int
forall a. [a] -> 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 (Char
' 'Char -> String -> String
forall a. a -> [a] -> [a]
:) [String]
ls
        | Bool
otherwise     = [String]
ls

-- | Like ptraceAt, but sequences properly in IO.
ptraceAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
ptraceAtIO :: forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO Int
level String
label a
a =
  if 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
  then () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  else IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> IO ()
traceIO (Bool -> String -> a -> String
forall a. Show a => Bool -> String -> a -> String
labelledPretty Bool
True String
label a
a)


-- | The debug log file: PROGNAME.log in the current directory.
-- See modifiedProgName.
debugLogFile :: FilePath
debugLogFile :: String
debugLogFile = String
progName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".log"

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

-- | Log a string to the debug log before returning the second argument,
-- if the program debug level is at or above the specified level.
-- At level 0, always logs. Otherwise, uses unsafePerformIO.
logAt :: Int -> String -> a -> a
logAt :: forall a. Int -> String -> a -> a
logAt Int
level String
str
  | 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 = String -> a -> a
forall a. String -> a -> a
log' String
str

-- | Like log' but sequences properly in IO.
logIO :: MonadIO m => String -> m ()
logIO :: forall (m :: * -> *). MonadIO m => String -> m ()
logIO String
s = do
  IO String -> m String
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO String -> m String) -> IO String -> m String
forall a b. (a -> b) -> a -> b
$ String -> IO String
forall a. a -> IO a
evaluate (String -> String
forall a. NFData a => a -> a
force String
s)  -- to complete any previous logging before we attempt more
  IO () -> m ()
forall a. IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO () -> m ()) -> IO () -> m ()
forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
appendFile String
debugLogFile (String
s String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n")

-- | Like logAt, but convenient to use in IO.
logAtIO :: (MonadIO m) => Int -> String -> m ()
logAtIO :: forall (m :: * -> *). MonadIO m => Int -> String -> m ()
logAtIO Int
level String
str
  | 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 = () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  | Bool
otherwise = String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
logIO String
str

-- -- | Log a value to the debug log with the given show function before returning it.
-- logWith :: (a -> String) -> a -> a
-- logWith f a = log' (f a) a

-- | Log a string to the debug log before returning the second argument,
-- if the program debug level is at or above the specified level.
-- At level 0, always logs. Otherwise, uses unsafePerformIO.
logAtWith :: Int -> (a -> String) -> a -> a
logAtWith :: forall a. Int -> (a -> String) -> a -> a
logAtWith Int
level a -> String
f a
a = Int -> String -> a -> a
forall a. Int -> String -> a -> a
logAt Int
level (a -> String
f a
a) a
a

-- | Pretty-log a label and showable value to the debug log,
-- if the program debug level is at or above the specified level. 
-- At level 0, always prints. Otherwise, uses unsafePerformIO.
plogAt :: (Show a) => Int -> String -> a -> a
plogAt :: forall a. Show a => Int -> String -> a -> a
plogAt 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 -> a) -> String -> a -> a
forall a b. a -> b -> a
const a -> a
forall a. a -> a
id
  | Bool
otherwise = \String
lbl a
a -> String -> a -> a
forall a. String -> a -> a
log' (Bool -> String -> a -> String
forall a. Show a => Bool -> String -> a -> String
labelledPretty Bool
False String
lbl a
a) a
a

-- | Like ptraceAt, but sequences properly in IO.
plogAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
plogAtIO :: forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
plogAtIO Int
level String
label a
a =
  if 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
  then () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
  else String -> m ()
forall (m :: * -> *). MonadIO m => String -> m ()
logIO (Bool -> String -> a -> String
forall a. Show a => Bool -> String -> a -> String
labelledPretty Bool
False String
label a
a)


-- | Should dbg* log to a file instead of tracing to stderr ?
-- True if the (internal) program name ends with ".log".
shouldLog :: Bool
shouldLog :: Bool
shouldLog = String
".log" String -> String -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
modifiedProgName


-- | Trace or log a string if the program debug level is at or above the specified level,
-- then return the second argument.
dbgMsg :: Int -> String -> a -> a
dbgMsg :: forall a. Int -> String -> a -> a
dbgMsg = if Bool
shouldLog then Int -> String -> a -> a
forall a. Int -> String -> a -> a
logAt else Int -> String -> a -> a
forall a. Int -> String -> a -> a
traceAt

dbg0Msg :: String -> a -> a
dbg0Msg :: forall a. String -> a -> a
dbg0Msg = Int -> String -> a -> a
forall a. Int -> String -> a -> a
dbgMsg Int
0

dbg1Msg :: String -> a -> a
dbg1Msg :: forall a. String -> a -> a
dbg1Msg = Int -> String -> a -> a
forall a. Int -> String -> a -> a
dbgMsg Int
1

dbg2Msg :: String -> a -> a
dbg2Msg :: forall a. String -> a -> a
dbg2Msg = Int -> String -> a -> a
forall a. Int -> String -> a -> a
dbgMsg Int
2

dbg3Msg :: String -> a -> a
dbg3Msg :: forall a. String -> a -> a
dbg3Msg = Int -> String -> a -> a
forall a. Int -> String -> a -> a
dbgMsg Int
3

dbg4Msg :: String -> a -> a
dbg4Msg :: forall a. String -> a -> a
dbg4Msg = Int -> String -> a -> a
forall a. Int -> String -> a -> a
dbgMsg Int
4

dbg5Msg :: String -> a -> a
dbg5Msg :: forall a. String -> a -> a
dbg5Msg = Int -> String -> a -> a
forall a. Int -> String -> a -> a
dbgMsg Int
5

dbg6Msg :: String -> a -> a
dbg6Msg :: forall a. String -> a -> a
dbg6Msg = Int -> String -> a -> a
forall a. Int -> String -> a -> a
dbgMsg Int
6

dbg7Msg :: String -> a -> a
dbg7Msg :: forall a. String -> a -> a
dbg7Msg = Int -> String -> a -> a
forall a. Int -> String -> a -> a
dbgMsg Int
7

dbg8Msg :: String -> a -> a
dbg8Msg :: forall a. String -> a -> a
dbg8Msg = Int -> String -> a -> a
forall a. Int -> String -> a -> a
dbgMsg Int
8

dbg9Msg :: String -> a -> a
dbg9Msg :: forall a. String -> a -> a
dbg9Msg = Int -> String -> a -> a
forall a. Int -> String -> a -> a
dbgMsg Int
9


-- | Like dbgMsg, but sequences properly in IO.
dbgMsgIO :: (MonadIO m) => Int -> String -> m ()
dbgMsgIO :: forall (m :: * -> *). MonadIO m => Int -> String -> m ()
dbgMsgIO = if Bool
shouldLog then Int -> String -> m ()
forall (m :: * -> *). MonadIO m => Int -> String -> m ()
logAtIO else Int -> String -> m ()
forall (m :: * -> *). MonadIO m => Int -> String -> m ()
traceAtIO

dbg0MsgIO :: (MonadIO m) => String -> m ()
dbg0MsgIO :: forall (m :: * -> *). MonadIO m => String -> m ()
dbg0MsgIO = Int -> String -> m ()
forall (m :: * -> *). MonadIO m => Int -> String -> m ()
dbgMsgIO Int
0

dbg1MsgIO :: (MonadIO m) => String -> m ()
dbg1MsgIO :: forall (m :: * -> *). MonadIO m => String -> m ()
dbg1MsgIO = Int -> String -> m ()
forall (m :: * -> *). MonadIO m => Int -> String -> m ()
dbgMsgIO Int
1

dbg2MsgIO :: (MonadIO m) => String -> m ()
dbg2MsgIO :: forall (m :: * -> *). MonadIO m => String -> m ()
dbg2MsgIO = Int -> String -> m ()
forall (m :: * -> *). MonadIO m => Int -> String -> m ()
dbgMsgIO Int
2

dbg3MsgIO :: (MonadIO m) => String -> m ()
dbg3MsgIO :: forall (m :: * -> *). MonadIO m => String -> m ()
dbg3MsgIO = Int -> String -> m ()
forall (m :: * -> *). MonadIO m => Int -> String -> m ()
dbgMsgIO Int
3

dbg4MsgIO :: (MonadIO m) => String -> m ()
dbg4MsgIO :: forall (m :: * -> *). MonadIO m => String -> m ()
dbg4MsgIO = Int -> String -> m ()
forall (m :: * -> *). MonadIO m => Int -> String -> m ()
dbgMsgIO Int
4

dbg5MsgIO :: (MonadIO m) => String -> m ()
dbg5MsgIO :: forall (m :: * -> *). MonadIO m => String -> m ()
dbg5MsgIO = Int -> String -> m ()
forall (m :: * -> *). MonadIO m => Int -> String -> m ()
dbgMsgIO Int
5

dbg6MsgIO :: (MonadIO m) => String -> m ()
dbg6MsgIO :: forall (m :: * -> *). MonadIO m => String -> m ()
dbg6MsgIO = Int -> String -> m ()
forall (m :: * -> *). MonadIO m => Int -> String -> m ()
dbgMsgIO Int
6

dbg7MsgIO :: (MonadIO m) => String -> m ()
dbg7MsgIO :: forall (m :: * -> *). MonadIO m => String -> m ()
dbg7MsgIO = Int -> String -> m ()
forall (m :: * -> *). MonadIO m => Int -> String -> m ()
dbgMsgIO Int
7

dbg8MsgIO :: (MonadIO m) => String -> m ()
dbg8MsgIO :: forall (m :: * -> *). MonadIO m => String -> m ()
dbg8MsgIO = Int -> String -> m ()
forall (m :: * -> *). MonadIO m => Int -> String -> m ()
dbgMsgIO Int
8

dbg9MsgIO :: (MonadIO m) => String -> m ()
dbg9MsgIO :: forall (m :: * -> *). MonadIO m => String -> m ()
dbg9MsgIO = Int -> String -> m ()
forall (m :: * -> *). MonadIO m => Int -> String -> m ()
dbgMsgIO Int
9


-- | Trace or log a label and showable value, pretty-printed,
-- if the program debug level is at or above the specified level;
-- then return the value.
dbg :: (Show a) => Int -> String -> a -> a
dbg :: forall a. Show a => Int -> String -> a -> a
dbg = if Bool
shouldLog then Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
plogAt else Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
ptraceAt

-- | Alias for dbg, can be used to avoid namespace clashes.
dbg_ :: (Show a) => Int -> String -> a -> a
dbg_ :: forall a. Show a => Int -> String -> a -> a
dbg_ = Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
dbg

dbg0 :: Show a => String -> a -> a
dbg0 :: forall a. Show a => String -> a -> a
dbg0 = Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
dbg Int
0

dbg1 :: Show a => String -> a -> a
dbg1 :: forall a. Show a => String -> a -> a
dbg1 = Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
dbg Int
1

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

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

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

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

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

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

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

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


-- | Like dbg, but sequences properly in IO.
dbgIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
dbgIO :: forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
dbgIO = if Bool
shouldLog then Int -> String -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
plogAtIO else Int -> String -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO

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

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

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

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

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

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

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

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

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

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


-- | Like dbg, but with a custom show function.
dbgWith :: Int -> (a -> String) -> a -> a
dbgWith :: forall a. Int -> (a -> String) -> a -> a
dbgWith = if Bool
shouldLog then Int -> (a -> String) -> a -> a
forall a. Int -> (a -> String) -> a -> a
logAtWith else Int -> (a -> String) -> a -> a
forall a. Int -> (a -> String) -> a -> a
traceAtWith

dbg0With :: (a -> String) -> a -> a
dbg0With :: forall a. (a -> String) -> a -> a
dbg0With = Int -> (a -> String) -> a -> a
forall a. Int -> (a -> String) -> a -> a
dbgWith Int
0

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

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

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

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

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

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

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

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

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

-- | Helper for producing debug messages:
-- concatenates a name (eg a function name),
-- short description of the value being logged,
-- and string representation of the value.
--
-- Eg: @let lbl = lbl_ "print"@,
-- @dbg1With (lbl "part 1".show) ...@.
--
lbl_ :: String -> String -> String -> String
lbl_ :: String -> String -> String -> String
lbl_ String
name String
desc String
val = String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
": " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
desc String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
":" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
val

-- XXX the resulting function is constrained to only one value type
-- -- | A helper for defining a local "dbg" function.
-- -- Given a debug level and a topic string (eg, a function name),
-- -- it generates a function which takes
-- -- - a description string,
-- -- - a value-to-string show function,
-- -- - and a value to be inspected,
-- -- debug-logs the topic, description and result of calling the show function on the value,
-- -- formatted nicely, at the specified debug level or above,
-- -- then returns the value.
-- dbg_ :: forall a. Int -> String -> (String -> (a -> String) -> a -> a)
-- dbg_ level topic =
--   \desc showfn val ->
--     dbgWith level (lbl_ topic desc . showfn) val
-- {-# HLINT ignore "Redundant lambda" #-}


-- | Whether ghc-debug support is included in this build, and if so, how it will behave.
-- When hledger is built with the @ghcdebug@ cabal flag (off by default, because of extra deps),
-- it can listen (on unix ?) for connections from ghc-debug clients like ghc-debug-brick,
-- for pausing/resuming the program and inspecting memory usage and profile information.
--
-- With a ghc-debug-supporting build, ghc-debug can be enabled by running hledger with
-- a negative --debug level. There are three different modes:
-- --debug=-1 - run normally (can be paused/resumed by a ghc-debug client),
-- --debug=-2 - pause and await client commands at program start (not useful currently),
-- --debug=-3 - pause and await client commands at program end.
data GhcDebugMode =
    GDNotSupported
  | GDDisabled
  | GDNoPause
  | GDPauseAtStart
  | GDPauseAtEnd
  -- keep synced with ghcDebugMode
  deriving (GhcDebugMode -> GhcDebugMode -> Bool
(GhcDebugMode -> GhcDebugMode -> Bool)
-> (GhcDebugMode -> GhcDebugMode -> Bool) -> Eq GhcDebugMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GhcDebugMode -> GhcDebugMode -> Bool
== :: GhcDebugMode -> GhcDebugMode -> Bool
$c/= :: GhcDebugMode -> GhcDebugMode -> Bool
/= :: GhcDebugMode -> GhcDebugMode -> Bool
Eq,Eq GhcDebugMode
Eq GhcDebugMode =>
(GhcDebugMode -> GhcDebugMode -> Ordering)
-> (GhcDebugMode -> GhcDebugMode -> Bool)
-> (GhcDebugMode -> GhcDebugMode -> Bool)
-> (GhcDebugMode -> GhcDebugMode -> Bool)
-> (GhcDebugMode -> GhcDebugMode -> Bool)
-> (GhcDebugMode -> GhcDebugMode -> GhcDebugMode)
-> (GhcDebugMode -> GhcDebugMode -> GhcDebugMode)
-> Ord GhcDebugMode
GhcDebugMode -> GhcDebugMode -> Bool
GhcDebugMode -> GhcDebugMode -> Ordering
GhcDebugMode -> GhcDebugMode -> GhcDebugMode
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: GhcDebugMode -> GhcDebugMode -> Ordering
compare :: GhcDebugMode -> GhcDebugMode -> Ordering
$c< :: GhcDebugMode -> GhcDebugMode -> Bool
< :: GhcDebugMode -> GhcDebugMode -> Bool
$c<= :: GhcDebugMode -> GhcDebugMode -> Bool
<= :: GhcDebugMode -> GhcDebugMode -> Bool
$c> :: GhcDebugMode -> GhcDebugMode -> Bool
> :: GhcDebugMode -> GhcDebugMode -> Bool
$c>= :: GhcDebugMode -> GhcDebugMode -> Bool
>= :: GhcDebugMode -> GhcDebugMode -> Bool
$cmax :: GhcDebugMode -> GhcDebugMode -> GhcDebugMode
max :: GhcDebugMode -> GhcDebugMode -> GhcDebugMode
$cmin :: GhcDebugMode -> GhcDebugMode -> GhcDebugMode
min :: GhcDebugMode -> GhcDebugMode -> GhcDebugMode
Ord,Int -> GhcDebugMode -> String -> String
[GhcDebugMode] -> String -> String
GhcDebugMode -> String
(Int -> GhcDebugMode -> String -> String)
-> (GhcDebugMode -> String)
-> ([GhcDebugMode] -> String -> String)
-> Show GhcDebugMode
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> GhcDebugMode -> String -> String
showsPrec :: Int -> GhcDebugMode -> String -> String
$cshow :: GhcDebugMode -> String
show :: GhcDebugMode -> String
$cshowList :: [GhcDebugMode] -> String -> String
showList :: [GhcDebugMode] -> String -> String
Show)

-- | Is the hledger-lib package built with ghc-debug support ?
ghcDebugSupportedInLib :: Bool
ghcDebugSupportedInLib :: Bool
ghcDebugSupportedInLib =
#ifdef GHCDEBUG
  True
#else
  Bool
False
#endif

-- | Should the program open a socket allowing control by ghc-debug-brick or similar ghc-debug client ?
-- See GhcDebugMode.
ghcDebugMode :: GhcDebugMode
ghcDebugMode :: GhcDebugMode
ghcDebugMode =
#ifdef GHCDEBUG
  case debugLevel of
    _ | not ghcDebugSupportedInLib -> GDNotSupported
    (-1) -> GDNoPause
    (-2) -> GDPauseAtStart
    (-3) -> GDPauseAtEnd
    _    -> GDDisabled
    -- keep synced with GhcDebugMode
#else
  GhcDebugMode
GDNotSupported
#endif

-- | When ghc-debug support has been built into the program and enabled at runtime with --debug=-N,
-- this calls ghc-debug's withGhcDebug; otherwise it's a no-op.
withGhcDebug' :: a -> a
withGhcDebug' =
#ifdef GHCDEBUG
  if ghcDebugMode > GDDisabled then withGhcDebug else id
#else
  a -> a
forall a. a -> a
id
#endif

-- | When ghc-debug support has been built into the program, this calls ghc-debug's pause, otherwise it's a no-op.
ghcDebugPause' :: IO ()
ghcDebugPause' :: IO ()
ghcDebugPause' =
#ifdef GHCDEBUG
  pause
#else
  () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
#endif