{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE NoImplicitPrelude #-}
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
import GHC.List
import GHC.Base
infixr 1 =<<
{-# SPECIALISE (=<<) :: (a -> [b]) -> [a] -> [b] #-}
(=<<) :: Monad m => (a -> m b) -> m a -> m b
f =<< x = x >>= f
sequence :: Monad m => [m a] -> m [a]
{-# INLINE sequence #-}
sequence ms = foldr k (return []) ms
where
k m m' = do { x <- m; xs <- m'; return (x:xs) }
sequence_ :: Monad m => [m a] -> m ()
{-# INLINE sequence_ #-}
sequence_ ms = foldr (>>) (return ()) ms
mapM :: Monad m => (a -> m b) -> [a] -> m [b]
{-# INLINE mapM #-}
mapM f as = sequence (map f as)
mapM_ :: Monad m => (a -> m b) -> [a] -> m ()
{-# INLINE mapM_ #-}
mapM_ f as = sequence_ (map f as)
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]
{-# INLINE forM #-}
forM = flip mapM
forM_ :: Monad m => [a] -> (a -> m b) -> m ()
{-# INLINE forM_ #-}
forM_ = flip mapM_
msum :: MonadPlus m => [m a] -> m a
{-# INLINE msum #-}
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
{-# INLINE forever #-}
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