{-# LANGUAGE AllowAmbiguousTypes #-}

module Pandora.Paradigm.Structure.Ability.Substructure where

import Pandora.Core.Functor (type (~>))
import Pandora.Pattern.Category ((.))
import Pandora.Pattern.Functor.Covariant (comap)
import Pandora.Pattern.Functor.Extractable (extract)
import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)
import Pandora.Paradigm.Inventory.Optics (type (:~.), view, over, set)
import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag))
import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>))

class Substructure f t where
	type Substructural (f :: k) (t :: * -> *) :: * -> *
	substructure :: Tagged f <:.> t :~. Substructural f t

	sub :: t :~. Substructural f t
	sub = (TU Covariant Covariant (Tagged f) t a -> t a)
-> Store
     (Substructural f t a) (TU Covariant Covariant (Tagged f) t a)
-> Store (Substructural f t a) (t a)
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
comap (t a <:= Tagged f
forall (t :: * -> *) a. Extractable t => a <:= t
extract (t a <:= Tagged f)
-> (TU Covariant Covariant (Tagged f) t a -> Tagged f (t a))
-> TU Covariant Covariant (Tagged f) t a
-> t a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. TU Covariant Covariant (Tagged f) t a -> Tagged f (t a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run) (Store
   (Substructural f t a) (TU Covariant Covariant (Tagged f) t a)
 -> Store (Substructural f t a) (t a))
-> (t a
    -> Store
         (Substructural f t a) (TU Covariant Covariant (Tagged f) t a))
-> Lens (t a) (Substructural f t a)
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Lens (TU Covariant Covariant (Tagged f) t a) (Substructural f t a)
forall k (f :: k) (t :: * -> *).
Substructure f t =>
(Tagged f <:.> t) :~. Substructural f t
substructure Lens (TU Covariant Covariant (Tagged f) t a) (Substructural f t a)
-> (t a -> TU Covariant Covariant (Tagged f) t a)
-> t a
-> Store
     (Substructural f t a) (TU Covariant Covariant (Tagged f) t a)
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Tagged f (t a) -> TU Covariant Covariant (Tagged f) t 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 f (t a) -> TU Covariant Covariant (Tagged f) t a)
-> (t a -> Tagged f (t a))
-> t a
-> TU Covariant Covariant (Tagged f) t a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. forall a. a -> Tagged f a
forall k (tag :: k) a. a -> Tagged tag a
Tag @f

	subview :: t ~> Substructural f t
	subview = Lens (t a) (Substructural f t a) -> t a -> Substructural f t a
forall src tgt. Lens src tgt -> src -> tgt
view (forall k (f :: k) (t :: * -> *).
Substructure f t =>
t :~. Substructural f t
forall (t :: * -> *). Substructure f t => t :~. Substructural f t
sub @f)

	substitute :: (Substructural f t a -> Substructural f t a) -> t a -> t a
	substitute = Lens (t a) (Substructural f t a)
-> (Substructural f t a -> Substructural f t a) -> t a -> t a
forall src tgt. Lens src tgt -> (tgt -> tgt) -> src -> src
over (forall k (f :: k) (t :: * -> *).
Substructure f t =>
t :~. Substructural f t
forall (t :: * -> *). Substructure f t => t :~. Substructural f t
sub @f)

	subplace :: (Substructural f t) a -> t a -> t a
	subplace = Lens (t a) (Substructural f t a)
-> Substructural f t a -> t a -> t a
forall src tgt. Lens src tgt -> tgt -> src -> src
set (forall k (f :: k) (t :: * -> *).
Substructure f t =>
t :~. Substructural f t
forall (t :: * -> *). Substructure f t => t :~. Substructural f t
sub @f)

data Command a = Delete a

data Segment a = All a | First a | Tail a