|
{-# LANGUAGE CPP #-}
|
|
{-# LANGUAGE ConstraintKinds #-}
|
|
{-# LANGUAGE KindSignatures #-}
|
|
{-# LANGUAGE BangPatterns #-}
|
|
#undef RELEASE
|
|
module Debug where
|
|
|
|
import qualified Debug.Trace as D
|
|
|
|
#if defined(RELEASE)
|
|
import GHC.Exts
|
|
#endif
|
|
|
|
import GHC.Stack
|
|
import Prettyprinter
|
|
import qualified Data.Text.Lazy as T
|
|
import Data.Text.Prettyprint.Doc.Render.Text (renderLazy)
|
|
|
|
traceDoc :: Doc a -> b -> b
|
|
|
|
#if defined(RELEASE)
|
|
type DebugCallStack = (() :: Constraint)
|
|
traceDoc !_ v = v
|
|
#else
|
|
type DebugCallStack = HasCallStack
|
|
traceDoc x = D.trace (T.unpack (renderLazy (layoutPretty defaultLayoutOptions x)))
|
|
#endif
|
|
|
|
trace :: Pretty a => a -> b -> b
|
|
trace x = traceDoc (pretty x)
|
|
|
|
traceWith :: Pretty a => String -> a -> b -> b
|
|
traceWith s x = traceDoc (pretty s <+> pretty x)
|
|
|
|
traceId :: Pretty a => a -> a
|
|
traceId x = traceDoc (pretty x) x
|
|
|
|
traceWithId :: Pretty a => String -> a -> a
|
|
traceWithId s x = traceWith s x x
|
|
|
|
traceDocM :: (Applicative m) => Doc a -> m ()
|
|
traceDocM x = traceDoc x (pure ())
|
|
|
|
traceM :: (Applicative m, Pretty a) => a -> m ()
|
|
traceM = traceDocM . pretty
|