module Pandora.Paradigm.Primary.Algebraic.Sum where

import Pandora.Pattern.Semigroupoid ((.))
import Pandora.Pattern.Category (($))
import Pandora.Pattern.Functor.Covariant (Covariant ((-<$>-)))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Bivariant (Bivariant ((<->)))
import Pandora.Paradigm.Primary.Algebraic.Exponential ()
import Pandora.Paradigm.Primary.Transformer.Flip (Flip (Flip))

infixr 0 :+:

data (:+:) s a = Option s | Adoption a

instance Covariant ((:+:) s) (->) (->) where
	a -> b
_ -<$>- :: (a -> b) -> (s :+: a) -> s :+: b
-<$>- Option s
s = s -> s :+: b
forall s a. s -> s :+: a
Option s
s
	a -> b
f -<$>- Adoption a
x = b -> s :+: b
forall s a. a -> s :+: a
Adoption (b -> s :+: b) -> b -> s :+: b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ a -> b
f a
x

instance Pointable ((:+:) e) (->) where
	point :: a -> e :+: a
point = a -> e :+: a
forall s a. a -> s :+: a
Adoption

instance Bivariant (:+:) (->) (->) (->) where
	a -> b
f <-> :: (a -> b) -> (c -> d) -> (a :+: c) -> b :+: d
<-> c -> d
g = \case
		Option a
s -> b -> b :+: d
forall s a. s -> s :+: a
Option (b -> b :+: d) -> b -> b :+: d
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ a -> b
f a
s
		Adoption c
x -> d -> b :+: d
forall s a. a -> s :+: a
Adoption (d -> b :+: d) -> d -> b :+: d
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ c -> d
g c
x

instance Covariant (Flip (:+:) a) (->) (->) where
	a -> b
_ -<$>- :: (a -> b) -> Flip (:+:) a a -> Flip (:+:) a b
-<$>- Flip (Adoption a
x) = (b :+: a) -> Flip (:+:) a b
forall (v :: * -> * -> *) a e. v e a -> Flip v a e
Flip ((b :+: a) -> Flip (:+:) a b) -> (b :+: a) -> Flip (:+:) a b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ a -> b :+: a
forall s a. a -> s :+: a
Adoption a
x
	a -> b
f -<$>- Flip (Option a
y) = (b :+: a) -> Flip (:+:) a b
forall (v :: * -> * -> *) a e. v e a -> Flip v a e
Flip ((b :+: a) -> Flip (:+:) a b)
-> (b -> b :+: a) -> b -> Flip (:+:) a b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. b -> b :+: a
forall s a. s -> s :+: a
Option (b -> Flip (:+:) a b) -> b -> Flip (:+:) a b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ a -> b
f a
y