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