module Pandora.Paradigm.Primary.Transformer.Outline where import Pandora.Core.Morphism ((%)) 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)) 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 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 ((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 :: * -> * -> *) a b. Category m => m a b -> m a b $ 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 ((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 (u a -> v a u ~> v f u a x) ((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