ghc/lib/required/Monad.hs

   1 module Monad (
   2     join, apply, (@@), mapAndUnzipL, mapAndUnzipR, accumulateL,
   3     accumulateR, zipWithL, zipWithR, sequenceL, sequenceR,
   4     mapL, mapR, map_, foldL, foldR, concatM, done, unless, when
   5     ) where
   6
   7 join             :: (Monad m) => m (m a) -> m a
   8 join x           = x >>= id
   9
  10 apply            :: (Monad m) => (a -> m b) -> (m a -> m b)
  11 apply f x        = x >>= f
  12
  13 (@@)             :: (Monad m) => (a -> m b) -> (c -> m a) -> (c -> m b)
  14 f @@ g           = \ x -> g x >>= f
  15
  16 mapAndUnzipL     :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
  17 mapAndUnzipL f xs = accumulateL (map f xs) >>= return . unzip
  18
  19 mapAndUnzipR     :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c])
  20 mapAndUnzipR f xs = accumulateR (map f xs) >>= return . unzip
  21
  22 accumulateL      :: (Monad m) => [m a] -> m [a]
  23 accumulateL      = accumulate
  24
  25 accumulateR      :: (Monad m) => [m a] -> m [a]
  26 accumulateR      = foldr mcons (return [])
  27         where mcons p q = q >>= \ xs -> p >>= \ x -> return (x:xs)
  28
  29 zipWithL         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
  30 zipWithL f xs ys = accumulateL (zipWith f xs ys)
  31
  32 zipWithR         :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c]
  33 zipWithR f xs ys = accumulateR (zipWith f xs ys)
  34
  35 sequenceL        :: (Monad m) => [m a] -> m ()
  36 sequenceL []     = return ()
  37 sequenceL (x:xs) = x >> sequenceL xs
  38
  39 sequenceR        :: (Monad m) => [m a] -> m ()
  40 sequenceR []     = return ()
  41 sequenceR (x:xs) = sequenceR xs >> x >> return ()
  42
  43 mapL             :: (Monad m) => (a -> m b) -> ([a] -> m [b])
  44 mapL f []        = return []
  45 mapL f (x:xs)    = f x >>= \ y -> mapL f xs >>= \ ys -> return (y:ys)
  46
  47 mapR             :: (Monad m) => (a -> m b) -> ([a] -> m [b])
  48 mapR f []        = return []
  49 mapR f (x:xs)    = mapR f xs >>= \ ys -> f x >>= \ y -> return (y:ys)
  50
  51 map_             :: (Monad m) => (a -> m b) -> ([a] -> m ())
  52 map_ f []        = return ()
  53 map_ f (x:xs)    = f x >> map_ f xs
  54
  55 foldL            :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a
  56 foldL f a []     = return a
  57 foldL f a (x:xs) = f a x >>= \fax -> foldL f fax xs
  58
  59 foldR            :: (Monad m) => (a -> b -> m b) -> b -> [a] -> m b
  60 foldR f a []     = return a
  61 foldR f a (x:xs) = foldR f a xs >>= \y -> f x y
  62
  63 concatM          :: MonadPlus m => [m a] -> m a
  64 concatM          =  foldr (++) zero
  65
  66 done             :: (Monad m) => m ()
  67 done             =  return ()
  68
  69 unless           :: (Monad m) => Bool -> m () -> m ()
  70 unless p s       =  if p then return () else s
  71
  72 when             :: (Monad m) => Bool -> m () -> m ()
  73 when p s         =  if p then s else return ()