ghc/lib/std/Monad.lhs

   1 % -----------------------------------------------------------------------------
   2 % $Id: Monad.lhs,v 1.13 2001/05/18 16:54:05 simonmar Exp $
   3 %
   4 % (c) The University of Glasgow, 1994-2000
   5 %
   6
   7 \section[Monad]{Module @Monad@}
   8
   9 \begin{code}
  10 {-# OPTIONS -fno-implicit-prelude #-}
  11
  12 module Monad
  13     ( MonadPlus (   -- class context: Monad
  14           mzero     -- :: (MonadPlus m) => m a
  15         , mplus     -- :: (MonadPlus m) => m a -> m a -> m a
  16         )
  17     , join          -- :: (Monad m) => m (m a) -> m a
  18     , guard         -- :: (MonadPlus m) => Bool -> m ()
  19     , when          -- :: (Monad m) => Bool -> m () -> m ()
  20     , unless        -- :: (Monad m) => Bool -> m () -> m ()
  21     , ap            -- :: (Monad m) => m (a -> b) -> m a -> m b
  22     , msum          -- :: (MonadPlus m) => [m a] -> m a
  23     , filterM       -- :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
  24     , mapAndUnzipM  -- :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
  25     , zipWithM      -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
  26     , zipWithM_     -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
  27     , foldM         -- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
  28
  29     , liftM         -- :: (Monad m) => (a -> b) -> (m a -> m b)
  30     , liftM2        -- :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c)
  31     , liftM3        -- :: ...
  32     , liftM4        -- :: ...
  33     , liftM5        -- :: ...
  34
  35     , Monad((>>=), (>>), return, fail)
  36     , Functor(fmap)
  37
  38     , mapM          -- :: (Monad m) => (a -> m b) -> [a] -> m [b]
  39     , mapM_         -- :: (Monad m) => (a -> m b) -> [a] -> m ()
  40     , sequence      -- :: (Monad m) => [m a] -> m [a]
  41     , sequence_     -- :: (Monad m) => [m a] -> m ()
  42     , (=<<)         -- :: (Monad m) => (a -> m b) -> m a -> m b
  43     ) where
  44
  45 import PrelList
  46 import PrelMaybe
  47 import PrelBase
  48
  49 infixr 1 =<<
  50 \end{code}
  51
  52 %*********************************************************
  53 %*                                                      *
  54 \subsection{Prelude monad functions}
  55 %*                                                      *
  56 %*********************************************************
  57
  58 \begin{code}
  59 {-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-}
  60 (=<<)           :: Monad m => (a -> m b) -> m a -> m b
  61 f =<< x         = x >>= f
  62
  63 sequence       :: Monad m => [m a] -> m [a]
  64 {-# INLINE sequence #-}
  65 sequence ms = foldr k (return []) ms
  66             where
  67               k m m' = do { x <- m; xs <- m'; return (x:xs) }
  68
  69 sequence_        :: Monad m => [m a] -> m ()
  70 {-# INLINE sequence_ #-}
  71 sequence_ ms     =  foldr (>>) (return ()) ms
  72
  73 mapM            :: Monad m => (a -> m b) -> [a] -> m [b]
  74 {-# INLINE mapM #-}
  75 mapM f as       =  sequence (map f as)
  76
  77 mapM_           :: Monad m => (a -> m b) -> [a] -> m ()
  78 {-# INLINE mapM_ #-}
  79 mapM_ f as      =  sequence_ (map f as)
  80 \end{code}
  81
  82 %*********************************************************
  83 %*                                                      *
  84 \subsection{Monadic classes: @MonadPlus@}
  85 %*                                                      *
  86 %*********************************************************
  87
  88
  89 \begin{code}
  90 class Monad m => MonadPlus m where
  91    mzero :: m a
  92    mplus :: m a -> m a -> m a
  93
  94 instance MonadPlus [] where
  95    mzero = []
  96    mplus = (++)
  97
  98 instance MonadPlus Maybe where
  99    mzero = Nothing
 100
 101    Nothing `mplus` ys  = ys
 102    xs      `mplus` _ys = xs
 103 \end{code}
 104
 105
 106 %*********************************************************
 107 %*                                                      *
 108 \subsection{Functions mandated by the Prelude}
 109 %*                                                      *
 110 %*********************************************************
 111
 112 \begin{code}
 113 guard           :: (MonadPlus m) => Bool -> m ()
 114 guard True      =  return ()
 115 guard False     =  mzero
 116
 117 -- This subsumes the list-based filter function.
 118
 119 filterM          :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
 120 filterM _ []     =  return []
 121 filterM p (x:xs) =  do
 122    flg <- p x
 123    ys  <- filterM p xs
 124    return (if flg then x:ys else ys)
 125
 126 -- This subsumes the list-based concat function.
 127
 128 msum        :: MonadPlus m => [m a] -> m a
 129 {-# INLINE msum #-}
 130 msum        =  foldr mplus mzero
 131 \end{code}
 132
 133
 134 %*********************************************************
 135 %                                                       *
 136 \subsection{Other monad functions}
 137 %*                                                      *
 138 %*********************************************************
 139
 140 \begin{code}
 141 join              :: (Monad m) => m (m a) -> m a
 142 join x            =  x >>= id
 143
 144 mapAndUnzipM      :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
 145 mapAndUnzipM f xs =  sequence (map f xs) >>= return . unzip
 146
 147 zipWithM          :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
 148 zipWithM f xs ys  =  sequence (zipWith f xs ys)
 149
 150 zipWithM_         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
 151 zipWithM_ f xs ys =  sequence_ (zipWith f xs ys)
 152
 153 foldM             :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
 154 foldM _ a []      =  return a
 155 foldM f a (x:xs)  =  f a x >>= \fax -> foldM f fax xs
 156
 157 unless            :: (Monad m) => Bool -> m () -> m ()
 158 unless p s        =  if p then return () else s
 159
 160 when              :: (Monad m) => Bool -> m () -> m ()
 161 when p s          =  if p then s else return ()
 162
 163 ap                :: (Monad m) => m (a -> b) -> m a -> m b
 164 ap                =  liftM2 id
 165
 166 liftM   :: (Monad m) => (a1 -> r) -> m a1 -> m r
 167 liftM2  :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r
 168 liftM3  :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r
 169 liftM4  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r
 170 liftM5  :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r
 171
 172 liftM f m1              = do { x1 <- m1; return (f x1) }
 173 liftM2 f m1 m2          = do { x1 <- m1; x2 <- m2; return (f x1 x2) }
 174 liftM3 f m1 m2 m3       = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) }
 175 liftM4 f m1 m2 m3 m4    = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) }
 176 liftM5 f m1 m2 m3 m4 m5 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; x5 <- m5; return (f x1 x2 x3 x4 x5) }
 177
 178 \end{code}