module Control.Supermonad.Functions
(
mapM, mapM_
, forM, forM_
, sequence, sequence_
, (=<<)
, (>=>), (<=<)
, forever, void, void'
, join
, filterM
, mapAndUnzipM
, zipWithM, zipWithM_
, foldM, foldM_
, replicateM, replicateM_
, when, unless
, liftM, liftM', liftM2, liftM3
, ap
, (<$!>)
, (<$>)
, ifThenElse
) where
import qualified Prelude as P
import Prelude
( Bool(..), Int
, Functor(..)
, (.), ($)
, id, flip, const
, not
, fromInteger
, (<=), () )
import Control.Supermonad
infixr 1 =<<
infixr 1 >=>
infixr 1 <=<
ifThenElse :: Bool -> a -> a -> a
ifThenElse True t _f = t
ifThenElse False _t f = f
(=<<) :: (Bind m n p, BindCts m n p) => (a -> n b) -> m a -> p b
f =<< ma = ma >>= f
(>=>) :: (Bind m n p, BindCts m n p) => (a -> m b) -> (b -> n c) -> a -> p c
(>=>) f g x = f x >>= g
(<=<) :: (Bind m n p, BindCts m n p) => (b -> n c) -> (a -> m b) -> a -> p c
(<=<) g f x = f x >>= g
when :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => Bool -> m () -> n ()
when True s = void' s
when False _ = return ()
unless :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => Bool -> m () -> n ()
unless b = when (not b)
mapM :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => (a -> m b) -> [a] -> n [b]
mapM f = P.foldr k (return [])
where
k a r = do
x <- f a
fmap (x :) r
mapM_ :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => (a -> m b) -> [a] -> n ()
mapM_ f = void . mapM f
forM :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => [a] -> (a -> m b) -> n [b]
forM = flip mapM
forM_ :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => [a] -> (a -> m b) -> n ()
forM_ xs = void . forM xs
join :: (Bind m n p, BindCts m n p) => m (n a) -> p a
join k = k >>= id
void :: (Functor m) => m a -> m ()
void = fmap (const ())
void' :: ( Bind m n n, BindCts m n n
, Return n, ReturnCts n
) => m a -> n ()
void' = (>> return ())
sequence :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => [m b] -> n [b]
sequence = mapM id
sequence_ :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => [m b] -> n ()
sequence_ = void . sequence
forever :: (Bind m n n, BindCts m n n) => m a -> n b
forever na = na >> forever na
filterM :: ( Bind m n n, BindCts m n n
, Return n, ReturnCts n
) => (a -> m Bool) -> [a] -> n [a]
filterM _f [] = return []
filterM f (x : xs) = do
keep <- f x
if keep
then fmap (x :) $ filterM f xs
else filterM f xs
mapAndUnzipM :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => (a -> m (b, c)) -> [a] -> n ([b], [c])
mapAndUnzipM f xs = liftM P.unzip (forM xs f)
zipWithM :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => (a -> b -> m c) -> [a] -> [b] -> n [c]
zipWithM f xs ys = sequence $ P.zipWith f xs ys
zipWithM_ :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => (a -> b -> m c) -> [a] -> [b] -> n ()
zipWithM_ f xs ys = void $ zipWithM f xs ys
foldM :: ( P.Foldable t
, Return m, ReturnCts m
, Bind m n m, BindCts m n m
) => (b -> a -> n b) -> b -> t a -> m b
foldM f e = P.foldl f' (return e)
where f' mb a = mb >>= \b -> f b a
foldM_ :: ( P.Foldable t
, Return m, ReturnCts m
, Bind m n m, BindCts m n m
) => (b -> a -> n b) -> b -> t a -> m ()
foldM_ f e = void . foldM f e
replicateM :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => Int -> m a -> n [a]
replicateM n _ma | n <= 0 = return []
replicateM n ma = do
a <- ma
fmap (a :) $ replicateM (n 1) ma
replicateM_ :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => Int -> m a -> n ()
replicateM_ n = void . replicateM n
liftM :: (Functor m) => (a -> b) -> m a -> m b
liftM f ma = fmap f ma
liftM' :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => (a -> b) -> m a -> n b
liftM' f ma = ma >>= (return . f)
liftM2 :: ( Bind m n p, BindCts m n p
) => (a -> b -> c) -> m a -> n b -> p c
liftM2 f ma nb = do
a <- ma
fmap (f a) nb
liftM3 :: ( Bind m q q, BindCts m q q
, Bind n p q, BindCts n p q)
=> (a -> b -> c -> d) -> m a -> n b -> p c -> q d
liftM3 f ma nb pc = do
a <- ma
b <- nb
fmap (f a b) pc
ap :: ( Bind m n p, BindCts m n p
) => m (a -> b) -> n a -> p b
ap mf na = do
f <- mf
fmap f na
(<$>) :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => (a -> b) -> m a -> n b
f <$> m = do
x <- m
return $ f x
(<$!>) :: ( Return n, ReturnCts n
, Bind m n n, BindCts m n n
) => (a -> b) -> m a -> n b
f <$!> m = do
x <- m
let z = f x
z `P.seq` return z