{-# LANGUAGE AllowAmbiguousTypes #-}

module Pandora.Paradigm.Structure.Ability.Morphable where

import Pandora.Core.Functor (type (~>))
import Pandora.Pattern.Category ((.))
import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag))
import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>))

class Morphable f t where
	type Morphing (f :: k) (t :: * -> *) :: * -> *
	morphing :: Tagged f <:.> t ~> Morphing f t

morph :: forall f t . Morphable f t => t ~> Morphing f t
morph :: t ~> Morphing f t
morph = (<:.>) (Tagged f) t a -> Morphing f t a
forall k (f :: k) (t :: * -> *).
Morphable f t =>
(Tagged f <:.> t) ~> Morphing f t
morphing ((<:.>) (Tagged f) t a -> Morphing f t a)
-> (t a -> (<:.>) (Tagged f) t a) -> t a -> Morphing f t a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. ((Tagged f :. t) := a) -> (<:.>) (Tagged f) t a
forall k k k k (ct :: k) (cu :: k) (t :: k -> *) (u :: k -> k)
       (a :: k).
((t :. u) := a) -> TU ct cu t u a
TU (((Tagged f :. t) := a) -> (<:.>) (Tagged f) t a)
-> (t a -> (Tagged f :. t) := a) -> t a -> (<:.>) (Tagged f) t a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. forall a. a -> Tagged f a
forall k (tag :: k) a. a -> Tagged tag a
Tag @f

data Walk a = Preorder a | Inorder a | Postorder a | Levelorder a

data Morph a = Rotate a | Into a

rotate :: forall f t . Morphable (Rotate f) t => t ~> Morphing (Rotate f) t
rotate :: t ~> Morphing ('Rotate f) t
rotate = (<:.>) (Tagged ('Rotate f)) t a -> Morphing ('Rotate f) t a
forall k (f :: k) (t :: * -> *).
Morphable f t =>
(Tagged f <:.> t) ~> Morphing f t
morphing ((<:.>) (Tagged ('Rotate f)) t a -> Morphing ('Rotate f) t a)
-> (t a -> (<:.>) (Tagged ('Rotate f)) t a)
-> t a
-> Morphing ('Rotate f) t a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. ((Tagged ('Rotate f) :. t) := a) -> (<:.>) (Tagged ('Rotate f)) t a
forall k k k k (ct :: k) (cu :: k) (t :: k -> *) (u :: k -> k)
       (a :: k).
((t :. u) := a) -> TU ct cu t u a
TU (((Tagged ('Rotate f) :. t) := a)
 -> (<:.>) (Tagged ('Rotate f)) t a)
-> (t a -> (Tagged ('Rotate f) :. t) := a)
-> t a
-> (<:.>) (Tagged ('Rotate f)) t a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. forall a. a -> Tagged ('Rotate f) a
forall k (tag :: k) a. a -> Tagged tag a
Tag @(Rotate f)

into :: forall f t . Morphable (Into f) t => t ~> Morphing (Into f) t
into :: t ~> Morphing ('Into f) t
into = (<:.>) (Tagged ('Into f)) t a -> Morphing ('Into f) t a
forall k (f :: k) (t :: * -> *).
Morphable f t =>
(Tagged f <:.> t) ~> Morphing f t
morphing ((<:.>) (Tagged ('Into f)) t a -> Morphing ('Into f) t a)
-> (t a -> (<:.>) (Tagged ('Into f)) t a)
-> t a
-> Morphing ('Into f) t a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. ((Tagged ('Into f) :. t) := a) -> (<:.>) (Tagged ('Into f)) t a
forall k k k k (ct :: k) (cu :: k) (t :: k -> *) (u :: k -> k)
       (a :: k).
((t :. u) := a) -> TU ct cu t u a
TU (((Tagged ('Into f) :. t) := a) -> (<:.>) (Tagged ('Into f)) t a)
-> (t a -> (Tagged ('Into f) :. t) := a)
-> t a
-> (<:.>) (Tagged ('Into f)) t a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. forall a. a -> Tagged ('Into f) a
forall k (tag :: k) a. a -> Tagged tag a
Tag @(Into f)