extensible-effects-3.0.0.0: An Alternative to Monad Transformers

Safe HaskellSafe
LanguageHaskell2010

Control.Eff.Extend

Contents

Description

This module exports functions, types, and typeclasses necessary for implementing a custom effect and/or effect handler.

Synopsis

The effect monad

data Eff r a Source #

The Eff monad (not a transformer!). It is a fairly standard coroutine monad where the type r is the type of effects that can be handled, and the missing type a (from the type application) is the type of value that is returned. It is NOT a Free monad! There are no Functor constraints.

The two constructors denote the status of a coroutine (client): done with the value of type a, or sending a request of type Union r with the continuation Arrs r b a. Expressed another way: an Eff can either be a value (i.e., Val case), or an effect of type Union r producing another Eff (i.e., E case). The result is that an Eff can produce an arbitrarily long chain of Union r effects, terminated with a pure value.

Potentially, inline Union into E

Constructors

Val a 
E (Union r b) (Arrs r b a) 

Instances

(MonadBase b m, SetMember (* -> *) (Lift *) (Lift * m) r) => MonadBase b (Eff r) Source # 

Methods

liftBase :: b α -> Eff r α #

MonadBase m m => MonadBaseControl m (Eff ((:) (* -> *) (Lift * m) ([] (* -> *)))) Source # 

Associated Types

type StM (Eff (((* -> *) ': Lift * m) [* -> *]) :: * -> *) a :: * #

Methods

liftBaseWith :: (RunInBase (Eff (((* -> *) ': Lift * m) [* -> *])) m -> m a) -> Eff (((* -> *) ': Lift * m) [* -> *]) a #

restoreM :: StM (Eff (((* -> *) ': Lift * m) [* -> *])) a -> Eff (((* -> *) ': Lift * m) [* -> *]) a #

(MonadBase m m, SetMember (* -> *) (Lift *) (Lift * m) r, MonadBaseControl m (Eff r)) => MonadBaseControl m (Eff ((:) (* -> *) (Writer w) r)) # 

Associated Types

type StM (Eff (((* -> *) ': Writer w) r) :: * -> *) a :: * #

Methods

liftBaseWith :: (RunInBase (Eff (((* -> *) ': Writer w) r)) m -> m a) -> Eff (((* -> *) ': Writer w) r) a #

restoreM :: StM (Eff (((* -> *) ': Writer w) r)) a -> Eff (((* -> *) ': Writer w) r) a #

(MonadBase m m, SetMember (* -> *) (Lift *) (Lift * m) r, MonadBaseControl m (Eff r)) => MonadBaseControl m (Eff ((:) (* -> *) (Writer w) r)) # 

Associated Types

type StM (Eff (((* -> *) ': Writer w) r) :: * -> *) a :: * #

Methods

liftBaseWith :: (RunInBase (Eff (((* -> *) ': Writer w) r)) m -> m a) -> Eff (((* -> *) ': Writer w) r) a #

restoreM :: StM (Eff (((* -> *) ': Writer w) r)) a -> Eff (((* -> *) ': Writer w) r) a #

(MonadBase m m, SetMember (* -> *) (Lift *) (Lift * m) s, MonadBaseControl m (Eff s)) => MonadBaseControl m (Eff ((:) (* -> *) (Reader * e) s)) # 

Associated Types

type StM (Eff (((* -> *) ': Reader * e) s) :: * -> *) a :: * #

Methods

liftBaseWith :: (RunInBase (Eff (((* -> *) ': Reader * e) s)) m -> m a) -> Eff (((* -> *) ': Reader * e) s) a #

restoreM :: StM (Eff (((* -> *) ': Reader * e) s)) a -> Eff (((* -> *) ': Reader * e) s) a #

(MonadBase m m, SetMember (* -> *) (Lift *) (Lift * m) r, MonadBaseControl m (Eff r)) => MonadBaseControl m (Eff ((:) (* -> *) (State s) r)) # 

Associated Types

type StM (Eff (((* -> *) ': State s) r) :: * -> *) a :: * #

Methods

liftBaseWith :: (RunInBase (Eff (((* -> *) ': State s) r)) m -> m a) -> Eff (((* -> *) ': State s) r) a #

restoreM :: StM (Eff (((* -> *) ': State s) r)) a -> Eff (((* -> *) ': State s) r) a #

(MonadBase m m, SetMember (* -> *) (Lift *) (Lift * m) s, MonadBaseControl m (Eff s)) => MonadBaseControl m (Eff ((:) (* -> *) (Reader * e) s)) # 

Associated Types

type StM (Eff (((* -> *) ': Reader * e) s) :: * -> *) a :: * #

Methods

liftBaseWith :: (RunInBase (Eff (((* -> *) ': Reader * e) s)) m -> m a) -> Eff (((* -> *) ': Reader * e) s) a #

restoreM :: StM (Eff (((* -> *) ': Reader * e) s)) a -> Eff (((* -> *) ': Reader * e) s) a #

(MonadBase m m, SetMember (* -> *) (Lift *) (Lift * m) r, MonadBaseControl m (Eff r)) => MonadBaseControl m (Eff ((:) (* -> *) (OnDemandState s) r)) # 

Associated Types

type StM (Eff (((* -> *) ': OnDemandState s) r) :: * -> *) a :: * #

Methods

liftBaseWith :: (RunInBase (Eff (((* -> *) ': OnDemandState s) r)) m -> m a) -> Eff (((* -> *) ': OnDemandState s) r) a #

restoreM :: StM (Eff (((* -> *) ': OnDemandState s) r)) a -> Eff (((* -> *) ': OnDemandState s) r) a #

(MonadBase m m, SetMember (* -> *) (Lift *) (Lift * m) r, MonadBaseControl m (Eff r)) => MonadBaseControl m (Eff ((:) (* -> *) (State s) r)) # 

Associated Types

type StM (Eff (((* -> *) ': State s) r) :: * -> *) a :: * #

Methods

liftBaseWith :: (RunInBase (Eff (((* -> *) ': State s) r)) m -> m a) -> Eff (((* -> *) ': State s) r) a #

restoreM :: StM (Eff (((* -> *) ': State s) r)) a -> Eff (((* -> *) ': State s) r) a #

(MonadBase m m, SetMember (* -> *) (Lift *) (Lift * m) r, MonadBaseControl m (Eff r)) => MonadBaseControl m (Eff ((:) (* -> *) NdetEff r)) # 

Associated Types

type StM (Eff (((* -> *) ': NdetEff) r) :: * -> *) a :: * #

Methods

liftBaseWith :: (RunInBase (Eff (((* -> *) ': NdetEff) r)) m -> m a) -> Eff (((* -> *) ': NdetEff) r) a #

restoreM :: StM (Eff (((* -> *) ': NdetEff) r)) a -> Eff (((* -> *) ': NdetEff) r) a #

(MonadBase m m, SetMember (* -> *) (Lift *) (Lift * m) r, MonadBaseControl m (Eff r)) => MonadBaseControl m (Eff ((:) (* -> *) Fresh r)) # 

Associated Types

type StM (Eff (((* -> *) ': Fresh) r) :: * -> *) a :: * #

Methods

liftBaseWith :: (RunInBase (Eff (((* -> *) ': Fresh) r)) m -> m a) -> Eff (((* -> *) ': Fresh) r) a #

restoreM :: StM (Eff (((* -> *) ': Fresh) r)) a -> Eff (((* -> *) ': Fresh) r) a #

(MonadBase m m, SetMember (* -> *) (Lift *) (Lift * m) r, MonadBaseControl m (Eff r)) => MonadBaseControl m (Eff ((:) (* -> *) (Exc * e) r)) # 

Associated Types

type StM (Eff (((* -> *) ': Exc * e) r) :: * -> *) a :: * #

Methods

liftBaseWith :: (RunInBase (Eff (((* -> *) ': Exc * e) r)) m -> m a) -> Eff (((* -> *) ': Exc * e) r) a #

restoreM :: StM (Eff (((* -> *) ': Exc * e) r)) a -> Eff (((* -> *) ': Exc * e) r) a #

(MonadBase m m, SetMember (* -> *) (Lift *) (Lift * m) r, MonadBaseControl m (Eff r)) => MonadBaseControl m (Eff ((:) (* -> *) Choose r)) # 

Associated Types

type StM (Eff (((* -> *) ': Choose) r) :: * -> *) a :: * #

Methods

liftBaseWith :: (RunInBase (Eff (((* -> *) ': Choose) r)) m -> m a) -> Eff (((* -> *) ': Choose) r) a #

restoreM :: StM (Eff (((* -> *) ': Choose) r)) a -> Eff (((* -> *) ': Choose) r) a #

Monad (Eff r) Source # 

Methods

(>>=) :: Eff r a -> (a -> Eff r b) -> Eff r b #

(>>) :: Eff r a -> Eff r b -> Eff r b #

return :: a -> Eff r a #

fail :: String -> Eff r a #

Functor (Eff r) Source #

Eff is still a monad and a functor (and Applicative) (despite the lack of the Functor constraint)

Methods

fmap :: (a -> b) -> Eff r a -> Eff r b #

(<$) :: a -> Eff r b -> Eff r a #

Applicative (Eff r) Source # 

Methods

pure :: a -> Eff r a #

(<*>) :: Eff r (a -> b) -> Eff r a -> Eff r b #

liftA2 :: (a -> b -> c) -> Eff r a -> Eff r b -> Eff r c #

(*>) :: Eff r a -> Eff r b -> Eff r b #

(<*) :: Eff r a -> Eff r b -> Eff r a #

(MonadIO m, SetMember (* -> *) (Lift *) (Lift * m) r) => MonadIO (Eff r) Source # 

Methods

liftIO :: IO a -> Eff r a #

type StM (Eff ((:) (* -> *) (Lift * m) ([] (* -> *)))) a Source # 
type StM (Eff ((:) (* -> *) (Lift * m) ([] (* -> *)))) a = a
type StM (Eff ((:) (* -> *) (Writer w) r)) a # 
type StM (Eff ((:) (* -> *) (Writer w) r)) a = StM (Eff r) (a, [w])
type StM (Eff ((:) (* -> *) (Writer w) r)) a # 
type StM (Eff ((:) (* -> *) (Writer w) r)) a = StM (Eff r) (a, [w])
type StM (Eff ((:) (* -> *) (State s) r)) a # 
type StM (Eff ((:) (* -> *) (State s) r)) a = StM (Eff r) (a, s)
type StM (Eff ((:) (* -> *) (OnDemandState s) r)) a # 
type StM (Eff ((:) (* -> *) (OnDemandState s) r)) a = StM (Eff r) (a, s)
type StM (Eff ((:) (* -> *) (State s) r)) a # 
type StM (Eff ((:) (* -> *) (State s) r)) a = StM (Eff r) (a, s)
type StM (Eff ((:) (* -> *) NdetEff r)) a # 
type StM (Eff ((:) (* -> *) NdetEff r)) a = StM (Eff r) [a]
type StM (Eff ((:) (* -> *) Fresh r)) a # 
type StM (Eff ((:) (* -> *) Fresh r)) a = StM (Eff r) (a, Int)
type StM (Eff ((:) (* -> *) Choose r)) a # 
type StM (Eff ((:) (* -> *) Choose r)) a = StM (Eff r) [a]
type StM (Eff ((:) (* -> *) (Reader * e) s)) a # 
type StM (Eff ((:) (* -> *) (Reader * e) s)) a = StM (Eff s) a
type StM (Eff ((:) (* -> *) (Reader * e) s)) a # 
type StM (Eff ((:) (* -> *) (Reader * e) s)) a = StM (Eff s) a
type StM (Eff ((:) (* -> *) (Exc * e) r)) a # 
type StM (Eff ((:) (* -> *) (Exc * e) r)) a = StM (Eff r) (Either e a)

run :: Eff '[] w -> w Source #

Get the result from a pure (i.e. no effects) computation.

The type of run ensures that all effects must be handled: only pure computations can be run.

Open Unions

data Union (r :: [* -> *]) v Source #

The data constructors of Union are not exported

Strong Sum (Existential with the evidence) is an open union t is can be a GADT and hence not necessarily a Functor. Int is the index of t in the list r; that is, the index of t in the universe r

class FindElem t r => Member (t :: * -> *) r where Source #

Typeclass that asserts that effect t is contained inside the effect-list r.

The FindElem typeclass is necessary for implementation reasons and is not required for using the effect list.

Minimal complete definition

inj, prj

Methods

inj :: t v -> Union r v Source #

prj :: Union r v -> Maybe (t v) Source #

Instances

FindElem [* -> *] t r => Member t r Source # 

Methods

inj :: t v -> Union * r v Source #

prj :: Union * r v -> Maybe (t v) Source #

(~) (* -> *) t s => Member t ((:) (* -> *) s ([] (* -> *))) Source #

Explicit type-level equality condition is a dirty hack to eliminate the type annotation in the trivial case, such as run (runReader () get).

There is no ambiguity when finding instances for Member t (a ': b ': r), which the second instance is selected.

The only case we have to concerned about is Member t '[s]. But, in this case, values of definition is the same (if present), and the first one is chosen according to GHC User Manual, since the latter one is incoherent. This is the optimal choice.

Methods

inj :: t v -> Union * (((* -> *) ': s) [* -> *]) v Source #

prj :: Union * (((* -> *) ': s) [* -> *]) v -> Maybe (t v) Source #

inj :: Member t r => t v -> Union r v Source #

prj :: Member t r => Union r v -> Maybe (t v) Source #

decomp :: Union (t ': r) v -> Either (Union r v) (t v) Source #

class Member t r => SetMember (tag :: k -> * -> *) (t :: * -> *) r | tag r -> t Source #

This class is used for emulating monad transformers

Instances

(EQU (* -> *) Bool t1 t2 p, MemberU' k p tag t1 ((:) (* -> *) t2 r)) => SetMember k tag t1 ((:) (* -> *) t2 r) Source # 

weaken :: Union r w -> Union (any ': r) w Source #

Helper functions that are used for implementing effect-handlers

handle_relay :: (a -> Eff r w) -> (forall v. t v -> Arr r v w -> Eff r w) -> Eff (t ': r) a -> Eff r w Source #

A convenient pattern: given a request (open union), either handle it or relay it.

handle_relay_s :: s -> (s -> a -> Eff r w) -> (forall v. s -> t v -> (s -> Arr r v w) -> Eff r w) -> Eff (t ': r) a -> Eff r w Source #

Parameterized handle_relay

interpose :: Member t r => (a -> Eff r w) -> (forall v. t v -> Arr r v w -> Eff r w) -> Eff r a -> Eff r w Source #

Add something like Control.Exception.catches? It could be useful for control with cut.

Intercept the request and possibly reply to it, but leave it unhandled (that's why we use the same r all throuout)

raise :: Eff r a -> Eff (e ': r) a Source #

Embeds a less-constrained Eff into a more-constrained one. Analogous to MTL's lift.

send :: Member t r => t v -> Eff r v Source #

Send a request and wait for a reply (resulting in an effectful computation).

Arrow types and compositions

type Arr r a b = a -> Eff r b Source #

Effectful arrow type: a function from a to b that also does effects denoted by r

data Arrs r a b Source #

An effectful function from a to b that is a composition of one or more effectful functions. The paremeter r describes the overall effect.

The composition members are accumulated in a type-aligned queue. Using a newtype here enables us to define Category and Arrow instances.

Instances

Arrow (Arrs r) Source #

As the name suggests, Arrs also has an Arrow instance.

Methods

arr :: (b -> c) -> Arrs r b c #

first :: Arrs r b c -> Arrs r (b, d) (c, d) #

second :: Arrs r b c -> Arrs r (d, b) (d, c) #

(***) :: Arrs r b c -> Arrs r b' c' -> Arrs r (b, b') (c, c') #

(&&&) :: Arrs r b c -> Arrs r b c' -> Arrs r b (c, c') #

Category * (Arrs r) Source #

Arrs can be composed and have a natural identity.

Methods

id :: cat a a #

(.) :: cat b c -> cat a b -> cat a c #

first :: Arr r a b -> Arr r (a, c) (b, c) Source #

singleK :: Arr r a b -> Arrs r a b Source #

convert single effectful arrow into composable type. i.e., convert Arr to Arrs

qApp :: forall r b w. Arrs r b w -> Arr r b w Source #

Application to the `generalized effectful function' Arrs r b w, i.e., convert Arrs to Arr

(^$) :: forall r b w. Arrs r b w -> Arr r b w Source #

Syntactic sugar for qApp

arr :: (a -> b) -> Arrs r a b Source #

Lift a function to an arrow

ident :: Arrs r a a Source #

The identity arrow

comp :: Arrs r a b -> Arrs r b c -> Arrs r a c Source #

Arrow composition

(^|>) :: Arrs r a b -> Arr r b c -> Arrs r a c Source #

Common pattern: append Arr to Arrs

qComp :: Arrs r a b -> (Eff r b -> Eff r' c) -> Arr r' a c Source #

Compose effectful arrows (and possibly change the effect!)

qComps :: Arrs r a b -> (Eff r b -> Eff r' c) -> Arrs r' a c Source #

Compose effectful arrows (and possibly change the effect!)