{-# LANGUAGE DerivingVia #-}
{-# OPTIONS_HADDOCK not-home #-}
module Control.Effect.Internal where

import Data.Coerce
import Data.Kind (Constraint)

import Data.Functor.Identity
import Data.Monoid
import Control.Monad.Trans
import Control.Monad.Trans.Identity
import Control.Effect.Internal.Membership
import Control.Effect.Internal.Union
import Control.Effect.Internal.Utils
import Control.Effect.Internal.Derive
import Control.Effect.Internal.Itself

-- | The class of effect carriers, and the underlying mechanism with which
-- effects are implemented.
--
-- Each carrier is able to implement a number of /derived/ effects,
-- and /primitive/ effects. Users usually only interact with derived
-- effects, as these determine the effects that users have access to.
--
-- The standard interpretation tools are typically powerful enough to
-- let you avoid making instances of this class directly. If you need to make
-- your own instance of 'Carrier', import "Control.Effect.Carrier" and consult the
-- [wiki](https://github.com/KingoftheHomeless/in-other-words/wiki/Advanced-topics#novel-carriers).
class Monad m => Carrier m where
  -- | The derived effects that @m@ carries. Each derived effect is eventually
  -- reformulated into terms of the primitive effects @'Prims' m@ or other
  -- effects in @'Derivs' m@.
  --
  -- In application code, you gain access to effects by placing membership
  -- constraints upon @'Derivs' m@. You can use 'Eff' or 'Effs' for this
  -- purpose.
  --
  -- Although rarely relevant for users, @'Derivs' m@ can also contain effects
  -- that aren't expressed in terms of other effects, as longs as the handlers
  -- for those effects can be lifted generically using 'lift'. Such effects don't
  -- need to be part of @'Prims' m@, which is exclusively for primitive effects
  -- whose handlers need special treatment to be lifted.
  --
  -- For example, first order effects such as 'Control.Effect.State.State'
  -- never need to be part of @'Prims' m@. Certain higher-order effects -
  -- such as 'Control.Effect.Cont.Cont' - can also be handled such that they
  -- never need to be primitive.
  type Derivs m :: [Effect]

  -- | The primitive effects that @m@ carries. These are higher-order effects
  -- whose handlers aren't expressed in terms of other effects, and thus need to
  -- be lifted on a carrier-by-carrier basis.
  --
  -- __Never place membership constraints on @'Prims' m@.__
  -- You should only gain access to effects by placing membership constraints
  -- on @'Derivs' m@.
  --
  -- /However/, running interpreters may place other kinds of constraints upon
  -- @'Prims' m@, namely /threading constraints/, marked by the use of
  -- 'Threaders'.
  -- If you want to run such an effect interpreter inside application code, you
  -- have to propagate such threading constraints through your application.
  --
  -- @'Prims' m@ should only contain higher-order effects that can't be lifted
  -- generically using 'lift'. Any other effects can be placed in @'Derivs' m@.
  type Prims  m :: [Effect]

  -- | An @m@-based 'Algebra' (i.e effect handler) over the union
  -- of the primitive effects:
  -- effects that aren't formulated in terms of other effects.
  -- See 'Prims'.
  algPrims :: Algebra' (Prims m) m a

  -- | Any 'Carrier' @m@ must provide a way to describe the derived effects it
  -- carries in terms of the primitive effects.
  --
  -- 'reformulate' is that decription: given any monad @z@ such that
  -- @z@ lifts @m@, then a @z@-based 'Algebra' (i.e. effect handler)
  -- over the derived effects can be created out of a @z@-based 'Algebra' over
  -- the primitive effects.
  reformulate :: Monad z
              => Reformulation' (Derivs m) (Prims m) m z a

  -- | An @m@-based algebra (i.e. effect handler) over the union of derived
  -- effects (see @'Derivs' m@).
  --
  -- This is what 'send' makes use of.
  --
  -- 'algDerivs' is subject to the law:
  --
  -- @
  -- algDerivs = 'reformulate' id 'algPrims'
  -- @
  --
  -- which serves as the default implementation.
  algDerivs :: Algebra' (Derivs m) m a
  algDerivs = Reformulation' (Derivs m) (Prims m) m m a
forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs m) (Prims m) m z a
reformulate forall a. a -> a
forall x. m x -> m x
id forall x. Algebra' (Prims m) m x
forall (m :: * -> *) x. Carrier m => Algebra' (Prims m) m x
algPrims
  {-# INLINE algDerivs #-}

deriving newtype instance Carrier m => Carrier (Alt m)
deriving newtype instance Carrier m => Carrier (Ap m)

-- | (Morally) a type synonym for
-- @('Member' e ('Derivs' m), 'Carrier' m)@.
-- This and 'Effs' are the typical methods to gain
-- access to effects.
--
-- Unlike 'Member', 'Eff' gives 'Bundle' special treatment.
-- As a side-effect, 'Eff' will get stuck if @e@ is a type variable.
--
-- If you need access to some completely polymorphic effect @e@,
-- use @('Member' e ('Derivs' m), 'Carrier' m)@ instead of @Eff e m@.
type Eff e m = Effs '[e] m

-- | A variant of 'Eff' that takes a list of effects, and expands them into
-- multiple 'Member' constraints on @'Derivs' m@.
-- This and 'Eff' are the typical methods to gain access to effects.
--
-- Like 'Eff', 'Effs' gives 'Bundle' special treatment.
-- As a side-effect, 'Effs' will get stuck if any element of the list
-- is a type variable.
--
-- If you need access to some completetely polymorphic effect @e@,
-- use a separate @'Member' e ('Derivs' m)@ constraint.
type Effs es m = (EffMembers es (Derivs m), Carrier m)


-- | Perform an action of an effect.
--
-- 'send' should be used to create actions of your own effects.
-- For example:
--
-- @
-- data CheckString :: Effect where
--   CheckString :: String -> CheckString m Bool
--
-- checkString :: Eff CheckString m => String -> m Bool
-- checkString str = send (CheckString str)
-- @
--
send :: (Member e (Derivs m), Carrier m) => e m a -> m a
send :: e m a -> m a
send = Union (Derivs m) m a -> m a
forall (m :: * -> *) a. Carrier m => Algebra' (Derivs m) m a
algDerivs (Union (Derivs m) m a -> m a)
-> (e m a -> Union (Derivs m) m a) -> e m a -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. e m a -> Union (Derivs m) m a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Member e r =>
e m a -> Union r m a
inj
{-# INLINE send #-}

deriving via (m :: * -> *) instance Carrier m => Carrier (IdentityT m)

-- | A constraint that @'Prims' m@ satisfies all the constraints in the list
-- @cs@.
--
-- This is used for /threading constraints/.
--
-- Every interpreter that relies on an underlying
-- non-trivial monad transformer -- such as 'Control.Effect.State.runState',
-- which uses 'Control.Monad.Trans.State.Strict.StateT' internally --
-- must be able to lift all primitive effect handlers of the monad it's transforming
-- so that the resulting transformed monad can also handle the primitive effects.
--
-- The ability of a monad transformer to lift handlers of a particular
-- primitive effect is called /threading/ that effect. /Threading constraints/
-- correspond to the requirement that the primitive effects of the monad that's
-- being transformed can be thread by certain monad transformers.
--
-- For example, the 'Control.Effect.State.runState' places the threading
-- constraint 'Control.Effect.State.StateThreads' on @'Prims' m@, so that
-- @'Control.Effect.State.StateC' s m@ can carry all primitive effects that
-- @m@ does.
--
-- 'Threaders' is used to handle threading constraints.
-- @'Threaders' '['Control.Effect.State.StateThreads', 'Control.Effect.Error.ExceptThreads'] m p@
-- allows you to use 'Control.Effect.State.runState' and
-- 'Control.Effect.Error.runError' with the carrier @m@.
--
-- Sometimes, you may want to have a local effect which you interpret
-- inside of application code, such as a local 'Control.Effect.State.State'
-- or 'Control.Effect.Error.Error' effect. In such cases, /try to use/
-- [split interpretation](https://github.com/KingoftheHomeless/in-other-words/wiki/Advanced-Topics#abstract-effect-interpretation) /instead of using interpreters with threading constraints/
-- /inside of application code./ If you can't, then using 'Threaders'
-- is necessary to propagate the threading constraints
-- throughout the application.
--
-- __The third argument @p@ should always be a polymorphic type variable, which__
-- __you can simply provide and ignore.__
-- It exists as a work-around to the fact that many threading constraints
-- /don't actually work/ if they operate on @'Prims' m@ directly, since
-- threading constraints often involve quantified constraints, which are fragile
-- in combination with type families -- like 'Prims'.
--
-- So @'Threaders' '['Control.Effect.State.StateThreads'] m p@
-- doesn't expand to @'Control.Effect.State.StateThreads' ('Prims' m)@, but rather,
-- @(p ~ 'Prims' m, 'Control.Effect.State.StateThreads' p)@
type Threaders cs m p = (p ~ Prims m, SatisfiesAll p cs)

type family SatisfiesAll (q :: k) cs :: Constraint where
  SatisfiesAll q '[] = ()
  SatisfiesAll q (c ': cs) = (c q, SatisfiesAll q cs)

-- | The identity carrier, which carries no effects at all.
type RunC = Identity

-- | Extract the final result from a computation of which no effects remain
-- to be handled.
run :: RunC a -> a
run :: RunC a -> a
run = RunC a -> a
forall a. Identity a -> a
runIdentity
{-# INLINE run #-}

instance Carrier Identity where
  type Derivs Identity = '[]
  type Prims  Identity = '[]

  algPrims :: Algebra' (Prims Identity) Identity a
algPrims = Algebra' (Prims Identity) Identity a
forall (m :: * -> *) a b. Union '[] m a -> b
absurdU
  {-# INLINE algPrims #-}

  reformulate :: Reformulation' (Derivs Identity) (Prims Identity) Identity z a
reformulate forall x. Identity x -> z x
_ Algebra (Prims Identity) z
_ = Union (Derivs Identity) z a -> z a
forall (m :: * -> *) a b. Union '[] m a -> b
absurdU
  {-# INLINE reformulate #-}

  algDerivs :: Algebra' (Derivs Identity) Identity a
algDerivs = Algebra' (Derivs Identity) Identity a
forall (m :: * -> *) a b. Union '[] m a -> b
absurdU
  {-# INLINE algDerivs #-}

deriving newtype instance Carrier m => Carrier (Itself m)


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

instance ( Carrier m
         , Member e (Derivs m)
         )
      => Carrier (SubsumeC e m) where
  type Derivs (SubsumeC e m) = e ': Derivs m
  type Prims  (SubsumeC e m) = Prims m

  algPrims :: Algebra' (Prims (SubsumeC e m)) (SubsumeC e m) a
algPrims = (Union (Prims m) m a -> m a) -> Algebra' (Prims m) (SubsumeC e m) a
coerce (forall a. Carrier m => Algebra' (Prims m) m a
forall (m :: * -> *) x. Carrier m => Algebra' (Prims m) m x
algPrims @m)
  {-# INLINE algPrims #-}

  reformulate :: Reformulation'
  (Derivs (SubsumeC e m)) (Prims (SubsumeC e m)) (SubsumeC e m) z a
reformulate forall x. SubsumeC e m x -> z x
n Algebra (Prims (SubsumeC e m)) z
alg = Algebra' (Derivs m) z a
-> (forall (z :: * -> *). Coercible z z => e z a -> z a)
-> Algebra' (e : Derivs m) z a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Algebra' r m a
-> (forall (z :: * -> *). Coercible z m => e z a -> m a)
-> Algebra' (e : r) m a
powerAlg' (Reformulation' (Derivs m) (Prims m) m z a
forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs m) (Prims m) m z a
reformulate (SubsumeC e m x -> z x
forall x. SubsumeC e m x -> z x
n (SubsumeC e m x -> z x) -> (m x -> SubsumeC e m x) -> m x -> z x
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# m x -> SubsumeC e m x
forall k (e :: (* -> *) -> * -> *) (m :: k -> *) (a :: k).
m a -> SubsumeC e m a
SubsumeC) forall x. Union (Prims m) z x -> z x
Algebra (Prims (SubsumeC e m)) z
alg) ((forall (z :: * -> *). Coercible z z => e z a -> z a)
 -> Algebra' (e : Derivs m) z a)
-> (forall (z :: * -> *). Coercible z z => e z a -> z a)
-> Algebra' (e : Derivs m) z a
forall a b. (a -> b) -> a -> b
$ \e z a
e ->
    Reformulation' (Derivs m) (Prims m) m z a
forall (m :: * -> *) (z :: * -> *) a.
(Carrier m, Monad z) =>
Reformulation' (Derivs m) (Prims m) m z a
reformulate (SubsumeC e m x -> z x
forall x. SubsumeC e m x -> z x
n (SubsumeC e m x -> z x) -> (m x -> SubsumeC e m x) -> m x -> z x
forall b a c. Coercible b a => (b -> c) -> (a -> b) -> a -> c
.# m x -> SubsumeC e m x
forall k (e :: (* -> *) -> * -> *) (m :: k -> *) (a :: k).
m a -> SubsumeC e m a
SubsumeC) forall x. Union (Prims m) z x -> z x
Algebra (Prims (SubsumeC e m)) z
alg (ElemOf e (Derivs m) -> e z a -> Union (Derivs m) z a
forall (z :: * -> *) (m :: * -> *) (e :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Coercible z m =>
ElemOf e r -> e z a -> Union r m a
Union ElemOf e (Derivs m)
forall k (e :: k) (r :: [k]). Member e r => ElemOf e r
membership e z a
e)
  {-# INLINE reformulate #-}

  algDerivs :: Algebra' (Derivs (SubsumeC e m)) (SubsumeC e m) a
algDerivs = Algebra' (Derivs m) (SubsumeC e m) a
-> (forall (z :: * -> *).
    Coercible z (SubsumeC e m) =>
    e z a -> SubsumeC e m a)
-> Algebra' (e : Derivs m) (SubsumeC e m) a
forall (e :: (* -> *) -> * -> *) (r :: [(* -> *) -> * -> *])
       (m :: * -> *) a.
Algebra' r m a
-> (forall (z :: * -> *). Coercible z m => e z a -> m a)
-> Algebra' (e : r) m a
powerAlg' (Algebra' (Derivs m) m a -> Algebra' (Derivs m) (SubsumeC e m) a
coerce (forall a. Carrier m => Algebra' (Derivs m) m a
forall (m :: * -> *) a. Carrier m => Algebra' (Derivs m) m a
algDerivs @m)) ((forall (z :: * -> *).
  Coercible z (SubsumeC e m) =>
  e z a -> SubsumeC e m a)
 -> Algebra' (e : Derivs m) (SubsumeC e m) a)
-> (forall (z :: * -> *).
    Coercible z (SubsumeC e m) =>
    e z a -> SubsumeC e m a)
-> Algebra' (e : Derivs m) (SubsumeC e m) a
forall a b. (a -> b) -> a -> b
$ \e z a
e ->
    Algebra' (Derivs m) m a -> Algebra' (Derivs m) (SubsumeC e m) a
forall (n :: * -> *) (m :: * -> *) (e :: (* -> *) -> * -> *) a b.
(Coercible n m, RepresentationalEff e) =>
(e m a -> m b) -> e n a -> n b
coerceAlg (forall a. Carrier m => Algebra' (Derivs m) m a
forall (m :: * -> *) a. Carrier m => Algebra' (Derivs m) m a
algDerivs @m) (ElemOf e (Derivs m) -> e z a -> Union (Derivs m) (SubsumeC e m) a
forall (z :: * -> *) (m :: * -> *) (e :: (* -> *) -> * -> *)
       (r :: [(* -> *) -> * -> *]) a.
Coercible z m =>
ElemOf e r -> e z a -> Union r m a
Union ElemOf e (Derivs m)
forall k (e :: k) (r :: [k]). Member e r => ElemOf e r
membership e z a
e)
  {-# INLINE algDerivs #-}

-- | Interpret an effect in terms of another, identical effect.
--
-- This is very rarely useful, but one use-case is to transform
-- reinterpreters into regular interpreters.
--
-- For example,
-- @'subsume' . 'Control.Effect.reinterpretSimple' \@e h@ is morally equivalent
-- to @'Control.Effect.interpretSimple' \@e h@
subsume :: ( Carrier m
           , Member e (Derivs m)
           )
        => SubsumeC e m a
        -> m a
subsume :: SubsumeC e m a -> m a
subsume = SubsumeC e m a -> m a
forall (e :: (* -> *) -> * -> *) k (m :: k -> *) (a :: k).
SubsumeC e m a -> m a
unSubsumeC
{-# INLINE subsume #-}