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.Functor.Function () 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 :: * -> * -> *). Category m => m ~~> m $ 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 :: * -> * -> *). Category m => m ~~> m $ 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 -> Jack t a) -> t a -> Jack t a forall (m :: * -> * -> *). Category m => m ~~> m / 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 :: * -> * -> *). Category m => m ~~> m $ 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 :: * -> * -> *). Category m => m ~~> m $ 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 :: * -> * -> *). Category m => m ~~> m $ ((a -> b) -> a -> b forall (m :: * -> * -> *). Category m => m ~~> m $ 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 :: * -> * -> *). Category m => m ~~> m $ 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 :: * -> * -> *). Category m => m ~~> m $ 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 :: * -> * -> *). Category m => m ~~> m $ 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 :: * -> * -> *). Category m => m ~~> m $ 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 :: * -> * -> *). Category m => m ~~> m $ 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 :: * -> * -> *). Category m => m ~~> m $ 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