module Pandora.Paradigm.Primary.Functor.Validation where 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.Functor.Bivariant (Bivariant ((<->))) import Pandora.Pattern.Object.Setoid (Setoid ((==))) import Pandora.Pattern.Object.Chain (Chain ((<=>))) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Paradigm.Primary.Algebraic.Exponential (type (-->)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Primary.Algebraic.Sum ((:+:) (Option, Adoption)) import Pandora.Paradigm.Primary.Algebraic.One (One (One)) import Pandora.Paradigm.Primary.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 a -> 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 a -> 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 a -> b f <$> 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 a -> b f <$> 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 (:*:) _ = ((One -> a) -> Validation e a) -> Straight (->) (One -> a) (Validation e a) forall (v :: * -> * -> *) a e. v a e -> Straight v a e Straight (((One -> a) -> Validation e a) -> Straight (->) (One -> a) (Validation e a)) -> ((One -> a) -> Validation e a) -> 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) -> ((One -> a) -> a) -> (One -> a) -> Validation e a forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . ((One -> a) -> One -> a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ 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 s a. a -> s :+: 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 s a. s -> s :+: 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 Bivariant (->) (->) (->) Validation where a -> b f <-> :: (a -> b) -> (c -> d) -> Validation a c -> Validation b d <-> c -> d g = (a -> Validation b d) -> (c -> Validation b d) -> Validation a c -> Validation b d forall e r a. (e -> r) -> (a -> r) -> Validation e a -> r validation ((a -> Validation b d) -> (c -> Validation b d) -> Validation a c -> Validation b d) -> (a -> Validation b d) -> (c -> Validation b d) -> Validation a c -> Validation b d forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # b -> Validation b d forall e a. e -> Validation e a Flaws (b -> Validation b d) -> (a -> b) -> a -> Validation b d forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . a -> b f ((c -> Validation b d) -> Validation a c -> Validation b d) -> (c -> Validation b d) -> Validation a c -> Validation b d forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # d -> Validation b d forall e a. a -> Validation e a Validated (d -> Validation b d) -> (c -> d) -> c -> Validation b d forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . c -> d g 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