Copyright | (c) 2016 Allele Dev; 2017 Ixperta Solutions s.r.o.; 2017 Alexis King |
---|---|
License | BSD3 |
Maintainer | Alexis King <lexi.lambda@gmail.com> |
Stability | experimental |
Portability | GHC specific language extensions. |
Safe Haskell | None |
Language | Haskell2010 |
Internal machinery for this effects library. This includes:
Eff
data type, for expressing effects.NonDet
data type, for nondeterministic effects.- Functions for facilitating the construction of effects and their handlers.
Using http://okmij.org/ftp/Haskell/extensible/Eff1.hs as a starting point.
Synopsis
- data Eff effs a
- type Arr effs a b = a -> Eff effs b
- type Arrs effs a b = FTCQueue (Eff effs) a b
- module Data.OpenUnion
- module Data.FTCQueue
- send :: Member eff effs => eff a -> Eff effs a
- sendM :: (Monad m, LastMember m effs) => m a -> Eff effs a
- raise :: Eff effs a -> Eff (e ': effs) a
- run :: Eff '[] a -> a
- runM :: Monad m => Eff '[m] a -> m a
- handleRelay :: (a -> Eff effs b) -> (forall v. eff v -> Arr effs v b -> Eff effs b) -> Eff (eff ': effs) a -> Eff effs b
- handleRelayS :: s -> (s -> a -> Eff effs b) -> (forall v. s -> eff v -> (s -> Arr effs v b) -> Eff effs b) -> Eff (eff ': effs) a -> Eff effs b
- interpose :: Member eff effs => (a -> Eff effs b) -> (forall v. eff v -> Arr effs v b -> Eff effs b) -> Eff effs a -> Eff effs b
- interposeS :: Member eff effs => s -> (s -> a -> Eff effs b) -> (forall v. s -> eff v -> (s -> Arr effs v b) -> Eff effs b) -> Eff effs a -> Eff effs b
- replaceRelay :: (a -> Eff (v ': effs) w) -> (forall x. t x -> Arr (v ': effs) x w -> Eff (v ': effs) w) -> Eff (t ': effs) a -> Eff (v ': effs) w
- replaceRelayS :: s -> (s -> a -> Eff (v ': effs) w) -> (forall x. s -> t x -> (s -> Arr (v ': effs) x w) -> Eff (v ': effs) w) -> Eff (t ': effs) a -> Eff (v ': effs) w
- replaceRelayN :: forall gs t a effs w. Weakens gs => (a -> Eff (gs :++: effs) w) -> (forall x. t x -> Arr (gs :++: effs) x w -> Eff (gs :++: effs) w) -> Eff (t ': effs) a -> Eff (gs :++: effs) w
- qApp :: Arrs effs b w -> b -> Eff effs w
- qComp :: Arrs effs a b -> (Eff effs b -> Eff effs' c) -> Arr effs' a c
- data NonDet a where
Effect Monad
The Eff
monad provides the implementation of a computation that performs
an arbitrary set of algebraic effects. In
, Eff
effs aeffs
is a
type-level list that contains all the effects that the computation may
perform. For example, a computation that produces an Integer
by consuming a
String
from the global environment and acting upon a single mutable cell
containing a Bool
would have the following type:
Eff
'[Reader
String
,State
Bool
]Integer
Normally, a concrete list of effects is not used to parameterize Eff
.
Instead, the Member
or Members
constraints are used to express
constraints on the list of effects without coupling a computation to a
concrete list of effects. For example, the above example would more commonly
be expressed with the following type:
Members
'[Reader
String
,State
Bool
] effs =>Eff
effsInteger
This abstraction allows the computation to be used in functions that may perform other effects, and it also allows the effects to be handled in any order.
Val a | |
forall b. E (Union effs b) (Arrs effs b a) | Sending a request of type |
Instances
(MonadBase b m, LastMember m effs) => MonadBase b (Eff effs) Source # | |
Defined in Control.Monad.Freer.Internal | |
Monad (Eff effs) Source # | |
Functor (Eff effs) Source # | |
Applicative (Eff effs) Source # | |
(MonadIO m, LastMember m effs) => MonadIO (Eff effs) Source # | |
Defined in Control.Monad.Freer.Internal | |
Member NonDet effs => Alternative (Eff effs) Source # | |
Member NonDet effs => MonadPlus (Eff effs) Source # | |
type Arr effs a b = a -> Eff effs b Source #
Effectful arrow type: a function from a :: *
to b :: *
that also does
effects denoted by effs :: [* -> *]
.
type Arrs effs a b = FTCQueue (Eff effs) a b Source #
An effectful function from a :: *
to b :: *
that is a composition of
several effectful functions. The paremeter effs :: [* -> *]
describes the
overall effect. The composition members are accumulated in a type-aligned
queue.
Open Union
Open Union (type-indexed co-product) of effects.
module Data.OpenUnion
Fast Type-aligned Queue
Fast type-aligned queue optimized to effectful functions of type
(a -> m b)
.
module Data.FTCQueue
Sending Arbitrary Effect
send :: Member eff effs => eff a -> Eff effs a Source #
“Sends” an effect, which should be a value defined as part of an effect
algebra (see the module documentation for Control.Monad.Freer), to an
effectful computation. This is used to connect the definition of an effect to
the Eff
monad so that it can be used and handled.
Lifting Effect Stacks
raise :: Eff effs a -> Eff (e ': effs) a Source #
Embeds a less-constrained Eff
into a more-constrained one. Analogous to
MTL's lift
.
Handling Effects
run :: Eff '[] a -> a Source #
Runs a pure Eff
computation, since an Eff
computation that performs no
effects (i.e. has no effects in its type-level list) is guaranteed to be
pure. This is usually used as the final step of running an effectful
computation, after all other effects have been discharged using effect
handlers.
Typically, this function is composed as follows:
someProgram&
runEff1 eff1Arg&
runEff2 eff2Arg1 eff2Arg2&
run
runM :: Monad m => Eff '[m] a -> m a Source #
Like run
, runM
runs an Eff
computation and extracts the result.
Unlike run
, runM
allows a single effect to remain within the type-level
list, which must be a monad. The value returned is a computation in that
monad, which is useful in conjunction with sendM
or liftBase
for plugging
in traditional transformer stacks.
Building Effect Handlers
:: (a -> Eff effs b) | Handle a pure value. |
-> (forall v. eff v -> Arr effs v b -> Eff effs b) | Handle a request for effect of type |
-> Eff (eff ': effs) a | |
-> Eff effs b | Result with effects of type |
Given a request, either handle it or relay it.
:: s | |
-> (s -> a -> Eff effs b) | Handle a pure value. |
-> (forall v. s -> eff v -> (s -> Arr effs v b) -> Eff effs b) | Handle a request for effect of type |
-> Eff (eff ': effs) a | |
-> Eff effs b | Result with effects of type |
Parameterized handleRelay
. Allows sending along some state of type
s :: *
to be handled for the target effect, or relayed to a handler that
can- handle the target effect.
interpose :: Member eff effs => (a -> Eff effs b) -> (forall v. eff v -> Arr effs v b -> Eff effs b) -> Eff effs a -> Eff effs b Source #
Intercept the request and possibly reply to it, but leave it unhandled.
interposeS :: Member eff effs => s -> (s -> a -> Eff effs b) -> (forall v. s -> eff v -> (s -> Arr effs v b) -> Eff effs b) -> Eff effs a -> Eff effs b Source #
Like interpose
, but with support for an explicit state to help implement
the interpreter.
replaceRelay :: (a -> Eff (v ': effs) w) -> (forall x. t x -> Arr (v ': effs) x w -> Eff (v ': effs) w) -> Eff (t ': effs) a -> Eff (v ': effs) w Source #
Interpret an effect by transforming it into another effect on top of the stack. The primary use case of this function is allow interpreters to be defined in terms of other ones without leaking intermediary implementation details through the type signature.
replaceRelayS :: s -> (s -> a -> Eff (v ': effs) w) -> (forall x. s -> t x -> (s -> Arr (v ': effs) x w) -> Eff (v ': effs) w) -> Eff (t ': effs) a -> Eff (v ': effs) w Source #
Like replaceRelay
, but with support for an explicit state to help
implement the interpreter.
replaceRelayN :: forall gs t a effs w. Weakens gs => (a -> Eff (gs :++: effs) w) -> (forall x. t x -> Arr (gs :++: effs) x w -> Eff (gs :++: effs) w) -> Eff (t ': effs) a -> Eff (gs :++: effs) w Source #
Low-level Functions for Building Effect Handlers
qApp :: Arrs effs b w -> b -> Eff effs w Source #
Function application in the context of an array of effects,
.Arrs
effs b w
qComp :: Arrs effs a b -> (Eff effs b -> Eff effs' c) -> Arr effs' a c Source #
Composition of effectful arrows (Arrs
). Allows for the caller to change
the effect environment, as well.