module Pandora.Paradigm.Primary.Transformer.Jack where

import Pandora.Pattern.Category (identity, (.), ($))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Extractable (Extractable (extract))
import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
import Pandora.Pattern.Functor.Avoidable (Avoidable (empty))
import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
import Pandora.Pattern.Functor.Distributive (Distributive ((>>-), distribute))
import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
import Pandora.Pattern.Functor.Extendable (Extendable ((=>>)))
import Pandora.Pattern.Transformer.Liftable (Liftable (lift))
import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))
import Pandora.Pattern.Object.Setoid (Setoid ((==)))
import Pandora.Pattern.Object.Chain (Chain ((<=>)))
import Pandora.Paradigm.Primary.Object.Boolean (Boolean (False))
import Pandora.Paradigm.Primary.Object.Ordering (Ordering (Less, Greater))

data Jack t a = It a | Other (t a)

instance Covariant t => Covariant (Jack t) where
	a -> b
f <$> :: (a -> b) -> Jack t a -> Jack t b
<$> It a
x = b -> Jack t b
forall (t :: * -> *) a. a -> Jack t a
It (b -> Jack t b) -> b -> Jack t b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> b
f a
x
	a -> b
f <$> Other t a
y = t b -> Jack t b
forall (t :: * -> *) a. t a -> Jack t a
Other (t b -> Jack t b) -> t b -> Jack t b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> b
f (a -> b) -> t a -> t b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> t a
y

instance Covariant t => Pointable (Jack t) where
	point :: a |-> Jack t
point = a |-> Jack t
forall (t :: * -> *) a. a -> Jack t a
It

instance Alternative t => Alternative (Jack t) where
	It a
x <+> :: Jack t a -> Jack t a -> Jack t a
<+> Jack t a
_ = a -> Jack t a
forall (t :: * -> *) a. a -> Jack t a
It a
x
	Other t a
_ <+> It a
y = a -> Jack t a
forall (t :: * -> *) a. a -> Jack t a
It a
y
	Other t a
x <+> Other t a
y = t a -> Jack t a
forall (t :: * -> *) a. t a -> Jack t a
Other (t a
x t a -> t a -> t a
forall (t :: * -> *) a. Alternative t => t a -> t a -> t a
<+> t a
y)

instance Avoidable t => Avoidable (Jack t) where
	empty :: Jack t a
empty = t a -> Jack t a
forall (t :: * -> *) a. t a -> Jack t a
Other t a
forall (t :: * -> *) a. Avoidable t => t a
empty

instance Extractable t => Extractable (Jack t) where
	extract :: a <-| Jack t
extract (It a
x) = a
x
	extract (Other t a
y) = a <-| t
forall (t :: * -> *) a. Extractable t => a <-| t
extract t a
y

instance Applicative t => Applicative (Jack t) where
	It a -> b
f <*> :: Jack t (a -> b) -> Jack t a -> Jack t b
<*> It a
x = b -> Jack t b
forall (t :: * -> *) a. a -> Jack t a
It (b -> Jack t b) -> b -> Jack t b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> b
f a
x
	It a -> b
f <*> Other t a
y = t b -> Jack t b
forall (t :: * -> *) a. t a -> Jack t a
Other (t b -> Jack t b) -> t b -> Jack t b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> b
f (a -> b) -> t a -> t b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> t a
y
	Other t (a -> b)
f <*> It a
x = t b -> Jack t b
forall (t :: * -> *) a. t a -> Jack t a
Other (t b -> Jack t b) -> t b -> Jack t b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ ((a -> b) -> a -> b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a
x) ((a -> b) -> b) -> t (a -> b) -> t b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> t (a -> b)
f
	Other t (a -> b)
f <*> Other t a
y = t b -> Jack t b
forall (t :: * -> *) a. t a -> Jack t a
Other (t b -> Jack t b) -> t b -> Jack t b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ t (a -> b)
f t (a -> b) -> t a -> t b
forall (t :: * -> *) a b. Applicative t => t (a -> b) -> t a -> t b
<*> t a
y

instance Traversable t => Traversable (Jack t) where
	It a
x ->> :: Jack t a -> (a -> u b) -> (u :. Jack t) := b
->> a -> u b
f = b -> Jack t b
forall (t :: * -> *) a. a -> Jack t a
It (b -> Jack t b) -> u b -> (u :. Jack t) := b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> a -> u b
f a
x
	Other t a
y ->> a -> u b
f = t b -> Jack t b
forall (t :: * -> *) a. t a -> Jack t a
Other (t b -> Jack t b) -> u (t b) -> (u :. Jack t) := b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> (t a
y t a -> (a -> u b) -> u (t b)
forall (t :: * -> *) (u :: * -> *) a b.
(Traversable t, Pointable u, Applicative u) =>
t a -> (a -> u b) -> (u :. t) := b
->> a -> u b
f)

instance Distributive t => Distributive (Jack t) where
	u a
x >>- :: u a -> (a -> Jack t b) -> (Jack t :. u) := b
>>- a -> Jack t b
f = ((u :. Jack t) := b) -> (Jack t :. u) := b
forall (t :: * -> *) (u :: * -> *) a.
(Distributive t, Covariant u) =>
((u :. t) := a) -> (t :. u) := a
distribute (((u :. Jack t) := b) -> (Jack t :. u) := b)
-> ((u :. Jack t) := b) -> (Jack t :. u) := b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> Jack t b
f (a -> Jack t b) -> u a -> (u :. Jack t) := b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> u a
x

instance (Pointable t, Bindable t) => Bindable (Jack t) where
	It a
x >>= :: Jack t a -> (a -> Jack t b) -> Jack t b
>>= a -> Jack t b
f = a -> Jack t b
f a
x
	Other t a
x >>= a -> Jack t b
f = t b -> Jack t b
forall (t :: * -> *) a. t a -> Jack t a
Other (t b -> Jack t b) -> t b -> Jack t b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ t a
x t a -> (a -> t b) -> t b
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= (b -> t b) -> (t b -> t b) -> Jack t b -> t b
forall a r (t :: * -> *). (a -> r) -> (t a -> r) -> Jack t a -> r
jack b -> t b
forall (t :: * -> *) a. Pointable t => a |-> t
point t b -> t b
forall (m :: * -> * -> *) a. Category m => m a a
identity (Jack t b -> t b) -> (a -> Jack t b) -> a -> t b
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. a -> Jack t b
f

instance Extendable t => Extendable (Jack t) where
	It a
x =>> :: Jack t a -> (Jack t a -> b) -> Jack t b
=>> Jack t a -> b
f = b -> Jack t b
forall (t :: * -> *) a. a -> Jack t a
It (b -> Jack t b) -> (Jack t a -> b) -> Jack t a -> Jack t b
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Jack t a -> b
f (Jack t a -> Jack t b) -> Jack t a -> Jack t b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> Jack t a
forall (t :: * -> *) a. a -> Jack t a
It a
x
	Other t a
x =>> Jack t a -> b
f = t b -> Jack t b
forall (t :: * -> *) a. t a -> Jack t a
Other (t b -> Jack t b) -> t b -> Jack t b
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ t a
x t a -> (t a -> b) -> t b
forall (t :: * -> *) a b. Extendable t => t a -> (t a -> b) -> t b
=>> Jack t a -> b
f (Jack t a -> b) -> (t a -> Jack t a) -> t a -> b
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. t a -> Jack t a
forall (t :: * -> *) a. t a -> Jack t a
Other

instance Liftable Jack where
	lift :: u ~> Jack u
lift = u a -> Jack u a
forall (t :: * -> *) a. t a -> Jack t a
Other

instance Hoistable Jack where
	hoist :: (u ~> v) -> Jack u ~> Jack v
hoist u ~> v
_ (It a
x) = a -> Jack v a
forall (t :: * -> *) a. a -> Jack t a
It a
x
	hoist u ~> v
f (Other u a
x) = v a -> Jack v a
forall (t :: * -> *) a. t a -> Jack t a
Other (v a -> Jack v a) -> v a -> Jack v a
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ u a -> v a
u ~> v
f u a
x

instance (Setoid a, Setoid (t a)) => Setoid (Jack t a) where
	It a
x == :: Jack t a -> Jack t a -> Boolean
== It a
y = a
x a -> a -> Boolean
forall a. Setoid a => a -> a -> Boolean
== a
y
	Other t a
x == Other t a
y = t a
x t a -> t a -> Boolean
forall a. Setoid a => a -> a -> Boolean
== t a
y
	Jack t a
_ == Jack t a
_ = Boolean
False

instance (Chain a, Chain (t a)) => Chain (Jack t a) where
	It a
_ <=> :: Jack t a -> Jack t a -> Ordering
<=> Other t a
_ = Ordering
Less
	Other t a
_ <=> It a
_ = Ordering
Greater
	It a
x <=> It a
y = a
x a -> a -> Ordering
forall a. Chain a => a -> a -> Ordering
<=> a
y
	Other t a
x <=> Other t a
y = t a
x t a -> t a -> Ordering
forall a. Chain a => a -> a -> Ordering
<=> t a
y

jack :: (a -> r) -> (t a -> r) -> Jack t a -> r
jack :: (a -> r) -> (t a -> r) -> Jack t a -> r
jack a -> r
f t a -> r
_ (It a
x) = a -> r
f a
x
jack a -> r
_ t a -> r
g (Other t a
y) = t a -> r
g t a
y