{-# 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