module Utils.Foldable where


hasNone :: Foldable t => t a -> Bool
hasNone :: forall (t :: * -> *) a. Foldable t => t a -> Bool
hasNone = forall (t :: * -> *) a. Foldable t => t a -> Bool
null

hasSome :: Foldable t => t a -> Bool
hasSome :: forall (t :: * -> *) a. Foldable t => t a -> Bool
hasSome = Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
hasNone

wrapMaybe :: Foldable t => t a -> Maybe (t a)
wrapMaybe :: forall (t :: * -> *) a. Foldable t => t a -> Maybe (t a)
wrapMaybe t a
x = if forall (t :: * -> *) a. Foldable t => t a -> Bool
hasSome t a
x then forall a. a -> Maybe a
Just t a
x else forall a. Maybe a
Nothing

orPred :: (Foldable t, Functor t) => t (p -> Bool) -> p -> Bool
orPred :: forall (t :: * -> *) p.
(Foldable t, Functor t) =>
t (p -> Bool) -> p -> Bool
orPred t (p -> Bool)
ps p
a = forall (t :: * -> *). Foldable t => t Bool -> Bool
or forall a b. (a -> b) -> a -> b
$ (forall a b. (a -> b) -> a -> b
$ p
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (p -> Bool)
ps

andPred :: (Foldable t, Functor t) => t (p -> Bool) -> p -> Bool
andPred :: forall (t :: * -> *) p.
(Foldable t, Functor t) =>
t (p -> Bool) -> p -> Bool
andPred t (p -> Bool)
ps p
a = forall (t :: * -> *). Foldable t => t Bool -> Bool
and forall a b. (a -> b) -> a -> b
$  (forall a b. (a -> b) -> a -> b
$ p
a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> t (p -> Bool)
ps