ghc/interpreter/lib/Monad.hs

   1 -----------------------------------------------------------------------------
   2 -- Standard Library: Monad operations
   3 --
   4 -- Suitable for use with Hugs 98
   5 -----------------------------------------------------------------------------
   6
   7 module Monad (
   8     MonadPlus(mzero, mplus),
   9     join, guard, when, unless, ap,
  10     msum,
  11     filterM, mapAndUnzipM, zipWithM, zipWithM_, foldM,
  12     liftM, liftM2, liftM3, liftM4, liftM5,
  13
  14     -- ... and what the Prelude exports
  15     Monad((>>=), (>>), return, fail),
  16     Functor(fmap),
  17     mapM, mapM_, accumulate, sequence, (=<<),
  18     ) where
  19
  20 -- The MonadPlus class definition
  21
  22 class Monad m => MonadPlus m where
  23     mzero :: m a
  24     mplus :: m a -> m a -> m a
  25
  26 -- Instances of MonadPlus
  27
  28 instance MonadPlus Maybe where
  29     mzero              = Nothing
  30     Nothing `mplus` ys = ys
  31     xs      `mplus` ys = xs
  32
  33 instance MonadPlus [ ] where
  34     mzero = []
  35     mplus = (++)
  36
  37 -- Functions
  38
  39 msum             :: MonadPlus m => [m a] -> m a
  40 msum              = foldr mplus mzero
  41
  42 join             :: (Monad m) => m (m a) -> m a
  43 join x            = x >>= id
  44
  45 when             :: (Monad m) => Bool -> m () -> m ()
  46 when p s          = if p then s else return ()
  47
  48 unless           :: (Monad m) => Bool -> m () -> m ()
  49 unless p s        = when (not p) s
  50
  51 ap               :: (Monad m) => m (a -> b) -> m a -> m b
  52 ap                = liftM2 ($)
  53
  54 guard            :: MonadPlus m => Bool -> m ()
  55 guard p           = if p then return () else mzero
  56
  57 mapAndUnzipM     :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
  58 mapAndUnzipM f xs = accumulate (map f xs) >>= return . unzip
  59
  60 zipWithM         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
  61 zipWithM f xs ys  = accumulate (zipWith f xs ys)
  62
  63 zipWithM_        :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m ()
  64 zipWithM_ f xs ys = sequence (zipWith f xs ys)
  65
  66 foldM            :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
  67 foldM f a []      = return a
  68 foldM f a (x:xs)  = f a x >>= \ y -> foldM f y xs
  69
  70 filterM          :: MonadPlus m => (a -> m Bool) -> [a] -> m [a]
  71 filterM p []      = return []
  72 filterM p (x:xs)  = do b <- p x
  73                        ys <- filterM p xs
  74                        return (if b then (x:ys) else ys)
  75
  76 liftM            :: (Monad m) => (a -> b) -> (m a -> m b)
  77 liftM f           = \a -> do { a' <- a; return (f a') }
  78
  79 liftM2           :: (Monad m) => (a -> b -> c) -> (m a -> m b -> m c)
  80 liftM2 f          = \a b -> do { a' <- a; b' <- b; return (f a' b') }
  81
  82 liftM3           :: (Monad m) => (a -> b -> c -> d) ->
  83                                  (m a -> m b -> m c -> m d)
  84 liftM3 f          = \a b c -> do { a' <- a; b' <- b; c' <- c;
  85                                    return (f a' b' c')}
  86
  87 liftM4           :: (Monad m) => (a -> b -> c -> d -> e) ->
  88                                  (m a -> m b -> m c -> m d -> m e)
  89 liftM4 f          = \a b c d -> do { a' <- a; b' <- b; c' <- c; d' <- d;
  90                                      return (f a' b' c' d')}
  91
  92 liftM5           :: (Monad m) => (a -> b -> c -> d -> e -> f) ->
  93                                  (m a -> m b -> m c -> m d -> m e -> m f)
  94 liftM5 f          = \a b c d e -> do { a' <- a; b' <- b; c' <- c; d' <- d;
  95                                        e' <- e; return (f a' b' c' d' e')}
  96
  97 -----------------------------------------------------------------------------