{-# 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.Pointable (Pointable (point)) import Pandora.Pattern.Functor.Extractable (Extractable (extract)) 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.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 (t :: * -> *) (source :: * -> * -> *) (target :: * -> * -> *) a b. Covariant t source target => source a b -> target (t a) (t b) -<$>- t a y instance Covariant t (->) (->) => Pointable (Jack t) (->) where point :: a -> Jack t a point = a -> Jack t a forall (t :: * -> *) a. a -> Jack t a It instance Extractable t (->) => Extractable (Jack t) (->) where extract :: Jack t a -> a extract (It a x) = a x extract (Other t a y) = t a -> a forall (t :: * -> *) (source :: * -> * -> *) a. Extractable t source => source (t a) a extract 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 (t :: * -> *) (source :: * -> * -> *) (target :: * -> * -> *) a b. Covariant t source target => 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 (t :: * -> *) (source :: * -> * -> *) (target :: * -> * -> *) a b. Covariant t source target => source a b -> target (t a) (t b) -<$>- a -> u b f (a -> u b) -> t a -> u (t b) forall (t :: * -> *) (source :: * -> * -> *) (target :: * -> * -> *) (u :: * -> *) a b. (Traversable t source target, Covariant u source target, Pointable u target, Semimonoidal u target (:*:) (:*:)) => source a (u b) -> target (t a) (u (t b)) <<- t a y instance (Pointable 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 :: * -> *) (source :: * -> * -> *) a. Pointable t source => source 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 (t :: * -> *) (source :: * -> * -> *) a b. Bindable t source => 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 (t :: * -> *) (source :: * -> * -> *) a b. Extendable t source => source (t a) b -> source (t a) (t b) <<= t a x 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 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