{-# LANGUAGE CPP #-}
{-# LANGUAGE Trustworthy #-}
{-# LANGUAGE TypeFamilies #-}
module Universum.Monad.Container
( concatMapM
, concatForM
, allM
, anyM
, andM
, orM
) where
import Control.Applicative (Applicative (pure))
import Data.Function ((.))
import Data.Traversable (Traversable (traverse))
import Prelude (Bool (..), Monoid, flip)
#if MIN_VERSION_base(4,17,0)
import Data.Type.Equality (type (~))
#endif
import Universum.Base (IO)
import Universum.Container (Container, Element, fold, toList)
import Universum.Functor (fmap)
import Universum.Monad.Reexport (Monad (..))
concatMapM
:: ( Applicative f
, Monoid m
, Container (l m)
, Element (l m) ~ m
, Traversable l
)
=> (a -> f m) -> l a -> f m
concatMapM :: forall (f :: * -> *) m (l :: * -> *) a.
(Applicative f, Monoid m, Container (l m), Element (l m) ~ m,
Traversable l) =>
(a -> f m) -> l a -> f m
concatMapM a -> f m
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall t. (Container t, Monoid (Element t)) => t -> Element t
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f m
f
{-# INLINE concatMapM #-}
concatForM
:: ( Applicative f
, Monoid m
, Container (l m)
, Element (l m) ~ m
, Traversable l
)
=> l a -> (a -> f m) -> f m
concatForM :: forall (f :: * -> *) m (l :: * -> *) a.
(Applicative f, Monoid m, Container (l m), Element (l m) ~ m,
Traversable l) =>
l a -> (a -> f m) -> f m
concatForM = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall (f :: * -> *) m (l :: * -> *) a.
(Applicative f, Monoid m, Container (l m), Element (l m) ~ m,
Traversable l) =>
(a -> f m) -> l a -> f m
concatMapM
{-# INLINE concatForM #-}
andM :: (Container f, Element f ~ m Bool, Monad m) => f -> m Bool
andM :: forall f (m :: * -> *).
(Container f, Element f ~ m Bool, Monad m) =>
f -> m Bool
andM = forall {f :: * -> *}. Monad f => [f Bool] -> f Bool
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Container t => t -> [Element t]
toList
where
go :: [f Bool] -> f Bool
go [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
go (f Bool
p:[f Bool]
ps) = do
Bool
q <- f Bool
p
if Bool
q then [f Bool] -> f Bool
go [f Bool]
ps else forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
orM :: (Container f, Element f ~ m Bool, Monad m) => f -> m Bool
orM :: forall f (m :: * -> *).
(Container f, Element f ~ m Bool, Monad m) =>
f -> m Bool
orM = forall {f :: * -> *}. Monad f => [f Bool] -> f Bool
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Container t => t -> [Element t]
toList
where
go :: [f Bool] -> f Bool
go [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
go (f Bool
p:[f Bool]
ps) = do
Bool
q <- f Bool
p
if Bool
q then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True else [f Bool] -> f Bool
go [f Bool]
ps
allM :: (Container f, Monad m) => (Element f -> m Bool) -> f -> m Bool
allM :: forall f (m :: * -> *).
(Container f, Monad m) =>
(Element f -> m Bool) -> f -> m Bool
allM Element f -> m Bool
p = [Element f] -> m Bool
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Container t => t -> [Element t]
toList
where
go :: [Element f] -> m Bool
go [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
go (Element f
x:[Element f]
xs) = do
Bool
q <- Element f -> m Bool
p Element f
x
if Bool
q then [Element f] -> m Bool
go [Element f]
xs else forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
anyM :: (Container f, Monad m) => (Element f -> m Bool) -> f -> m Bool
anyM :: forall f (m :: * -> *).
(Container f, Monad m) =>
(Element f -> m Bool) -> f -> m Bool
anyM Element f -> m Bool
p = [Element f] -> m Bool
go forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall t. Container t => t -> [Element t]
toList
where
go :: [Element f] -> m Bool
go [] = forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
go (Element f
x:[Element f]
xs) = do
Bool
q <- Element f -> m Bool
p Element f
x
if Bool
q then forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True else [Element f] -> m Bool
go [Element f]
xs
{-# SPECIALIZE andM :: [IO Bool] -> IO Bool #-}
{-# SPECIALIZE orM :: [IO Bool] -> IO Bool #-}
{-# SPECIALIZE anyM :: (a -> IO Bool) -> [a] -> IO Bool #-}
{-# SPECIALIZE allM :: (a -> IO Bool) -> [a] -> IO Bool #-}