{-# LANGUAGE AllowAmbiguousTypes #-}

module Pandora.Paradigm.Structure.Ability.Morphable where

import Pandora.Core.Functor (type (:=), type (~>), type (:=:=>))
import Pandora.Pattern.Semigroupoid ((.))
import Pandora.Pattern.Category ((#))
import Pandora.Pattern.Object.Chain (Chain ((<=>)))
import Pandora.Pattern.Object.Setoid (Setoid)
import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)))
import Pandora.Paradigm.Primary.Algebraic (extract)
import Pandora.Paradigm.Primary.Functor (Comparison)
import Pandora.Paradigm.Primary.Functor.Convergence (Convergence (Convergence))
import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity))
import Pandora.Paradigm.Primary.Functor.Maybe (Maybe)
import Pandora.Paradigm.Primary.Functor.Predicate (Predicate, equate)
import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag))
import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)
import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>))
import Pandora.Paradigm.Schemes.T_U (T_U (T_U), type (<:.:>))

class Morphable mod struct | mod struct -> struct where
	type Morphing (mod :: k) (struct :: * -> *) :: * -> *
	morphing :: Tagged mod <:.> struct ~> Morphing mod struct

type Morphed mod struct result = (Morphable mod struct, Morphing mod struct ~ result)

morph :: forall mod struct . Morphable mod struct => struct ~> Morphing mod struct
morph :: struct ~> Morphing mod struct
morph = (<:.>) (Tagged mod) struct a -> Morphing mod struct a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <:.> struct) ~> Morphing mod struct
morphing ((<:.>) (Tagged mod) struct a -> Morphing mod struct a)
-> (struct a -> (<:.>) (Tagged mod) struct a)
-> struct a
-> Morphing mod struct a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. ((Tagged mod :. struct) := a) -> (<:.>) (Tagged mod) struct 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 mod :. struct) := a) -> (<:.>) (Tagged mod) struct a)
-> (struct a -> (Tagged mod :. struct) := a)
-> struct a
-> (<:.>) (Tagged mod) struct a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. forall a. a -> Tagged mod a
forall k (tag :: k) a. a -> Tagged tag a
Tag @mod

premorph :: Morphable mod struct => Tagged mod <:.> struct ~> struct
premorph :: (Tagged mod <:.> struct) ~> struct
premorph = Tagged mod (struct a) -> struct a
forall (t :: * -> *) a. Extractable_ t => t a -> a
extract (Tagged mod (struct a) -> struct a)
-> (TU Covariant Covariant (Tagged mod) struct a
    -> Tagged mod (struct a))
-> TU Covariant Covariant (Tagged mod) struct a
-> struct a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. TU Covariant Covariant (Tagged mod) struct a
-> Tagged mod (struct a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run

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

data Morph a = Rotate a | Into a | Insert a | Push a | Pop a | Delete a | Find a | Lookup a | Vary a | Key a | Element a

data Occurrence a = All a | First a

data Vertical a = Up a | Down a

rotate :: forall mod struct . Morphable (Rotate mod) struct => struct ~> Morphing (Rotate mod) struct
rotate :: struct ~> Morphing ('Rotate mod) struct
rotate = (<:.>) (Tagged ('Rotate mod)) struct a
-> Morphing ('Rotate mod) struct a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <:.> struct) ~> Morphing mod struct
morphing ((<:.>) (Tagged ('Rotate mod)) struct a
 -> Morphing ('Rotate mod) struct a)
-> (struct a -> (<:.>) (Tagged ('Rotate mod)) struct a)
-> struct a
-> Morphing ('Rotate mod) struct a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. ((Tagged ('Rotate mod) :. struct) := a)
-> (<:.>) (Tagged ('Rotate mod)) struct 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 mod) :. struct) := a)
 -> (<:.>) (Tagged ('Rotate mod)) struct a)
-> (struct a -> (Tagged ('Rotate mod) :. struct) := a)
-> struct a
-> (<:.>) (Tagged ('Rotate mod)) struct a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. forall a. a -> Tagged ('Rotate mod) a
forall k (tag :: k) a. a -> Tagged tag a
Tag @(Rotate mod)

into :: forall mod struct . Morphable (Into mod) struct => struct ~> Morphing (Into mod) struct
into :: struct ~> Morphing ('Into mod) struct
into = (<:.>) (Tagged ('Into mod)) struct a
-> Morphing ('Into mod) struct a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <:.> struct) ~> Morphing mod struct
morphing ((<:.>) (Tagged ('Into mod)) struct a
 -> Morphing ('Into mod) struct a)
-> (struct a -> (<:.>) (Tagged ('Into mod)) struct a)
-> struct a
-> Morphing ('Into mod) struct a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. ((Tagged ('Into mod) :. struct) := a)
-> (<:.>) (Tagged ('Into mod)) struct 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 mod) :. struct) := a)
 -> (<:.>) (Tagged ('Into mod)) struct a)
-> (struct a -> (Tagged ('Into mod) :. struct) := a)
-> struct a
-> (<:.>) (Tagged ('Into mod)) struct a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. forall a. a -> Tagged ('Into mod) a
forall k (tag :: k) a. a -> Tagged tag a
Tag @(Into mod)

insert :: forall mod struct a . Morphed (Insert mod) struct (Identity <:.:> struct := (->)) => a :=:=> struct
insert :: a :=:=> struct
insert a
new struct a
xs = T_U Covariant Covariant (->) Identity struct a
-> Identity a -> struct a
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run (T_U Covariant Covariant (->) Identity struct a
 -> Identity a -> struct a)
-> T_U Covariant Covariant (->) Identity struct a
-> Identity a
-> struct a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# struct a -> Morphing ('Insert mod) struct a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
struct ~> Morphing mod struct
morph @(Insert mod) struct a
xs (Identity a -> struct a) -> Identity a -> struct a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# a -> Identity a
forall a. a -> Identity a
Identity a
new

item :: forall mod struct a . Morphed mod struct (Identity <:.:> struct := (->)) => a :=:=> struct
item :: a :=:=> struct
item a
new struct a
xs = T_U Covariant Covariant (->) Identity struct a
-> Identity a -> struct a
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run (T_U Covariant Covariant (->) Identity struct a
 -> Identity a -> struct a)
-> T_U Covariant Covariant (->) Identity struct a
-> Identity a
-> struct a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# struct a -> Morphing mod struct a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
struct ~> Morphing mod struct
morph @mod struct a
xs (Identity a -> struct a) -> Identity a -> struct a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# a -> Identity a
forall a. a -> Identity a
Identity a
new

collate :: forall mod struct a . (Chain a, Morphed mod struct ((Identity <:.:> Comparison := (:*:)) <:.:> struct := (->))) => a :=:=> struct
collate :: a :=:=> struct
collate a
new struct a
xs = T_U
  Covariant
  Covariant
  (->)
  ((Identity <:.:> Comparison) := (:*:))
  struct
  a
-> T_U Covariant Covariant (:*:) Identity Comparison a -> struct a
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run (T_U
   Covariant
   Covariant
   (->)
   ((Identity <:.:> Comparison) := (:*:))
   struct
   a
 -> T_U Covariant Covariant (:*:) Identity Comparison a -> struct a)
-> T_U
     Covariant
     Covariant
     (->)
     ((Identity <:.:> Comparison) := (:*:))
     struct
     a
-> T_U Covariant Covariant (:*:) Identity Comparison a
-> struct a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# struct a -> Morphing mod struct a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
struct ~> Morphing mod struct
morph @mod struct a
xs (T_U Covariant Covariant (:*:) Identity Comparison a -> struct a)
-> T_U Covariant Covariant (:*:) Identity Comparison a -> struct a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# (Identity a :*: Convergence Ordering a)
-> T_U Covariant Covariant (:*:) Identity Comparison a
forall k k k k k (ct :: k) (cu :: k) (p :: k -> k -> *)
       (t :: k -> k) (u :: k -> k) (a :: k).
p (t a) (u a) -> T_U ct cu p t u a
T_U (a -> Identity a
forall a. a -> Identity a
Identity a
new Identity a
-> Convergence Ordering a -> Identity a :*: Convergence Ordering a
forall s a. s -> a -> s :*: a
:*: (a -> a -> Ordering) -> Convergence Ordering a
forall r a. (a -> a -> r) -> Convergence r a
Convergence a -> a -> Ordering
forall a. Chain a => a -> a -> Ordering
(<=>))

delete :: forall mod struct a . (Setoid a, Morphed (Delete mod) struct (Predicate <:.:> struct := (->))) => a :=:=> struct
delete :: a :=:=> struct
delete a
x struct a
xs = T_U Covariant Covariant (->) Predicate struct a
-> Predicate a -> struct a
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run (T_U Covariant Covariant (->) Predicate struct a
 -> Predicate a -> struct a)
-> T_U Covariant Covariant (->) Predicate struct a
-> Predicate a
-> struct a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# struct a -> Morphing ('Delete mod) struct a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
struct ~> Morphing mod struct
morph @(Delete mod) struct a
xs (Predicate a -> struct a) -> Predicate a -> struct a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# a :=> Predicate
forall a. Setoid a => a :=> Predicate
equate a
x

filter :: forall mod struct a . (Morphed (Delete mod) struct (Predicate <:.:> struct := (->))) => Predicate a -> struct a -> struct a
filter :: Predicate a -> struct a -> struct a
filter Predicate a
p struct a
xs = T_U Covariant Covariant (->) Predicate struct a
-> Predicate a -> struct a
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run (T_U Covariant Covariant (->) Predicate struct a
 -> Predicate a -> struct a)
-> T_U Covariant Covariant (->) Predicate struct a
-> Predicate a
-> struct a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# struct a -> Morphing ('Delete mod) struct a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
struct ~> Morphing mod struct
morph @(Delete mod) struct a
xs (Predicate a -> struct a) -> Predicate a -> struct a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# Predicate a
p

find :: forall mod struct result a . (Morphed (Find mod) struct (Predicate <:.:> result := (->))) => Predicate a -> struct a -> result a
find :: Predicate a -> struct a -> result a
find Predicate a
p struct a
xs = T_U Covariant Covariant (->) Predicate result a
-> Predicate a -> result a
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run (T_U Covariant Covariant (->) Predicate result a
 -> Predicate a -> result a)
-> T_U Covariant Covariant (->) Predicate result a
-> Predicate a
-> result a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# struct a -> Morphing ('Find mod) struct a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
struct ~> Morphing mod struct
morph @(Find mod) struct a
xs (Predicate a -> result a) -> Predicate a -> result a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# Predicate a
p

lookup :: forall mod key struct a . (Morphed (Lookup mod) struct ((->) key <:.> Maybe)) => key -> struct a -> Maybe a
lookup :: key -> struct a -> Maybe a
lookup key
key struct a
struct = TU Covariant Covariant ((->) key) Maybe a
-> ((->) key :. Maybe) := a
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run (TU Covariant Covariant ((->) key) Maybe a
 -> ((->) key :. Maybe) := a)
-> TU Covariant Covariant ((->) key) Maybe a
-> ((->) key :. Maybe) := a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# struct a -> Morphing ('Lookup mod) struct a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
struct ~> Morphing mod struct
morph @(Lookup mod) struct a
struct (((->) key :. Maybe) := a) -> ((->) key :. Maybe) := a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# key
key

vary :: forall mod key value struct . (Morphed (Vary mod) struct (((:*:) key <:.> Identity) <:.:> struct := (->))) => key -> value -> struct value -> struct value
vary :: key -> value -> struct value -> struct value
vary key
key value
value struct value
xs = T_U Covariant Covariant (->) ((:*:) key <:.> Identity) struct value
-> TU Covariant Covariant ((:*:) key) Identity value
-> struct value
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run (T_U
   Covariant Covariant (->) ((:*:) key <:.> Identity) struct value
 -> TU Covariant Covariant ((:*:) key) Identity value
 -> struct value)
-> T_U
     Covariant Covariant (->) ((:*:) key <:.> Identity) struct value
-> TU Covariant Covariant ((:*:) key) Identity value
-> struct value
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# struct value -> Morphing ('Vary mod) struct value
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
struct ~> Morphing mod struct
morph @(Vary mod) @struct struct value
xs (TU Covariant Covariant ((:*:) key) Identity value -> struct value)
-> TU Covariant Covariant ((:*:) key) Identity value
-> struct value
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# (((:*:) key :. Identity) := value)
-> TU Covariant Covariant ((:*:) key) Identity value
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 (key
key key -> Identity value -> ((:*:) key :. Identity) := value
forall s a. s -> a -> s :*: a
:*: value -> Identity value
forall a. a -> Identity a
Identity value
value)