module Pandora.Paradigm.Primary.Functor.Validation where

import Pandora.Pattern.Category ((.), ($))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
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.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 :: * -> * -> *). Category m => m ~~> m
$ a -> b
f a
x

instance Pointable (Validation e) where
	point :: a :=> Validation e
point = a :=> Validation e
forall e a. a -> Validation e a
Validated

instance Semigroup e => Applicative (Validation e) where
	Flaws e
e <*> :: Validation e (a -> b) -> Validation e a -> Validation e b
<*> Flaws e
e' = e -> Validation e b
forall e a. e -> Validation e a
Flaws (e -> Validation e b) -> e -> Validation e b
forall (m :: * -> * -> *). Category m => m ~~> m
$ e
e e -> e -> e
forall a. Semigroup a => a -> a -> a
+ e
e'
	Flaws e
e <*> Validated a
_ = e -> Validation e b
forall e a. e -> Validation e a
Flaws e
e
	Validated a -> b
_ <*> Flaws e
e' = e -> Validation e b
forall e a. e -> Validation e a
Flaws e
e'
	Validated 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 :: * -> * -> *). Category m => m ~~> m
$ a -> b
f a
x

instance Alternative (Validation e) where
	Flaws e
_ <+> :: Validation e a -> Validation e a -> Validation e a
<+> Validation e a
x = Validation e a
x
	Validated a
x <+> Validation e a
_ = a -> Validation e a
forall e a. a -> Validation e a
Validated a
x

instance Traversable (Validation e) where
	Validated a
x ->> :: Validation e a -> (a -> u b) -> (u :. Validation e) := b
->> a -> u b
f = b -> Validation e b
forall e a. a -> Validation e a
Validated (b -> Validation e b) -> u b -> (u :. Validation e) := b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> a -> u b
f a
x
	Flaws e
e ->> a -> u b
_ = Validation e b :=> u
forall (t :: * -> *) a. Pointable t => a :=> t
point (Validation e b :=> u) -> Validation e b :=> u
forall (m :: * -> * -> *). Category m => m ~~> m
$ 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 (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.
Category m =>
m b c -> m a b -> m a c
. a -> b
f) (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.
Category 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 :: * -> * -> *). Category m => m ~~> m
$ 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 :: * -> * -> *). Category m => m ~~> m
$ 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