{-# 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.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 (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 (Outline u (a -> a) -> Outline u a)
-> Outline u (a -> a) -> Outline u a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- (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
	forall a. u a -> v a
_ /|\ :: (forall a. u a -> v a) -> forall a. Outline u a -> Outline v a
/|\ Line a
x = a -> Outline v a
forall a (t :: * -> *). a -> Outline t a
Line a
x
	forall a. u a -> v a
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
forall a. u a -> v a
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)
<------ forall a. u a -> v a
f (forall a. u a -> v a) -> Outline u (a -> a) -> Outline v (a -> a)
forall k (m :: * -> * -> *) (t :: (* -> *) -> k -> *) (u :: * -> *)
       (v :: * -> *).
(Hoistable m t, Covariant m m u) =>
(forall a. m (u a) (v a)) -> forall (a :: k). m (t u a) (t v a)
/|\ Outline u (a -> a)
y