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