{-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Primary.Transformer.Jack where import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (identity, ($)) import Pandora.Pattern.Functor.Covariant (Covariant ((-<$>-))) import Pandora.Pattern.Functor.Monoidal (Monoidal) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) 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 ((/|\))) import Pandora.Pattern.Object.Setoid (Setoid ((==))) import Pandora.Pattern.Object.Chain (Chain ((<=>))) import Pandora.Paradigm.Primary.Algebraic.Exponential () import Pandora.Paradigm.Primary.Algebraic.Product ((:*:)) import Pandora.Paradigm.Primary.Algebraic (point) 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 (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 (m a b) (m a b) $ a -> b f (a -> b) -> t a -> t b forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Covariant source target t => source a b -> target (t a) (t b) -<$>- t a y instance Traversable (->) (->) t => Traversable (->) (->) (Jack t) where a -> u b f <<- :: (a -> u b) -> Jack t a -> u (Jack t b) <<- It a x = b -> Jack t b forall (t :: * -> *) a. a -> Jack t a It (b -> Jack t b) -> u b -> u (Jack t 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 f <<- Other t a y = 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 (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Covariant source target t => source a b -> target (t a) (t b) -<$>- a -> u b f (a -> u b) -> t a -> u (t b) forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) (u :: * -> *) a b. (Traversable source target t, Covariant source target u, Monoidal source target (:*:) (:*:) u) => source a (u b) -> target (t a) (u (t b)) <<- t a y instance (Monoidal (->) (->) (:*:) (:*:) t, Bindable (->) t) => Bindable (->) (Jack t) where a -> Jack t b f =<< :: (a -> Jack t b) -> Jack t a -> Jack t b =<< It a x = a -> Jack t b f a x a -> Jack t b f =<< Other t 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 (m a b) (m a 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. Monoidal (->) (->) (:*:) (:*:) t => a -> t a 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. Semigroupoid m => m b c -> m a b -> m a c . a -> Jack t b f (a -> t b) -> t a -> t b forall (source :: * -> * -> *) (t :: * -> *) a b. Bindable source t => source a (t b) -> source (t a) (t b) =<< t a x instance Extendable (->) t => Extendable (->) (Jack t) where Jack t 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) -> (Jack t a -> b) -> Jack t a -> Jack t b forall (m :: * -> * -> *) b c a. Semigroupoid 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 (m a b) (m a b) $ a -> Jack t a forall (t :: * -> *) a. a -> Jack t a It a x Jack t a -> b f <<= Other t 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 (m a b) (m a b) $ Jack t a -> b f (Jack t a -> b) -> (t a -> Jack t a) -> t a -> b forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c . t a -> Jack t a forall (t :: * -> *) a. t a -> Jack t a Other (t a -> b) -> t a -> t b forall (source :: * -> * -> *) (t :: * -> *) a b. Extendable source t => source (t a) b -> source (t a) (t b) <<= t a x instance Liftable (->) Jack where lift :: u a -> Jack u a lift = u a -> Jack u a forall (t :: * -> *) a. t a -> Jack t a Other instance Hoistable Jack where u ~> v _ /|\ :: (u ~> v) -> Jack u ~> Jack v /|\ It a x = a -> Jack v a forall (t :: * -> *) a. a -> Jack t a It a x 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 (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