effin-0.3.0.3: A Typeable-free implementation of extensible effects

Safe HaskellNone
LanguageHaskell2010

Control.Monad.Effect

Contents

Synopsis

The Effect Monad

data Effect l a Source #

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

Instances

Effectful l (Effect l a) Source # 

Associated Types

type EffectsOf (Effect l a) :: Row (* -> *) Source #

Methods

relay :: Union l a -> (a -> Effect l a) -> Effect l a

Monad (Effect l) Source # 

Methods

(>>=) :: Effect l a -> (a -> Effect l b) -> Effect l b #

(>>) :: Effect l a -> Effect l b -> Effect l b #

return :: a -> Effect l a #

fail :: String -> Effect l a #

Functor (Effect l) Source # 

Methods

fmap :: (a -> b) -> Effect l a -> Effect l b #

(<$) :: a -> Effect l b -> Effect l a #

Applicative (Effect l) Source # 

Methods

pure :: a -> Effect l a #

(<*>) :: Effect l (a -> b) -> Effect l a -> Effect l b #

(*>) :: Effect l a -> Effect l b -> Effect l b #

(<*) :: Effect l a -> Effect l b -> Effect l a #

type EffectsOf (Effect l a) Source # 
type EffectsOf (Effect l a) = l

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
...

Associated Types

type EffectsOf r :: Row (* -> *) Source #

Determines the effects associated with the return type of a function.

Instances

Effectful l r => Effectful l (a -> r) Source # 

Associated Types

type EffectsOf (a -> r) :: Row (* -> *) Source #

Methods

relay :: Union l a -> (a -> a -> r) -> a -> r

Effectful l (Effect l a) Source # 

Associated Types

type EffectsOf (Effect l a) :: Row (* -> *) Source #

Methods

relay :: Union l a -> (a -> Effect l a) -> Effect l a

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.

enable :: Effect (f :- l) a -> Effect l a Source #

Enables an effect that was previously disabled.

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 #

Converts a set of effects l into a single effect f.

 mask f = conceal . rename f . unflatten

unmask :: (Inclusive l, Member f m) => (forall r. f r -> Union l r) -> Effect m a -> Effect (l :++ m) a Source #

Converts an effect f into a set of effects l.

 unmask f = flatten . rename f . reveal

Unions

data Union l a Source #

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.

Instances

KnownNat (IndexOf a e l) => Member a e l Source # 

class (Member f l, f ~ InstanceOf name l) => MemberEffect name f l Source #

A refined Membership constraint that can infer f from l, given name. In order for this to be used, Is name f must be defined. For example:

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.

Instances

(Member (* -> *) f l, (~) (* -> *) f (InstanceOf k name l)) => MemberEffect k name f l Source # 

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 ((* -> *) -> * -> *) Lift f
type Is (* -> * -> * -> *) Coroutine f Source # 
type Is (* -> * -> * -> *) Coroutine f
type Is (* -> * -> * -> *) Exception f Source # 
type Is (* -> * -> * -> *) Exception f
type Is (* -> * -> *) Witness f Source # 
type Is (* -> * -> *) Witness f
type Is (* -> * -> *) State f Source # 
type Is (* -> * -> *) State f
type Is (* -> * -> *) Writer f Source # 
type Is (* -> * -> *) Writer f
type Is (* -> * -> *) Reader f Source # 
type Is (* -> * -> *) Reader f
type Is (* -> * -> *) Bracket f Source # 
type Is (* -> * -> *) Bracket f
type Is (* -> *) List f Source # 
type Is (* -> *) List f

Effect Rows

data Row a Source #

A type level list with explicit removals.

Constructors

Nil

The empty list.

a :+ (Row a) infixr 5

Prepends an element (cons).

a :- (Row a) infixr 5

Deletes the first instance an element.

type family l :++ m where ... infixr 5 Source #

Appends two type level Rows.

Equations

Nil :++ l = l 
(e :+ l) :++ m = e :+ (l :++ m) 
(e :- l) :++ m = e :- (l :++ m) 

class KnownNat (Length l) => KnownLength l Source #

The class of Rows with statically known lengths.

Instances

KnownNat (Length a l) => KnownLength a l Source # 

class KnownLength l => Inclusive l Source #

The class of Rows that do not contain deletions (`:-).

Instances

Inclusive a (Nil a) Source # 
Inclusive a l => Inclusive a ((:+) a e l) Source #