module Pandora.Paradigm.Primary.Functor.Wye where

import Pandora.Core.Functor (type (~>))
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.Traversable (Traversable ((->>)))

data Wye a = End | Left a | Right a | Both a a

instance Covariant Wye where
	a -> b
_ <$> :: (a -> b) -> Wye a -> Wye b
<$> Wye a
End = Wye b
forall a. Wye a
End
	a -> b
f <$> Left a
x = b -> Wye b
forall a. a -> Wye a
Left (b -> Wye b) -> b -> Wye b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> b
f a
x
	a -> b
f <$> Right a
y = b -> Wye b
forall a. a -> Wye a
Right (b -> Wye b) -> b -> Wye b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> b
f a
y
	a -> b
f <$> Both a
x a
y = b -> b -> Wye b
forall a. a -> a -> Wye a
Both (a -> b
f a
x) (a -> b
f a
y)

instance Traversable Wye where
	Wye a
End ->> :: Wye a -> (a -> u b) -> (u :. Wye) := b
->> a -> u b
_ = Wye b |-> u
forall (t :: * -> *) a. Pointable t => a |-> t
point Wye b
forall a. Wye a
End
	Left a
x ->> a -> u b
f = b -> Wye b
forall a. a -> Wye a
Left (b -> Wye b) -> u b -> (u :. Wye) := b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> a -> u b
f a
x
	Right a
y ->> a -> u b
f = b -> Wye b
forall a. a -> Wye a
Right (b -> Wye b) -> u b -> (u :. Wye) := b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> a -> u b
f a
y
	Both a
x a
y ->> a -> u b
f = b -> b -> Wye b
forall a. a -> a -> Wye a
Both (b -> b -> Wye b) -> u b -> u (b -> Wye b)
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> a -> u b
f a
x u (b -> Wye b) -> u b -> (u :. Wye) := b
forall (t :: * -> *) a b. Applicative t => t (a -> b) -> t a -> t b
<*> a -> u b
f a
y

wye :: r -> (a -> r) -> (a -> r) -> (a -> a -> r) -> Wye a -> r
wye :: r -> (a -> r) -> (a -> r) -> (a -> a -> r) -> Wye a -> r
wye r
r a -> r
_ a -> r
_ a -> a -> r
_ Wye a
End = r
r
wye r
_ a -> r
f a -> r
_ a -> a -> r
_ (Left a
x) = a -> r
f a
x
wye r
_ a -> r
_ a -> r
g a -> a -> r
_ (Right a
y) = a -> r
g a
y
wye r
_ a -> r
_ a -> r
_ a -> a -> r
h (Both a
x a
y) = a -> a -> r
h a
x a
y

swop :: Wye ~> Wye
swop :: Wye a -> Wye a
swop Wye a
End = Wye a
forall a. Wye a
End
swop (Both a
l a
r) = a -> a -> Wye a
forall a. a -> a -> Wye a
Both a
r a
l
swop (Left a
l) = a -> Wye a
forall a. a -> Wye a
Right a
l
swop (Right a
r) = a -> Wye a
forall a. a -> Wye a
Left a
r