{-# 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.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Extractable (Extractable (extract))
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 (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 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