{-# LANGUAGE AllowAmbiguousTypes #-}
module Pandora.Paradigm.Structure.Ability.Morphable where

import Pandora.Core.Functor (type (>>>>>>), type (>>>>>>>), type (~>), type (:=:=>))
import Pandora.Core.Interpreted (run)
import Pandora.Pattern.Semigroupoid ((.))
import Pandora.Pattern.Category ((<--))
import Pandora.Pattern.Object.Chain (Chain ((<=>)))
import Pandora.Pattern.Object.Setoid (Setoid)
import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)))
import Pandora.Paradigm.Algebraic (extract)
import Pandora.Paradigm.Primary.Functor (Comparison)
import Pandora.Paradigm.Primary.Functor.Convergence (Convergence (Convergence))
import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly))
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.Schemes.TT (TT (TT), type (<::>))
import Pandora.Paradigm.Schemes.T_U (T_U (T_U), type (<:.:>))

-- type Morphable :: k -> (* -> *) -> Constraint
class Morphable (mod :: k) 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) (ct' :: k) (t :: k -> *) (t' :: k -> k)
       (a :: k).
((t :. t') >>> a) -> TT ct ct' t t' a
TT (((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)
-> (TT Covariant Covariant (Tagged mod) struct a
    -> Tagged mod (struct a))
-> TT Covariant Covariant (Tagged mod) struct a
-> struct a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. TT Covariant Covariant (Tagged mod) struct a
-> Tagged mod (struct a)
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < 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

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) (ct' :: k) (t :: k -> *) (t' :: k -> k)
       (a :: k).
((t :. t') >>> a) -> TT ct ct' t t' a
TT (((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) (ct' :: k) (t :: k -> *) (t' :: k -> k)
       (a :: k).
((t :. t') >>> a) -> TT ct ct' t t' a
TT (((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 (Exactly <:.:> struct >>>>>> (->)) => a :=:=> struct
insert :: a :=:=> struct
insert a
new struct a
xs = T_U Covariant Covariant (->) Exactly struct a
-> Exactly a -> struct a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (T_U Covariant Covariant (->) Exactly struct a
 -> Exactly a -> struct a)
-> T_U Covariant Covariant (->) Exactly struct a
-> Exactly 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 (Exactly a -> struct a) -> Exactly a -> struct a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a -> Exactly a
forall a. a -> Exactly a
Exactly a
new

item :: forall mod struct a . Morphed mod struct (Exactly <:.:> struct >>>>>> (->)) => a :=:=> struct
item :: a :=:=> struct
item a
new struct a
xs = T_U Covariant Covariant (->) Exactly struct a
-> Exactly a -> struct a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (T_U Covariant Covariant (->) Exactly struct a
 -> Exactly a -> struct a)
-> T_U Covariant Covariant (->) Exactly struct a
-> Exactly 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 (Exactly a -> struct a) -> Exactly a -> struct a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a -> Exactly a
forall a. a -> Exactly a
Exactly a
new

collate :: forall mod struct a . (Chain a, Morphed mod struct ((Exactly <:.:> Comparison >>>>>> (:*:)) <:.:> struct >>>>>> (->))) => a :=:=> struct
collate :: a :=:=> struct
collate a
new struct a
xs = T_U
  Covariant
  Covariant
  (->)
  ((Exactly <:.:> Comparison) >>>>>> (:*:))
  struct
  a
-> T_U Covariant Covariant (:*:) Exactly Comparison a -> struct a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (T_U
   Covariant
   Covariant
   (->)
   ((Exactly <:.:> Comparison) >>>>>> (:*:))
   struct
   a
 -> T_U Covariant Covariant (:*:) Exactly Comparison a -> struct a)
-> T_U
     Covariant
     Covariant
     (->)
     ((Exactly <:.:> Comparison) >>>>>> (:*:))
     struct
     a
-> T_U Covariant Covariant (:*:) Exactly 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 (:*:) Exactly Comparison a -> struct a)
-> T_U Covariant Covariant (:*:) Exactly Comparison a -> struct a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- (Exactly a :*: Convergence Ordering a)
-> T_U Covariant Covariant (:*:) Exactly 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 -> Exactly a
forall a. a -> Exactly a
Exactly a
new Exactly a
-> Convergence Ordering a -> Exactly 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 (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < 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 (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < 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 (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < 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 = TT Covariant Covariant ((->) key) Maybe a
-> ((->) key :. Maybe) >>> a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (TT Covariant Covariant ((->) key) Maybe a
 -> ((->) key :. Maybe) >>> a)
-> TT 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 <::> Exactly) <:.:> 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 <::> Exactly) struct value
-> TT Covariant Covariant ((:*:) key) Exactly value -> struct value
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (T_U Covariant Covariant (->) ((:*:) key <::> Exactly) struct value
 -> TT Covariant Covariant ((:*:) key) Exactly value
 -> struct value)
-> T_U
     Covariant Covariant (->) ((:*:) key <::> Exactly) struct value
-> TT Covariant Covariant ((:*:) key) Exactly 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 (TT Covariant Covariant ((:*:) key) Exactly value -> struct value)
-> TT Covariant Covariant ((:*:) key) Exactly value -> struct value
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- (((:*:) key :. Exactly) >>> value)
-> TT Covariant Covariant ((:*:) key) Exactly value
forall k k k k (ct :: k) (ct' :: k) (t :: k -> *) (t' :: k -> k)
       (a :: k).
((t :. t') >>> a) -> TT ct ct' t t' a
TT (key
key key -> Exactly value -> ((:*:) key :. Exactly) >>> value
forall s a. s -> a -> s :*: a
:*: value -> Exactly value
forall a. a -> Exactly a
Exactly value
value)