{-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Primary.Transformer.Outline where import Pandora.Pattern.Category (identity, (.), ($), (#)) import Pandora.Pattern.Functor.Covariant (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 ((/|\))) 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 :: * -> * -> *) 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. 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 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. 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 :: * -> *) (source :: * -> * -> *) (target :: * -> * -> *) a b. Covariant_ t source target => source a b -> target (t a) (t b) -<$>- Outline t (a -> a) y instance Pointable (Outline t) (->) where point :: a -> Outline t a point = a -> Outline t a forall a (t :: * -> *). a -> Outline t a Line instance Extractable t (->) => Extractable (Outline t) (->) where extract :: Outline t a -> a extract (Line a x) = a x extract (Outlined t a x Outline t (a -> a) y) = Outline t (a -> a) -> a -> a forall (t :: * -> *) (source :: * -> * -> *) a. Extractable t source => source (t a) a extract Outline t (a -> a) y (a -> a) -> a -> a forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b) # t a -> a forall (t :: * -> *) (source :: * -> * -> *) a. Extractable t source => source (t a) a 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 :: * -> * -> *) a b. Category m => m (m a b) (m a b) # (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 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 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 a forall (t :: * -> *) (source :: * -> * -> *) a. Pointable t source => source a (t a) 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 :: * -> *) (source :: * -> * -> *) a. Extractable t source => source (t a) a extract