{-# LANGUAGE DerivingVia #-}
module Control.Effect.Trace
  ( -- * Effects
    Trace(..)

    -- * Actions
  , trace
  , traceShow

    -- * Interpretations
  , runTraceList

  , runTraceListIO

  , runTracePrinting
  , runTraceToHandle

  , ignoreTrace

  , traceIntoTell

    -- * Simple variants of interprations
  , runTraceListIOSimple
  , runTraceToHandleSimple

    -- * Threading constraints
  , WriterThreads

    -- * Carriers
  , TraceListC
  , TracePrintingC
  , IgnoreTraceC
  , TraceIntoTellC
  ) where

import Data.IORef
import Data.Semigroup

import Control.Effect
import Control.Effect.Writer

import System.IO

-- For coercion purposes
import Control.Effect.Carrier
import Control.Effect.Internal.Utils
import Control.Effect.Carrier.Internal.Interpret
import Control.Effect.Carrier.Internal.Compose
import Control.Effect.Carrier.Internal.Intro
import qualified Control.Monad.Trans.Writer.CPS as CPS


-- | An effect for debugging by printing/logging strings.
data Trace :: Effect where
  Trace :: String -> Trace m ()

-- | Log the provided string
trace :: Eff Trace m => String -> m ()
trace :: String -> m ()
trace = Trace m () -> m ()
forall (e :: Effect) (m :: * -> *) a.
(Member e (Derivs m), Carrier m) =>
e m a -> m a
send (Trace m () -> m ()) -> (String -> Trace m ()) -> String -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Trace m ()
forall (m :: * -> *). String -> Trace m ()
Trace
{-# INLINE trace #-}

-- | 'show' the provided item and log it.
traceShow :: (Show a, Eff Trace m) => a -> m ()
traceShow :: a -> m ()
traceShow = String -> m ()
forall (m :: * -> *). Eff Trace m => String -> m ()
trace (String -> m ()) -> (a -> String) -> a -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show
{-# INLINE traceShow #-}

newtype TraceListC m a = TraceListC {
    TraceListC m a -> TraceIntoTellC (TellListC String m) a
unTraceListC ::
        TraceIntoTellC
      ( TellListC String
      ( m
      )) a
  } deriving ( a -> TraceListC m b -> TraceListC m a
(a -> b) -> TraceListC m a -> TraceListC m b
(forall a b. (a -> b) -> TraceListC m a -> TraceListC m b)
-> (forall a b. a -> TraceListC m b -> TraceListC m a)
-> Functor (TraceListC m)
forall a b. a -> TraceListC m b -> TraceListC m a
forall a b. (a -> b) -> TraceListC m a -> TraceListC m b
forall (m :: * -> *) a b.
Functor m =>
a -> TraceListC m b -> TraceListC m a
forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TraceListC m a -> TraceListC m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> TraceListC m b -> TraceListC m a
$c<$ :: forall (m :: * -> *) a b.
Functor m =>
a -> TraceListC m b -> TraceListC m a
fmap :: (a -> b) -> TraceListC m a -> TraceListC m b
$cfmap :: forall (m :: * -> *) a b.
Functor m =>
(a -> b) -> TraceListC m a -> TraceListC m b
Functor, Functor (TraceListC m)
a -> TraceListC m a
Functor (TraceListC m)
-> (forall a. a -> TraceListC m a)
-> (forall a b.
    TraceListC m (a -> b) -> TraceListC m a -> TraceListC m b)
-> (forall a b c.
    (a -> b -> c)
    -> TraceListC m a -> TraceListC m b -> TraceListC m c)
-> (forall a b. TraceListC m a -> TraceListC m b -> TraceListC m b)
-> (forall a b. TraceListC m a -> TraceListC m b -> TraceListC m a)
-> Applicative (TraceListC m)
TraceListC m a -> TraceListC m b -> TraceListC m b
TraceListC m a -> TraceListC m b -> TraceListC m a
TraceListC m (a -> b) -> TraceListC m a -> TraceListC m b
(a -> b -> c) -> TraceListC m a -> TraceListC m b -> TraceListC m c
forall a. a -> TraceListC m a
forall a b. TraceListC m a -> TraceListC m b -> TraceListC m a
forall a b. TraceListC m a -> TraceListC m b -> TraceListC m b
forall a b.
TraceListC m (a -> b) -> TraceListC m a -> TraceListC m b
forall a b c.
(a -> b -> c) -> TraceListC m a -> TraceListC m b -> TraceListC m c
forall (m :: * -> *). Monad m => Functor (TraceListC m)
forall (m :: * -> *) a. Monad m => a -> TraceListC m a
forall (m :: * -> *) a b.
Monad m =>
TraceListC m a -> TraceListC m b -> TraceListC m a
forall (m :: * -> *) a b.
Monad m =>
TraceListC m a -> TraceListC m b -> TraceListC m b
forall (m :: * -> *) a b.
Monad m =>
TraceListC m (a -> b) -> TraceListC m a -> TraceListC m b
forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> TraceListC m a -> TraceListC m b -> TraceListC m c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
<* :: TraceListC m a -> TraceListC m b -> TraceListC m a
$c<* :: forall (m :: * -> *) a b.
Monad m =>
TraceListC m a -> TraceListC m b -> TraceListC m a
*> :: TraceListC m a -> TraceListC m b -> TraceListC m b
$c*> :: forall (m :: * -> *) a b.
Monad m =>
TraceListC m a -> TraceListC m b -> TraceListC m b
liftA2 :: (a -> b -> c) -> TraceListC m a -> TraceListC m b -> TraceListC m c
$cliftA2 :: forall (m :: * -> *) a b c.
Monad m =>
(a -> b -> c) -> TraceListC m a -> TraceListC m b -> TraceListC m c
<*> :: TraceListC m (a -> b) -> TraceListC m a -> TraceListC m b
$c<*> :: forall (m :: * -> *) a b.
Monad m =>
TraceListC m (a -> b) -> TraceListC m a -> TraceListC m b
pure :: a -> TraceListC m a
$cpure :: forall (m :: * -> *) a. Monad m => a -> TraceListC m a
$cp1Applicative :: forall (m :: * -> *). Monad m => Functor (TraceListC m)
Applicative, Applicative (TraceListC m)
a -> TraceListC m a
Applicative (TraceListC m)
-> (forall a b.
    TraceListC m a -> (a -> TraceListC m b) -> TraceListC m b)
-> (forall a b. TraceListC m a -> TraceListC m b -> TraceListC m b)
-> (forall a. a -> TraceListC m a)
-> Monad (TraceListC m)
TraceListC m a -> (a -> TraceListC m b) -> TraceListC m b
TraceListC m a -> TraceListC m b -> TraceListC m b
forall a. a -> TraceListC m a
forall a b. TraceListC m a -> TraceListC m b -> TraceListC m b
forall a b.
TraceListC m a -> (a -> TraceListC m b) -> TraceListC m b
forall (m :: * -> *). Monad m => Applicative (TraceListC m)
forall (m :: * -> *) a. Monad m => a -> TraceListC m a
forall (m :: * -> *) a b.
Monad m =>
TraceListC m a -> TraceListC m b -> TraceListC m b
forall (m :: * -> *) a b.
Monad m =>
TraceListC m a -> (a -> TraceListC m b) -> TraceListC m b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
return :: a -> TraceListC m a
$creturn :: forall (m :: * -> *) a. Monad m => a -> TraceListC m a
>> :: TraceListC m a -> TraceListC m b -> TraceListC m b
$c>> :: forall (m :: * -> *) a b.
Monad m =>
TraceListC m a -> TraceListC m b -> TraceListC m b
>>= :: TraceListC m a -> (a -> TraceListC m b) -> TraceListC m b
$c>>= :: forall (m :: * -> *) a b.
Monad m =>
TraceListC m a -> (a -> TraceListC m b) -> TraceListC m b
$cp1Monad :: forall (m :: * -> *). Monad m => Applicative (TraceListC m)
Monad
             , Applicative (TraceListC m)
TraceListC m a
Applicative (TraceListC m)
-> (forall a. TraceListC m a)
-> (forall a. TraceListC m a -> TraceListC m a -> TraceListC m a)
-> (forall a. TraceListC m a -> TraceListC m [a])
-> (forall a. TraceListC m a -> TraceListC m [a])
-> Alternative (TraceListC m)
TraceListC m a -> TraceListC m a -> TraceListC m a
TraceListC m a -> TraceListC m [a]
TraceListC m a -> TraceListC m [a]
forall a. TraceListC m a
forall a. TraceListC m a -> TraceListC m [a]
forall a. TraceListC m a -> TraceListC m a -> TraceListC m a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall (m :: * -> *). MonadPlus m => Applicative (TraceListC m)
forall (m :: * -> *) a. MonadPlus m => TraceListC m a
forall (m :: * -> *) a.
MonadPlus m =>
TraceListC m a -> TraceListC m [a]
forall (m :: * -> *) a.
MonadPlus m =>
TraceListC m a -> TraceListC m a -> TraceListC m a
many :: TraceListC m a -> TraceListC m [a]
$cmany :: forall (m :: * -> *) a.
MonadPlus m =>
TraceListC m a -> TraceListC m [a]
some :: TraceListC m a -> TraceListC m [a]
$csome :: forall (m :: * -> *) a.
MonadPlus m =>
TraceListC m a -> TraceListC m [a]
<|> :: TraceListC m a -> TraceListC m a -> TraceListC m a
$c<|> :: forall (m :: * -> *) a.
MonadPlus m =>
TraceListC m a -> TraceListC m a -> TraceListC m a
empty :: TraceListC m a
$cempty :: forall (m :: * -> *) a. MonadPlus m => TraceListC m a
$cp1Alternative :: forall (m :: * -> *). MonadPlus m => Applicative (TraceListC m)
Alternative, Monad (TraceListC m)
Alternative (TraceListC m)
TraceListC m a
Alternative (TraceListC m)
-> Monad (TraceListC m)
-> (forall a. TraceListC m a)
-> (forall a. TraceListC m a -> TraceListC m a -> TraceListC m a)
-> MonadPlus (TraceListC m)
TraceListC m a -> TraceListC m a -> TraceListC m a
forall a. TraceListC m a
forall a. TraceListC m a -> TraceListC m a -> TraceListC m a
forall (m :: * -> *).
Alternative m
-> Monad m
-> (forall a. m a)
-> (forall a. m a -> m a -> m a)
-> MonadPlus m
forall (m :: * -> *). MonadPlus m => Monad (TraceListC m)
forall (m :: * -> *). MonadPlus m => Alternative (TraceListC m)
forall (m :: * -> *) a. MonadPlus m => TraceListC m a
forall (m :: * -> *) a.
MonadPlus m =>
TraceListC m a -> TraceListC m a -> TraceListC m a
mplus :: TraceListC m a -> TraceListC m a -> TraceListC m a
$cmplus :: forall (m :: * -> *) a.
MonadPlus m =>
TraceListC m a -> TraceListC m a -> TraceListC m a
mzero :: TraceListC m a
$cmzero :: forall (m :: * -> *) a. MonadPlus m => TraceListC m a
$cp2MonadPlus :: forall (m :: * -> *). MonadPlus m => Monad (TraceListC m)
$cp1MonadPlus :: forall (m :: * -> *). MonadPlus m => Alternative (TraceListC m)
MonadPlus
             , Monad (TraceListC m)
Monad (TraceListC m)
-> (forall a. (a -> TraceListC m a) -> TraceListC m a)
-> MonadFix (TraceListC m)
(a -> TraceListC m a) -> TraceListC m a
forall a. (a -> TraceListC m a) -> TraceListC m a
forall (m :: * -> *).
Monad m -> (forall a. (a -> m a) -> m a) -> MonadFix m
forall (m :: * -> *). MonadFix m => Monad (TraceListC m)
forall (m :: * -> *) a.
MonadFix m =>
(a -> TraceListC m a) -> TraceListC m a
mfix :: (a -> TraceListC m a) -> TraceListC m a
$cmfix :: forall (m :: * -> *) a.
MonadFix m =>
(a -> TraceListC m a) -> TraceListC m a
$cp1MonadFix :: forall (m :: * -> *). MonadFix m => Monad (TraceListC m)
MonadFix, Monad (TraceListC m)
Monad (TraceListC m)
-> (forall a. String -> TraceListC m a) -> MonadFail (TraceListC m)
String -> TraceListC m a
forall a. String -> TraceListC m a
forall (m :: * -> *).
Monad m -> (forall a. String -> m a) -> MonadFail m
forall (m :: * -> *). MonadFail m => Monad (TraceListC m)
forall (m :: * -> *) a. MonadFail m => String -> TraceListC m a
fail :: String -> TraceListC m a
$cfail :: forall (m :: * -> *) a. MonadFail m => String -> TraceListC m a
$cp1MonadFail :: forall (m :: * -> *). MonadFail m => Monad (TraceListC m)
MonadFail, Monad (TraceListC m)
Monad (TraceListC m)
-> (forall a. IO a -> TraceListC m a) -> MonadIO (TraceListC m)
IO a -> TraceListC m a
forall a. IO a -> TraceListC m a
forall (m :: * -> *).
Monad m -> (forall a. IO a -> m a) -> MonadIO m
forall (m :: * -> *). MonadIO m => Monad (TraceListC m)
forall (m :: * -> *) a. MonadIO m => IO a -> TraceListC m a
liftIO :: IO a -> TraceListC m a
$cliftIO :: forall (m :: * -> *) a. MonadIO m => IO a -> TraceListC m a
$cp1MonadIO :: forall (m :: * -> *). MonadIO m => Monad (TraceListC m)
MonadIO
             , Monad (TraceListC m)
e -> TraceListC m a
Monad (TraceListC m)
-> (forall e a. Exception e => e -> TraceListC m a)
-> MonadThrow (TraceListC m)
forall e a. Exception e => e -> TraceListC m a
forall (m :: * -> *).
Monad m -> (forall e a. Exception e => e -> m a) -> MonadThrow m
forall (m :: * -> *). MonadThrow m => Monad (TraceListC m)
forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> TraceListC m a
throwM :: e -> TraceListC m a
$cthrowM :: forall (m :: * -> *) e a.
(MonadThrow m, Exception e) =>
e -> TraceListC m a
$cp1MonadThrow :: forall (m :: * -> *). MonadThrow m => Monad (TraceListC m)
MonadThrow, MonadThrow (TraceListC m)
MonadThrow (TraceListC m)
-> (forall e a.
    Exception e =>
    TraceListC m a -> (e -> TraceListC m a) -> TraceListC m a)
-> MonadCatch (TraceListC m)
TraceListC m a -> (e -> TraceListC m a) -> TraceListC m a
forall e a.
Exception e =>
TraceListC m a -> (e -> TraceListC m a) -> TraceListC m a
forall (m :: * -> *).
MonadThrow m
-> (forall e a. Exception e => m a -> (e -> m a) -> m a)
-> MonadCatch m
forall (m :: * -> *). MonadCatch m => MonadThrow (TraceListC m)
forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
TraceListC m a -> (e -> TraceListC m a) -> TraceListC m a
catch :: TraceListC m a -> (e -> TraceListC m a) -> TraceListC m a
$ccatch :: forall (m :: * -> *) e a.
(MonadCatch m, Exception e) =>
TraceListC m a -> (e -> TraceListC m a) -> TraceListC m a
$cp1MonadCatch :: forall (m :: * -> *). MonadCatch m => MonadThrow (TraceListC m)
MonadCatch, MonadCatch (TraceListC m)
MonadCatch (TraceListC m)
-> (forall b.
    ((forall a. TraceListC m a -> TraceListC m a) -> TraceListC m b)
    -> TraceListC m b)
-> (forall b.
    ((forall a. TraceListC m a -> TraceListC m a) -> TraceListC m b)
    -> TraceListC m b)
-> (forall a b c.
    TraceListC m a
    -> (a -> ExitCase b -> TraceListC m c)
    -> (a -> TraceListC m b)
    -> TraceListC m (b, c))
-> MonadMask (TraceListC m)
TraceListC m a
-> (a -> ExitCase b -> TraceListC m c)
-> (a -> TraceListC m b)
-> TraceListC m (b, c)
((forall a. TraceListC m a -> TraceListC m a) -> TraceListC m b)
-> TraceListC m b
((forall a. TraceListC m a -> TraceListC m a) -> TraceListC m b)
-> TraceListC m b
forall b.
((forall a. TraceListC m a -> TraceListC m a) -> TraceListC m b)
-> TraceListC m b
forall a b c.
TraceListC m a
-> (a -> ExitCase b -> TraceListC m c)
-> (a -> TraceListC m b)
-> TraceListC m (b, c)
forall (m :: * -> *).
MonadCatch m
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall b. ((forall a. m a -> m a) -> m b) -> m b)
-> (forall a b c.
    m a -> (a -> ExitCase b -> m c) -> (a -> m b) -> m (b, c))
-> MonadMask m
forall (m :: * -> *). MonadMask m => MonadCatch (TraceListC m)
forall (m :: * -> *) b.
MonadMask m =>
((forall a. TraceListC m a -> TraceListC m a) -> TraceListC m b)
-> TraceListC m b
forall (m :: * -> *) a b c.
MonadMask m =>
TraceListC m a
-> (a -> ExitCase b -> TraceListC m c)
-> (a -> TraceListC m b)
-> TraceListC m (b, c)
generalBracket :: TraceListC m a
-> (a -> ExitCase b -> TraceListC m c)
-> (a -> TraceListC m b)
-> TraceListC m (b, c)
$cgeneralBracket :: forall (m :: * -> *) a b c.
MonadMask m =>
TraceListC m a
-> (a -> ExitCase b -> TraceListC m c)
-> (a -> TraceListC m b)
-> TraceListC m (b, c)
uninterruptibleMask :: ((forall a. TraceListC m a -> TraceListC m a) -> TraceListC m b)
-> TraceListC m b
$cuninterruptibleMask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. TraceListC m a -> TraceListC m a) -> TraceListC m b)
-> TraceListC m b
mask :: ((forall a. TraceListC m a -> TraceListC m a) -> TraceListC m b)
-> TraceListC m b
$cmask :: forall (m :: * -> *) b.
MonadMask m =>
((forall a. TraceListC m a -> TraceListC m a) -> TraceListC m b)
-> TraceListC m b
$cp1MonadMask :: forall (m :: * -> *). MonadMask m => MonadCatch (TraceListC m)
MonadMask
             , MonadBase b, MonadBaseControl b
             )
    deriving (m a -> TraceListC m a
(forall (m :: * -> *) a. Monad m => m a -> TraceListC m a)
-> MonadTrans TraceListC
forall (m :: * -> *) a. Monad m => m a -> TraceListC m a
forall (t :: Effect).
(forall (m :: * -> *) a. Monad m => m a -> t m a) -> MonadTrans t
lift :: m a -> TraceListC m a
$clift :: forall (m :: * -> *) a. Monad m => m a -> TraceListC m a
MonadTrans, MonadTrans TraceListC
m (StT TraceListC a) -> TraceListC m a
MonadTrans TraceListC
-> (forall (m :: * -> *) a.
    Monad m =>
    (Run TraceListC -> m a) -> TraceListC m a)
-> (forall (m :: * -> *) a.
    Monad m =>
    m (StT TraceListC a) -> TraceListC m a)
-> MonadTransControl TraceListC
(Run TraceListC -> m a) -> TraceListC m a
forall (m :: * -> *) a.
Monad m =>
m (StT TraceListC a) -> TraceListC m a
forall (m :: * -> *) a.
Monad m =>
(Run TraceListC -> m a) -> TraceListC m a
forall (t :: Effect).
MonadTrans t
-> (forall (m :: * -> *) a. Monad m => (Run t -> m a) -> t m a)
-> (forall (m :: * -> *) a. Monad m => m (StT t a) -> t m a)
-> MonadTransControl t
restoreT :: m (StT TraceListC a) -> TraceListC m a
$crestoreT :: forall (m :: * -> *) a.
Monad m =>
m (StT TraceListC a) -> TraceListC m a
liftWith :: (Run TraceListC -> m a) -> TraceListC m a
$cliftWith :: forall (m :: * -> *) a.
Monad m =>
(Run TraceListC -> m a) -> TraceListC m a
$cp1MonadTransControl :: MonadTrans TraceListC
MonadTransControl)
    via CompositionBaseT
     '[ TraceIntoTellC
      , TellListC String
      ]

deriving instance (Carrier m, Threads (CPS.WriterT (Dual [String])) (Prims m))
               => Carrier (TraceListC m)

-- | Run a 'Trace' effect purely by accumulating all 'trace'd strings
-- into a list.
runTraceList :: forall m a p
              . ( Threaders '[WriterThreads] m p
                , Carrier m
                )
             => TraceListC m a
             -> m ([String], a)
runTraceList :: TraceListC m a -> m ([String], a)
runTraceList =
     TellListC String m a -> m ([String], a)
forall o (m :: * -> *) a (p :: [Effect]).
(Carrier m, Threaders '[WriterThreads] m p) =>
TellListC o m a -> m ([o], a)
runTellList
  (TellListC String m a -> m ([String], a))
-> (TraceIntoTellC (TellListC String m) a -> TellListC String m a)
-> TraceIntoTellC (TellListC String m) a
-> m ([String], a)
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# TraceIntoTellC (TellListC String m) a -> TellListC String m a
forall (m :: * -> *) a.
HeadEff (Tell String) m =>
TraceIntoTellC m a -> m a
traceIntoTell
  (TraceIntoTellC (TellListC String m) a -> m ([String], a))
-> (TraceListC m a -> TraceIntoTellC (TellListC String m) a)
-> TraceListC m a
-> m ([String], a)
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# TraceListC m a -> TraceIntoTellC (TellListC String m) a
forall (m :: * -> *) a.
TraceListC m a -> TraceIntoTellC (TellListC String m) a
unTraceListC
{-# INLINE runTraceList #-}

data TracePrintingH

instance Eff (Embed IO) m
      => Handler TracePrintingH Trace m where
  effHandler :: Trace (Effly z) x -> Effly z x
effHandler (Trace String
str) = IO () -> Effly z ()
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO () -> Effly z ()) -> IO () -> Effly z ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
stderr String
str
  {-# INLINEABLE effHandler #-}

type TracePrintingC = InterpretC TracePrintingH Trace

-- | Run a 'Trace' effect by printing each 'trace'd string
-- to stderr.
runTracePrinting :: Eff (Embed IO) m
                 => TracePrintingC m a
                 -> m a
runTracePrinting :: TracePrintingC m a -> m a
runTracePrinting = TracePrintingC m a -> m a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
{-# INLINE runTracePrinting #-}

-- | Run 'Trace' effect by providing each 'trace'd string
-- to the provided 'Handle'.
--
-- This has a higher-rank type, as it makes use of 'InterpretReifiedC'.
-- __This makes 'runTraceToHandle' very difficult to use partially applied.__
-- __In particular, it can't be composed using @'.'@.__
--
-- If performance is secondary, consider using the slower 'runTraceToHandleSimple',
-- which doesn't have a higher-rank type.
runTraceToHandle :: Eff (Embed IO) m
                 => Handle
                 -> InterpretReifiedC Trace m a
                 -> m a
runTraceToHandle :: Handle -> InterpretReifiedC Trace m a -> m a
runTraceToHandle Handle
hdl = EffHandler Trace m -> InterpretReifiedC Trace m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(RepresentationalEff e, Carrier m) =>
EffHandler e m -> InterpretReifiedC e m a -> m a
interpret (EffHandler Trace m -> InterpretReifiedC Trace m a -> m a)
-> EffHandler Trace m -> InterpretReifiedC Trace m a -> m a
forall a b. (a -> b) -> a -> b
$ \case
  Trace str -> IO () -> Effly z ()
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO () -> Effly z ()) -> IO () -> Effly z ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
hdl String
str
{-# INLINE runTraceToHandle #-}

-- | Run 'Trace' effect by providing each 'trace'd string
-- to the provided 'Handle'.
--
-- This is a less performant version of 'runTraceToHandle' that doesn't have
-- a higher-rank type, making it much easier to use partially applied.
runTraceToHandleSimple :: forall m a p
                        . ( Eff (Embed IO) m
                          , Threaders '[ReaderThreads] m p
                          )
                       => Handle
                       -> InterpretSimpleC Trace m a
                       -> m a
runTraceToHandleSimple :: Handle -> InterpretSimpleC Trace m a -> m a
runTraceToHandleSimple Handle
hdl = EffHandler Trace m -> InterpretSimpleC Trace m a -> m a
forall (e :: Effect) (m :: * -> *) a (p :: [Effect]).
(RepresentationalEff e, Threaders '[ReaderThreads] m p,
 Carrier m) =>
EffHandler e m -> InterpretSimpleC e m a -> m a
interpretSimple (EffHandler Trace m -> InterpretSimpleC Trace m a -> m a)
-> EffHandler Trace m -> InterpretSimpleC Trace m a -> m a
forall a b. (a -> b) -> a -> b
$ \case
  Trace str -> IO () -> Effly z ()
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IO () -> Effly z ()) -> IO () -> Effly z ()
forall a b. (a -> b) -> a -> b
$ Handle -> String -> IO ()
hPutStrLn Handle
hdl String
str
{-# INLINE runTraceToHandleSimple #-}

-- | Run a 'Trace' effect by accumulating all 'trace'd strings
-- into a list using atomic operations in IO.
--
-- This has a higher-rank type, as it makes use of 'InterpretReifiedC'.
-- __This makes 'runTraceListIO' very difficult to use partially applied.__
-- __In particular, it can't be composed using @'.'@.__
--
-- If performance is secondary, consider using the slower 'runTraceListIOSimple',
-- which doesn't have a higher-rank type.
runTraceListIO :: Eff (Embed IO) m
               => InterpretReifiedC Trace m a
               -> m ([String], a)
runTraceListIO :: InterpretReifiedC Trace m a -> m ([String], a)
runTraceListIO InterpretReifiedC Trace m a
m = do
  IORef [String]
ref <- IO (IORef [String]) -> m (IORef [String])
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed ([String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef [])
  a
a   <- (EffHandler Trace m -> InterpretReifiedC Trace m a -> m a
forall (e :: Effect) (m :: * -> *) a.
(RepresentationalEff e, Carrier m) =>
EffHandler e m -> InterpretReifiedC e m a -> m a
`interpret` InterpretReifiedC Trace m a
m) (EffHandler Trace m -> m a) -> EffHandler Trace m -> m a
forall a b. (a -> b) -> a -> b
$ \case
    Trace o -> IO () -> Effly z ()
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IORef [String] -> ([String] -> ([String], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [String]
ref (\[String]
s -> (String
oString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
s, ())))
  [String]
s   <- [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> m [String] -> m [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String] -> m [String]
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IORef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef IORef [String]
ref)
  ([String], a) -> m ([String], a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
s, a
a)
{-# INLINE runTraceListIO #-}


-- | Run a 'Trace' effect by accumulating all 'trace'd strings
-- into a list using atomic operations in IO.
--
-- This is a less performant version of 'runTraceListIOSimple' that doesn't have
-- a higher-rank type, making it much easier to use partially applied.
runTraceListIOSimple :: forall m a p
                      . ( Eff (Embed IO) m
                        , Threaders '[ReaderThreads] m p
                        )
                     => InterpretSimpleC Trace m a
                     -> m ([String], a)
runTraceListIOSimple :: InterpretSimpleC Trace m a -> m ([String], a)
runTraceListIOSimple InterpretSimpleC Trace m a
m = do
  IORef [String]
ref <- IO (IORef [String]) -> m (IORef [String])
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed ([String] -> IO (IORef [String])
forall a. a -> IO (IORef a)
newIORef [])
  a
a   <- (EffHandler Trace m -> InterpretSimpleC Trace m a -> m a
forall (e :: Effect) (m :: * -> *) a (p :: [Effect]).
(RepresentationalEff e, Threaders '[ReaderThreads] m p,
 Carrier m) =>
EffHandler e m -> InterpretSimpleC e m a -> m a
`interpretSimple` InterpretSimpleC Trace m a
m) (EffHandler Trace m -> m a) -> EffHandler Trace m -> m a
forall a b. (a -> b) -> a -> b
$ \case
    Trace String
o -> IO () -> Effly z ()
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IORef [String] -> ([String] -> ([String], ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef [String]
ref (\[String]
s -> (String
oString -> [String] -> [String]
forall a. a -> [a] -> [a]
:[String]
s, ())))
  [String]
s   <- [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> [String]) -> m [String] -> m [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [String] -> m [String]
forall (b :: * -> *) (m :: * -> *) a. Eff (Embed b) m => b a -> m a
embed (IORef [String] -> IO [String]
forall a. IORef a -> IO a
readIORef IORef [String]
ref)
  ([String], a) -> m ([String], a)
forall (m :: * -> *) a. Monad m => a -> m a
return ([String]
s, a
a)
{-# INLINE runTraceListIOSimple #-}

data IgnoreTraceH

instance Carrier m
      => Handler IgnoreTraceH Trace m where
  effHandler :: Trace (Effly z) x -> Effly z x
effHandler (Trace String
_) = () -> Effly z ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  {-# INLINEABLE effHandler #-}

type IgnoreTraceC = InterpretC IgnoreTraceH Trace

-- | Run a 'Trace' effect by ignoring it, doing no logging at all.
ignoreTrace :: Carrier m
            => IgnoreTraceC m a
            -> m a
ignoreTrace :: IgnoreTraceC m a -> m a
ignoreTrace = IgnoreTraceC m a -> m a
forall h (e :: Effect) (m :: * -> *) a.
Handler h e m =>
InterpretC h e m a -> m a
interpretViaHandler
{-# INLINE ignoreTrace #-}

data TraceToTellH

instance Eff (Tell String) m
      => Handler TraceToTellH Trace m where
  effHandler :: Trace (Effly z) x -> Effly z x
effHandler (Trace String
str) = String -> Effly z ()
forall o (m :: * -> *). Eff (Tell o) m => o -> m ()
tell String
str
  {-# INLINEABLE effHandler #-}

type TraceIntoTellC = ReinterpretC TraceToTellH Trace '[Tell String]

-- | Rewrite a 'Trace' effect into a @'Tell' String@ effect on top of the
-- effect stack.
traceIntoTell :: HeadEff (Tell String) m
              => TraceIntoTellC m a
              -> m a
traceIntoTell :: TraceIntoTellC m a -> m a
traceIntoTell = TraceIntoTellC m a -> m a
forall h (e :: Effect) (new :: [Effect]) (m :: * -> *) a.
(Handler h e m, KnownList new, HeadEffs new m) =>
ReinterpretC h e new m a -> m a
reinterpretViaHandler
{-# INLINE traceIntoTell #-}