module Pandora.Paradigm.Structure.Interface.Set where

import Pandora.Core.Morphism ((!), (%))
import Pandora.Pattern.Category ((.))
import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
import Pandora.Pattern.Object.Setoid (Setoid ((/=)))
import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Nothing), maybe)
import Pandora.Paradigm.Primary.Functor.Predicate (equate)
import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False))
import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic, find)

member :: (Setoid a, Monotonic e a) => a -> e -> Boolean
member :: a -> e -> Boolean
member a
x = Boolean -> (a -> Boolean) -> Maybe a -> Boolean
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Boolean
False (Boolean
True Boolean -> a -> Boolean
forall a b. a -> b -> a
!) (Maybe a -> Boolean) -> (e -> Maybe a) -> e -> Boolean
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Predicate a -> e -> Maybe a
forall e a (t :: * -> *).
(Monotonic e a, Pointable t, Avoidable t) =>
Predicate a -> e -> t a
find (a |-> Predicate
forall a. Setoid a => a |-> Predicate
equate a
x)

subset :: (Monotonic (t a) a, Traversable t, Setoid a, Setoid (t a)) => t a -> t a -> Boolean
subset :: t a -> t a -> Boolean
subset t a
ss t a
s = Maybe (t a)
forall a. Maybe a
Nothing Maybe (t a) -> Maybe (t a) -> Boolean
forall a. Setoid a => a -> a -> Boolean
/= (t a
ss t a -> (a -> Maybe a) -> Maybe (t a)
forall (t :: * -> *) (u :: * -> *) a b.
(Traversable t, Pointable u, Applicative u) =>
t a -> (a -> u b) -> (u :. t) := b
->> Predicate a -> t a -> Maybe a
forall e a (t :: * -> *).
(Monotonic e a, Pointable t, Avoidable t) =>
Predicate a -> e -> t a
find (Predicate a -> t a -> Maybe a) -> t a -> Predicate a -> Maybe a
forall a b c. (a -> b -> c) -> b -> a -> c
% t a
s (Predicate a -> Maybe a) -> (a -> Predicate a) -> a -> Maybe a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. a -> Predicate a
forall a. Setoid a => a |-> Predicate
equate)