module Pandora.Paradigm.Primary.Transformer.Outline 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.Applicative (Applicative ((<*>))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist)) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite)) import Pandora.Paradigm.Primary.Functor.Function ((%)) 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 :: * -> * -> *). Category m => m ~~> m $ 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 :: * -> * -> *). Category m => m ~~> m / (a -> b) -> (a -> a) -> a -> b forall (m :: * -> * -> *) b c a. Category 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 (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b <$> Outline t (a -> a) y instance Pointable (Outline t) where point :: a :=> Outline t point = a :=> Outline t forall a (t :: * -> *). a -> Outline t a Line instance Extractable t => Extractable (Outline t) where extract :: a <:= Outline t extract (Line a x) = a x extract (Outlined t a x Outline t (a -> a) y) = (a -> a) <:= Outline t forall (t :: * -> *) a. Extractable t => a <:= t extract Outline t (a -> a) y (a -> a) -> a -> a forall (m :: * -> * -> *). Category m => m ~~> m / a <:= t forall (t :: * -> *) a. Extractable t => a <:= t extract t a x instance Applicative (Outline f) where Line a -> b f <*> :: Outline f (a -> b) -> Outline f a -> Outline f b <*> Outline f a y = a -> b f (a -> b) -> Outline f a -> Outline f b forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b <$> Outline f a y Outlined f a x Outline f (a -> a -> b) y <*> Outline f a z = f a -> Outline f (a -> b) -> Outline f b forall (t :: * -> *) a b. t a -> Outline t (a -> b) -> Outline t b Outlined f a x (Outline f (a -> b) -> Outline f b) -> Outline f (a -> b) -> Outline f b forall (m :: * -> * -> *). Category m => m ~~> m / (a -> a -> b) -> a -> a -> b forall a b c. (a -> b -> c) -> b -> a -> c (%) ((a -> a -> b) -> a -> a -> b) -> Outline f (a -> a -> b) -> Outline f (a -> a -> b) forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b <$> Outline f (a -> a -> b) y Outline f (a -> a -> b) -> Outline f a -> Outline f (a -> b) forall (t :: * -> *) a b. Applicative t => t (a -> b) -> t a -> t b <*> Outline f a z instance Liftable Outline where lift :: u ~> Outline u 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 hoist :: (u ~> v) -> Outline u ~> Outline v hoist u ~> v _ (Line a x) = a -> Outline v a forall a (t :: * -> *). a -> Outline t a Line a x hoist 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 :: * -> * -> *). Category m => m ~~> m / 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 :: * -> * -> *). Category m => m ~~> m / (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 hoist u ~> v f Outline u (a -> a) y instance (Extractable t, Pointable t, Applicative t) => Interpreted (Outline t) where type Primary (Outline t) a = t a run :: Outline t a -> Primary (Outline t) a run (Line a x) = a :=> t forall (t :: * -> *) a. Pointable t => a :=> t point a x run (Outlined t a t Outline t (a -> a) f) = Outline t (a -> a) -> Primary (Outline t) (a -> a) forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run Outline t (a -> a) f t (a -> a) -> t a -> t a forall (t :: * -> *) a b. Applicative t => t (a -> b) -> t a -> t b <*> t a t unite :: Primary (Outline t) a -> Outline t a unite = a -> Outline t a forall a (t :: * -> *). a -> Outline t a Line (a -> Outline t a) -> (t a -> a) -> t a -> Outline t a forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . t a -> a forall (t :: * -> *) a. Extractable t => a <:= t extract