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