module Plutarch.Trace (
  ptrace,
  ptraceShowId,
  ptraceIfTrue,
  ptraceIfFalse,
  ptraceError,
) where

import Plutarch.Bool (PBool, pif)
import Plutarch.Internal (
  Term,
  perror,
  pgetConfig,
  plet,
  tracingMode,
  (#),
  pattern NoTracing,
 )
import Plutarch.Internal.Trace (ptrace, ptrace')
import Plutarch.Show (PShow, pshow)
import Plutarch.String (PString)

-- | Like Haskell's `traceShowId` but for Plutarch
ptraceShowId :: PShow a => Term s a -> Term s a
ptraceShowId :: forall (a :: PType) (s :: S). PShow a => Term s a -> Term s a
ptraceShowId Term s a
a = forall (s :: S) (a :: PType). (Config -> Term s a) -> Term s a
pgetConfig \Config
c -> case Config -> TracingMode
tracingMode Config
c of
  TracingMode
NoTracing -> Term s a
a
  TracingMode
_ -> forall (s :: S) (a :: PType).
Term s PString -> Term s a -> Term s a
ptrace (forall (a :: PType) (s :: S). PShow a => Term s a -> Term s PString
pshow Term s a
a) Term s a
a

-- | Trace the given message and terminate evaluation with a 'perror'.
ptraceError :: Term s PString -> Term s a
ptraceError :: forall (s :: S) (a :: PType). Term s PString -> Term s a
ptraceError = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (s :: S) (a :: PType).
Term s PString -> Term s a -> Term s a
ptrace forall (s :: S) (a :: PType). Term s a
perror

-- | Trace the given message if the argument evaluates to true.
ptraceIfTrue :: Term s PString -> Term s PBool -> Term s PBool
ptraceIfTrue :: forall (s :: S). Term s PString -> Term s PBool -> Term s PBool
ptraceIfTrue Term s PString
s Term s PBool
a' = forall (s :: S) (a :: PType). (Config -> Term s a) -> Term s a
pgetConfig \Config
c -> case Config -> TracingMode
tracingMode Config
c of
  TracingMode
NoTracing -> Term s PBool
a'
  TracingMode
_ -> forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s PBool
a' forall a b. (a -> b) -> a -> b
$ \Term s PBool
a -> forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif Term s PBool
a (forall (s :: S) (a :: PType). Term s (PString :--> (a :--> a))
ptrace' forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PString
s forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PBool
a) Term s PBool
a

-- | Trace the given message if the argument evaluates to False.
ptraceIfFalse :: Term s PString -> Term s PBool -> Term s PBool
ptraceIfFalse :: forall (s :: S). Term s PString -> Term s PBool -> Term s PBool
ptraceIfFalse Term s PString
s Term s PBool
a' = forall (s :: S) (a :: PType). (Config -> Term s a) -> Term s a
pgetConfig \Config
c -> case Config -> TracingMode
tracingMode Config
c of
  TracingMode
NoTracing -> Term s PBool
a'
  TracingMode
_ -> forall (s :: S) (a :: PType) (b :: PType).
Term s a -> (Term s a -> Term s b) -> Term s b
plet Term s PBool
a' forall a b. (a -> b) -> a -> b
$ \Term s PBool
a -> forall (s :: S) (a :: PType).
Term s PBool -> Term s a -> Term s a -> Term s a
pif Term s PBool
a Term s PBool
a (forall (s :: S) (a :: PType). Term s (PString :--> (a :--> a))
ptrace' forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PString
s forall (s :: S) (a :: PType) (b :: PType).
HasCallStack =>
Term s (a :--> b) -> Term s a -> Term s b
# Term s PBool
a)