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 (multiply)) 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 () 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.Paradigm.Primary.Transformer.Flip (Flip (Flip)) 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 multiply :: (Validation e a :*: Validation e b) -> Validation e (a :*: b) multiply (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 multiply (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 multiply (Validated a _ :*: Flaws e y) = e -> Validation e (a :*: b) forall e a. e -> Validation e a Flaws e y multiply (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 (:*:) _ Unit (:*:) -> a f = 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) $ Unit (:*:) -> a f One Unit (:*:) One instance Semigroup e => Semimonoidal (->) (:*:) (:+:) (Validation e) where multiply :: (Validation e a :*: Validation e b) -> Validation e (a :+: b) multiply (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 multiply (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. Monoidal (->) (->) (:*:) (:*:) 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