Chapter 13
Control.Monad

module Control.Monad (  
    Functor(fmap),  Monad((>>=), (>>), return, fail),  MonadPlus(mzero, mplus),  
    mapM,  mapM_,  forM,  forM_,  sequence,  sequence_,  (=<<),  (>=>),  (<=<),  
    forever,  void,  join,  msum,  filterM,  mapAndUnzipM,  zipWithM,  
    zipWithM_,  foldM,  foldM_,  replicateM,  replicateM_,  guard,  when,  
    unless,  liftM,  liftM2,  liftM3,  liftM4,  liftM5,  ap  
  ) where

The Control.Monad module provides the Functor, Monad and MonadPlus classes, together with some useful operations on monads.

13.1 Functor and monad classes

class Functor f where
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 satisfy these laws.

Methods

fmap :: (a -> b) -> f a -> f b

instance Functor []
instance Functor IO
instance Functor Maybe
instance Ix i => Functor (Array i)

class Monad m where
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

(>>=) :: m a -> (a -> m b) -> m b
Sequentially compose two actions, passing any value produced by the first as an argument to the second.

(>>) :: m a -> m b -> m b
Sequentially compose two actions, discarding any value produced by the first, like sequencing operators (such as the semicolon) in imperative languages.

return :: a -> m a
Inject a value into the monadic type.

fail :: String -> m a
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.

instance Monad []
instance Monad IO
instance Monad Maybe

class<