module Hledger.Utils.Debug (
debugLevel
,traceWith
,traceAt
,traceAtWith
,ptrace
,ptraceAt
,ptraceAtIO
,traceLog
,traceLogAt
,traceLogIO
,traceLogAtIO
,traceLogWith
,traceLogAtWith
,ptraceLogAt
,ptraceLogAtIO
,traceOrLog
,traceOrLogAt
,ptraceOrLogAt
,ptraceOrLogAtIO
,traceOrLogAtWith
,dbg0
,dbg1
,dbg2
,dbg3
,dbg4
,dbg5
,dbg6
,dbg7
,dbg8
,dbg9
,dbgExit
,dbg0IO
,dbg1IO
,dbg2IO
,dbg3IO
,dbg4IO
,dbg5IO
,dbg6IO
,dbg7IO
,dbg8IO
,dbg9IO
,dbg0With
,dbg1With
,dbg2With
,dbg3With
,dbg4With
,dbg5With
,dbg6With
,dbg7With
,dbg8With
,dbg9With
,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)
import Safe (readDef)
import System.Environment (getProgName)
import System.Exit (exitFailure)
import System.IO.Unsafe (unsafePerformIO)
import Hledger.Utils.IO (progArgs, pshow, pshow')
{-# NOINLINE modifiedProgName #-}
modifiedProgName :: String
modifiedProgName :: String
modifiedProgName = forall a. IO a -> a
unsafePerformIO IO String
getProgName
progName :: String
progName :: String
progName =
if String
".log" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
modifiedProgName
then forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. Int -> [a] -> [a]
drop Int
4 forall a b. (a -> b) -> a -> b
$ forall a. [a] -> [a]
reverse String
modifiedProgName
else String
modifiedProgName
debugLevel :: Int
debugLevel :: Int
debugLevel = case forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=String
"--debug") [String]
progArgs 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]
progArgs 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
traceWith :: (a -> String) -> a -> a
traceWith :: forall a. (a -> String) -> a -> a
traceWith a -> String
f a
a = forall a. String -> a -> a
trace (a -> String
f a
a) a
a
ptrace :: Show a => a -> a
ptrace :: forall a. Show a => a -> a
ptrace = forall a. (a -> String) -> a -> a
traceWith forall a. Show a => a -> String
pshow
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
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
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
lbl a
a -> forall a. String -> a -> a
trace (forall a. Show a => Bool -> String -> a -> String
labelledPretty Bool
True String
lbl a
a) a
a
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 forall a. [a] -> [a] -> [a]
++ String
":" forall a. [a] -> [a] -> [a]
++ String
nlorspace forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"\n" [String]
ls'
where
ls :: [String]
ls = String -> [String]
lines forall a b. (a -> b) -> a -> b
$ (if Bool
allowcolour then forall a. Show a => a -> String
pshow else 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
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 forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
debugLevel forall a. Ord a => a -> a -> Bool
< Int
level
then forall (m :: * -> *) a. Monad m => a -> m a
return ()
else forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> IO ()
traceIO (forall a. Show a => Bool -> String -> a -> String
labelledPretty Bool
True String
label a
a)
shouldLog :: Bool
shouldLog :: Bool
shouldLog = String
".log" forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` String
modifiedProgName
debugLogFile :: FilePath
debugLogFile :: String
debugLogFile = String
progName forall a. [a] -> [a] -> [a]
++ String
".log"
traceLog :: String -> a -> a
traceLog :: forall a. String -> a -> a
traceLog 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)
String -> String -> IO ()
appendFile String
debugLogFile (String
s forall a. [a] -> [a] -> [a]
++ String
"\n")
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
traceLogAt :: Int -> String -> a -> a
traceLogAt :: forall a. Int -> String -> a -> a
traceLogAt Int
level String
str
| 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
traceLog String
str
traceLogIO :: MonadIO m => String -> m ()
traceLogIO :: forall (m :: * -> *). MonadIO m => String -> m ()
traceLogIO String
s = do
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. a -> IO a
evaluate (forall a. NFData a => a -> a
force String
s)
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ String -> String -> IO ()
appendFile String
debugLogFile (String
s forall a. [a] -> [a] -> [a]
++ String
"\n")
traceLogAtIO :: MonadIO m => Int -> String -> m ()
traceLogAtIO :: forall (m :: * -> *). MonadIO m => Int -> String -> m ()
traceLogAtIO Int
level String
str
| 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 (m :: * -> *) a. Monad m => a -> m a
return ()
| Bool
otherwise = forall (m :: * -> *). MonadIO m => String -> m ()
traceLogIO String
str
traceLogWith :: (a -> String) -> a -> a
traceLogWith :: forall a. (a -> String) -> a -> a
traceLogWith a -> String
f a
a = forall a. String -> a -> a
traceLog (a -> String
f a
a) a
a
traceLogAtWith :: Int -> (a -> String) -> a -> a
traceLogAtWith :: forall a. Int -> (a -> String) -> a -> a
traceLogAtWith Int
level a -> String
f a
a = forall a. Int -> String -> a -> a
traceLogAt Int
level (a -> String
f a
a) a
a
ptraceLogAt :: Show a => Int -> String -> a -> a
ptraceLogAt :: forall a. Show a => Int -> String -> a -> a
ptraceLogAt 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 -> forall a. String -> a -> a
traceLog (forall a. Show a => Bool -> String -> a -> String
labelledPretty Bool
False String
lbl a
a) a
a
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 forall a. Ord a => a -> a -> Bool
> Int
0 Bool -> Bool -> Bool
&& Int
debugLevel forall a. Ord a => a -> a -> Bool
< Int
level
then forall (m :: * -> *) a. Monad m => a -> m a
return ()
else forall (m :: * -> *). MonadIO m => String -> m ()
traceLogIO (forall a. Show a => Bool -> String -> a -> String
labelledPretty Bool
False String
label a
a)
traceOrLog :: String -> a -> a
traceOrLog :: forall a. String -> a -> a
traceOrLog = if Bool
shouldLog then forall a. String -> a -> a
trace else forall a. String -> a -> a
traceLog
traceOrLogAt :: Int -> String -> a -> a
traceOrLogAt :: forall a. Int -> String -> a -> a
traceOrLogAt = if Bool
shouldLog then forall a. Int -> String -> a -> a
traceLogAt else forall a. Int -> String -> a -> a
traceAt
ptraceOrLogAt :: Show a => Int -> String -> a -> a
ptraceOrLogAt :: forall a. Show a => Int -> String -> a -> a
ptraceOrLogAt = if Bool
shouldLog then forall a. Show a => Int -> String -> a -> a
ptraceLogAt else forall a. Show a => Int -> String -> a -> a
ptraceAt
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 forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceLogAtIO else forall (m :: * -> *) a.
(MonadIO m, Show a) =>
Int -> String -> a -> m ()
ptraceAtIO
traceOrLogAtWith :: Int -> (a -> String) -> a -> a
traceOrLogAtWith :: forall a. Int -> (a -> String) -> a -> a
traceOrLogAtWith = if Bool
shouldLog then forall a. Int -> (a -> String) -> a -> a
traceLogAtWith else forall a. Int -> (a -> String) -> a -> a
traceAtWith
dbg0 :: Show a => String -> a -> a
dbg0 :: forall a. Show a => String -> a -> a
dbg0 = forall a. Show a => Int -> String -> a -> a
ptraceOrLogAt Int
0
dbg1 :: Show a => String -> a -> a
dbg1 :: forall a. Show a => String -> a -> a
dbg1 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = forall a. Show a => Int -> String -> a -> a
ptraceOrLogAt Int
9
dbgExit :: Show a => String -> a -> a
dbgExit :: forall a. Show a => String -> a -> a
dbgExit String
label a
a = forall a. IO a -> a
unsafePerformIO forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. (MonadIO m, Show a) => String -> a -> m ()
dbg0IO String
label a
a forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. IO a
exitFailure
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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO 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 ()
ptraceOrLogAtIO Int
9
dbg0With :: (a -> String) -> a -> a
dbg0With :: forall a. (a -> String) -> a -> a
dbg0With = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = 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 = forall a. Int -> (a -> String) -> a -> a
traceOrLogAtWith Int
9