Maintainer | Ralf Laemmel, Joost Visser |
---|---|
Stability | experimental |
Portability | portable |
Safe Haskell | None |
Language | Haskell98 |
This module is part of StrategyLib
, a library of functional strategy
combinators, including combinators for generic traversal. This module
provides non-strategic functionality for running monads and unlifting
monad transformers. In a sense, this is dual to the return
and lift
functionality of the Monad
and MonadTrans
classes.
- data MaybeAlg a b = MaybeAlg {}
- data ErrorAlg e a b = ErrorAlg {}
- data ListAlg a b = ListAlg {}
- data StateAlg s a b = StateAlg {}
- class MonadRun s m | m -> s where
- run :: s a b -> m a -> b
- mrun :: (MonadRun s m, Monad m') => s a b -> m a -> m' b
- class MonadUnTrans s t | t -> s where
- mplus' :: (Monad m, MonadUnTrans MaybeAlg t) => t m b -> m b -> m b
- mswitch :: (Monad m, MonadUnTrans MaybeAlg t) => [t m b] -> m b -> m b
- mayswitch :: Monad m => [MaybeT m b] -> m b -> m b
- mchoice' :: (Monad m, MonadUnTrans MaybeAlg t) => (a -> t m b) -> (a -> m b) -> a -> m b
- mchoices :: (Monad m, MonadUnTrans MaybeAlg t, MonadPlus (t m)) => [a -> t m b] -> (a -> m b) -> a -> m b
- mswitch0 :: (Monad m, MonadUnTrans MaybeAlg t) => [t m b] -> m b -> m b
- mswitch1 :: (Monad m, MonadUnTrans MaybeAlg t) => [t m b] -> m b -> m b
- mswitch' :: (Monad m, MonadUnTrans MaybeAlg t, MonadPlus (t m)) => [t m b] -> m b -> m b
Monad algebras
The algebra for the non-determinacy effect of '[]' and ListT
.
MonadUnTrans ListAlg ListT | Unlifting the list monad transformer. |
MonadRun ListAlg [] | Running the list monad. |
Running monads
class MonadRun s m | m -> s where Source
The class of monads for which a run
function is defined that
executes the computation of the monad.
run :: s a b -> m a -> b Source
The overloaded function run takes as first argument an "algebra" which captures the ingredients necessary to run the particular monad at hand. This algebra is parameterized with the domain and co-domain of run.
MonadRun (->) IO | Running the |
MonadRun (->) Identity | Running the |
MonadRun ListAlg [] | Running the list monad. |
MonadRun MaybeAlg Maybe | Running the |
MonadRun (StateAlg s) (State s) | Running the |
MonadRun (ErrorAlg e) (Either e) | Running the error monad. |
mrun :: (MonadRun s m, Monad m') => s a b -> m a -> m' b Source
Exchange one monad by another.
This function runs one monad, and puts its value in another. This is
basically a monadic version of the run
function itself. Note that the two
monads are unrelated, so none of the effects of the incoming monad are
transferred to the result monad.
Unlifting monad transformers
class MonadUnTrans s t | t -> s where Source
Just as a base monad can be run to remove the monad, so can a transformed monad be unlifted to remove the transformer and obtain the original monad.
unlift :: Monad m => s a b -> t m a -> m b Source
The overloaded function unlift
for monad transformers takes as first
argument an "algebra" just like the run function for base monads. For
each monad transformer, the same algebra is used as for the base monad
of which the transformer is the parameterized variant.
MonadUnTrans ListAlg ListT | Unlifting the list monad transformer. |
MonadUnTrans MaybeAlg MaybeT | Unlifting the partiality monad transformer. |
MonadUnTrans (StateAlg s) (StateT s) | Unlifting the state monad transformer |
MonadUnTrans (ErrorAlg e) (ErrorT e) | Unlifting the error monad transformer. |
Monadic choice combinators that confine the partiality effect
Monadic choice
mplus' :: (Monad m, MonadUnTrans MaybeAlg t) => t m b -> m b -> m b Source
Monadic choice combinator that confines the partiality effect to
the first argument. This is a variation on mplus
which allows
the partiality effect to spread to both arguments and to the result.
:: (Monad m, MonadUnTrans MaybeAlg t) | |
=> [t m b] | choice branches |
-> m b | otherwise |
-> m b | result |
Monadic choice combinator. Generalization of mplus'
that takes a list
of choice arguments rather than a single one.
Monadic function choice
mchoice' :: (Monad m, MonadUnTrans MaybeAlg t) => (a -> t m b) -> (a -> m b) -> a -> m b Source
Monadic function choice combinator that confines the partiality effect
to the first argument. This is a variation on mchoice
which
allows the partiality effect to spread to both arguments and to the
result.
mchoices :: (Monad m, MonadUnTrans MaybeAlg t, MonadPlus (t m)) => [a -> t m b] -> (a -> m b) -> a -> m b Source
Monadic function choice combinator. Generalization of mchoice'
that
takes a list of choice arguments rather than a single one.
Implementation variants
mswitch0 :: (Monad m, MonadUnTrans MaybeAlg t) => [t m b] -> m b -> m b Source
Implementation variant of mswitch
in terms of foldr.
mswitch1 :: (Monad m, MonadUnTrans MaybeAlg t) => [t m b] -> m b -> m b Source