extensible-effects-1.7.1.0: An Alternative to Monad Transformers

Safe HaskellTrustworthy
LanguageHaskell98

Control.Eff

Description

Original work available at http://okmij.org/ftp/Haskell/extensible/Eff.hs. This module implements extensible effects as an alternative to monad transformers, as described in http://okmij.org/ftp/Haskell/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

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

Constructors

Eff 

Fields

runEff :: forall w. (a -> VE r w) -> VE r w
 

Instances

(MonadBase b m, Typeable (* -> *) m, SetMember ((* -> *) -> * -> *) * Lift (Lift m) r) => MonadBase b (Eff r) 
Monad (Eff r) 
Functor (Eff r) 
Applicative (Eff r) 
(Typeable (* -> *) m, MonadIO m, SetMember ((* -> *) -> * -> *) * Lift (Lift m) r) => MonadIO (Eff r) 
Typeable (* -> * -> *) Eff 

data VE r w 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 r w)) 

Instances

Typeable (* -> * -> *) VE 

class Member t r Source

The Member t r specifies whether t is present anywhere in the sum type r, where t is some effectful type, e.g. Lift IO, State Int`.

Instances

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

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

SetMember is similar to Member, but it allows types to belong to a "set". For every set, only one member can be in r at any given time. This allows us to specify exclusivity and uniqueness among arbitrary effects:

-- 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 ((:>) k 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 infixr 1 Source

A sum data type, for composing effects

Instances

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

inj :: (Functor t, Typeable t, Member t r) => t v -> Union r v Source

Construct a Union.

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

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

prjForce :: (Typeable t, Member t r) => Union r v -> (t v -> a) -> a Source

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

decomp :: Typeable 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 r w) -> Union r (VE r w)) -> Eff r a Source

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

admin :: Eff r w -> VE r w Source

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

run :: Eff () w -> w Source

Get the result from a pure computation.

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

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.

handleRelay Source

Arguments

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

unsafeReUnion :: Union r w -> Union t w Source

Juggle types for a Union. Use cautiously.