module Pandora.Paradigm.Primary.Functor.Validation where import Pandora.Core.Interpreted ((<~)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category ((<--), (<---)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Object.Setoid (Setoid ((==))) import Pandora.Pattern.Object.Chain (Chain ((<=>))) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Paradigm.Algebraic.Exponential (type (-->)) import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Algebraic.Sum ((:+:) (Option, Adoption)) import Pandora.Paradigm.Algebraic.One (One (One)) import Pandora.Paradigm.Algebraic (point) import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Paradigm.Primary.Object.Boolean (Boolean (False)) import Pandora.Paradigm.Primary.Object.Ordering (Ordering (Less, Greater)) data Validation e a = Flaws e | Validated a instance Covariant (->) (->) (Validation e) where a -> b _ <-|- :: (a -> b) -> Validation e a -> Validation e b <-|- Flaws e e = e -> Validation e b forall e a. e -> Validation e a Flaws e e a -> b f <-|- Validated a x = b -> Validation e b forall e a. a -> Validation e a Validated (b -> Validation e b) -> b -> Validation e b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- a -> b f a x instance Covariant (->) (->) (Flip Validation a) where a -> b f <-|- :: (a -> b) -> Flip Validation a a -> Flip Validation a b <-|- Flip (Flaws a e) = Validation b a -> Flip Validation a b forall (v :: * -> * -> *) a e. v e a -> Flip v a e Flip (Validation b a -> Flip Validation a b) -> (b -> Validation b a) -> b -> Flip Validation a b forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . b -> Validation b a forall e a. e -> Validation e a Flaws (b -> Flip Validation a b) -> b -> Flip Validation a b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- a -> b f a e a -> b _ <-|- Flip (Validated a x) = Validation b a -> Flip Validation a b forall (v :: * -> * -> *) a e. v e a -> Flip v a e Flip (Validation b a -> Flip Validation a b) -> Validation b a -> Flip Validation a b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- a -> Validation b a forall e a. a -> Validation e a Validated a x instance Semigroup e => Semimonoidal (-->) (:*:) (:*:) (Validation e) where mult :: (Validation e a :*: Validation e b) --> Validation e (a :*: b) mult = ((Validation e a :*: Validation e b) -> Validation e (a :*: b)) -> (Validation e a :*: Validation e b) --> Validation e (a :*: b) forall (v :: * -> * -> *) a e. v a e -> Straight v a e Straight (((Validation e a :*: Validation e b) -> Validation e (a :*: b)) -> (Validation e a :*: Validation e b) --> Validation e (a :*: b)) -> ((Validation e a :*: Validation e b) -> Validation e (a :*: b)) -> (Validation e a :*: Validation e b) --> Validation e (a :*: b) forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- \case Validated a x :*: Validated b y -> (a :*: b) -> Validation e (a :*: b) forall e a. a -> Validation e a Validated ((a :*: b) -> Validation e (a :*: b)) -> (a :*: b) -> Validation e (a :*: b) forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <--- a x a -> b -> a :*: b forall s a. s -> a -> s :*: a :*: b y Flaws e x :*: Flaws e y -> e -> Validation e (a :*: b) forall e a. e -> Validation e a Flaws (e -> Validation e (a :*: b)) -> e -> Validation e (a :*: b) forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- e x e -> e -> e forall a. Semigroup a => a -> a -> a + e y Validated a _ :*: Flaws e y -> e -> Validation e (a :*: b) forall e a. e -> Validation e a Flaws e y Flaws e x :*: Validated b _ -> e -> Validation e (a :*: b) forall e a. e -> Validation e a Flaws e x instance Semigroup e => Monoidal (-->) (-->) (:*:) (:*:) (Validation e) where unit :: Proxy (:*:) -> (Unit (:*:) --> a) --> Validation e a unit Proxy (:*:) _ = (Straight (->) One a -> Validation e a) -> Straight (->) (Straight (->) One a) (Validation e a) forall (v :: * -> * -> *) a e. v a e -> Straight v a e Straight ((Straight (->) One a -> Validation e a) -> Straight (->) (Straight (->) One a) (Validation e a)) -> (Straight (->) One a -> Validation e a) -> Straight (->) (Straight (->) One a) (Validation e a) forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- a -> Validation e a forall e a. a -> Validation e a Validated (a -> Validation e a) -> (Straight (->) One a -> a) -> Straight (->) One a -> Validation e a forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . (Straight (->) One a -> One -> a forall (m :: * -> * -> *) (t :: * -> *) a. Interpreted m t => (m < t a) < Primary t a <~ One One) instance Semigroup e => Semimonoidal (-->) (:*:) (:+:) (Validation e) where mult :: (Validation e a :*: Validation e b) --> Validation e (a :+: b) mult = ((Validation e a :*: Validation e b) -> Validation e (a :+: b)) -> (Validation e a :*: Validation e b) --> Validation e (a :+: b) forall (v :: * -> * -> *) a e. v a e -> Straight v a e Straight (((Validation e a :*: Validation e b) -> Validation e (a :+: b)) -> (Validation e a :*: Validation e b) --> Validation e (a :+: b)) -> ((Validation e a :*: Validation e b) -> Validation e (a :+: b)) -> (Validation e a :*: Validation e b) --> Validation e (a :+: b) forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- \case Flaws e _ :*: Validation e b y -> b -> a :+: b forall o a. a -> o :+: a Adoption (b -> a :+: b) -> Validation e b -> Validation e (a :+: b) forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Covariant source target t => source a b -> target (t a) (t b) <-|- Validation e b y Validated a x :*: Validation e b _ -> a -> a :+: b forall o a. o -> o :+: a Option (a -> a :+: b) -> Validation e a -> Validation e (a :+: b) forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Covariant source target t => source a b -> target (t a) (t b) <-|- a -> Validation e a forall e a. a -> Validation e a Validated a x instance Traversable (->) (->) (Validation e) where a -> u b f <-/- :: (a -> u b) -> Validation e a -> u (Validation e b) <-/- Validated a x = b -> Validation e b forall e a. a -> Validation e a Validated (b -> Validation e b) -> u b -> u (Validation e b) forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Covariant source target t => source a b -> target (t a) (t b) <-|- a -> u b f a x a -> u b _ <-/- Flaws e e = Validation e b -> u (Validation e b) forall (t :: * -> *) a. Pointable t => a -> t a point (Validation e b -> u (Validation e b)) -> Validation e b -> u (Validation e b) forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- e -> Validation e b forall e a. e -> Validation e a Flaws e e instance (Setoid e, Setoid a) => Setoid (Validation e a) where Validated a x == :: Validation e a -> Validation e a -> Boolean == Validated a y = a x a -> a -> Boolean forall a. Setoid a => a -> a -> Boolean == a y Flaws e x == Flaws e y = e x e -> e -> Boolean forall a. Setoid a => a -> a -> Boolean == e y Validation e a _ == Validation e a _ = Boolean False instance (Chain e, Chain a) => Chain (Validation e a) where Validated a x <=> :: Validation e a -> Validation e a -> Ordering <=> Validated a y = a x a -> a -> Ordering forall a. Chain a => a -> a -> Ordering <=> a y Flaws e x <=> Flaws e y = e x e -> e -> Ordering forall a. Chain a => a -> a -> Ordering <=> e y Flaws e _ <=> Validated a _ = Ordering Less Validated a _ <=> Flaws e _ = Ordering Greater instance (Semigroup e, Semigroup a) => Semigroup (Validation e a) where Validated a x + :: Validation e a -> Validation e a -> Validation e a + Validated a y = a -> Validation e a forall e a. a -> Validation e a Validated (a -> Validation e a) -> a -> Validation e a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- a x a -> a -> a forall a. Semigroup a => a -> a -> a + a y Flaws e x + Flaws e y = e -> Validation e a forall e a. e -> Validation e a Flaws (e -> Validation e a) -> e -> Validation e a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) <-- e x e -> e -> e forall a. Semigroup a => a -> a -> a + e y Flaws e _ + Validated a y = a -> Validation e a forall e a. a -> Validation e a Validated a y Validated a x + Flaws e _ = a -> Validation e a forall e a. a -> Validation e a Validated a x validation :: (e -> r) -> (a -> r) -> Validation e a -> r validation :: (e -> r) -> (a -> r) -> Validation e a -> r validation e -> r f a -> r _ (Flaws e x) = e -> r f e x validation e -> r _ a -> r s (Validated a x) = a -> r s a x