{-# LANGUAGE UndecidableInstances #-}

module Pandora.Paradigm.Primary.Transformer.Jet where

import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), (<$$>), Covariant_ ((-<$>-)), (-<$$>-))
import Pandora.Pattern.Functor.Avoidable (Avoidable (empty))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Extractable (Extractable (extract))
import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)), (-<<-<<-))
import Pandora.Paradigm.Primary.Algebraic ((-<*>-))

data Jet t a = Jet a (Jet t (t a))

instance Covariant t => Covariant (Jet t) where
	a -> b
f <$> :: (a -> b) -> Jet t a -> Jet t b
<$> Jet a
x Jet t (t a)
xs = b -> Jet t (t b) -> Jet t b
forall (t :: * -> *) a. a -> Jet t (t a) -> Jet t a
Jet (a -> b
f a
x) (a -> b
f (a -> b) -> Jet t (t a) -> Jet t (t b)
forall (t :: * -> *) (u :: * -> *) a b.
(Covariant t, Covariant u) =>
(a -> b) -> ((t :. u) := a) -> (t :. u) := b
<$$> Jet t (t a)
xs)

instance Covariant_ t (->) (->) => Covariant_ (Jet t) (->) (->) where
	a -> b
f -<$>- :: (a -> b) -> Jet t a -> Jet t b
-<$>- Jet a
x Jet t (t a)
xs = b -> Jet t (t b) -> Jet t b
forall (t :: * -> *) a. a -> Jet t (t a) -> Jet t a
Jet (a -> b
f a
x) (a -> b
f (a -> b) -> Jet t (t a) -> Jet t (t b)
forall (t :: * -> *) (u :: * -> *) (category :: * -> * -> *) a b.
(Covariant_ u category category, Covariant_ t category category) =>
category a b -> category (t (u a)) (t (u b))
-<$$>- Jet t (t a)
xs)

instance Traversable t (->) (->) => Traversable (Jet t) (->) (->) where
	a -> u b
f <<- :: (a -> u b) -> Jet t a -> u (Jet t b)
<<- Jet a
x Jet t (t a)
xs = b -> Jet t (t b) -> Jet t b
forall (t :: * -> *) a. a -> Jet t (t a) -> Jet t a
Jet (b -> Jet t (t b) -> Jet t b) -> u b -> u (Jet t (t b) -> Jet t b)
forall (t :: * -> *) (source :: * -> * -> *)
       (target :: * -> * -> *) a b.
Covariant_ t source target =>
source a b -> target (t a) (t b)
-<$>- a -> u b
f a
x u (Jet t (t b) -> Jet t b) -> u (Jet t (t b)) -> u (Jet t b)
forall a b (t :: * -> *).
Semimonoidal t (:*:) (->) (->) =>
t (a -> b) -> t a -> t b
-<*>- a -> u b
f (a -> u b) -> Jet t (t a) -> u (Jet t (t b))
forall (t :: * -> *) (u :: * -> *) (v :: * -> *)
       (category :: * -> * -> *) a b.
(Traversable t category category, Covariant_ u category category,
 Pointable u category, Semimonoidal u (:*:) category category,
 Traversable v category category) =>
category a (u b) -> category (v (t a)) (u (v (t b)))
-<<-<<- Jet t (t a)
xs

instance (forall u . Avoidable u, Covariant_ t (->) (->)) => Pointable (Jet t) (->) where
	point :: a -> Jet t a
point a
x = a -> Jet t (t a) -> Jet t a
forall (t :: * -> *) a. a -> Jet t (t a) -> Jet t a
Jet a
x Jet t (t a)
forall (t :: * -> *) a. Avoidable t => t a
empty

instance Covariant_ t (->) (->) => Extractable (Jet t) (->) where
	extract :: Jet t a -> a
extract (Jet a
x Jet t (t a)
_) = a
x