Safe Haskell | Trustworthy |
---|
This library provides a collection of monad transformers that can be combined to produce various monads.
- data Id a
- data Lift a
- data IdT m a
- data ReaderT i m a
- data WriterT i m a
- data StateT i m a
- data ExceptionT i m a
- data ChoiceT m a
- data ContT i m a
- class MonadT t where
- class (Monad m, Monad n) => BaseM m n | m -> n where
- inBase :: n a -> m a
- class Monad m => ReaderM m i | m -> i where
- ask :: m i
- class Monad m => WriterM m i | m -> i where
- put :: i -> m ()
- class Monad m => StateM m i | m -> i where
- class Monad m => ExceptionM m i | m -> i where
- raise :: i -> m a
- class Monad m => ContM m where
- callWithCC :: ((a -> Label m) -> m a) -> m a
- class Monad m => AbortM m i where
- abort :: i -> m a
- data Label m
- labelCC :: ContM m => a -> m (a, a -> Label m)
- labelCC_ :: forall m. ContM m => m (Label m)
- jump :: Label m -> m a
- labelC :: (forall b. m b) -> Label m
- callCC :: ContM m => ((a -> m b) -> m a) -> m a
- runId :: Id a -> a
- runLift :: Lift a -> a
- runIdT :: IdT m a -> m a
- runReaderT :: i -> ReaderT i m a -> m a
- runWriterT :: Monad m => WriterT i m a -> m (a, i)
- runStateT :: i -> StateT i m a -> m (a, i)
- runExceptionT :: ExceptionT i m a -> m (Either i a)
- runContT :: (a -> m i) -> ContT i m a -> m i
- runChoiceT :: Monad m => ChoiceT m a -> m (Maybe (a, ChoiceT m a))
- findOne :: Monad m => ChoiceT m a -> m (Maybe a)
- findAll :: Monad m => ChoiceT m a -> m [a]
- class Monad m => RunM m a r | m a -> r where
- runM :: m a -> r
- class ReaderM m i => RunReaderM m i | m -> i where
- local :: i -> m a -> m a
- class WriterM m i => RunWriterM m i | m -> i where
- collect :: m a -> m (a, i)
- class ExceptionM m i => RunExceptionM m i | m -> i where
- asks :: ReaderM m r => (r -> a) -> m a
- puts :: WriterM m w => (a, w) -> m a
- sets :: StateM m s => (s -> (a, s)) -> m a
- sets_ :: StateM m s => (s -> s) -> m ()
- raises :: ExceptionM m x => Either x a -> m a
- mapReader :: RunReaderM m r => (r -> r) -> m a -> m a
- mapWriter :: RunWriterM m w => (w -> w) -> m a -> m a
- mapException :: RunExceptionM m x => (x -> x) -> m a -> m a
- handle :: RunExceptionM m x => m a -> (x -> m a) -> m a
- version :: (Int, Int, Int)
- module Control.Monad
Types
The following types define the representations of the computation types supported by the library. Each type adds support for a different effect.
Computations with no effects.
Computation with no effects (strict).
Adds no new features. Useful as a placeholder.
MonadT IdT | |
Monad m => Monad (IdT m) | |
Monad m => Functor (IdT m) | |
MonadFix m => MonadFix (IdT m) | |
MonadPlus m => MonadPlus (IdT m) | |
Monad m => Applicative (IdT m) | |
MonadPlus m => Alternative (IdT m) | |
ContM m => ContM (IdT m) | |
AbortM m i => AbortM (IdT m) i | |
RunExceptionM m i => RunExceptionM (IdT m) i | |
RunWriterM m j => RunWriterM (IdT m) j | |
RunReaderM m j => RunReaderM (IdT m) j | |
ExceptionM m j => ExceptionM (IdT m) j | |
StateM m j => StateM (IdT m) j | |
WriterM m j => WriterM (IdT m) j | |
ReaderM m j => ReaderM (IdT m) j | |
BaseM m n => BaseM (IdT m) n | |
RunM m a r => RunM (IdT m) a r |
Add support for propagating a context of type i
.
MonadT (ReaderT i) | |
Monad m => Monad (ReaderT i m) | |
Monad m => Functor (ReaderT i m) | |
MonadFix m => MonadFix (ReaderT i m) | |
MonadPlus m => MonadPlus (ReaderT i m) | |
Monad m => Applicative (ReaderT i m) | |
MonadPlus m => Alternative (ReaderT i m) | |
ContM m => ContM (ReaderT i m) | |
AbortM m i => AbortM (ReaderT j m) i | |
RunExceptionM m i => RunExceptionM (ReaderT j m) i | |
RunWriterM m j => RunWriterM (ReaderT i m) j | |
Monad m => RunReaderM (ReaderT i m) i | |
ExceptionM m j => ExceptionM (ReaderT i m) j | |
StateM m j => StateM (ReaderT i m) j | |
WriterM m j => WriterM (ReaderT i m) j | |
Monad m => ReaderM (ReaderT i m) i | |
BaseM m n => BaseM (ReaderT i m) n | |
RunM m a r => RunM (ReaderT i m) a (i -> r) |
Add support for collecting values of type i
.
The type i
should be a monoid, whose unit is used to represent
a lack of a value, and whose binary operation is used to combine
multiple values.
This transformer is strict in its output component.
Monoid i => MonadT (WriterT i) | |
(Monad m, Monoid i) => Monad (WriterT i m) | |
(Monad m, Monoid i) => Functor (WriterT i m) | |
(MonadFix m, Monoid i) => MonadFix (WriterT i m) | |
(MonadPlus m, Monoid i) => MonadPlus (WriterT i m) | |
(Monad m, Monoid i) => Applicative (WriterT i m) | |
(MonadPlus m, Monoid i) => Alternative (WriterT i m) | |
(ContM m, Monoid i) => ContM (WriterT i m) | |
(AbortM m i, Monoid j) => AbortM (WriterT j m) i | |
(RunExceptionM m i, Monoid j) => RunExceptionM (WriterT j m) i | |
(Monad m, Monoid i) => RunWriterM (WriterT i m) i | |
(RunReaderM m j, Monoid i) => RunReaderM (WriterT i m) j | |
(ExceptionM m j, Monoid i) => ExceptionM (WriterT i m) j | |
(StateM m j, Monoid i) => StateM (WriterT i m) j | |
(Monad m, Monoid i) => WriterM (WriterT i m) i | |
(ReaderM m j, Monoid i) => ReaderM (WriterT i m) j | |
(BaseM m n, Monoid i) => BaseM (WriterT i m) n | |
(Monoid i, RunM m (a, i) r) => RunM (WriterT i m) a r |
Add support for threading state of type i
.
MonadT (StateT i) | |
Monad m => Monad (StateT i m) | |
Monad m => Functor (StateT i m) | |
MonadFix m => MonadFix (StateT i m) | |
MonadPlus m => MonadPlus (StateT i m) | |
Monad m => Applicative (StateT i m) | |
MonadPlus m => Alternative (StateT i m) | |
ContM m => ContM (StateT i m) | |
AbortM m i => AbortM (StateT j m) i | |
RunExceptionM m i => RunExceptionM (StateT j m) i | |
RunWriterM m j => RunWriterM (StateT i m) j | |
RunReaderM m j => RunReaderM (StateT i m) j | |
ExceptionM m j => ExceptionM (StateT i m) j | |
Monad m => StateM (StateT i m) i | |
WriterM m j => WriterM (StateT i m) j | |
ReaderM m j => ReaderM (StateT i m) j | |
BaseM m n => BaseM (StateT i m) n | |
RunM m (a, i) r => RunM (StateT i m) a (i -> r) |
data ExceptionT i m a Source
Add support for exceptions of type i
.
MonadT (ExceptionT i) | |
Monad m => Monad (ExceptionT i m) | |
Monad m => Functor (ExceptionT i m) | |
MonadFix m => MonadFix (ExceptionT i m) | |
MonadPlus m => MonadPlus (ExceptionT i m) | |
Monad m => Applicative (ExceptionT i m) | |
MonadPlus m => Alternative (ExceptionT i m) | |
ContM m => ContM (ExceptionT i m) | |
AbortM m i => AbortM (ExceptionT j m) i | |
Monad m => RunExceptionM (ExceptionT i m) i | |
RunWriterM m j => RunWriterM (ExceptionT i m) j | |
RunReaderM m j => RunReaderM (ExceptionT i m) j | |
Monad m => ExceptionM (ExceptionT i m) i | |
StateM m j => StateM (ExceptionT i m) j | |
WriterM m j => WriterM (ExceptionT i m) j | |
ReaderM m j => ReaderM (ExceptionT i m) j | |
BaseM m n => BaseM (ExceptionT i m) n | |
RunM m (Either i a) r => RunM (ExceptionT i m) a r |
About the WriterM
instance:
If an exception is risen while we are collecting output,
then the output is lost. If the output is important,
then use try
to ensure that no exception may occur.
Example:
do (r,w) <- collect (try m) case r of Left err -> ...do something... Right a -> ...do something...
Add support for multiple answers.
MonadT ChoiceT | |
Monad m => Monad (ChoiceT m) | |
Monad m => Functor (ChoiceT m) | |
Monad m => MonadPlus (ChoiceT m) | |
Monad m => Applicative (ChoiceT m) | |
Monad m => Alternative (ChoiceT m) | |
ContM m => ContM (ChoiceT m) | |
AbortM m i => AbortM (ChoiceT m) i | |
ExceptionM m j => ExceptionM (ChoiceT m) j | |
StateM m j => StateM (ChoiceT m) j | |
WriterM m j => WriterM (ChoiceT m) j | |
ReaderM m j => ReaderM (ChoiceT m) j | |
BaseM m n => BaseM (ChoiceT m) n | |
RunM m (Maybe (a, ChoiceT m a)) r => RunM (ChoiceT m) a r |
Add support for continuations within a prompt of type i
.
MonadT (ContT i) | |
Monad m => Monad (ContT i m) | |
Monad m => Functor (ContT i m) | |
MonadPlus m => MonadPlus (ContT i m) | |
Monad m => Applicative (ContT i m) | |
MonadPlus m => Alternative (ContT i m) | |
Monad m => ContM (ContT i m) | |
Monad m => AbortM (ContT i m) i | |
(RunWriterM m j, MonadFix m) => RunWriterM (ContT i m) j | |
RunReaderM m j => RunReaderM (ContT i m) j | |
ExceptionM m j => ExceptionM (ContT i m) j | |
StateM m j => StateM (ContT i m) j | |
WriterM m j => WriterM (ContT i m) j | |
ReaderM m j => ReaderM (ContT i m) j | |
BaseM m n => BaseM (ContT i m) n | |
RunM m i r => RunM (ContT i m) a ((a -> m i) -> r) |
Lifting
The following operations allow us to promote computations in the underlying monad to computations that support an extra effect. Computations defined in this way do not make use of the new effect but can be combined with other operations that utilize the effect.
class (Monad m, Monad n) => BaseM m n | m -> n whereSource
BaseM [] [] | |
BaseM IO IO | |
BaseM Maybe Maybe | |
BaseM Lift Lift | |
BaseM Id Id | |
BaseM m n => BaseM (ChoiceT m) n | |
BaseM m n => BaseM (IdT m) n | |
BaseM (ST s) (ST s) | |
BaseM (Cont i) (Cont i) | |
BaseM (Exception i) (Exception i) | |
BaseM (State i) (State i) | |
Monoid i => BaseM (Writer i) (Writer i) | |
BaseM (Reader i) (Reader i) | |
BaseM m n => BaseM (ContT i m) n | |
BaseM m n => BaseM (ExceptionT i m) n | |
BaseM m n => BaseM (StateT i m) n | |
(BaseM m n, Monoid i) => BaseM (WriterT i m) n | |
BaseM m n => BaseM (ReaderT i m) n |
Effect Classes
The following classes define overloaded operations that can be used to define effectful computations.
class Monad m => ReaderM m i | m -> i whereSource
Classifies monads that provide access to a context of type i
.
class Monad m => WriterM m i | m -> i whereSource
Classifies monads that can collect values of type i
.
WriterM m j => WriterM (ChoiceT m) j | |
WriterM m j => WriterM (IdT m) j | |
Monoid i => WriterM (Writer i) i | |
WriterM m j => WriterM (ContT i m) j | |
WriterM m j => WriterM (ExceptionT i m) j | |
WriterM m j => WriterM (StateT i m) j | |
(Monad m, Monoid i) => WriterM (WriterT i m) i | |
WriterM m j => WriterM (ReaderT i m) j |
class Monad m => StateM m i | m -> i whereSource
Classifies monads that propagate a state component of type i
.
class Monad m => ExceptionM m i | m -> i whereSource
Classifies monads that support raising exceptions of type i
.
ExceptionM IO SomeException | |
ExceptionM m j => ExceptionM (ChoiceT m) j | |
ExceptionM m j => ExceptionM (IdT m) j | |
ExceptionM (Exception i) i | |
ExceptionM m j => ExceptionM (ContT i m) j | |
Monad m => ExceptionM (ExceptionT i m) i | |
ExceptionM m j => ExceptionM (StateT i m) j | |
(ExceptionM m j, Monoid i) => ExceptionM (WriterT i m) j | |
ExceptionM m j => ExceptionM (ReaderT i m) j |
class Monad m => ContM m whereSource
Classifies monads that provide access to a computation's continuation.
callWithCC :: ((a -> Label m) -> m a) -> m aSource
Capture the current continuation.
class Monad m => AbortM m i whereSource
Classifies monads that support aborting the program and returning
a given final result of type i
.
labelCC_ :: forall m. ContM m => m (Label m)Source
Capture the current continuation.
Later we can use jump
to restart the program from this point.
callCC :: ContM m => ((a -> m b) -> m a) -> m aSource
A version of callWithCC
that avoids the need for an explicit
use of the jump
function.
Execution
Eliminating Effects
The following functions eliminate the outermost effect
of a computation by translating a computation into an
equivalent computation in the underlying monad.
(The exceptions are Id
and Lift
which are not transformers
but ordinary monads and so, their run operations simply
eliminate the monad.)
runReaderT :: i -> ReaderT i m a -> m aSource
Execute a reader computation in the given context.
runWriterT :: Monad m => WriterT i m a -> m (a, i)Source
Execute a writer computation. Returns the result and the collected output.
runStateT :: i -> StateT i m a -> m (a, i)Source
Execute a stateful computation in the given initial state. The second component of the result is the final state.
runExceptionT :: ExceptionT i m a -> m (Either i a)Source
runContT :: (a -> m i) -> ContT i m a -> m iSource
Execute a computation with the given continuation.
runChoiceT :: Monad m => ChoiceT m a -> m (Maybe (a, ChoiceT m a))Source
Execute a computation that may return multiple answers.
The resulting computation returns Nothing
if no answers were found, or Just (answer,new_comp)
,
where answer
is an answer, and new_comp
is a computation
that may produce more answers.
The search is depth-first and left-biased with respect to the
mplus
operation.
findOne :: Monad m => ChoiceT m a -> m (Maybe a)Source
Execute a computation that may return multiple answers, returning at most one answer.
findAll :: Monad m => ChoiceT m a -> m [a]Source
Execute a computation that may return multiple answers, collecting all possible answers.
class Monad m => RunM m a r | m a -> r whereSource
Generalized running.
RunM Lift a a | |
RunM Id a a | |
RunM IO a (IO a) | |
RunM m (Maybe (a, ChoiceT m a)) r => RunM (ChoiceT m) a r | |
RunM m a r => RunM (IdT m) a r | |
RunM m (Either i a) r => RunM (ExceptionT i m) a r | |
(Monoid i, RunM m (a, i) r) => RunM (WriterT i m) a r | |
RunM m i r => RunM (ContT i m) a ((a -> m i) -> r) | |
RunM m (a, i) r => RunM (StateT i m) a (i -> r) | |
RunM m a r => RunM (ReaderT i m) a (i -> r) |
Nested Execution
The following classes define operations that are overloaded
versions of the run
operations. Unlike the run
operations,
these functions do not change the type of the computation (i.e., they
do not remove a layer). Instead, they perform the effects in
a ``separate effect thread''.
class ReaderM m i => RunReaderM m i | m -> i whereSource
Classifies monads that support changing the context for a sub-computation.
RunReaderM m j => RunReaderM (IdT m) j | |
RunReaderM (Reader i) i | |
RunReaderM m j => RunReaderM (ContT i m) j | |
RunReaderM m j => RunReaderM (ExceptionT i m) j | |
RunReaderM m j => RunReaderM (StateT i m) j | |
(RunReaderM m j, Monoid i) => RunReaderM (WriterT i m) j | |
Monad m => RunReaderM (ReaderT i m) i |
class WriterM m i => RunWriterM m i | m -> i whereSource
Classifies monads that support collecting the output of a sub-computation.
RunWriterM m j => RunWriterM (IdT m) j | |
Monoid i => RunWriterM (Writer i) i | |
(RunWriterM m j, MonadFix m) => RunWriterM (ContT i m) j | |
RunWriterM m j => RunWriterM (ExceptionT i m) j | |
RunWriterM m j => RunWriterM (StateT i m) j | |
(Monad m, Monoid i) => RunWriterM (WriterT i m) i | |
RunWriterM m j => RunWriterM (ReaderT i m) j |
class ExceptionM m i => RunExceptionM m i | m -> i whereSource
Classifies monads that support handling of exceptions.
RunExceptionM IO SomeException | |
RunExceptionM m i => RunExceptionM (IdT m) i | |
RunExceptionM (Exception i) i | |
Monad m => RunExceptionM (ExceptionT i m) i | |
RunExceptionM m i => RunExceptionM (StateT j m) i | |
(RunExceptionM m i, Monoid j) => RunExceptionM (WriterT j m) i | |
RunExceptionM m i => RunExceptionM (ReaderT j m) i |
Utility functions
asks :: ReaderM m r => (r -> a) -> m aSource
Apply a function to the environment. Useful for accessing environmnt components.
raises :: ExceptionM m x => Either x a -> m aSource
mapReader :: RunReaderM m r => (r -> r) -> m a -> m aSource
Modify the environment for the duration of a computation.
mapWriter :: RunWriterM m w => (w -> w) -> m a -> m aSource
Modify the output of a computation.
mapException :: RunExceptionM m x => (x -> x) -> m a -> m aSource
Modify the exception that was risen by a computation.
handle :: RunExceptionM m x => m a -> (x -> m a) -> m aSource
Apply the given exception handler, if a computation raises an exception.
Miscellaneous
module Control.Monad