ghc/lib/std/Monad.lhs

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