{-# LANGUAGE AllowAmbiguousTypes #-}

module Pandora.Paradigm.Structure.Ability.Morphable where

import Pandora.Core.Functor (type (:=), type (~>), type (:=:=>))
import Pandora.Pattern.Category ((.), (#))
import Pandora.Pattern.Functor.Extractable (extract)
import Pandora.Pattern.Object.Chain (Chain ((<=>)))
import Pandora.Pattern.Object.Setoid (Setoid)
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.Product (Product ((:*:)), type (:*:))
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.
Category 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.
Category 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 = struct a <:= Tagged mod
forall (t :: * -> *) a. Extractable t => a <:= t
extract (struct a <:= Tagged mod)
-> (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.
Category 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.
Category 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.
Category 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.
Category 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.
Category 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)
# Product (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
-> Product (Identity a) (Convergence Ordering a)
forall s a. s -> a -> Product 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 ((Product 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 (->) (Product key <:.> Identity) struct value
-> TU Covariant Covariant (Product key) Identity value
-> struct value
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run (T_U
   Covariant Covariant (->) (Product key <:.> Identity) struct value
 -> TU Covariant Covariant (Product key) Identity value
 -> struct value)
-> T_U
     Covariant Covariant (->) (Product key <:.> Identity) struct value
-> TU Covariant Covariant (Product 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 (Product key) Identity value
 -> struct value)
-> TU Covariant Covariant (Product key) Identity value
-> struct value
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
# ((Product key :. Identity) := value)
-> TU Covariant Covariant (Product 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 -> (Product key :. Identity) := value
forall s a. s -> a -> Product s a
:*: value -> Identity value
forall a. a -> Identity a
Identity value
value)