module GHC.Utils.Monad
( Applicative(..)
, (<$>)
, MonadFix(..)
, MonadIO(..)
, zipWith3M, zipWith3M_, zipWith4M, zipWithAndUnzipM
, mapAndUnzipM, mapAndUnzip3M, mapAndUnzip4M, mapAndUnzip5M
, mapAccumLM
, liftFstM, liftSndM
, mapSndM
, concatMapM
, mapMaybeM
, fmapMaybeM, fmapEitherM
, anyM, allM, orM
, foldlM, foldlM_, foldrM
, maybeMapM
, whenM, unlessM
, filterOutM
) where
import GHC.Prelude
import Control.Applicative
import Control.Monad
import Control.Monad.Fix
import Control.Monad.IO.Class
import Data.Foldable (sequenceA_, foldlM, foldrM)
import Data.List (unzip4, unzip5, zipWith4)
zipWith3M :: Monad m => (a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m [d]
{-# INLINE zipWith3M #-}
zipWith3M :: forall (m :: * -> *) a b c d.
Monad m =>
(a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m [d]
zipWith3M a -> b -> c -> m d
f [a]
xs [b]
ys [c]
zs = [m d] -> m [d]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ((a -> b -> c -> m d) -> [a] -> [b] -> [c] -> [m d]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 a -> b -> c -> m d
f [a]
xs [b]
ys [c]
zs)
zipWith3M_ :: Monad m => (a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m ()
{-# INLINE zipWith3M_ #-}
zipWith3M_ :: forall (m :: * -> *) a b c d.
Monad m =>
(a -> b -> c -> m d) -> [a] -> [b] -> [c] -> m ()
zipWith3M_ a -> b -> c -> m d
f [a]
xs [b]
ys [c]
zs = [m d] -> m ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ ((a -> b -> c -> m d) -> [a] -> [b] -> [c] -> [m d]
forall a b c d. (a -> b -> c -> d) -> [a] -> [b] -> [c] -> [d]
zipWith3 a -> b -> c -> m d
f [a]
xs [b]
ys [c]
zs)
zipWith4M :: Monad m => (a -> b -> c -> d -> m e)
-> [a] -> [b] -> [c] -> [d] -> m [e]
{-# INLINE zipWith4M #-}
zipWith4M :: forall (m :: * -> *) a b c d e.
Monad m =>
(a -> b -> c -> d -> m e) -> [a] -> [b] -> [c] -> [d] -> m [e]
zipWith4M a -> b -> c -> d -> m e
f [a]
xs [b]
ys [c]
ws [d]
zs = [m e] -> m [e]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA ((a -> b -> c -> d -> m e) -> [a] -> [b] -> [c] -> [d] -> [m e]
forall a b c d e.
(a -> b -> c -> d -> e) -> [a] -> [b] -> [c] -> [d] -> [e]
zipWith4 a -> b -> c -> d -> m e
f [a]
xs [b]
ys [c]
ws [d]
zs)
zipWithAndUnzipM :: Monad m
=> (a -> b -> m (c, d)) -> [a] -> [b] -> m ([c], [d])
{-# INLINABLE zipWithAndUnzipM #-}
zipWithAndUnzipM :: forall (m :: * -> *) a b c d.
Monad m =>
(a -> b -> m (c, d)) -> [a] -> [b] -> m ([c], [d])
zipWithAndUnzipM a -> b -> m (c, d)
f (a
x:[a]
xs) (b
y:[b]
ys)
= do { (c
c, d
d) <- a -> b -> m (c, d)
f a
x b
y
; ([c]
cs, [d]
ds) <- (a -> b -> m (c, d)) -> [a] -> [b] -> m ([c], [d])
forall (m :: * -> *) a b c d.
Monad m =>
(a -> b -> m (c, d)) -> [a] -> [b] -> m ([c], [d])
zipWithAndUnzipM a -> b -> m (c, d)
f [a]
xs [b]
ys
; ([c], [d]) -> m ([c], [d])
forall (m :: * -> *) a. Monad m => a -> m a
return (c
cc -> [c] -> [c]
forall a. a -> [a] -> [a]
:[c]
cs, d
dd -> [d] -> [d]
forall a. a -> [a] -> [a]
:[d]
ds) }
zipWithAndUnzipM a -> b -> m (c, d)
_ [a]
_ [b]
_ = ([c], [d]) -> m ([c], [d])
forall (m :: * -> *) a. Monad m => a -> m a
return ([], [])
mapAndUnzip3M :: Monad m => (a -> m (b,c,d)) -> [a] -> m ([b],[c],[d])
{-# INLINE mapAndUnzip3M #-}
mapAndUnzip3M :: forall (m :: * -> *) a b c d.
Monad m =>
(a -> m (b, c, d)) -> [a] -> m ([b], [c], [d])
mapAndUnzip3M a -> m (b, c, d)
f [a]
xs = [(b, c, d)] -> ([b], [c], [d])
forall a b c. [(a, b, c)] -> ([a], [b], [c])
unzip3 ([(b, c, d)] -> ([b], [c], [d]))
-> m [(b, c, d)] -> m ([b], [c], [d])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m (b, c, d)) -> [a] -> m [(b, c, d)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> m (b, c, d)
f [a]
xs
mapAndUnzip4M :: Monad m => (a -> m (b,c,d,e)) -> [a] -> m ([b],[c],[d],[e])
{-# INLINE mapAndUnzip4M #-}
mapAndUnzip4M :: forall (m :: * -> *) a b c d e.
Monad m =>
(a -> m (b, c, d, e)) -> [a] -> m ([b], [c], [d], [e])
mapAndUnzip4M a -> m (b, c, d, e)
f [a]
xs = [(b, c, d, e)] -> ([b], [c], [d], [e])
forall a b c d. [(a, b, c, d)] -> ([a], [b], [c], [d])
unzip4 ([(b, c, d, e)] -> ([b], [c], [d], [e]))
-> m [(b, c, d, e)] -> m ([b], [c], [d], [e])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m (b, c, d, e)) -> [a] -> m [(b, c, d, e)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> m (b, c, d, e)
f [a]
xs
mapAndUnzip5M :: Monad m => (a -> m (b,c,d,e,f)) -> [a] -> m ([b],[c],[d],[e],[f])
{-# INLINE mapAndUnzip5M #-}
mapAndUnzip5M :: forall (m :: * -> *) a b c d e f.
Monad m =>
(a -> m (b, c, d, e, f)) -> [a] -> m ([b], [c], [d], [e], [f])
mapAndUnzip5M a -> m (b, c, d, e, f)
f [a]
xs = [(b, c, d, e, f)] -> ([b], [c], [d], [e], [f])
forall a b c d e. [(a, b, c, d, e)] -> ([a], [b], [c], [d], [e])
unzip5 ([(b, c, d, e, f)] -> ([b], [c], [d], [e], [f]))
-> m [(b, c, d, e, f)] -> m ([b], [c], [d], [e], [f])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (a -> m (b, c, d, e, f)) -> [a] -> m [(b, c, d, e, f)]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> m (b, c, d, e, f)
f [a]
xs
mapAccumLM :: Monad m
=> (acc -> x -> m (acc, y))
-> acc
-> [x]
-> m (acc, [y])
mapAccumLM :: forall (m :: * -> *) acc x y.
Monad m =>
(acc -> x -> m (acc, y)) -> acc -> [x] -> m (acc, [y])
mapAccumLM acc -> x -> m (acc, y)
f acc
s [x]
xs =
acc -> [x] -> m (acc, [y])
go acc
s [x]
xs
where
go :: acc -> [x] -> m (acc, [y])
go acc
s (x
x:[x]
xs) = do
(acc
s1, y
x') <- acc -> x -> m (acc, y)
f acc
s x
x
(acc
s2, [y]
xs') <- acc -> [x] -> m (acc, [y])
go acc
s1 [x]
xs
(acc, [y]) -> m (acc, [y])
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s2, y
x' y -> [y] -> [y]
forall a. a -> [a] -> [a]
: [y]
xs')
go acc
s [] = (acc, [y]) -> m (acc, [y])
forall (m :: * -> *) a. Monad m => a -> m a
return (acc
s, [])
mapSndM :: Monad m => (b -> m c) -> [(a,b)] -> m [(a,c)]
mapSndM :: forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> [(a, b)] -> m [(a, c)]
mapSndM b -> m c
f [(a, b)]
xs = [(a, b)] -> m [(a, c)]
go [(a, b)]
xs
where
go :: [(a, b)] -> m [(a, c)]
go [] = [(a, c)] -> m [(a, c)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
go ((a
a,b
b):[(a, b)]
xs) = do { c
c <- b -> m c
f b
b; [(a, c)]
rs <- [(a, b)] -> m [(a, c)]
go [(a, b)]
xs; [(a, c)] -> m [(a, c)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((a
a,c
c)(a, c) -> [(a, c)] -> [(a, c)]
forall a. a -> [a] -> [a]
:[(a, c)]
rs) }
liftFstM :: Monad m => (a -> b) -> m (a, r) -> m (b, r)
liftFstM :: forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> m (a, r) -> m (b, r)
liftFstM a -> b
f m (a, r)
thing = do { (a
a,r
r) <- m (a, r)
thing; (b, r) -> m (b, r)
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> b
f a
a, r
r) }
liftSndM :: Monad m => (a -> b) -> m (r, a) -> m (r, b)
liftSndM :: forall (m :: * -> *) a b r.
Monad m =>
(a -> b) -> m (r, a) -> m (r, b)
liftSndM a -> b
f m (r, a)
thing = do { (r
r,a
a) <- m (r, a)
thing; (r, b) -> m (r, b)
forall (m :: * -> *) a. Monad m => a -> m a
return (r
r, a -> b
f a
a) }
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM :: forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM a -> m [b]
f [a]
xs = ([[b]] -> [b]) -> m [[b]] -> m [b]
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [[b]] -> [b]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ((a -> m [b]) -> [a] -> m [[b]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM a -> m [b]
f [a]
xs)
mapMaybeM :: Applicative m => (a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM :: forall (m :: * -> *) a b.
Applicative m =>
(a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM a -> m (Maybe b)
f = (a -> m [b] -> m [b]) -> m [b] -> [a] -> m [b]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr a -> m [b] -> m [b]
g ([b] -> m [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
where g :: a -> m [b] -> m [b]
g a
a = (Maybe b -> [b] -> [b]) -> m (Maybe b) -> m [b] -> m [b]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (([b] -> [b]) -> (b -> [b] -> [b]) -> Maybe b -> [b] -> [b]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [b] -> [b]
forall a. a -> a
id (:)) (a -> m (Maybe b)
f a
a)
fmapMaybeM :: (Monad m) => (a -> m b) -> Maybe a -> m (Maybe b)
fmapMaybeM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
fmapMaybeM a -> m b
_ Maybe a
Nothing = Maybe b -> m (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
fmapMaybeM a -> m b
f (Just a
x) = a -> m b
f a
x m b -> (b -> m (Maybe b)) -> m (Maybe b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Maybe b -> m (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe b -> m (Maybe b)) -> (b -> Maybe b) -> b -> m (Maybe b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Maybe b
forall a. a -> Maybe a
Just)
fmapEitherM :: Monad m => (a -> m b) -> (c -> m d) -> Either a c -> m (Either b d)
fmapEitherM :: forall (m :: * -> *) a b c d.
Monad m =>
(a -> m b) -> (c -> m d) -> Either a c -> m (Either b d)
fmapEitherM a -> m b
fl c -> m d
_ (Left a
a) = a -> m b
fl a
a m b -> (b -> m (Either b d)) -> m (Either b d)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either b d -> m (Either b d)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either b d -> m (Either b d))
-> (b -> Either b d) -> b -> m (Either b d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> Either b d
forall a b. a -> Either a b
Left)
fmapEitherM a -> m b
_ c -> m d
fr (Right c
b) = c -> m d
fr c
b m d -> (d -> m (Either b d)) -> m (Either b d)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Either b d -> m (Either b d)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either b d -> m (Either b d))
-> (d -> Either b d) -> d -> m (Either b d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. d -> Either b d
forall a b. b -> Either a b
Right)
anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
anyM :: forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM a -> m Bool
f [a]
xs = [a] -> m Bool
go [a]
xs
where
go :: [a] -> m Bool
go [] = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
go (a
x:[a]
xs) = do Bool
b <- a -> m Bool
f a
x
if Bool
b then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else [a] -> m Bool
go [a]
xs
allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
allM :: forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM a -> m Bool
f [a]
bs = [a] -> m Bool
go [a]
bs
where
go :: [a] -> m Bool
go [] = Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
go (a
b:[a]
bs) = (a -> m Bool
f a
b) m Bool -> (Bool -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (\Bool
bv -> if Bool
bv then [a] -> m Bool
go [a]
bs else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False)
orM :: Monad m => m Bool -> m Bool -> m Bool
orM :: forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
orM m Bool
m1 m Bool
m2 = m Bool
m1 m Bool -> (Bool -> m Bool) -> m Bool
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
x -> if Bool
x then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else m Bool
m2
foldlM_ :: (Monad m, Foldable t) => (a -> b -> m a) -> a -> t b -> m ()
foldlM_ :: forall (m :: * -> *) (t :: * -> *) a b.
(Monad m, Foldable t) =>
(a -> b -> m a) -> a -> t b -> m ()
foldlM_ = (a -> b -> m a) -> a -> t b -> m ()
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m ()
foldM_
maybeMapM :: Monad m => (a -> m b) -> (Maybe a -> m (Maybe b))
maybeMapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Maybe a -> m (Maybe b)
maybeMapM a -> m b
_ Maybe a
Nothing = Maybe b -> m (Maybe b)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe b
forall a. Maybe a
Nothing
maybeMapM a -> m b
m (Just a
x) = (b -> Maybe b) -> m b -> m (Maybe b)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM b -> Maybe b
forall a. a -> Maybe a
Just (m b -> m (Maybe b)) -> m b -> m (Maybe b)
forall a b. (a -> b) -> a -> b
$ a -> m b
m a
x
whenM :: Monad m => m Bool -> m () -> m ()
whenM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
whenM m Bool
mb m ()
thing = do { Bool
b <- m Bool
mb
; Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b m ()
thing }
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM :: forall (m :: * -> *). Monad m => m Bool -> m () -> m ()
unlessM m Bool
condM m ()
acc = do { Bool
cond <- m Bool
condM
; Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
cond m ()
acc }
filterOutM :: (Applicative m) => (a -> m Bool) -> [a] -> m [a]
filterOutM :: forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterOutM a -> m Bool
p =
(a -> m [a] -> m [a]) -> m [a] -> [a] -> m [a]
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\ a
x -> (Bool -> [a] -> [a]) -> m Bool -> m [a] -> m [a]
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (\ Bool
flg -> if Bool
flg then [a] -> [a]
forall a. a -> a
id else (a
xa -> [a] -> [a]
forall a. a -> [a] -> [a]
:)) (a -> m Bool
p a
x)) ([a] -> m [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])