Safe Haskell | Safe |
---|---|
Language | Haskell98 |
This library provides a collection of monad transformers that can be combined to produce various monads.
Synopsis
- 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
- type family WithBase base layers :: Type -> Type where ...
- 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.
Instances
MonadT IdT Source # | |
Monad m => Monad (IdT m) Source # | |
Monad m => Functor (IdT m) Source # | |
MonadFix m => MonadFix (IdT m) Source # | |
Monad m => Applicative (IdT m) Source # | |
MonadPlus m => Alternative (IdT m) Source # | |
MonadPlus m => MonadPlus (IdT m) Source # | |
ContM m => ContM (IdT m) Source # | |
AbortM m i => AbortM (IdT m) i Source # | |
RunExceptionM m i => RunExceptionM (IdT m) i Source # | |
RunWriterM m j => RunWriterM (IdT m) j Source # | |
RunReaderM m j => RunReaderM (IdT m) j Source # | |
ExceptionM m j => ExceptionM (IdT m) j Source # | |
StateM m j => StateM (IdT m) j Source # | |
WriterM m j => WriterM (IdT m) j Source # | |
ReaderM m j => ReaderM (IdT m) j Source # | |
BaseM m n => BaseM (IdT m) n Source # | |
RunM m a r => RunM (IdT m) a r Source # | |
Add support for propagating a context of type i
.
Instances
MonadT (ReaderT i) Source # | |
Monad m => Monad (ReaderT i m) Source # | |
Monad m => Functor (ReaderT i m) Source # | |
MonadFix m => MonadFix (ReaderT i m) Source # | |
Monad m => Applicative (ReaderT i m) Source # | |
Defined in MonadLib | |
MonadPlus m => Alternative (ReaderT i m) Source # | |
MonadPlus m => MonadPlus (ReaderT i m) Source # | |
ContM m => ContM (ReaderT i m) Source # | |
AbortM m i => AbortM (ReaderT j m) i Source # | |
RunExceptionM m i => RunExceptionM (ReaderT j m) i Source # | |
RunWriterM m j => RunWriterM (ReaderT i m) j Source # | |
Monad m => RunReaderM (ReaderT i m) i Source # | |
ExceptionM m j => ExceptionM (ReaderT i m) j Source # | |
StateM m j => StateM (ReaderT i m) j Source # | |
WriterM m j => WriterM (ReaderT i m) j Source # | |
Monad m => ReaderM (ReaderT i m) i Source # | |
BaseM m n => BaseM (ReaderT i m) n Source # | |
RunM m a r => RunM (ReaderT i m) a (i -> r) Source # | |
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.
Instances
Add support for threading state of type i
.
Instances
MonadT (StateT i) Source # | |
Monad m => Monad (StateT i m) Source # | |
Monad m => Functor (StateT i m) Source # | |
MonadFix m => MonadFix (StateT i m) Source # | |
Monad m => Applicative (StateT i m) Source # | |
MonadPlus m => Alternative (StateT i m) Source # | |
MonadPlus m => MonadPlus (StateT i m) Source # | |
ContM m => ContM (StateT i m) Source # | |
AbortM m i => AbortM (StateT j m) i Source # | |
RunExceptionM m i => RunExceptionM (StateT j m) i Source # | |
RunWriterM m j => RunWriterM (StateT i m) j Source # | |
RunReaderM m j => RunReaderM (StateT i m) j Source # | |
ExceptionM m j => ExceptionM (StateT i m) j Source # | |
Monad m => StateM (StateT i m) i Source # | |
WriterM m j => WriterM (StateT i m) j Source # | |
ReaderM m j => ReaderM (StateT i m) j Source # | |
BaseM m n => BaseM (StateT i m) n Source # | |
RunM m (a, i) r => RunM (StateT i m) a (i -> r) Source # | |
data ExceptionT i m a Source #
Add support for exceptions of type i
.
Instances
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.
Instances
MonadT ChoiceT Source # | |
Monad m => Monad (ChoiceT m) Source # | |
Monad m => Functor (ChoiceT m) Source # | |
Monad m => Applicative (ChoiceT m) Source # | |
Monad m => Alternative (ChoiceT m) Source # | |
Monad m => MonadPlus (ChoiceT m) Source # | |
ContM m => ContM (ChoiceT m) Source # | |
AbortM m i => AbortM (ChoiceT m) i Source # | |
ExceptionM m j => ExceptionM (ChoiceT m) j Source # | |
StateM m j => StateM (ChoiceT m) j Source # | |
WriterM m j => WriterM (ChoiceT m) j Source # | |
ReaderM m j => ReaderM (ChoiceT m) j Source # | |
BaseM m n => BaseM (ChoiceT m) n Source # | |
RunM m (Maybe (a, ChoiceT m a)) r => RunM (ChoiceT m) a r Source # | |
Add support for continuations within a prompt of type i
.
Instances
MonadT (ContT i) Source # | |
Monad m => Monad (ContT i m) Source # | |
Monad m => Functor (ContT i m) Source # | |
Monad m => Applicative (ContT i m) Source # | |
MonadPlus m => Alternative (ContT i m) Source # | |
MonadPlus m => MonadPlus (ContT i m) Source # | |
Monad m => ContM (ContT i m) Source # | |
Monad m => AbortM (ContT i m) i Source # | |
(RunWriterM m j, MonadFix m) => RunWriterM (ContT i m) j Source # | |
RunReaderM m j => RunReaderM (ContT i m) j Source # | |
ExceptionM m j => ExceptionM (ContT i m) j Source # | |
StateM m j => StateM (ContT i m) j Source # | |
WriterM m j => WriterM (ContT i m) j Source # | |
ReaderM m j => ReaderM (ContT i m) j Source # | |
BaseM m n => BaseM (ContT i m) n Source # | |
RunM m i r => RunM (ContT i m) a ((a -> m i) -> r) Source # | |
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 where Source #
Instances
BaseM [] [] Source # | |
BaseM Maybe Maybe Source # | |
BaseM IO IO Source # | |
BaseM Lift Lift Source # | |
BaseM Id Id Source # | |
BaseM m n => BaseM (ChoiceT m) n Source # | |
BaseM m n => BaseM (IdT m) n Source # | |
BaseM (ST s) (ST s) Source # | |
BaseM (Cont i) (Cont i) Source # | |
BaseM (Exception i) (Exception i) Source # | |
BaseM (State i) (State i) Source # | |
Monoid i => BaseM (Writer i) (Writer i) Source # | |
BaseM (Reader i) (Reader i) Source # | |
BaseM m n => BaseM (ContT i m) n Source # | |
BaseM m n => BaseM (ExceptionT i m) n Source # | |
Defined in MonadLib inBase :: n a -> ExceptionT i m a Source # | |
BaseM m n => BaseM (StateT i m) n Source # | |
(BaseM m n, Monoid i) => BaseM (WriterT i m) n Source # | |
BaseM m n => BaseM (ReaderT i m) n Source # | |
Effect Classes
The following classes define overloaded operations that can be used to define effectful computations.
class Monad m => ReaderM m i | m -> i where Source #
Classifies monads that provide access to a context of type i
.
Instances
ReaderM m j => ReaderM (ChoiceT m) j Source # | |
ReaderM m j => ReaderM (IdT m) j Source # | |
ReaderM (Reader i) i Source # | |
Defined in MonadLib.Monads | |
ReaderM m j => ReaderM (ContT i m) j Source # | |
ReaderM m j => ReaderM (ExceptionT i m) j Source # | |
Defined in MonadLib ask :: ExceptionT i m j Source # | |
ReaderM m j => ReaderM (StateT i m) j Source # | |
(ReaderM m j, Monoid i) => ReaderM (WriterT i m) j Source # | |
Monad m => ReaderM (ReaderT i m) i Source # | |
class Monad m => WriterM m i | m -> i where Source #
Classifies monads that can collect values of type i
.
Instances
WriterM m j => WriterM (ChoiceT m) j Source # | |
WriterM m j => WriterM (IdT m) j Source # | |
Monoid i => WriterM (Writer i) i Source # | |
Defined in MonadLib.Monads | |
WriterM m j => WriterM (ContT i m) j Source # | |
WriterM m j => WriterM (ExceptionT i m) j Source # | |
Defined in MonadLib put :: j -> ExceptionT i m () Source # | |
WriterM m j => WriterM (StateT i m) j Source # | |
(Monad m, Monoid i) => WriterM (WriterT i m) i Source # | |
WriterM m j => WriterM (ReaderT i m) j Source # | |
class Monad m => StateM m i | m -> i where Source #
Classifies monads that propagate a state component of type i
.
Instances
StateM m j => StateM (ChoiceT m) j Source # | |
StateM m j => StateM (IdT m) j Source # | |
StateM (State i) i Source # | |
StateM m j => StateM (ContT i m) j Source # | |
StateM m j => StateM (ExceptionT i m) j Source # | |
Defined in MonadLib get :: ExceptionT i m j Source # set :: j -> ExceptionT i m () Source # | |
Monad m => StateM (StateT i m) i Source # | |
(StateM m j, Monoid i) => StateM (WriterT i m) j Source # | |
StateM m j => StateM (ReaderT i m) j Source # | |
class Monad m => ExceptionM m i | m -> i where Source #
Classifies monads that support raising exceptions of type i
.
Instances
ExceptionM IO SomeException Source # | |
ExceptionM m j => ExceptionM (ChoiceT m) j Source # | |
ExceptionM m j => ExceptionM (IdT m) j Source # | |
ExceptionM (Exception i) i Source # | |
Defined in MonadLib.Monads | |
ExceptionM m j => ExceptionM (ContT i m) j Source # | |
Monad m => ExceptionM (ExceptionT i m) i Source # | |
Defined in MonadLib raise :: i -> ExceptionT i m a Source # | |
ExceptionM m j => ExceptionM (StateT i m) j Source # | |
(ExceptionM m j, Monoid i) => ExceptionM (WriterT i m) j Source # | |
ExceptionM m j => ExceptionM (ReaderT i m) j Source # | |
class Monad m => ContM m where Source #
Classifies monads that provide access to a computation's continuation.
callWithCC :: ((a -> Label m) -> m a) -> m a Source #
Capture the current continuation.
Instances
ContM m => ContM (ChoiceT m) Source # | |
ContM m => ContM (IdT m) Source # | |
ContM (Cont i) Source # | |
Defined in MonadLib.Monads | |
Monad m => ContM (ContT i m) Source # | |
ContM m => ContM (ExceptionT i m) Source # | |
Defined in MonadLib callWithCC :: ((a -> Label (ExceptionT i m)) -> ExceptionT i m a) -> ExceptionT i m a Source # | |
ContM m => ContM (StateT i m) Source # | |
(ContM m, Monoid i) => ContM (WriterT i m) Source # | |
ContM m => ContM (ReaderT i m) Source # | |
class Monad m => AbortM m i where Source #
Classifies monads that support aborting the program and returning
a given final result of type i
.
Instances
AbortM IO ExitCode Source # | |
AbortM m i => AbortM (ChoiceT m) i Source # | |
AbortM m i => AbortM (IdT m) i Source # | |
Monad m => AbortM (ContT i m) i Source # | |
AbortM m i => AbortM (ExceptionT j m) i Source # | |
Defined in MonadLib abort :: i -> ExceptionT j m a Source # | |
AbortM m i => AbortM (StateT j m) i Source # | |
(AbortM m i, Monoid j) => AbortM (WriterT j m) i Source # | |
AbortM m i => AbortM (ReaderT j m) i Source # | |
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 a Source #
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 a Source #
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 i Source #
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 where Source #
Generalized running.
Instances
RunM Lift a a Source # | |
RunM Id a a Source # | |
RunM IO a (IO a) Source # | |
RunM m (Maybe (a, ChoiceT m a)) r => RunM (ChoiceT m) a r Source # | |
RunM m a r => RunM (IdT m) a r Source # | |
RunM m (Either i a) r => RunM (ExceptionT i m) a r Source # | |
Defined in MonadLib runM :: ExceptionT i m a -> r Source # | |
(Monoid i, RunM m (a, i) r) => RunM (WriterT i m) a r Source # | |
RunM m i r => RunM (ContT i m) a ((a -> m i) -> r) Source # | |
RunM m (a, i) r => RunM (StateT i m) a (i -> r) Source # | |
RunM m a r => RunM (ReaderT i m) a (i -> r) Source # | |
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 where Source #
Classifies monads that support changing the context for a sub-computation.
Instances
RunReaderM m j => RunReaderM (IdT m) j Source # | |
RunReaderM (Reader i) i Source # | |
RunReaderM m j => RunReaderM (ContT i m) j Source # | |
RunReaderM m j => RunReaderM (ExceptionT i m) j Source # | |
Defined in MonadLib local :: j -> ExceptionT i m a -> ExceptionT i m a Source # | |
RunReaderM m j => RunReaderM (StateT i m) j Source # | |
(RunReaderM m j, Monoid i) => RunReaderM (WriterT i m) j Source # | |
Monad m => RunReaderM (ReaderT i m) i Source # | |
class WriterM m i => RunWriterM m i | m -> i where Source #
Classifies monads that support collecting the output of a sub-computation.
Instances
RunWriterM m j => RunWriterM (IdT m) j Source # | |
Monoid i => RunWriterM (Writer i) i Source # | |
(RunWriterM m j, MonadFix m) => RunWriterM (ContT i m) j Source # | |
RunWriterM m j => RunWriterM (ExceptionT i m) j Source # | |
Defined in MonadLib collect :: ExceptionT i m a -> ExceptionT i m (a, j) Source # | |
RunWriterM m j => RunWriterM (StateT i m) j Source # | |
(Monad m, Monoid i) => RunWriterM (WriterT i m) i Source # | |
RunWriterM m j => RunWriterM (ReaderT i m) j Source # | |
class ExceptionM m i => RunExceptionM m i | m -> i where Source #
Classifies monads that support handling of exceptions.
Instances
RunExceptionM IO SomeException Source # | |
RunExceptionM m i => RunExceptionM (IdT m) i Source # | |
RunExceptionM (Exception i) i Source # | |
Monad m => RunExceptionM (ExceptionT i m) i Source # | |
Defined in MonadLib try :: ExceptionT i m a -> ExceptionT i m (Either i a) Source # | |
RunExceptionM m i => RunExceptionM (StateT j m) i Source # | |
(RunExceptionM m i, Monoid j) => RunExceptionM (WriterT j m) i Source # | |
RunExceptionM m i => RunExceptionM (ReaderT j m) i Source # | |
Utility functions
asks :: ReaderM m r => (r -> a) -> m a Source #
Apply a function to the environment. Useful for accessing environmnt components.
raises :: ExceptionM m x => Either x a -> m a Source #
mapReader :: RunReaderM m r => (r -> r) -> m a -> m a Source #
Modify the environment for the duration of a computation.
mapWriter :: RunWriterM m w => (w -> w) -> m a -> m a Source #
Modify the output of a computation.
mapException :: RunExceptionM m x => (x -> x) -> m a -> m a Source #
Modify the exception that was risen by a computation.
handle :: RunExceptionM m x => m a -> (x -> m a) -> m a Source #
Apply the given exception handler, if a computation raises an exception.
type family WithBase base layers :: Type -> Type where ... Source #
A convenience type family for defining stacks of monads. The first entry in the list is the top-most layer of the monad stack (i.e., the one that is furtherest from the base). For example:
newtype M a = M { unM :: WithBase IO '[ ReaderT Int , StateT Char , ExceptionT String ] a }
is equivalent to:
newtype M a = M { unM :: ReaderT Int ( StateT Char ( ExceptionT String IO )) a }
Miscellaneous
module Control.Monad