Safe Haskell | None |
---|---|
Language | Haskell2010 |
Control.Monad.Effect
- data Effect l a
- runEffect :: Effect Nil a -> a
- send :: Member f l => f a -> Effect l a
- sendEffect :: (Member f l, Effectful l r) => f r -> r
- class l ~ EffectsOf r => Effectful l r where
- eliminate :: Effectful l r => (a -> r) -> (forall b. f b -> (b -> r) -> r) -> Effect (f :+ l) a -> r
- intercept :: (Effectful l r, Member f l) => (a -> r) -> (forall b. f b -> (b -> r) -> r) -> Effect l a -> r
- extend :: Effect l a -> Effect (f :+ l) a
- enable :: Effect (f :- l) a -> Effect l a
- conceal :: Member f l => Effect (f :+ l) a -> Effect l a
- reveal :: Member f l => Effect l a -> Effect (f :+ l) a
- rename :: (forall r. f r -> g r) -> Effect (f :+ l) a -> Effect (g :+ l) a
- swap :: Effect (f :+ (g :+ l)) a -> Effect (g :+ (f :+ l)) a
- rotate :: Effect (f :+ (g :+ (h :+ l))) a -> Effect (g :+ (h :+ (f :+ l))) a
- mask :: (KnownLength l, Member f m) => (forall r. Union l r -> f r) -> Effect (l :++ m) a -> Effect m a
- unmask :: (Inclusive l, Member f m) => (forall r. f r -> Union l r) -> Effect m a -> Effect (l :++ m) a
- data Union l a
- flatten :: Inclusive l => Effect (Union l :+ m) a -> Effect (l :++ m) a
- unflatten :: KnownLength l => Effect (l :++ m) a -> Effect (Union l :+ m) a
- class KnownNat (IndexOf e l) => Member e l
- class (Member f l, f ~ InstanceOf name l) => MemberEffect name f l
- type family Is (name :: k) (f :: * -> *) :: Bool
- data Row a
- type family l :++ m where ...
- class KnownNat (Length l) => KnownLength l
- class KnownLength l => Inclusive l
The Effect Monad
An effectful computation. An Effect l a
may perform any of the effects
specified by the list of effects l
before returning a result of type a
.
The definition is isomorphic to the following GADT:
data Effect l a where
Done :: a -> Effect l a
Side :: Union
l (Effect l a) -> Effect l a
runEffect :: Effect Nil a -> a Source #
Converts an computation that produces no effects into a regular value.
send :: Member f l => f a -> Effect l a Source #
Executes an effect of type f
that produces a return value of type a
.
sendEffect :: (Member f l, Effectful l r) => f r -> r Source #
Executes an effect of type f
that produces a return value of type r
.
Note that a specific instance of this function is of type
Member f l => f (Effect l a) -> Effect l a
, which allows users
to send effects parameterized by effects.
Effect Handlers
class l ~ EffectsOf r => Effectful l r Source #
The class of types which result in an effect. That is:
Effect l r a -> Effect l r a -> b -> Effect l r ...
eliminate :: Effectful l r => (a -> r) -> (forall b. f b -> (b -> r) -> r) -> Effect (f :+ l) a -> r Source #
Completely handles an effect. The second function parameter is passed an effect value and a continuation function.
The most common instantiation of this function is:
(a -> Effect l b) -> (f (Effect l b) -> Effect l b) -> Effect (f ': l) a -> Effect l b
intercept :: (Effectful l r, Member f l) => (a -> r) -> (forall b. f b -> (b -> r) -> r) -> Effect l a -> r Source #
Handles an effect without eliminating it. The second function parameter is passed an effect value and a continuation function.
The most common instantiation of this function is:
(a -> Effect l b) -> (f (Effect l b) -> Effect l b) -> Effect l a -> Effect l b
extend :: Effect l a -> Effect (f :+ l) a Source #
Adds an arbitrary effect to the head of the effect list.
conceal :: Member f l => Effect (f :+ l) a -> Effect l a Source #
Hides an effect f
by translating each instance of the effect into an
equivalent effect further into the effect list.
conceal = eliminate return (\x k -> send x >>= k)
reveal :: Member f l => Effect l a -> Effect (f :+ l) a Source #
Hides an effect f
by translating each instance of the effect into an
equivalent effect at the head of the effect list.
rename :: (forall r. f r -> g r) -> Effect (f :+ l) a -> Effect (g :+ l) a Source #
Translates the first effect in the effect list into another effect.
rename f = eliminate return (\x k -> send (f x) >>= k) . swap . extend
swap :: Effect (f :+ (g :+ l)) a -> Effect (g :+ (f :+ l)) a Source #
Reorders the first two effects in a computation.
rotate :: Effect (f :+ (g :+ (h :+ l))) a -> Effect (g :+ (h :+ (f :+ l))) a Source #
Rotates the first three effects in a computation.
mask :: (KnownLength l, Member f m) => (forall r. Union l r -> f r) -> Effect (l :++ m) a -> Effect m a Source #
unmask :: (Inclusive l, Member f m) => (forall r. f r -> Union l r) -> Effect m a -> Effect (l :++ m) a Source #
Unions
Represents a union of the list of type constructors in l
parameterized
by a
. As an effect, it represents the union of each type constructor's
corresponding effect. From the user's perspective, it provides a way to
encapsulate multiple effects.
flatten :: Inclusive l => Effect (Union l :+ m) a -> Effect (l :++ m) a Source #
Distributes the sub-effects of a Union
effect across a computation.
unflatten :: KnownLength l => Effect (l :++ m) a -> Effect (Union l :+ m) a Source #
Collects some effects in a computation into a Union
effect.
Membership
class KnownNat (IndexOf e l) => Member e l Source #
A constraint specifying that e
is a member of the Row
l
.
class (Member f l, f ~ InstanceOf name l) => MemberEffect name f l Source #
A refined Member
ship constraint that can infer f
from l
, given
name
. In order for this to be used,
must be defined.
For example:Is
name f
data Reader r a = ... type instance Is Reader f = IsReader f type IsReader f where IsReader (Reader r) = True IsReader f = False type ReaderEffect r l = MemberEffect Reader (Reader r) l ask :: ReaderEffect r l => Effect l r ask = ...
Given the constraint ReaderEffect r l
in the above example, r
can be
inferred from l
.
type family Is (name :: k) (f :: * -> *) :: Bool Source #
Returns a boolean value indicating whether f
belongs to the group of
effects identified by name
. This allows MemberEffect
to infer the
associated types for arbitrary effects.
Instances
type Is ((* -> *) -> * -> *) Lift f Source # | |
type Is (* -> * -> * -> *) Coroutine f Source # | |
type Is (* -> * -> * -> *) Exception f Source # | |
type Is (* -> * -> *) Witness f Source # | |
type Is (* -> * -> *) State f Source # | |
type Is (* -> * -> *) Writer f Source # | |
type Is (* -> * -> *) Reader f Source # | |
type Is (* -> * -> *) Bracket f Source # | |
type Is (* -> *) List f Source # | |
Effect Rows
A type level list with explicit removals.
class KnownNat (Length l) => KnownLength l Source #
The class of Row
s with statically known lengths.
Instances
KnownNat (Length a l) => KnownLength a l Source # | |