Control/Monad.hs

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