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/core/LICENSE)
   7 --
   8 -- Maintainer  :  libraries@haskell.org
   9 -- Stability   :  provisional
  10 -- Portability :  portable
  11 --
  12 -- $Id: Monad.hs,v 1.1 2001/06/28 14:15:01 simonmar Exp $
  13 --
  14 -----------------------------------------------------------------------------
  15
  16 module Control.Monad
  17     ( MonadPlus (   -- class context: Monad
  18           mzero     -- :: (MonadPlus m) => m a
  19         , mplus     -- :: (MonadPlus m) => m a -> m a -> m a
  20         )
  21     , join          -- :: (Monad m) => m (m a) -> m a
  22     , guard         -- :: (MonadPlus m) => Bool -> m ()
  23     , when          -- :: (Monad m) => Bool -> m () -> m ()
  24     , unless        -- :: (Monad m) => Bool -> m () -> m ()
  25     , ap            -- :: (Monad m) => m (a -> b) -> m a -> m b
  26     , msum          -- :: (MonadPlus m) => [m a] -> m a
  27     , filterM       -- :: (Monad m) => (a -> m Bool) -> [a] -> m [a]
  28     , mapAndUnzipM  -- :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
  29     , zipWithM      -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
  30     , zipWithM_     -- :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
  31     , foldM         -- :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
  32
  33     , liftM         -- :: (Monad m) => (a -> b) -> (m a -> m b)
  34     , liftM2        -- :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c)
  35     , liftM3        -- :: ...
  36     , liftM4        -- :: ...
  37     , liftM5        -- :: ...
  38
  39     , Monad((>>=), (>>), return, fail)
  40     , Functor(fmap)
  41
  42     , mapM          -- :: (Monad m) => (a -> m b) -> [a] -> m [b]
  43     , mapM_         -- :: (Monad m) => (a -> m b) -> [a] -> m ()
  44     , sequence      -- :: (Monad m) => [m a] -> m [a]
  45     , sequence_     -- :: (Monad m) => [m a] -> m ()
  46     , (=<<)         -- :: (Monad m) => (a -> m b) -> m a -> m b
  47     ) where
  48
  49 import Data.Maybe
  50
  51 #ifdef __GLASGOW_HASKELL__
  52 import GHC.List
  53 import GHC.Base
  54 #endif
  55
  56 infixr 1 =<<
  57
  58 -- -----------------------------------------------------------------------------
  59 -- Prelude monad functions
  60
  61 {-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-}
  62 (=<<)           :: Monad m => (a -> m b) -> m a -> m b
  63 f =<< x         = x >>= f
  64
  65 sequence       :: Monad m => [m a] -> m [a]
  66 {-# INLINE sequence #-}
  67 sequence ms = foldr k (return []) ms
  68             where
  69               k m m' = do { x <- m; xs <- m'; return (x:xs) }
  70
  71 sequence_        :: Monad m => [m a] -> m ()
  72 {-# INLINE sequence_ #-}
  73 sequence_ ms     =  foldr (>>) (return ()) ms
  74
  75 mapM            :: Monad m => (a -> m b) -> [a] -> m [b]
  76 {-# INLINE mapM #-}
  77 mapM f as       =  sequence (map f as)
  78
  79 mapM_           :: Monad m => (a -> m b) -> [a] -> m ()
  80 {-# INLINE mapM_ #-}
  81 mapM_ f as      =  sequence_ (map f as)
  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) }