Control/Monad.hs (original) (raw)

module Control.Monad (

  Functor(fmap)
, Monad((>>=), (>>), return, fail)

, MonadPlus (   
      mzero     
    , mplus     
    )


, mapM          
, mapM_         
, forM          
, forM_         
, sequence      
, sequence_     
, (=<<)         
, (>=>)         
, (<=<)         
, forever       
, void


, join          
, msum          
, mfilter       
, filterM       
, mapAndUnzipM  
, zipWithM      
, zipWithM_     
, foldM         
, foldM_        
, replicateM    
, replicateM_   


, guard         
, when          
, unless        


, liftM         
, liftM2        
, liftM3        
, liftM4        
, liftM5        

, ap            

) where

import Data.Maybe

#ifdef GLASGOW_HASKELL import GHC.List import GHC.Base #endif

#ifdef GLASGOW_HASKELL infixr 1 =<<

(=<<) :: Monad m => (a -> m b) -> m a -> m b f =<< x = x >>= f

sequence :: Monad m => [m a] -> m [a]

sequence ms = foldr k (return []) ms where k m m' = do { x <- m; xs <- m'; return (x:xs) }

sequence_ :: Monad m => [m a] -> m ()

sequence_ ms = foldr (>>) (return ()) ms

mapM :: Monad m => (a -> m b) -> [a] -> m [b]

mapM f as = sequence (map f as)

mapM_ :: Monad m => (a -> m b) -> [a] -> m ()

mapM_ f as = sequence_ (map f as)

#endif /* GLASGOW_HASKELL */

class Monad m => MonadPlus m where

mzero :: m a

mplus :: m a -> m a -> m a

instance MonadPlus [] where mzero = [] mplus = (++)

instance MonadPlus Maybe where mzero = Nothing

Nothing mplus ys = ys xs mplus _ys = xs

guard :: (MonadPlus m) => Bool -> m () guard True = return () guard False = mzero

filterM :: (Monad m) => (a -> m Bool) -> [a] -> m [a] filterM _ [] = return [] filterM p (x:xs) = do flg <- p x ys <- filterM p xs return (if flg then x:ys else ys)

forM :: Monad m => [a] -> (a -> m b) -> m [b]

forM = flip mapM

forM_ :: Monad m => [a] -> (a -> m b) -> m ()

forM_ = flip mapM_

msum :: MonadPlus m => [m a] -> m a

msum = foldr mplus mzero

infixr 1 <=<, >=>

(>=>) :: Monad m => (a -> m b) -> (b -> m c) -> (a -> m c) f >=> g = \x -> f x >>= g

(<=<) :: Monad m => (b -> m c) -> (a -> m b) -> (a -> m c) (<=<) = flip (>=>)

forever :: (Monad m) => m a -> m b

forever a = let a' = a >> a' in a'

void :: Functor f => f a -> f () void = fmap (const ())

join :: (Monad m) => m (m a) -> m a join x = x >>= id

mapAndUnzipM :: (Monad m) => (a -> m (b,c)) -> [a] -> m ([b], [c]) mapAndUnzipM f xs = sequence (map f xs) >>= return . unzip

zipWithM :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m [c] zipWithM f xs ys = sequence (zipWith f xs ys)

zipWithM_ :: (Monad m) => (a -> b -> m c) -> [a] -> [b] -> m () zipWithM_ f xs ys = sequence_ (zipWith f xs ys)

foldM :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m a foldM _ a [] = return a foldM f a (x:xs) = f a x >>= \fax -> foldM f fax xs

foldM_ :: (Monad m) => (a -> b -> m a) -> a -> [b] -> m () foldM_ f a xs = foldM f a xs >> return ()

replicateM :: (Monad m) => Int -> m a -> m [a] replicateM n x = sequence (replicate n x)

replicateM_ :: (Monad m) => Int -> m a -> m () replicateM_ n x = sequence_ (replicate n x)

when :: (Monad m) => Bool -> m () -> m () when p s = if p then s else return ()

unless :: (Monad m) => Bool -> m () -> m () unless p s = if p then return () else s

liftM :: (Monad m) => (a1 -> r) -> m a1 -> m r liftM f m1 = do { x1 <- m1; return (f x1) }

liftM2 :: (Monad m) => (a1 -> a2 -> r) -> m a1 -> m a2 -> m r liftM2 f m1 m2 = do { x1 <- m1; x2 <- m2; return (f x1 x2) }

liftM3 :: (Monad m) => (a1 -> a2 -> a3 -> r) -> m a1 -> m a2 -> m a3 -> m r liftM3 f m1 m2 m3 = do { x1 <- m1; x2 <- m2; x3 <- m3; return (f x1 x2 x3) }

liftM4 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m r liftM4 f m1 m2 m3 m4 = do { x1 <- m1; x2 <- m2; x3 <- m3; x4 <- m4; return (f x1 x2 x3 x4) }

liftM5 :: (Monad m) => (a1 -> a2 -> a3 -> a4 -> a5 -> r) -> m a1 -> m a2 -> m a3 -> m a4 -> m a5 -> m r 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) }

ap :: (Monad m) => m (a -> b) -> m a -> m b ap = liftM2 id

mfilter :: (MonadPlus m) => (a -> Bool) -> m a -> m a mfilter p ma = do a <- ma if p a then return a else mzero