{-# 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 = (l m -> m) -> f (l m) -> f m
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap l m -> m
l m -> Element (l m)
forall t. (Container t, Monoid (Element t)) => t -> Element t
fold (f (l m) -> f m) -> (l a -> f (l m)) -> l a -> f m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f m) -> l a -> f (l m)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> l a -> f (l 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 = ((a -> f m) -> l a -> f m) -> l a -> (a -> f m) -> f m
forall a b c. (a -> b -> c) -> b -> a -> c
flip (a -> f m) -> l a -> f m
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 = [m Bool] -> m Bool
forall {f :: * -> *}. Monad f => [f Bool] -> f Bool
go ([m Bool] -> m Bool) -> (f -> [m Bool]) -> f -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f -> [m Bool]
f -> [Element f]
forall t. Container t => t -> [Element t]
toList
where
go :: [f Bool] -> f Bool
go [] = Bool -> f Bool
forall a. a -> f a
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 Bool -> f Bool
forall a. a -> f a
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 = [m Bool] -> m Bool
forall {f :: * -> *}. Monad f => [f Bool] -> f Bool
go ([m Bool] -> m Bool) -> (f -> [m Bool]) -> f -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f -> [m Bool]
f -> [Element f]
forall t. Container t => t -> [Element t]
toList
where
go :: [f Bool] -> f Bool
go [] = Bool -> f Bool
forall a. a -> f a
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 Bool -> f Bool
forall a. a -> f a
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 ([Element f] -> m Bool) -> (f -> [Element f]) -> f -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f -> [Element f]
forall t. Container t => t -> [Element t]
toList
where
go :: [Element f] -> m Bool
go [] = Bool -> m Bool
forall a. a -> m a
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 Bool -> m Bool
forall a. a -> m a
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 ([Element f] -> m Bool) -> (f -> [Element f]) -> f -> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f -> [Element f]
forall t. Container t => t -> [Element t]
toList
where
go :: [Element f] -> m Bool
go [] = Bool -> m Bool
forall a. a -> m a
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 Bool -> m Bool
forall a. a -> m a
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 #-}