extensible-effects-1.2.0: An Alternative to Monad Transformers

Safe HaskellNone

Control.Eff

Description

Original work available at http://okmij.org/ftp/Hgetell/extensible/Eff.hs. This module implements extensible effects as an alternative to monad transformers, as described in http://okmij.org/ftp/Hgetell/extensible/exteff.pdf.

Extensible Effects are implemented as typeclass constraints on an Eff[ect] datatype. A contrived example is:

 {-# LANGUAGE FlexibleContexts #-}
 import Control.Eff
 import Control.Eff.Lift
 import Control.Eff.State
 import Control.Monad (void)
 import Data.Typeable

 -- Write the elements of a list of numbers, in order.
 writeAll :: (Typeable a, Member (Writer a) e)
          => [a]
          -> Eff e ()
 writeAll = mapM_ putWriter

 -- Add a list of numbers to the current state.
 sumAll :: (Typeable a, Num a, Member (State a) e)
        => [a]
        -> Eff e ()
 sumAll = mapM_ (onState . (+))

 -- Write a list of numbers and add them to the current state.
 writeAndAdd :: (Member (Writer Integer) e, Member (State Integer) e)
             => [Integer]
             -> Eff e ()
 writeAndAdd l = do
     writeAll l
     sumAll l

 -- Sum a list of numbers.
 sumEff :: (Num a, Typeable a) => [a] -> a
 sumEff l = let (s, ()) = run $ runState 0 $ sumAll l
            in s

 -- Safely get the last element of a list.
 -- Nothing for empty lists; Just the last element otherwise.
 lastEff :: Typeable a => [a] -> Maybe a
 lastEff l = let (a, ()) = run $ runWriter $ writeAll l
             in a

 -- Get the last element and sum of a list
 lastAndSum :: (Typeable a, Num a) => [a] -> (Maybe a, a)
 lastAndSum l = let (lst, (total, ())) = run $ runWriter $ runState 0 $ writeAndAdd l
                in (lst, total)

Synopsis

Documentation

data Eff r a Source

Basic datatype returned by all computations with extensible effects. The type r is the type of effects that can be handled, and a is the type of value that is returned.

Instances

data VE w r Source

A VE is either a value, or an effect of type Union r producing another VE. The result is that a VE can produce an arbitrarily long chain of Union r effects, terminated with a pure value.

Constructors

Val w 
E !(Union r (VE w r)) 

class Member t r Source

The Member t r determines whether t is anywhere in the sum type r.

Instances

Member k k1 t r => Member k * t (:> k1 t' r) 
Member (* -> *) * t (:> k t r) 

class Member t r => SetMember set t r | r set -> tSource

SetMember is similar to Member, but it allows types to belong to a set, by taking advantage of the r set -> t fundep:

 -- Terminal effects (effects which must be run last)
 data Terminal

 -- Make Lifts part of the Terminal effects set.
 -- The fundep assures that there can only be one Terminal effect for any r.
 instance Member (Lift m) r => SetMember Terminal (Lift m) r

 -- Only allow a single unique Lift effect, by making a "Lift" set.
 instance Member (Lift m) r => SetMember Lift (Lift m) r

Instances

SetMember k k1 set t r => SetMember k * set t (:> k1 t' r) 
SetMember ((* -> *) -> * -> *) * Lift (Lift m) (:> * (Lift m) ()) 

data Union r v Source

Where r is t1 :> t2 ... :> tn, Union r v can be constructed with a value of type ti v. Ideally, we should be be able to add the constraint Member t r.

Instances

Functor (Union k r) 

data a :> b Source

A sum data type, for composing effects

Instances

SetMember k k1 set t r => SetMember k * set t (:> k1 t' r) 
Member k k1 t r => Member k * t (:> k1 t' r) 
SetMember ((* -> *) -> * -> *) * Lift (Lift m) (:> * (Lift m) ()) 
Member (* -> *) * t (:> k t r) 

inj :: (Functor t, Typeable1 t, Member t r) => t v -> Union r vSource

Construct a Union.

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

Try extracting the contents of a Union as a given type.

prjForce :: (Typeable1 t, Member t r) => Union r v -> (t v -> a) -> aSource

Extract the contents of a Union as a given type. If the Union isn't of that type, a runtime error occurs.

decomp :: Typeable1 t => Union (t :> r) v -> Either (Union r v) (t v)Source

Try extracting the contents of a Union as a given type. If we can't, return a reduced Union that excludes the type we just checked.

send :: (forall w. (a -> VE w r) -> Union r (VE w r)) -> Eff r aSource

Given a method of turning requests into results, we produce an effectful computation.

admin :: Eff r w -> VE w rSource

Tell an effectful computation that you're ready to start running effects and return a value.

run :: Eff () w -> wSource

Get the result from a pure computation.

interpose :: (Typeable1 t, Functor t, Member t r) => Union r v -> (v -> Eff r a) -> (t v -> Eff r a) -> Eff r aSource

Given a request, either handle it or relay it. Both the handler and the relay can produce the same type of request that was handled.

handleRelaySource

Arguments

:: Typeable1 t 
=> Union (t :> r) v

Request

-> (v -> Eff r a)

Relay the request

-> (t v -> Eff r a)

Handle the request of type t

-> Eff r a 

Given a request, either handle it or relay it.