monad-param-0.0.1: Parameterized monads

Portabilitynon-portable (requires the kitchen sink)
Stabilityexperimental
MaintainerEdward Kmett <ekmett@gmail.com>

Control.Monad.Parameterized

Contents

Description

Implements a notion of parameterized monad by varying the monad itself, this lets us avoid having to carry a parameter around for monads that do not need it, and we can rederive the normal notion of a parameterized monad from this variation for those that do. The signature of >>= costs us type inference for the types of return and mzero, so we restore that by defining returnM as the unit of the Identity monad and mzeroM as the unit of the trivial bottom monad, and appealing to the monad laws to allow these to combine with all other monads satisfying the monad laws through >>=

Caveat: this currently does not permit types to vary under the do-sugar because of assumptions in GHC about the shape of >>=.

This imports and defines the correct instances for a good portion of the MTL, primarily because it is so awkward to import them all otherwise due to the fact that most of them re-export the Control.Monad.Monad syntax. Does not export Control.Monad.ST or Control.Monad.Writer since it is unclear if you want strict or lazy versions in scope

Synopsis

Rebound Monad

class Return m whereSource

Traditional return, note this probably has lost its type inference where you want to use it. You probably want to use returnM

Methods

return :: a -> m aSource

Instances

Return [] 
Return IO 
Return STM 
Return Maybe 
Return Identity 
Return MZero 
Return (ST s) 
Return (ST s) 
Return (Cont r) 
Monoid w => Return (Writer w) 
Monoid w => Return (Writer w) 
Return (State s) 
Monad m => Return (ListT m) 
Return (Reader e) 
Monad m => Return (ContT r m) 
(Monad m, Monoid w) => Return (WriterT w m) 
(Monad m, Monoid w) => Return (WriterT w m) 
Monad m => Return (StateT s m) 
(Monad m, Error e) => Return (ErrorT e m) 
Monad m => Return (ReaderT e m) 

class Fail m whereSource

Restrict the cases where we allow pattern matching to fail. You have to explicitly supply this for your Monad

Methods

fail :: String -> m aSource

Instances

Fail [] 
Fail IO 
Fail STM 
Fail Maybe 
Fail (ST s) 
Fail (ST s) 
Fail (Cont r) 
Monoid w => Fail (Writer w) 
Monoid w => Fail (Writer w) 
Fail (State s) 
Monad m => Fail (ListT m) 
Fail (Reader e) 
Monad m => Fail (ContT r m) 
(Monad m, Monoid w) => Fail (WriterT w m) 
(Monad m, Monoid w) => Fail (WriterT w m) 
Monad m => Fail (StateT s m) 
(Monad m, Error e) => Fail (ErrorT e m) 
Monad m => Fail (ReaderT e m) 

class (Functor m, Functor m', Functor m'') => Bind m m' m'' | m m' -> m'' whereSource

Implement parameterized monads like Oleg's restricted monads, but vary the monad itself rather than restrict its parameters

Methods

(>>=) :: m a -> (a -> m' b) -> m'' bSource

(>>) :: m a -> m' b -> m'' bSource

Instances

Bind [] [] [] 
Bind [] Maybe [] 
Bind IO IO IO 
Bind IO STM IO 
Functor a => Bind a MZero MZero 
Functor a => Bind a Identity a 
Bind STM IO IO 
Bind STM STM STM 
Bind Maybe [] [] 
Bind Maybe Maybe Maybe 
Functor a => Bind Identity a a 
Bind Identity Identity Identity 
Bind Identity MZero MZero 
Functor a => Bind MZero a MZero 
Bind MZero Identity MZero 
Bind MZero MZero MZero 
Bind [] IO (ListT IO) 
Bind (ST s) (ST s) (ST s) 
Bind (ST s) (ST s) (ST s) 
Bind (Cont r) (Cont r) (Cont r) 
Monoid w => Bind (Writer w) (Writer w) (Writer w) 
Monoid w => Bind (Writer w) (Writer w) (Writer w) 
Bind (State s) (State s) (State s) 
Monad m => Bind (ListT m) (ListT m) (ListT m) 
Bind (Reader e) (Reader e) (Reader e) 
Monad m => Bind (ContT r m) (ContT r m) (ContT r m) 
(Monad m, Monoid w) => Bind (WriterT w m) (WriterT w m) (WriterT w m) 
(Monad m, Monoid w) => Bind (WriterT w m) (WriterT w m) (WriterT w m) 
Monad m => Bind (StateT s m) (StateT s m) (StateT s m) 
(Monad m, Error e) => Bind (ErrorT e m) (ErrorT e m) (ErrorT e m) 
Monad m => Bind (ReaderT e m) (ReaderT e m) (ReaderT e m) 

(=<<) :: Bind m m' m'' => (a -> m' b) -> m a -> m'' bSource

Rebound MonadPlus

class MPlus m m' m'' | m m' -> m'' whereSource

Break out mplus

Methods

mplus :: m a -> m' a -> m'' aSource

Instances

MPlus [] [] [] 
MPlus a MZero a 
MPlus Maybe Maybe Maybe 
MPlus MZero a a

We we losing type inference for MonadZero anyways, plumb around the special cases

MPlus MZero MZero MZero 
Monad m => MPlus (ListT m) (ListT m) (ListT m) 
(Monad m, Error e) => MPlus (ErrorT e m) (ErrorT e m) (ErrorT e m) 

class MonadZero m whereSource

Traditional mzero, note this probably has lost its type inference. You probably want mzeroM.

Methods

mzero :: m aSource

Instances

Convenient class aliases

class (Fail m, Return m, Bind m m m) => Monad m Source

When a parameterized monad can be used without varying its parameter, we can get the ease of use of the original Monad class.

Instances

(Fail m, Return m, Bind m m m) => Monad m 

class (MPlus m m m, MonadZero m) => MonadPlus m Source

Class alias to get back an approximation of the original, easy-to-specify MonadPlus class where available

Instances

(MPlus m m m, MonadZero m) => MonadPlus m 

Restoring type inference

class Go n m whereSource

Now of course we can have MZeros and Identitys float to the top of a do expression, so we need a way to convert them to any Monad or MonadPlus instance respectively

Methods

go :: n a -> m aSource

Usage: go (do something)

Instances

Go a a 
Return a => Go Identity a 
MonadZero a => Go MZero a 

returnM :: a -> Identity aSource

An inferable version of return

mzeroM :: MZero aSource

An inferable version of mzero

data MZero a Source

Same trick using with Identity to build a canonical returnM, here we exploit the MonadPlus laws to make a canonical mzeroM. Has no members except bottom.

Instances

Functor MZero

its trivial to map a function over nothing

Return MZero 
MonadZero a => Go MZero a 
MPlus a MZero a 
MPlus MZero a a

We we losing type inference for MonadZero anyways, plumb around the special cases

MPlus MZero MZero MZero 
Functor a => Bind a MZero MZero 
Bind Identity MZero MZero 
Functor a => Bind MZero a MZero 
Bind MZero Identity MZero 
Bind MZero MZero MZero 

Export common monads in this sugar

mapM :: Monad m => (a -> m b) -> [a] -> m [b]

mapM f is equivalent to sequence . map f.

mapM_ :: Monad m => (a -> m b) -> [a] -> m ()

mapM_ f is equivalent to sequence_ . map f.

forM :: Monad m => [a] -> (a -> m b) -> m [b]

forM is mapM with its arguments flipped

forM_ :: Monad m => [a] -> (a -> m b) -> m ()

forM_ is mapM_ with its arguments flipped

sequence :: Monad m => [m a] -> m [a]

Evaluate each action in the sequence from left to right, and collect the results.

sequence_ :: Monad m => [m a] -> m ()

Evaluate each action in the sequence from left to right, and ignore the results.

join :: Monad m => m (m a) -> m a

The join function is the conventional monad join operator. It is used to remove one level of monadic structure, projecting its bound argument into the outer level.

msum :: MonadPlus m => [m a] -> m a

This generalizes the list-based concat function.

filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]

This generalizes the list-based filter function.

mapAndUnzipM :: Monad m => (a -> m (b, c)) -> [a] -> m ([b], [c])

The mapAndUnzipM function maps its first argument over a list, returning the result as a pair of lists. This function is mainly used with complicated data structures or a state-transforming monad.

zipWithM :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c]

The zipWithM function generalizes zipWith to arbitrary monads.

zipWithM_ :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m ()

zipWithM_ is the extension of zipWithM which ignores the final result.

foldM :: Monad m => (a -> b -> m a) -> a -> [b] -> m a

The foldM function is analogous to foldl, except that its result is encapsulated in a monad. Note that foldM works from left-to-right over the list arguments. This could be an issue where '(>>)' and the `folded function' are not commutative.

foldM f a1 [x1, x2, ..., xm ]

==

do a2 <- f a1 x1 a3 <- f a2 x2 ... f am xm

If right-to-left evaluation is required, the input list should be reversed.

foldM_ :: Monad m => (a -> b -> m a) -> a -> [b] -> m ()

Like foldM, but discards the result.

replicateM :: Monad m => Int -> m a -> m [a]

replicateM n act performs the action n times, gathering the results.

replicateM_ :: Monad m => Int -> m a -> m ()

Like replicateM, but discards the result.

guard :: MonadPlus m => Bool -> m ()

guard b is return () if b is True, and mzero if b is False.

when :: Monad m => Bool -> m () -> m ()

Conditional execution of monadic expressions. For example,

when debug (putStr "Debugging\n")

will output the string Debugging\n if the Boolean value debug is True, and otherwise do nothing.

unless :: Monad m => Bool -> m () -> m ()

The reverse of when.

liftM :: Monad m => (a1 -> r) -> m a1 -> m r

Promote a function to a monad.

liftM2 :: Monad m => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r

Promote a function to a monad, scanning the monadic arguments from left to right. For example,

liftM2 (+) [0,1] [0,2] = [0,2,1,3] liftM2 (+) (Just 1) Nothing = Nothing

liftM3 :: Monad m => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r

Promote a function to a monad, scanning the monadic arguments from left to right (cf. liftM2).

liftM4 :: Monad m => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r

Promote a function to a monad, scanning the monadic arguments from left to right (cf. liftM2).

liftM5 :: Monad m => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r

Promote a function to a monad, scanning the monadic arguments from left to right (cf. liftM2).

ap :: Monad m => m (a -> b) -> m a -> m b

In many situations, the liftM operations can be replaced by uses of ap, which promotes function application.

return f `ap` x1 `ap` ... `ap` xn

is equivalent to

liftMn f x1 x2 ... xn