module Pandora.Paradigm.Primary.Functor.These where

import Pandora.Pattern.Category ((<--))
import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))
import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-)))
import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
import Pandora.Paradigm.Algebraic.Exponential ()
import Pandora.Paradigm.Algebraic (point)

data These e a = This a | That e | These e a

instance Covariant (->) (->) (These e) where
	a -> b
f <-|- :: (a -> b) -> These e a -> These e b
<-|- This a
x = b -> These e b
forall e a. a -> These e a
This (b -> These e b) -> b -> These e b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a -> b
f a
x
	a -> b
_ <-|- That e
y = e -> These e b
forall e a. e -> These e a
That e
y
	a -> b
f <-|- These e
y a
x = e -> b -> These e b
forall e a. e -> a -> These e a
These e
y (b -> These e b) -> b -> These e b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a -> b
f a
x

instance Traversable (->) (->) (These e) where
	a -> u b
f <-/- :: (a -> u b) -> These e a -> u (These e b)
<-/- This a
x = b -> These e b
forall e a. a -> These e a
This (b -> These e b) -> u b -> u (These 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
_ <-/- That e
y = These e b -> u (These e b)
forall (t :: * -> *) a. Pointable t => a -> t a
point (These e b -> u (These e b)) -> These e b -> u (These e b)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- e -> These e b
forall e a. e -> These e a
That e
y
	a -> u b
f <-/- These e
y a
x = e -> b -> These e b
forall e a. e -> a -> These e a
These e
y (b -> These e b) -> u b -> u (These 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

instance (Semigroup e, Semigroup a) => Semigroup (These e a) where
	This a
x + :: These e a -> These e a -> These e a
+ This a
x' = a -> These e a
forall e a. a -> These e a
This (a -> These e a) -> a -> These 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
x'
	This a
x + That e
y = e -> a -> These e a
forall e a. e -> a -> These e a
These (e -> a -> These e a) -> e -> a -> These e a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- e
y (a -> These e a) -> a -> These e a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a
x
	This a
x + These e
y a
x' = e -> a -> These e a
forall e a. e -> a -> These e a
These e
y (a -> These e a) -> a -> These 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
x'
	That e
y + This a
x' = e -> a -> These e a
forall e a. e -> a -> These e a
These (e -> a -> These e a) -> e -> a -> These e a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- e
y (a -> These e a) -> a -> These e a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a
x'
	That e
y + That e
y' = e -> These e a
forall e a. e -> These e a
That (e -> These e a) -> e -> These e a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- e
y e -> e -> e
forall a. Semigroup a => a -> a -> a
+ e
y'
	That e
y + These e
y' a
x = e -> a -> These e a
forall e a. e -> a -> These e a
These (e -> a -> These e a) -> e -> a -> These e a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- e
y e -> e -> e
forall a. Semigroup a => a -> a -> a
+ e
y' (a -> These e a) -> a -> These e a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a
x
	These e
y a
x + This a
x' = e -> a -> These e a
forall e a. e -> a -> These e a
These (e -> a -> These e a) -> e -> a -> These e a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- e
y (a -> These e a) -> a -> These 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
x'
	These e
y a
x + That e
y' = e -> a -> These e a
forall e a. e -> a -> These e a
These (e -> a -> These e a) -> e -> a -> These e a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- e
y e -> e -> e
forall a. Semigroup a => a -> a -> a
+ e
y' (a -> These e a) -> a -> These e a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a
x
	These e
y a
x + These e
y' a
x' = e -> a -> These e a
forall e a. e -> a -> These e a
These (e -> a -> These e a) -> e -> a -> These e a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- e
y e -> e -> e
forall a. Semigroup a => a -> a -> a
+ e
y' (a -> These e a) -> a -> These 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
x'

these :: (a -> r) -> (e -> r) -> (e -> a -> r) -> These e a -> r
these :: (a -> r) -> (e -> r) -> (e -> a -> r) -> These e a -> r
these a -> r
f e -> r
_ e -> a -> r
_ (This a
x) = a -> r
f a
x
these a -> r
_ e -> r
g e -> a -> r
_ (That e
y) = e -> r
g e
y
these a -> r
_ e -> r
_ e -> a -> r
h (These e
y a
x) = e -> a -> r
h e
y a
x