{- | 

Here are fancier versions of Debug.Trace, with these features:

- unsafePerformIO-based for easy usage in pure code, IO code, and program startup code
- reasonably short and memorable function names
- pretty-printing haskell values, with or without colour, using pretty-simple
- enabling/disabling debug output with --debug
- multiple debug verbosity levels, from 1 to 9
- sending debug output to stderr or to a log file
- enabling logging based on program name

The basic "trace" functions print to stderr.
This debug output will be interleaved with the program's normal output, which can be
useful for understanding when code executes.

The "Log" functions log to a file instead.
The need for these is arguable, since a technically savvy user can redirect
stderr output to a log file, eg: @CMD 2>debug.log@.
But here is how they currently work:

The "traceLog" functions log to the program's debug log file,
which is @PROGNAME.log@ in the current directory,
where PROGNAME is the program name returned by @getProgName@.
When using this logging feature you should call @withProgName@ explicitly
at the start of your program to ensure a stable program name,
otherwise it can change to "<interactive>" eg when running in GHCI.
Eg: @main = withProgName "MYPROG" $ do ...@.

The "OrLog" functions can either print to stderr or log to a file.

- By default, they print to stderr.

- If the program name has been set (with @withProgName) to something ending with ".log", they log to that file instead.
  This can be useful for programs which should never print to stderr, eg TUI programs like hledger-ui.

The "At" functions produce output only when the program was run with a 
sufficiently high debug level, as set by a @--debug[=N]@ command line option.
N ranges from 1 (least debug output) to 9 (most debug output),
@--debug@ with no argument means 1.

The "dbgN*" functions are intended to be the most convenient API, to be embedded
at points of interest in your code. They combine the conditional output of "At",
the conditional logging of "OrLog", pretty printing, and short searchable function names.

Parsing the command line, detecting program name, and file logging is done with unsafePerformIO.
If you are working in GHCI, changing the debug level requires editing and reloading this file
(sometimes it's more convenient to add a dbg0 temporarily).

In hledger, debug levels are used as follows:

@
Debug level:  What to show:
------------  ---------------------------------------------------------
0             normal command output only (no warnings, eg)
1             useful warnings, most common troubleshooting info (config file args, 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
@

We don't yet have the ability to select debug output by topic. For now, here
are some standardish topic strings to search for in hledger debug messages:

acct
arg
budget
calc
csv
journalFinalise
multiBalanceReport
opts
precision
price
q
style
val

-}

-- 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

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

module Hledger.Utils.Debug (

   debugLevel

  -- * Tracing to stderr
  ,traceWith
  ,traceAt
  ,traceAtWith
  ,ptrace
  ,ptraceAt
  ,ptraceAtIO

  -- * Logging to PROGNAME.log
  ,traceLog
  ,traceLogAt
  ,traceLogIO
  ,traceLogAtIO
  ,traceLogWith
  ,traceLogAtWith
  ,ptraceLogAt
  ,ptraceLogAtIO

  -- * Tracing or logging based on shouldLog
  ,traceOrLog
  ,traceOrLogAt
  ,ptraceOrLogAt
  ,ptraceOrLogAtIO
  ,traceOrLogAtWith

  -- * Pretty tracing/logging in pure code
  ,dbg0
  ,dbg1
  ,dbg2
  ,dbg3
  ,dbg4
  ,dbg5
  ,dbg6
  ,dbg7
  ,dbg8
  ,dbg9
  ,dbgExit

  -- * Pretty tracing/logging in IO
  ,dbg0IO
  ,dbg1IO
  ,dbg2IO
  ,dbg3IO
  ,dbg4IO
  ,dbg5IO
  ,dbg6IO
  ,dbg7IO
  ,dbg8IO
  ,dbg9IO

  -- * Tracing/logging with a show function
  ,dbg0With
  ,dbg1With
  ,dbg2With
  ,dbg3With
  ,dbg4With
  ,dbg5With
  ,dbg6With
  ,dbg7With
  ,dbg8With
  ,dbg9With

  -- * Utilities
  ,ghcDebugSupportedInLib
  ,GhcDebugMode(..)
  ,ghcDebugMode
  ,withGhcDebug'
  ,ghcDebugPause'
  ,lbl_
  ,progName

  -- * Re-exports
  -- ,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.Breakpoint
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 programs debug output verbosity. 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 (the = is required). Uses unsafePerformIO. 
-- 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

-- | 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

-- | Trace a value with the given show function before returning it.
traceWith :: (a -> String) -> a -> a
traceWith :: forall a. (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

-- | 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 :: forall a. Show a => a -> a
ptrace = (a -> String) -> a -> a
forall a. (a -> String) -> a -> a
traceWith a -> String
forall a. Show a => a -> String
pshow

-- | 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 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

-- | 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 = 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 :: 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 convenient to insert in an IO monad and
-- enforces monadic sequencing.
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)

-- | Should the "trace or log" functions output to a file instead of stderr ?
-- True if the 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

-- | 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"

-- -- | The debug log file: debug.log in the current directory.
-- debugLogFile :: FilePath
-- debugLogFile = "debug.log"

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

-- | Like traceLog but sequences properly in IO.
traceLogIO :: MonadIO m => String -> m ()
traceLogIO :: forall (m :: * -> *). MonadIO m => String -> m ()
traceLogIO 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 traceLogAt, but convenient to use in IO.
traceLogAtIO :: MonadIO m => Int -> String -> m ()
traceLogAtIO :: forall (m :: * -> *). MonadIO m => Int -> String -> m ()
traceLogAtIO 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 ()
traceLogIO String
str

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

-- | Log a string to the 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.
traceLogAtWith :: Int -> (a -> String) -> a -> a
traceLogAtWith :: forall a. Int -> (a -> String) -> a -> a
traceLogAtWith Int
level a -> String
f a
a = Int -> String -> a -> a
forall a. Int -> String -> a -> a
traceLogAt Int
level (a -> String
f a
a) a
a

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

-- | Like ptraceAt, but convenient to insert in an IO monad and
-- enforces monadic sequencing.
ptraceLogAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
ptraceLogAtIO :: forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceLogAtIO 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 ()
traceLogIO (Bool -> String -> a -> String
forall a. Show a => Bool -> String -> a -> String
labelledPretty Bool
False String
label a
a)

-- | Trace or log a string depending on shouldLog,
-- before returning the second argument.
traceOrLog :: String -> a -> a
traceOrLog :: forall a. String -> a -> a
traceOrLog = if Bool
shouldLog then String -> a -> a
forall a. String -> a -> a
traceLog else String -> a -> a
forall a. String -> a -> a
trace

-- | Trace or log a string depending on shouldLog,
-- when global debug level is at or above the specified level,
-- before returning the second argument.
traceOrLogAt :: Int -> String -> a -> a
traceOrLogAt :: forall a. Int -> String -> a -> a
traceOrLogAt = if Bool
shouldLog then Int -> String -> a -> a
forall a. Int -> String -> a -> a
traceLogAt else Int -> String -> a -> a
forall a. Int -> String -> a -> a
traceAt

-- | Pretty-trace or log depending on shouldLog, when global debug level
-- is at or above the specified level.
ptraceOrLogAt :: Show a => Int -> String -> a -> a
ptraceOrLogAt :: forall a. Show a => Int -> String -> a -> a
ptraceOrLogAt = if Bool
shouldLog then Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
ptraceLogAt else Int -> String -> a -> a
forall a. Show a => Int -> String -> a -> a
ptraceAt

-- | Like ptraceOrLogAt, but convenient in IO.
ptraceOrLogAtIO :: (MonadIO m, Show a) => Int -> String -> a -> m ()
ptraceOrLogAtIO :: forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceOrLogAtIO = if Bool
shouldLog then Int -> String -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceLogAtIO else Int -> String -> a -> m ()
forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO

-- | Trace or log, with a show function, depending on shouldLog.
traceOrLogAtWith :: Int -> (a -> String) -> a -> a
traceOrLogAtWith :: forall a. Int -> (a -> String) -> a -> a
traceOrLogAtWith = if Bool
shouldLog then Int -> (a -> String) -> a -> a
forall a. Int -> (a -> String) -> a -> a
traceLogAtWith else Int -> (a -> String) -> a -> a
forall a. Int -> (a -> String) -> a -> a
traceAtWith

-- | Pretty-trace to stderr (or log to debug log) a label and showable value,
-- then return it.
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
ptraceOrLogAt Int
0

-- | Pretty-trace to stderr (or log to debug log) a label and showable value
-- if the --debug level is high enough, then return the value.
-- Uses unsafePerformIO.
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
ptraceOrLogAt 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
ptraceOrLogAt 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
ptraceOrLogAt 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
ptraceOrLogAt 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
ptraceOrLogAt 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
ptraceOrLogAt 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
ptraceOrLogAt 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
ptraceOrLogAt 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
ptraceOrLogAt Int
9

-- | Like dbg0, but also exit the program. Uses unsafePerformIO.
dbgExit :: Show a => String -> a -> a
dbgExit :: forall a. Show a => String -> a -> a
dbgExit String
label a
a = IO a -> a
forall a. IO a -> a
unsafePerformIO (IO a -> a) -> IO a -> a
forall a b. (a -> b) -> a -> b
$ String -> a -> IO ()
forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg0IO String
label a
a IO () -> IO a -> IO a
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO a
forall a. IO a
exitFailure

-- | Like dbgN, but convenient to use in IO.
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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO Int
9

-- | Like dbgN, but taking a show function instead of a label.
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
traceOrLogAtWith Int
0

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

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

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

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

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

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

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

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

dbg9With :: Show a => (a -> String) -> a -> a
dbg9With :: forall a. Show a => (a -> String) -> a -> a
dbg9With = Int -> (a -> String) -> a -> a
forall a. Int -> (a -> String) -> a -> a
traceOrLogAtWith 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.
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 new 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. Show a => Int -> String -> (String -> (a -> String) -> a -> a)
-- dbg_ level topic =
--   \desc showfn val ->
--     traceOrLogAtWith level (lbl_ topic desc . showfn) val
-- {-# HLINT ignore "Redundant lambda" #-}