{-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Primary.Transformer.Outline where import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (identity, ($), (#)) import Pandora.Pattern.Functor.Covariant (Covariant ((-<$>-))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Paradigm.Primary.Algebraic.Exponential () data Outline t a where Line :: a -> Outline t a Outlined :: t a -> Outline t (a -> b) -> Outline t b instance Covariant (->) (->) (Outline t) where a -> b f -<$>- :: (a -> b) -> Outline t a -> Outline t b -<$>- Line a a = b -> Outline t b forall a (t :: * -> *). a -> Outline t a Line (b -> Outline t b) -> b -> Outline t b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) $ a -> b f a a a -> b f -<$>- Outlined t a x Outline t (a -> a) y = t a -> Outline t (a -> b) -> Outline t b forall (t :: * -> *) a b. t a -> Outline t (a -> b) -> Outline t b Outlined t a x (Outline t (a -> b) -> Outline t b) -> Outline t (a -> b) -> Outline t b forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # (a -> b) -> (a -> a) -> a -> b forall (m :: * -> * -> *) b c a. Semigroupoid m => m b c -> m a b -> m a c (.) a -> b f ((a -> a) -> a -> b) -> Outline t (a -> a) -> Outline t (a -> b) forall (source :: * -> * -> *) (target :: * -> * -> *) (t :: * -> *) a b. Covariant source target t => source a b -> target (t a) (t b) -<$>- Outline t (a -> a) y instance Liftable (->) Outline where lift :: u a -> Outline u a lift u a t = u a -> Outline u (a -> a) -> Outline u a forall (t :: * -> *) a b. t a -> Outline t (a -> b) -> Outline t b Outlined u a t ((a -> a) -> Outline u (a -> a) forall a (t :: * -> *). a -> Outline t a Line a -> a forall (m :: * -> * -> *) a. Category m => m a a identity) instance Hoistable Outline where u ~> v _ /|\ :: (u ~> v) -> Outline u ~> Outline v /|\ Line a x = a -> Outline v a forall a (t :: * -> *). a -> Outline t a Line a x u ~> v f /|\ Outlined u a x Outline u (a -> a) y = v a -> Outline v (a -> a) -> Outline v a forall (t :: * -> *) a b. t a -> Outline t (a -> b) -> Outline t b Outlined (v a -> Outline v (a -> a) -> Outline v a) -> v a -> Outline v (a -> a) -> Outline 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 (Outline v (a -> a) -> Outline v a) -> Outline v (a -> a) -> Outline v a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # u ~> v f (u ~> v) -> Outline u (a -> a) -> Outline v (a -> a) forall k (t :: (* -> *) -> k -> *) (u :: * -> *) (v :: * -> *). (Hoistable t, Covariant (->) (->) u) => (u ~> v) -> t u ~> t v /|\ Outline u (a -> a) y