{-# LANGUAGE ConstraintKinds #-}
module Control.Monad.Extra(
module Control.Monad,
whenJust, whenJustM,
pureIf,
whenMaybe, whenMaybeM,
unit,
maybeM, fromMaybeM, eitherM,
loop, loopM, whileM, whileJustM, untilJustM,
partitionM, concatMapM, concatForM, mconcatMapM, mapMaybeM, findM, firstJustM,
fold1M, fold1M_,
whenM, unlessM, ifM, notM, (||^), (&&^), orM, andM, anyM, allM
) where
import Control.Monad
import Control.Exception.Extra
import Data.Maybe
import Control.Applicative
import Data.Monoid
import Prelude
whenJust :: Applicative m => Maybe a -> (a -> m ()) -> m ()
whenJust :: Maybe a -> (a -> m ()) -> m ()
whenJust Maybe a
mg a -> m ()
f = m () -> (a -> m ()) -> Maybe a -> m ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) a -> m ()
f Maybe a
mg
whenJustM :: Monad m => m (Maybe a) -> (a -> m ()) -> m ()
whenJustM :: m (Maybe a) -> (a -> m ()) -> m ()
whenJustM m (Maybe a)
mg a -> m ()
f = m () -> (a -> m ()) -> m (Maybe a) -> m ()
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) a -> m ()
f m (Maybe a)
mg
pureIf :: (Alternative m) => Bool -> a -> m a
pureIf :: Bool -> a -> m a
pureIf Bool
b a
a = if Bool
b then a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a else m a
forall (f :: * -> *) a. Alternative f => f a
empty
whenMaybe :: Applicative m => Bool -> m a -> m (Maybe a)
whenMaybe :: Bool -> m a -> m (Maybe a)
whenMaybe Bool
b m a
x = if Bool
b then a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a) -> m a -> m (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a
x else Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
whenMaybeM :: Monad m => m Bool -> m a -> m (Maybe a)
whenMaybeM :: m Bool -> m a -> m (Maybe a)
whenMaybeM m Bool
mb m a
x = do
Bool
b <- m Bool
mb
if Bool
b then (a -> Maybe a) -> m a -> m (Maybe a)
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM a -> Maybe a
forall a. a -> Maybe a
Just m a
x else Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing
unit :: m () -> m ()
unit :: m () -> m ()
unit = m () -> m ()
forall a. a -> a
id
maybeM :: Monad m => m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM :: m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM m b
n a -> m b
j m (Maybe a)
x = m b -> (a -> m b) -> Maybe a -> m b
forall b a. b -> (a -> b) -> Maybe a -> b
maybe m b
n a -> m b
j (Maybe a -> m b) -> m (Maybe a) -> m b
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Maybe a)
x
fromMaybeM :: Monad m => m a -> m (Maybe a) -> m a
fromMaybeM :: m a -> m (Maybe a) -> m a
fromMaybeM m a
n m (Maybe a)
x = m a -> (a -> m a) -> m (Maybe a) -> m a
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM m a
n a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure m (Maybe a)
x
eitherM :: Monad m => (a -> m c) -> (b -> m c) -> m (Either a b) -> m c
eitherM :: (a -> m c) -> (b -> m c) -> m (Either a b) -> m c
eitherM a -> m c
l b -> m c
r m (Either a b)
x = (a -> m c) -> (b -> m c) -> Either a b -> m c
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either a -> m c
l b -> m c
r (Either a b -> m c) -> m (Either a b) -> m c
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Either a b)
x
fold1M :: (Partial, Monad m) => (a -> a -> m a) -> [a] -> m a
fold1M :: (a -> a -> m a) -> [a] -> m a
fold1M a -> a -> m a
f (a
x:[a]
xs) = (a -> a -> m a) -> a -> [a] -> m a
forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM a -> a -> m a
f a
x [a]
xs
fold1M a -> a -> m a
f [a]
xs = [Char] -> m a
forall a. HasCallStack => [Char] -> a
error [Char]
"fold1M: empty list"
fold1M_ :: (Partial, Monad m) => (a -> a -> m a) -> [a] -> m ()
fold1M_ :: (a -> a -> m a) -> [a] -> m ()
fold1M_ a -> a -> m a
f [a]
xs = (a -> a -> m a) -> [a] -> m a
forall (m :: * -> *) a.
(HasCallStack, Monad m) =>
(a -> a -> m a) -> [a] -> m a
fold1M a -> a -> m a
f [a]
xs m a -> m () -> m ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
partitionM :: Monad m => (a -> m Bool) -> [a] -> m ([a], [a])
partitionM :: (a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
f [] = ([a], [a]) -> m ([a], [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([], [])
partitionM a -> m Bool
f (a
x:[a]
xs) = do
Bool
res <- a -> m Bool
f a
x
([a]
as,[a]
bs) <- (a -> m Bool) -> [a] -> m ([a], [a])
forall (m :: * -> *) a.
Monad m =>
(a -> m Bool) -> [a] -> m ([a], [a])
partitionM a -> m Bool
f [a]
xs
([a], [a]) -> m ([a], [a])
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([a
x | Bool
res][a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
as, [a
x | Bool -> Bool
not Bool
res][a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++[a]
bs)
concatMapM :: Monad m => (a -> m [b]) -> [a] -> m [b]
{-# INLINE concatMapM #-}
concatMapM :: (a -> m [b]) -> [a] -> m [b]
concatMapM a -> m [b]
op = (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]
f ([b] -> m [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
where f :: a -> m [b] -> m [b]
f a
x m [b]
xs = do [b]
x <- a -> m [b]
op a
x; if [b] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [b]
x then m [b]
xs else do [b]
xs <- m [b]
xs; [b] -> m [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([b] -> m [b]) -> [b] -> m [b]
forall a b. (a -> b) -> a -> b
$ [b]
x[b] -> [b] -> [b]
forall a. [a] -> [a] -> [a]
++[b]
xs
concatForM :: Monad m => [a] -> (a -> m [b]) -> m [b]
concatForM :: [a] -> (a -> m [b]) -> m [b]
concatForM = ((a -> m [b]) -> [a] -> m [b]) -> [a] -> (a -> m [b]) -> m [b]
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> m [b]) -> [a] -> m [b]
forall (m :: * -> *) a b. Monad m => (a -> m [b]) -> [a] -> m [b]
concatMapM
mconcatMapM :: (Monad m, Monoid b) => (a -> m b) -> [a] -> m b
mconcatMapM :: (a -> m b) -> [a] -> m b
mconcatMapM a -> m b
f = ([b] -> b) -> m [b] -> m b
forall (m :: * -> *) a1 r. Monad m => (a1 -> r) -> m a1 -> m r
liftM [b] -> b
forall a. Monoid a => [a] -> a
mconcat (m [b] -> m b) -> ([a] -> m [b]) -> [a] -> m b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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
mapMaybeM :: Monad m => (a -> m (Maybe b)) -> [a] -> m [b]
{-# INLINE mapMaybeM #-}
mapMaybeM :: (a -> m (Maybe b)) -> [a] -> m [b]
mapMaybeM a -> m (Maybe b)
op = (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]
f ([b] -> m [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure [])
where f :: a -> m [b] -> m [b]
f a
x m [b]
xs = do Maybe b
x <- a -> m (Maybe b)
op a
x; case Maybe b
x of Maybe b
Nothing -> m [b]
xs; Just b
x -> do [b]
xs <- m [b]
xs; [b] -> m [b]
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([b] -> m [b]) -> [b] -> m [b]
forall a b. (a -> b) -> a -> b
$ b
xb -> [b] -> [b]
forall a. a -> [a] -> [a]
:[b]
xs
loop :: (a -> Either a b) -> a -> b
loop :: (a -> Either a b) -> a -> b
loop a -> Either a b
act a
x = case a -> Either a b
act a
x of
Left a
x -> (a -> Either a b) -> a -> b
forall a b. (a -> Either a b) -> a -> b
loop a -> Either a b
act a
x
Right b
v -> b
v
loopM :: Monad m => (a -> m (Either a b)) -> a -> m b
loopM :: (a -> m (Either a b)) -> a -> m b
loopM a -> m (Either a b)
act a
x = do
Either a b
res <- a -> m (Either a b)
act a
x
case Either a b
res of
Left a
x -> (a -> m (Either a b)) -> a -> m b
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Either a b)) -> a -> m b
loopM a -> m (Either a b)
act a
x
Right b
v -> b -> m b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
v
whileM :: Monad m => m Bool -> m ()
whileM :: m Bool -> m ()
whileM m Bool
act = do
Bool
b <- m Bool
act
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
b (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ m Bool -> m ()
forall (m :: * -> *). Monad m => m Bool -> m ()
whileM m Bool
act
whileJustM :: (Monad m, Monoid a) => m (Maybe a) -> m a
whileJustM :: m (Maybe a) -> m a
whileJustM m (Maybe a)
act = a -> m a
go a
forall a. Monoid a => a
mempty
where
go :: a -> m a
go a
accum = do
Maybe a
res <- m (Maybe a)
act
case Maybe a
res of
Maybe a
Nothing -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
accum
Just a
r -> a -> m a
go (a -> m a) -> a -> m a
forall a b. (a -> b) -> a -> b
$! (a
accum a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
r)
untilJustM :: Monad m => m (Maybe a) -> m a
untilJustM :: m (Maybe a) -> m a
untilJustM m (Maybe a)
act = do
Maybe a
res <- m (Maybe a)
act
case Maybe a
res of
Just a
r -> a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
r
Maybe a
Nothing -> m (Maybe a) -> m a
forall (m :: * -> *) a. Monad m => m (Maybe a) -> m a
untilJustM m (Maybe a)
act
whenM :: Monad m => m Bool -> m () -> m ()
whenM :: m Bool -> m () -> m ()
whenM m Bool
b m ()
t = m Bool -> m () -> m () -> m ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
b m ()
t (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ())
unlessM :: Monad m => m Bool -> m () -> m ()
unlessM :: m Bool -> m () -> m ()
unlessM m Bool
b m ()
f = m Bool -> m () -> m () -> m ()
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
b (() -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()) m ()
f
ifM :: Monad m => m Bool -> m a -> m a -> m a
ifM :: m Bool -> m a -> m a -> m a
ifM m Bool
b m a
t m a
f = do Bool
b <- m Bool
b; if Bool
b then m a
t else m a
f
notM :: Functor m => m Bool -> m Bool
notM :: m Bool -> m Bool
notM = (Bool -> Bool) -> m Bool -> m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Bool -> Bool
not
(||^) :: Monad m => m Bool -> m Bool -> m Bool
||^ :: m Bool -> m Bool -> m Bool
(||^) m Bool
a m Bool
b = m Bool -> m Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
a (Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True) m Bool
b
(&&^) :: Monad m => m Bool -> m Bool -> m Bool
&&^ :: m Bool -> m Bool -> m Bool
(&&^) m Bool
a m Bool
b = m Bool -> m Bool -> m Bool -> m Bool
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM m Bool
a m Bool
b (Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
anyM :: Monad m => (a -> m Bool) -> [a] -> m Bool
anyM :: (a -> m Bool) -> [a] -> m Bool
anyM a -> m Bool
p = (a -> m Bool -> m Bool) -> m Bool -> [a] -> m Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (m Bool -> m Bool -> m Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
(||^) (m Bool -> m Bool -> m Bool)
-> (a -> m Bool) -> a -> m Bool -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m Bool
p) (Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False)
allM :: Monad m => (a -> m Bool) -> [a] -> m Bool
allM :: (a -> m Bool) -> [a] -> m Bool
allM a -> m Bool
p = (a -> m Bool -> m Bool) -> m Bool -> [a] -> m Bool
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (m Bool -> m Bool -> m Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
(&&^) (m Bool -> m Bool -> m Bool)
-> (a -> m Bool) -> a -> m Bool -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> m Bool
p) (Bool -> m Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True)
orM :: Monad m => [m Bool] -> m Bool
orM :: [m Bool] -> m Bool
orM = (m Bool -> m Bool) -> [m Bool] -> m Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
anyM m Bool -> m Bool
forall a. a -> a
id
andM :: Monad m => [m Bool] -> m Bool
andM :: [m Bool] -> m Bool
andM = (m Bool -> m Bool) -> [m Bool] -> m Bool
forall (m :: * -> *) a. Monad m => (a -> m Bool) -> [a] -> m Bool
allM m Bool -> m Bool
forall a. a -> a
id
findM :: Monad m => (a -> m Bool) -> [a] -> m (Maybe a)
findM :: (a -> m Bool) -> [a] -> m (Maybe a)
findM a -> m Bool
p = (a -> m (Maybe a) -> m (Maybe a))
-> m (Maybe a) -> [a] -> m (Maybe a)
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\a
x -> m Bool -> m (Maybe a) -> m (Maybe a) -> m (Maybe a)
forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a
ifM (a -> m Bool
p a
x) (Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
x)) (Maybe a -> m (Maybe a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe a
forall a. Maybe a
Nothing)
firstJustM :: Monad m => (a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM :: (a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM a -> m (Maybe b)
p [] = Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe b
forall a. Maybe a
Nothing
firstJustM a -> m (Maybe b)
p (a
x:[a]
xs) = m (Maybe b) -> (b -> m (Maybe b)) -> m (Maybe b) -> m (Maybe b)
forall (m :: * -> *) b a.
Monad m =>
m b -> (a -> m b) -> m (Maybe a) -> m b
maybeM ((a -> m (Maybe b)) -> [a] -> m (Maybe b)
forall (m :: * -> *) a b.
Monad m =>
(a -> m (Maybe b)) -> [a] -> m (Maybe b)
firstJustM a -> m (Maybe b)
p [a]
xs) (Maybe b -> m (Maybe b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (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) (a -> m (Maybe b)
p a
x)