base-4.2.0.1: Basic librariesSource codeContentsIndex
Control.Monad
Portabilityportable
Stabilityprovisional
Maintainerlibraries@haskell.org
Contents
Functor and monad classes
Functions
Naming conventions
Basic functions from the Prelude
Generalisations of list functions
Conditional execution of monadic expressions
Monadic lifting operators
Description
The Functor, Monad and MonadPlus classes, with some useful operations on monads.
Synopsis
class Functor f where
fmap :: (a -> b) -> f a -> f b
class Monad m where
(>>=) :: forall a b. m a -> (a -> m b) -> m b
(>>) :: forall a b. m a -> m b -> m b
return :: a -> m a
fail :: String -> m a
class Monad m => MonadPlus m where
mzero :: m a
mplus :: m a -> m a -> m a
mapM :: Monad m => (a -> m b) -> [a] -> m [b]
mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
forM :: Monad m => [a] -> (a -> m b) -> m [b]
forM_ :: Monad m => [a] -> (a -> m b) -> m ()
sequence :: Monad m => [m a] -> m [a]
sequence_ :: Monad m => [m a] -> m ()
(=<<) :: Monad m => (a -> m b) -> m a -> m b
(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m c
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m c
forever :: Monad m => m a -> m b
join :: Monad m => m (m a) -> m a
msum :: MonadPlus m => [m a] -> m a
filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]
mapAndUnzipM :: Monad m => (a -> m (b, c)) -> [a] -> m ([b], [c])
zipWithM :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM_ :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m ()
foldM :: Monad m => (a -> b -> m a) -> a -> [b] -> m a
foldM_ :: Monad m => (a -> b -> m a) -> a -> [b] -> m ()
replicateM :: Monad m => Int -> m a -> m [a]
replicateM_ :: Monad m => Int -> m a -> m ()
guard :: MonadPlus m => Bool -> m ()
when :: Monad m => Bool -> m () -> m ()
unless :: Monad m => Bool -> m () -> m ()
liftM :: Monad m => (a1 -> r) -> m a1 -> m r
liftM2 :: Monad m => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
liftM3 :: Monad m => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
liftM4 :: Monad m => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
liftM5 :: Monad m => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
ap :: Monad m => m (a -> b) -> m a -> m b
Functor and monad classes
class Functor f whereSource

The Functor class is used for types that can be mapped over. Instances of Functor should satisfy the following laws:

 fmap id  ==  id
 fmap (f . g)  ==  fmap f . fmap g

The instances of Functor for lists, Data.Maybe.Maybe and System.IO.IO defined in the Prelude satisfy these laws.

Methods
fmap :: (a -> b) -> f a -> f bSource
show/hide Instances
class Monad m whereSource

The Monad class defines the basic operations over a monad, a concept from a branch of mathematics known as category theory. From the perspective of a Haskell programmer, however, it is best to think of a monad as an abstract datatype of actions. Haskell's do expressions provide a convenient syntax for writing monadic expressions.

Minimal complete definition: >>= and return.

Instances of Monad should satisfy the following laws:

 return a >>= k  ==  k a
 m >>= return  ==  m
 m >>= (\x -> k x >>= h)  ==  (m >>= k) >>= h

Instances of both Monad and Functor should additionally satisfy the law:

 fmap f xs  ==  xs >>= return . f

The instances of Monad for lists, Data.Maybe.Maybe and System.IO.IO defined in the Prelude satisfy these laws.

Methods
(>>=) :: forall a b. m a -> (a -> m b) -> m bSource
Sequentially compose two actions, passing any value produced by the first as an argument to the second.
(>>) :: forall a b. m a -> m b -> m bSource
Sequentially compose two actions, discarding any value produced by the first, like sequencing operators (such as the semicolon) in imperative languages.
return :: a -> m aSource
Inject a value into the monadic type.
fail :: String -> m aSource
Fail with a message. This operation is not part of the mathematical definition of a monad, but is invoked on pattern-match failure in a do expression.
show/hide Instances
class Monad m => MonadPlus m whereSource
Monads that also support choice and failure.
Methods
mzero :: m aSource

the identity of mplus. It should also satisfy the equations

 mzero >>= f  =  mzero
 v >> mzero   =  mzero

(but the instance for System.IO.IO defined in Control.Monad.Error in the mtl package does not satisfy the second one).

mplus :: m a -> m a -> m aSource
an associative operation
show/hide Instances
Functions
Naming conventions

The functions in this library use the following naming conventions:

  • A postfix 'M' always stands for a function in the Kleisli category: The monad type constructor m is added to function results (modulo currying) and nowhere else. So, for example,
  filter  ::              (a ->   Bool) -> [a] ->   [a]
  filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
  • A postfix '_' changes the result type from (m a) to (m ()). Thus, for example:
  sequence  :: Monad m => [m a] -> m [a] 
  sequence_ :: Monad m => [m a] -> m () 
  • A prefix 'm' generalizes an existing function to a monadic form. Thus, for example:
  sum  :: Num a       => [a]   -> a
  msum :: MonadPlus m => [m a] -> m a
Basic functions from the Prelude
mapM :: Monad m => (a -> m b) -> [a] -> m [b]Source
mapM f is equivalent to sequence . map f.
mapM_ :: Monad m => (a -> m b) -> [a] -> m ()Source
mapM_ f is equivalent to sequence_ . map f.
forM :: Monad m => [a] -> (a -> m b) -> m [b]Source
forM is mapM with its arguments flipped
forM_ :: Monad m => [a] -> (a -> m b) -> m ()Source
forM_ is mapM_ with its arguments flipped
sequence :: Monad m => [m a] -> m [a]Source
Evaluate each action in the sequence from left to right, and collect the results.
sequence_ :: Monad m => [m a] -> m ()Source
Evaluate each action in the sequence from left to right, and ignore the results.
(=<<) :: Monad m => (a -> m b) -> m a -> m bSource
Same as >>=, but with the arguments interchanged.
(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> a -> m cSource
Left-to-right Kleisli composition of monads.
(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> a -> m cSource
Right-to-left Kleisli composition of monads. '(>=>)', with the arguments flipped
forever :: Monad m => m a -> m bSource
forever act repeats the action infinitely.
Generalisations of list functions
join :: Monad m => m (m a) -> m aSource
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 aSource
This generalizes the list-based concat function.
filterM :: Monad m => (a -> m Bool) -> [a] -> m [a]Source
This generalizes the list-based filter function.
mapAndUnzipM :: Monad m => (a -> m (b, c)) -> [a] -> m ([b], [c])Source
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]Source
The zipWithM function generalizes zipWith to arbitrary monads.
zipWithM_ :: Monad m => (a -> b -> m c) -> [a] -> [b] -> m ()Source
zipWithM_ is the extension of zipWithM which ignores the final result.
foldM :: Monad m => (a -> b -> m a) -> a -> [b] -> m aSource

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 ()Source
Like foldM, but discards the result.
replicateM :: Monad m => Int -> m a -> m [a]Source
replicateM n act performs the action n times, gathering the results.
replicateM_ :: Monad m => Int -> m a -> m ()Source
Like replicateM, but discards the result.
Conditional execution of monadic expressions
guard :: MonadPlus m => Bool -> m ()Source
guard b is return () if b is True, and mzero if b is False.
when :: Monad m => Bool -> m () -> m ()Source

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 ()Source
The reverse of when.
Monadic lifting operators
liftM :: Monad m => (a1 -> r) -> m a1 -> m rSource
Promote a function to a monad.
liftM2 :: Monad m => (a1 -> a2 -> r) -> m a1 -> m a2 -> m rSource

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 rSource
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 rSource
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 rSource
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 bSource

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
Produced by Haddock version 2.6.1