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