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