module Control.Monad.Freer.Trace
( Trace(..)
, trace
, runTrace
) where
import Control.Monad.Freer.Internal (Eff(..), Member, extract, qApp, send)
data Trace a where
Trace :: String -> Trace ()
trace :: Member Trace effs => String -> Eff effs ()
trace :: String -> Eff effs ()
trace = Trace () -> Eff effs ()
forall (eff :: * -> *) (effs :: [* -> *]) a.
Member eff effs =>
eff a -> Eff effs a
send (Trace () -> Eff effs ())
-> (String -> Trace ()) -> String -> Eff effs ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Trace ()
Trace
runTrace :: Eff '[Trace] a -> IO a
runTrace :: Eff '[Trace] a -> IO a
runTrace (Val a
x) = a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return a
x
runTrace (E Union '[Trace] b
u Arrs '[Trace] b a
q) = case Union '[Trace] b -> Trace b
forall (t :: * -> *) a. Union '[t] a -> t a
extract Union '[Trace] b
u of
Trace String
s -> String -> IO ()
putStrLn String
s IO () -> IO a -> IO a
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Eff '[Trace] a -> IO a
forall a. Eff '[Trace] a -> IO a
runTrace (Arrs '[Trace] b a -> b -> Eff '[Trace] a
forall (effs :: [* -> *]) b w. Arrs effs b w -> b -> Eff effs w
qApp Arrs '[Trace] b a
q ())