{-# LANGUAGE UndecidableInstances #-}

module Pandora.Paradigm.Primary.Transformer.Instruction where

import Pandora.Core.Functor (type (:.), type (:=))
import Pandora.Pattern.Category (($))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>)))
import Pandora.Pattern.Functor.Avoidable (Avoidable (empty))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
import Pandora.Pattern.Functor.Traversable (Traversable ((->>), (->>>)))
import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
import Pandora.Pattern.Functor.Monad (Monad)
import Pandora.Pattern.Transformer.Liftable (Liftable (lift))
import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))
import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\), hoist))
import Pandora.Paradigm.Primary.Functor.Function ()

data Instruction t a = Enter a | Instruct (t :. Instruction t := a)

instance Covariant t => Covariant (Instruction t) where
	a -> b
f <$> :: (a -> b) -> Instruction t a -> Instruction t b
<$> Enter a
x = b -> Instruction t b
forall (t :: * -> *) a. a -> Instruction t a
Enter (b -> Instruction t b) -> b -> Instruction t b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ a -> b
f a
x
	a -> b
f <$> Instruct (t :. Instruction t) := a
xs = ((t :. Instruction t) := b) -> Instruction t b
forall (t :: * -> *) a.
((t :. Instruction t) := a) -> Instruction t a
Instruct (((t :. Instruction t) := b) -> Instruction t b)
-> ((t :. Instruction t) := b) -> Instruction t b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ a -> b
f (a -> b)
-> ((t :. Instruction t) := a) -> (t :. Instruction t) := b
forall (t :: * -> *) (u :: * -> *) a b.
(Covariant t, Covariant u) =>
(a -> b) -> ((t :. u) := a) -> (t :. u) := b
<$$> (t :. Instruction t) := a
xs

instance Covariant t => Pointable (Instruction t) where
	point :: a :=> Instruction t
point = a :=> Instruction t
forall (t :: * -> *) a. a -> Instruction t a
Enter

instance Alternative t => Alternative (Instruction t) where
	Enter a
x <+> :: Instruction t a -> Instruction t a -> Instruction t a
<+> Instruction t a
_ = a -> Instruction t a
forall (t :: * -> *) a. a -> Instruction t a
Enter a
x
	Instruction t a
_ <+> Enter a
y = a -> Instruction t a
forall (t :: * -> *) a. a -> Instruction t a
Enter a
y
	Instruct (t :. Instruction t) := a
xs <+> Instruct (t :. Instruction t) := a
ys = ((t :. Instruction t) := a) -> Instruction t a
forall (t :: * -> *) a.
((t :. Instruction t) := a) -> Instruction t a
Instruct (((t :. Instruction t) := a) -> Instruction t a)
-> ((t :. Instruction t) := a) -> Instruction t a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ (t :. Instruction t) := a
xs ((t :. Instruction t) := a)
-> ((t :. Instruction t) := a) -> (t :. Instruction t) := a
forall (t :: * -> *) a. Alternative t => t a -> t a -> t a
<+> (t :. Instruction t) := a
ys

instance Avoidable t => Avoidable (Instruction t) where
	empty :: Instruction t a
empty = ((t :. Instruction t) := a) -> Instruction t a
forall (t :: * -> *) a.
((t :. Instruction t) := a) -> Instruction t a
Instruct (t :. Instruction t) := a
forall (t :: * -> *) a. Avoidable t => t a
empty

instance Covariant t => Applicative (Instruction t) where
	Enter a -> b
f <*> :: Instruction t (a -> b) -> Instruction t a -> Instruction t b
<*> Enter a
y = b -> Instruction t b
forall (t :: * -> *) a. a -> Instruction t a
Enter (b -> Instruction t b) -> b -> Instruction t b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ a -> b
f a
y
	Enter a -> b
f <*> Instruct (t :. Instruction t) := a
y = ((t :. Instruction t) := b) -> Instruction t b
forall (t :: * -> *) a.
((t :. Instruction t) := a) -> Instruction t a
Instruct (((t :. Instruction t) := b) -> Instruction t b)
-> ((t :. Instruction t) := b) -> Instruction t b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ a -> b
f (a -> b)
-> ((t :. Instruction t) := a) -> (t :. Instruction t) := b
forall (t :: * -> *) (u :: * -> *) a b.
(Covariant t, Covariant u) =>
(a -> b) -> ((t :. u) := a) -> (t :. u) := b
<$$> (t :. Instruction t) := a
y
	Instruct (t :. Instruction t) := (a -> b)
f <*> Instruction t a
y = ((t :. Instruction t) := b) -> Instruction t b
forall (t :: * -> *) a.
((t :. Instruction t) := a) -> Instruction t a
Instruct (((t :. Instruction t) := b) -> Instruction t b)
-> ((t :. Instruction t) := b) -> Instruction t b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ (Instruction t (a -> b) -> Instruction t a -> Instruction t b
forall (t :: * -> *) a b. Applicative t => t (a -> b) -> t a -> t b
<*> Instruction t a
y) (Instruction t (a -> b) -> Instruction t b)
-> ((t :. Instruction t) := (a -> b)) -> (t :. Instruction t) := b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> (t :. Instruction t) := (a -> b)
f

instance Covariant t => Bindable (Instruction t) where
	Enter a
x >>= :: Instruction t a -> (a -> Instruction t b) -> Instruction t b
>>= a -> Instruction t b
f = a -> Instruction t b
f a
x
	Instruct (t :. Instruction t) := a
xs >>= a -> Instruction t b
f = ((t :. Instruction t) := b) -> Instruction t b
forall (t :: * -> *) a.
((t :. Instruction t) := a) -> Instruction t a
Instruct (((t :. Instruction t) := b) -> Instruction t b)
-> ((t :. Instruction t) := b) -> Instruction t b
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ (Instruction t a -> (a -> Instruction t b) -> Instruction t b
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= a -> Instruction t b
f) (Instruction t a -> Instruction t b)
-> ((t :. Instruction t) := a) -> (t :. Instruction t) := b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> (t :. Instruction t) := a
xs

instance Traversable t => Traversable (Instruction t) where
	Enter a
x ->> :: Instruction t a -> (a -> u b) -> (u :. Instruction t) := b
->> a -> u b
f = b -> Instruction t b
forall (t :: * -> *) a. a -> Instruction t a
Enter (b -> Instruction t b) -> u b -> (u :. Instruction t) := b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> a -> u b
f a
x
	Instruct (t :. Instruction t) := a
xs ->> a -> u b
f = ((t :. Instruction t) := b) -> Instruction t b
forall (t :: * -> *) a.
((t :. Instruction t) := a) -> Instruction t a
Instruct (((t :. Instruction t) := b) -> Instruction t b)
-> u ((t :. Instruction t) := b) -> (u :. Instruction t) := b
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> (t :. Instruction t) := a
xs ((t :. Instruction t) := a)
-> (a -> u b) -> u ((t :. Instruction t) := b)
forall (t :: * -> *) (u :: * -> *) (v :: * -> *) a b.
(Traversable t, Pointable u, Applicative u, Traversable v) =>
((v :. t) := a) -> (a -> u b) -> (u :. (v :. t)) := b
->>> a -> u b
f

instance Liftable Instruction where
	lift :: u ~> Instruction u
lift u a
x = ((u :. Instruction u) := a) -> Instruction u a
forall (t :: * -> *) a.
((t :. Instruction t) := a) -> Instruction t a
Instruct (((u :. Instruction u) := a) -> Instruction u a)
-> ((u :. Instruction u) := a) -> Instruction u a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ a -> Instruction u a
forall (t :: * -> *) a. a -> Instruction t a
Enter (a -> Instruction u a) -> u a -> (u :. Instruction u) := a
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> u a
x

instance (forall t . Monad t) => Lowerable Instruction where
	lower :: Instruction u ~> u
lower (Enter a
x) = a :=> u
forall (t :: * -> *) a. Pointable t => a :=> t
point a
x
	lower (Instruct (u :. Instruction u) := a
xs) = (u :. Instruction u) := a
xs ((u :. Instruction u) := a) -> (Instruction u a -> u a) -> u a
forall (t :: * -> *) a b. Bindable t => t a -> (a -> t b) -> t b
>>= Instruction u a -> u a
forall (t :: (* -> *) -> * -> *) (u :: * -> *).
(Lowerable t, Covariant u) =>
t u ~> u
lower

instance (forall v . Covariant v) => Hoistable Instruction where
	u ~> v
_ /|\ :: (u ~> v) -> Instruction u ~> Instruction v
/|\ Enter a
x = a -> Instruction v a
forall (t :: * -> *) a. a -> Instruction t a
Enter a
x
	u ~> v
f /|\ Instruct (u :. Instruction u) := a
xs = ((v :. Instruction v) := a) -> Instruction v a
forall (t :: * -> *) a.
((t :. Instruction t) := a) -> Instruction t a
Instruct (((v :. Instruction v) := a) -> Instruction v a)
-> ((v :. Instruction v) := a) -> Instruction v a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
$ (u ~> v) -> Instruction u ~> Instruction v
forall k (t :: (* -> *) -> k -> *) (u :: * -> *) (v :: * -> *).
(Hoistable t, Covariant u) =>
(u ~> v) -> t u ~> t v
hoist u ~> v
f (Instruction u a -> Instruction v a)
-> v (Instruction u a) -> (v :. Instruction v) := a
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
<$> ((u :. Instruction u) := a) -> v (Instruction u a)
u ~> v
f (u :. Instruction u) := a
xs