{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

-- | Provides an 'InterpretC' carrier capable of interpreting an arbitrary effect using a passed-in higher order function to interpret that effect. This is suitable for prototyping new effects quickly.

module Control.Carrier.Interpret
( -- * Interpret carrier
  runInterpret
, runInterpretState
, InterpretC(InterpretC)
, Reifies
, Interpreter
  -- * Re-exports
, Algebra
, Has
, run
) where

import Control.Algebra
import Control.Applicative (Alternative)
import Control.Carrier.State.Strict
import Control.Monad (MonadPlus)
import Control.Monad.Fail as Fail
import Control.Monad.Fix
import Control.Monad.IO.Class
import Control.Monad.Trans.Class
import Control.Monad.IO.Unlift (MonadUnliftIO)
import Data.Functor.Const (Const(..))
import Data.Kind (Type)
import Unsafe.Coerce (unsafeCoerce)

-- | An @Interpreter@ is a function that interprets effects described by @sig@ into the carrier monad @m@.
newtype Interpreter sig m = Interpreter
  { forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Interpreter sig m
-> forall (ctx :: * -> *) (n :: * -> *) s x.
   Functor ctx =>
   Handler ctx n (InterpretC s sig m)
   -> sig n x -> ctx () -> InterpretC s sig m (ctx x)
runInterpreter :: forall ctx n s x . Functor ctx => Handler ctx n (InterpretC s sig m) -> sig n x -> ctx () -> InterpretC s sig m (ctx x) }


class Reifies s a | s -> a where
  reflect :: Const a s


data Skolem

-- | @Magic@ captures the GHC implementation detail of how single method type classes are implemented.
newtype Magic a r = Magic (Reifies Skolem a => Const r Skolem)

-- For more information on this technique, see the @reflection@ library. We use the formulation described in https://github.com/ekmett/reflection/issues/31 for better inlining.
--
-- Essentially we can view @k@ as internally a function of type @Reifies s a -> Tagged s r@, which we can again view as just @a -> Tagged s r@ through @unsafeCoerce@. After this coercion, we just apply the function to @a@.
reify :: a -> (forall s . Reifies s a => Const r s) -> r
reify :: forall a r. a -> (forall s. Reifies s a => Const r s) -> r
reify a
a forall s. Reifies s a => Const r s
k = Magic a r -> a -> r
forall a b. a -> b
unsafeCoerce ((Reifies Skolem a => Const r Skolem) -> Magic a r
forall a r. (Reifies Skolem a => Const r Skolem) -> Magic a r
Magic Const r Skolem
Reifies Skolem a => Const r Skolem
forall s. Reifies s a => Const r s
k) a
a


-- | Interpret an effect using a higher-order function.
--
-- Note that due to the higher-rank type, you have to use either '$' or explicit application when applying this interpreter. That is, you will need to write @runInterpret f (runInterpret g myPrgram)@ or @runInterpret f $ runInterpret g $ myProgram@. If you try and write @runInterpret f . runInterpret g@, you will unfortunately get a rather scary type error!
--
-- @since 1.0.0.0
runInterpret
  :: (forall ctx n x . Functor ctx => Handler ctx n m -> eff n x -> ctx () -> m (ctx x))
  -> (forall s . Reifies s (Interpreter eff m) => InterpretC s eff m a)
  -> m a
runInterpret :: forall (m :: * -> *) (eff :: (* -> *) -> * -> *) a.
(forall (ctx :: * -> *) (n :: * -> *) x.
 Functor ctx =>
 Handler ctx n m -> eff n x -> ctx () -> m (ctx x))
-> (forall s.
    Reifies s (Interpreter eff m) =>
    InterpretC s eff m a)
-> m a
runInterpret forall (ctx :: * -> *) (n :: * -> *) x.
Functor ctx =>
Handler ctx n m -> eff n x -> ctx () -> m (ctx x)
f forall s. Reifies s (Interpreter eff m) => InterpretC s eff m a
m = Interpreter eff m
-> (forall s. Reifies s (Interpreter eff m) => Const (m a) s)
-> m a
forall a r. a -> (forall s. Reifies s a => Const r s) -> r
reify ((forall (ctx :: * -> *) (n :: * -> *) s x.
 Functor ctx =>
 Handler ctx n (InterpretC s eff m)
 -> eff n x -> ctx () -> InterpretC s eff m (ctx x))
-> Interpreter eff m
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(forall (ctx :: * -> *) (n :: * -> *) s x.
 Functor ctx =>
 Handler ctx n (InterpretC s sig m)
 -> sig n x -> ctx () -> InterpretC s sig m (ctx x))
-> Interpreter sig m
Interpreter (\ Handler ctx n (InterpretC s eff m)
hdl eff n x
sig -> m (ctx x) -> InterpretC s eff m (ctx x)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
m a -> InterpretC s sig m a
InterpretC (m (ctx x) -> InterpretC s eff m (ctx x))
-> (ctx () -> m (ctx x)) -> ctx () -> InterpretC s eff m (ctx x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler ctx n m -> eff n x -> ctx () -> m (ctx x)
forall (ctx :: * -> *) (n :: * -> *) x.
Functor ctx =>
Handler ctx n m -> eff n x -> ctx () -> m (ctx x)
f (InterpretC s eff m (ctx x) -> m (ctx x)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
InterpretC s sig m a -> m a
runInterpretC (InterpretC s eff m (ctx x) -> m (ctx x))
-> (ctx (n x) -> InterpretC s eff m (ctx x))
-> ctx (n x)
-> m (ctx x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ctx (n x) -> InterpretC s eff m (ctx x)
Handler ctx n (InterpretC s eff m)
hdl) eff n x
sig)) (InterpretC s eff m a -> Const (m a) s
forall s (eff :: (* -> *) -> * -> *) (m :: * -> *) x.
InterpretC s eff m x -> Const (m x) s
go InterpretC s eff m a
forall s. Reifies s (Interpreter eff m) => InterpretC s eff m a
m) where
  go :: InterpretC s eff m x -> Const (m x) s
  go :: forall s (eff :: (* -> *) -> * -> *) (m :: * -> *) x.
InterpretC s eff m x -> Const (m x) s
go (InterpretC m x
m) = m x -> Const (m x) s
forall {k} a (b :: k). a -> Const a b
Const m x
m
{-# INLINE runInterpret #-}

-- | Interpret an effect using a higher-order function with some state variable.
--
-- @since 1.0.0.0
runInterpretState
  :: (forall ctx n x . Functor ctx => Handler ctx n (StateC s m) -> eff n x -> s -> ctx () -> m (s, ctx x))
  -> s
  -> (forall t . Reifies t (Interpreter eff (StateC s m)) => InterpretC t eff (StateC s m) a)
  -> m (s, a)
runInterpretState :: forall s (m :: * -> *) (eff :: (* -> *) -> * -> *) a.
(forall (ctx :: * -> *) (n :: * -> *) x.
 Functor ctx =>
 Handler ctx n (StateC s m)
 -> eff n x -> s -> ctx () -> m (s, ctx x))
-> s
-> (forall t.
    Reifies t (Interpreter eff (StateC s m)) =>
    InterpretC t eff (StateC s m) a)
-> m (s, a)
runInterpretState forall (ctx :: * -> *) (n :: * -> *) x.
Functor ctx =>
Handler ctx n (StateC s m)
-> eff n x -> s -> ctx () -> m (s, ctx x)
handler s
state forall t.
Reifies t (Interpreter eff (StateC s m)) =>
InterpretC t eff (StateC s m) a
m
  = s -> StateC s m a -> m (s, a)
forall s (m :: * -> *) a. s -> StateC s m a -> m (s, a)
runState s
state
  (StateC s m a -> m (s, a)) -> StateC s m a -> m (s, a)
forall a b. (a -> b) -> a -> b
$ (forall (ctx :: * -> *) (n :: * -> *) x.
 Functor ctx =>
 Handler ctx n (StateC s m)
 -> eff n x -> ctx () -> StateC s m (ctx x))
-> (forall t.
    Reifies t (Interpreter eff (StateC s m)) =>
    InterpretC t eff (StateC s m) a)
-> StateC s m a
forall (m :: * -> *) (eff :: (* -> *) -> * -> *) a.
(forall (ctx :: * -> *) (n :: * -> *) x.
 Functor ctx =>
 Handler ctx n m -> eff n x -> ctx () -> m (ctx x))
-> (forall s.
    Reifies s (Interpreter eff m) =>
    InterpretC s eff m a)
-> m a
runInterpret (\ Handler ctx n (StateC s m)
hdl eff n x
sig ctx ()
ctx -> (s -> m (s, ctx x)) -> StateC s m (ctx x)
forall s (m :: * -> *) a. (s -> m (s, a)) -> StateC s m a
StateC ((s -> ctx () -> m (s, ctx x)) -> ctx () -> s -> m (s, ctx x)
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Handler ctx n (StateC s m)
-> eff n x -> s -> ctx () -> m (s, ctx x)
forall (ctx :: * -> *) (n :: * -> *) x.
Functor ctx =>
Handler ctx n (StateC s m)
-> eff n x -> s -> ctx () -> m (s, ctx x)
handler ctx (n x) -> StateC s m (ctx x)
Handler ctx n (StateC s m)
hdl eff n x
sig) ctx ()
ctx)) InterpretC s eff (StateC s m) a
forall t.
Reifies t (Interpreter eff (StateC s m)) =>
InterpretC t eff (StateC s m) a
m
{-# INLINE runInterpretState #-}

-- | @since 1.0.0.0
newtype InterpretC s (sig :: (Type -> Type) -> (Type -> Type)) m a = InterpretC { forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
InterpretC s sig m a -> m a
runInterpretC :: m a }
  deriving (Applicative (InterpretC s sig m)
Applicative (InterpretC s sig m) =>
(forall a. InterpretC s sig m a)
-> (forall a.
    InterpretC s sig m a
    -> InterpretC s sig m a -> InterpretC s sig m a)
-> (forall a. InterpretC s sig m a -> InterpretC s sig m [a])
-> (forall a. InterpretC s sig m a -> InterpretC s sig m [a])
-> Alternative (InterpretC s sig m)
forall a. InterpretC s sig m a
forall a. InterpretC s sig m a -> InterpretC s sig m [a]
forall a.
InterpretC s sig m a
-> InterpretC s sig m a -> InterpretC s sig m a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Alternative m =>
Applicative (InterpretC s sig m)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
InterpretC s sig m a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
InterpretC s sig m a -> InterpretC s sig m [a]
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
InterpretC s sig m a
-> InterpretC s sig m a -> InterpretC s sig 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
$cempty :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
InterpretC s sig m a
empty :: forall a. InterpretC s sig m a
$c<|> :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
InterpretC s sig m a
-> InterpretC s sig m a -> InterpretC s sig m a
<|> :: forall a.
InterpretC s sig m a
-> InterpretC s sig m a -> InterpretC s sig m a
$csome :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
InterpretC s sig m a -> InterpretC s sig m [a]
some :: forall a. InterpretC s sig m a -> InterpretC s sig m [a]
$cmany :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Alternative m =>
InterpretC s sig m a -> InterpretC s sig m [a]
many :: forall a. InterpretC s sig m a -> InterpretC s sig m [a]
Alternative, Functor (InterpretC s sig m)
Functor (InterpretC s sig m) =>
(forall a. a -> InterpretC s sig m a)
-> (forall a b.
    InterpretC s sig m (a -> b)
    -> InterpretC s sig m a -> InterpretC s sig m b)
-> (forall a b c.
    (a -> b -> c)
    -> InterpretC s sig m a
    -> InterpretC s sig m b
    -> InterpretC s sig m c)
-> (forall a b.
    InterpretC s sig m a
    -> InterpretC s sig m b -> InterpretC s sig m b)
-> (forall a b.
    InterpretC s sig m a
    -> InterpretC s sig m b -> InterpretC s sig m a)
-> Applicative (InterpretC s sig m)
forall a. a -> InterpretC s sig m a
forall a b.
InterpretC s sig m a
-> InterpretC s sig m b -> InterpretC s sig m a
forall a b.
InterpretC s sig m a
-> InterpretC s sig m b -> InterpretC s sig m b
forall a b.
InterpretC s sig m (a -> b)
-> InterpretC s sig m a -> InterpretC s sig m b
forall a b c.
(a -> b -> c)
-> InterpretC s sig m a
-> InterpretC s sig m b
-> InterpretC s sig m c
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Applicative m =>
Functor (InterpretC s sig m)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative m =>
a -> InterpretC s sig m a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative m =>
InterpretC s sig m a
-> InterpretC s sig m b -> InterpretC s sig m a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative m =>
InterpretC s sig m a
-> InterpretC s sig m b -> InterpretC s sig m b
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative m =>
InterpretC s sig m (a -> b)
-> InterpretC s sig m a -> InterpretC s sig m b
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> InterpretC s sig m a
-> InterpretC s sig m b
-> InterpretC s sig 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
$cpure :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Applicative m =>
a -> InterpretC s sig m a
pure :: forall a. a -> InterpretC s sig m a
$c<*> :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative m =>
InterpretC s sig m (a -> b)
-> InterpretC s sig m a -> InterpretC s sig m b
<*> :: forall a b.
InterpretC s sig m (a -> b)
-> InterpretC s sig m a -> InterpretC s sig m b
$cliftA2 :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b c.
Applicative m =>
(a -> b -> c)
-> InterpretC s sig m a
-> InterpretC s sig m b
-> InterpretC s sig m c
liftA2 :: forall a b c.
(a -> b -> c)
-> InterpretC s sig m a
-> InterpretC s sig m b
-> InterpretC s sig m c
$c*> :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative m =>
InterpretC s sig m a
-> InterpretC s sig m b -> InterpretC s sig m b
*> :: forall a b.
InterpretC s sig m a
-> InterpretC s sig m b -> InterpretC s sig m b
$c<* :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Applicative m =>
InterpretC s sig m a
-> InterpretC s sig m b -> InterpretC s sig m a
<* :: forall a b.
InterpretC s sig m a
-> InterpretC s sig m b -> InterpretC s sig m a
Applicative, (forall a b.
 (a -> b) -> InterpretC s sig m a -> InterpretC s sig m b)
-> (forall a b. a -> InterpretC s sig m b -> InterpretC s sig m a)
-> Functor (InterpretC s sig m)
forall a b. a -> InterpretC s sig m b -> InterpretC s sig m a
forall a b.
(a -> b) -> InterpretC s sig m a -> InterpretC s sig m b
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor m =>
a -> InterpretC s sig m b -> InterpretC s sig m a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> InterpretC s sig m a -> InterpretC s sig m b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor m =>
(a -> b) -> InterpretC s sig m a -> InterpretC s sig m b
fmap :: forall a b.
(a -> b) -> InterpretC s sig m a -> InterpretC s sig m b
$c<$ :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Functor m =>
a -> InterpretC s sig m b -> InterpretC s sig m a
<$ :: forall a b. a -> InterpretC s sig m b -> InterpretC s sig m a
Functor, Applicative (InterpretC s sig m)
Applicative (InterpretC s sig m) =>
(forall a b.
 InterpretC s sig m a
 -> (a -> InterpretC s sig m b) -> InterpretC s sig m b)
-> (forall a b.
    InterpretC s sig m a
    -> InterpretC s sig m b -> InterpretC s sig m b)
-> (forall a. a -> InterpretC s sig m a)
-> Monad (InterpretC s sig m)
forall a. a -> InterpretC s sig m a
forall a b.
InterpretC s sig m a
-> InterpretC s sig m b -> InterpretC s sig m b
forall a b.
InterpretC s sig m a
-> (a -> InterpretC s sig m b) -> InterpretC s sig m b
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
Monad m =>
Applicative (InterpretC s sig m)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad m =>
a -> InterpretC s sig m a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad m =>
InterpretC s sig m a
-> InterpretC s sig m b -> InterpretC s sig m b
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad m =>
InterpretC s sig m a
-> (a -> InterpretC s sig m b) -> InterpretC s sig 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
$c>>= :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad m =>
InterpretC s sig m a
-> (a -> InterpretC s sig m b) -> InterpretC s sig m b
>>= :: forall a b.
InterpretC s sig m a
-> (a -> InterpretC s sig m b) -> InterpretC s sig m b
$c>> :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a b.
Monad m =>
InterpretC s sig m a
-> InterpretC s sig m b -> InterpretC s sig m b
>> :: forall a b.
InterpretC s sig m a
-> InterpretC s sig m b -> InterpretC s sig m b
$creturn :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Monad m =>
a -> InterpretC s sig m a
return :: forall a. a -> InterpretC s sig m a
Monad, Monad (InterpretC s sig m)
Monad (InterpretC s sig m) =>
(forall a. String -> InterpretC s sig m a)
-> MonadFail (InterpretC s sig m)
forall a. String -> InterpretC s sig m a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
MonadFail m =>
Monad (InterpretC s sig m)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadFail m =>
String -> InterpretC s sig m a
forall (m :: * -> *).
Monad m =>
(forall a. String -> m a) -> MonadFail m
$cfail :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadFail m =>
String -> InterpretC s sig m a
fail :: forall a. String -> InterpretC s sig m a
Fail.MonadFail, Monad (InterpretC s sig m)
Monad (InterpretC s sig m) =>
(forall a. (a -> InterpretC s sig m a) -> InterpretC s sig m a)
-> MonadFix (InterpretC s sig m)
forall a. (a -> InterpretC s sig m a) -> InterpretC s sig m a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
MonadFix m =>
Monad (InterpretC s sig m)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadFix m =>
(a -> InterpretC s sig m a) -> InterpretC s sig m a
forall (m :: * -> *).
Monad m =>
(forall a. (a -> m a) -> m a) -> MonadFix m
$cmfix :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadFix m =>
(a -> InterpretC s sig m a) -> InterpretC s sig m a
mfix :: forall a. (a -> InterpretC s sig m a) -> InterpretC s sig m a
MonadFix, Monad (InterpretC s sig m)
Monad (InterpretC s sig m) =>
(forall a. IO a -> InterpretC s sig m a)
-> MonadIO (InterpretC s sig m)
forall a. IO a -> InterpretC s sig m a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
MonadIO m =>
Monad (InterpretC s sig m)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> InterpretC s sig m a
forall (m :: * -> *).
Monad m =>
(forall a. IO a -> m a) -> MonadIO m
$cliftIO :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadIO m =>
IO a -> InterpretC s sig m a
liftIO :: forall a. IO a -> InterpretC s sig m a
MonadIO, Monad (InterpretC s sig m)
Alternative (InterpretC s sig m)
(Alternative (InterpretC s sig m), Monad (InterpretC s sig m)) =>
(forall a. InterpretC s sig m a)
-> (forall a.
    InterpretC s sig m a
    -> InterpretC s sig m a -> InterpretC s sig m a)
-> MonadPlus (InterpretC s sig m)
forall a. InterpretC s sig m a
forall a.
InterpretC s sig m a
-> InterpretC s sig m a -> InterpretC s sig m a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
MonadPlus m =>
Monad (InterpretC s sig m)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
MonadPlus m =>
Alternative (InterpretC s sig m)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadPlus m =>
InterpretC s sig m a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadPlus m =>
InterpretC s sig m a
-> InterpretC s sig m a -> InterpretC s sig m a
forall (m :: * -> *).
(Alternative m, Monad m) =>
(forall a. m a) -> (forall a. m a -> m a -> m a) -> MonadPlus m
$cmzero :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadPlus m =>
InterpretC s sig m a
mzero :: forall a. InterpretC s sig m a
$cmplus :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
MonadPlus m =>
InterpretC s sig m a
-> InterpretC s sig m a -> InterpretC s sig m a
mplus :: forall a.
InterpretC s sig m a
-> InterpretC s sig m a -> InterpretC s sig m a
MonadPlus, MonadIO (InterpretC s sig m)
MonadIO (InterpretC s sig m) =>
(forall b.
 ((forall a. InterpretC s sig m a -> IO a) -> IO b)
 -> InterpretC s sig m b)
-> MonadUnliftIO (InterpretC s sig m)
forall b.
((forall a. InterpretC s sig m a -> IO a) -> IO b)
-> InterpretC s sig m b
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *).
MonadUnliftIO m =>
MonadIO (InterpretC s sig m)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. InterpretC s sig m a -> IO a) -> IO b)
-> InterpretC s sig m b
forall (m :: * -> *).
MonadIO m =>
(forall b. ((forall a. m a -> IO a) -> IO b) -> m b)
-> MonadUnliftIO m
$cwithRunInIO :: forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) b.
MonadUnliftIO m =>
((forall a. InterpretC s sig m a -> IO a) -> IO b)
-> InterpretC s sig m b
withRunInIO :: forall b.
((forall a. InterpretC s sig m a -> IO a) -> IO b)
-> InterpretC s sig m b
MonadUnliftIO)

instance MonadTrans (InterpretC s sig) where
  lift :: forall (m :: * -> *) a. Monad m => m a -> InterpretC s sig m a
lift = m a -> InterpretC s sig m a
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
m a -> InterpretC s sig m a
InterpretC
  {-# INLINE lift #-}

instance (Reifies s (Interpreter eff m), Algebra sig m) => Algebra (eff :+: sig) (InterpretC s eff m) where
  alg :: forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n (InterpretC s eff m)
-> (:+:) eff sig n a -> ctx () -> InterpretC s eff m (ctx a)
alg Handler ctx n (InterpretC s eff m)
hdl = \case
    L eff n a
eff   -> Interpreter eff m
-> forall (ctx :: * -> *) (n :: * -> *) s x.
   Functor ctx =>
   Handler ctx n (InterpretC s eff m)
   -> eff n x -> ctx () -> InterpretC s eff m (ctx x)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
Interpreter sig m
-> forall (ctx :: * -> *) (n :: * -> *) s x.
   Functor ctx =>
   Handler ctx n (InterpretC s sig m)
   -> sig n x -> ctx () -> InterpretC s sig m (ctx x)
runInterpreter (Const (Interpreter eff m) s -> Interpreter eff m
forall {k} a (b :: k). Const a b -> a
getConst (forall s a. Reifies s a => Const a s
reflect @s)) ctx (n x) -> InterpretC s eff m (ctx x)
Handler ctx n (InterpretC s eff m)
hdl eff n a
eff
    R sig n a
other -> m (ctx a) -> InterpretC s eff m (ctx a)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
m a -> InterpretC s sig m a
InterpretC (m (ctx a) -> InterpretC s eff m (ctx a))
-> (ctx () -> m (ctx a)) -> ctx () -> InterpretC s eff m (ctx a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
forall (ctx :: * -> *) (n :: * -> *) a.
Functor ctx =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) (ctx :: * -> *)
       (n :: * -> *) a.
(Algebra sig m, Functor ctx) =>
Handler ctx n m -> sig n a -> ctx () -> m (ctx a)
alg (InterpretC s eff m (ctx x) -> m (ctx x)
forall s (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
InterpretC s sig m a -> m a
runInterpretC (InterpretC s eff m (ctx x) -> m (ctx x))
-> (ctx (n x) -> InterpretC s eff m (ctx x))
-> ctx (n x)
-> m (ctx x)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ctx (n x) -> InterpretC s eff m (ctx x)
Handler ctx n (InterpretC s eff m)
hdl) sig n a
other
  {-# INLINE alg #-}