{-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Structure (module Exports) where import Pandora.Paradigm.Structure.Ability as Exports import Pandora.Paradigm.Structure.Interface as Exports import Pandora.Paradigm.Structure.Rose as Exports import Pandora.Paradigm.Structure.Splay as Exports import Pandora.Paradigm.Structure.Binary as Exports import Pandora.Paradigm.Structure.Stack as Exports import Pandora.Paradigm.Structure.Stream as Exports import Pandora.Pattern (($), (.), extract) import Pandora.Paradigm.Controlflow.Effect.Interpreted (run) import Pandora.Paradigm.Inventory (Store (Store), (^.), (.~)) import Pandora.Paradigm.Primary.Functor.Delta (Delta ((:^:))) import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)), type (:*:), attached) import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag)) import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right)) import Pandora.Paradigm.Primary.Transformer.Tap (Tap (Tap)) import Pandora.Paradigm.Schemes.TU (type (<:.>)) instance Monotonic a s => Monotonic (s :*: a) s where bypass :: (s -> r -> r) -> r -> (s :*: a) -> r bypass s -> r -> r f r r s :*: a x = (s -> r -> r) -> r -> a -> r forall e a r. Monotonic e a => (a -> r -> r) -> r -> e -> r bypass s -> r -> r f (s -> r -> r f ((s :*: a) -> s forall a b. (a :*: b) -> a attached s :*: a x) r r) (a -> r) -> a -> r forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ a <-| Product s forall (t :: * -> *) a. Extractable t => a <-| t extract s :*: a x instance Substructure Left (Product s) where type Substructural Left (Product s) a = s substructure :: Tagged 'Left (Product s a) :-. Substructural 'Left (Product s) a substructure (Product s a <-| Tagged 'Left forall (t :: * -> *) a. Extractable t => a <-| t extract -> s s :*: a x) = ((Product s :. (->) s) := Tagged 'Left (Product s a)) -> Store s (Tagged 'Left (Product s a)) forall p a. (((:*:) p :. (->) p) := a) -> Store p a Store (((Product s :. (->) s) := Tagged 'Left (Product s a)) -> Store s (Tagged 'Left (Product s a))) -> ((Product s :. (->) s) := Tagged 'Left (Product s a)) -> Store s (Tagged 'Left (Product s a)) forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ s s s -> (s -> Tagged 'Left (Product s a)) -> (Product s :. (->) s) := Tagged 'Left (Product s a) forall s a. s -> a -> Product s a :*: Product s a -> Tagged 'Left (Product s a) forall k (tag :: k) a. a -> Tagged tag a Tag (Product s a -> Tagged 'Left (Product s a)) -> (s -> Product s a) -> s -> Tagged 'Left (Product s a) forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . (s -> a -> Product s a forall s a. s -> a -> Product s a :*: a x) instance Substructure Right (Product s) where type Substructural Right (Product s) a = a substructure :: Tagged 'Right (Product s a) :-. Substructural 'Right (Product s) a substructure (Product s a <-| Tagged 'Right forall (t :: * -> *) a. Extractable t => a <-| t extract -> s s :*: a x) = (((:*:) a :. (->) a) := Tagged 'Right (Product s a)) -> Store a (Tagged 'Right (Product s a)) forall p a. (((:*:) p :. (->) p) := a) -> Store p a Store ((((:*:) a :. (->) a) := Tagged 'Right (Product s a)) -> Store a (Tagged 'Right (Product s a))) -> (((:*:) a :. (->) a) := Tagged 'Right (Product s a)) -> Store a (Tagged 'Right (Product s a)) forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ a x a -> (a -> Tagged 'Right (Product s a)) -> ((:*:) a :. (->) a) := Tagged 'Right (Product s a) forall s a. s -> a -> Product s a :*: Product s a -> Tagged 'Right (Product s a) forall k (tag :: k) a. a -> Tagged tag a Tag (Product s a -> Tagged 'Right (Product s a)) -> (a -> Product s a) -> a -> Tagged 'Right (Product s a) forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . (s s s -> a -> Product s a forall s a. s -> a -> Product s a :*:) instance Substructure Left Delta where type Substructural Left Delta a = a substructure :: Tagged 'Left (Delta a) :-. Substructural 'Left Delta a substructure (Delta a <-| Tagged 'Left forall (t :: * -> *) a. Extractable t => a <-| t extract -> a l :^: a r) = (((:*:) a :. (->) a) := Tagged 'Left (Delta a)) -> Store a (Tagged 'Left (Delta a)) forall p a. (((:*:) p :. (->) p) := a) -> Store p a Store ((((:*:) a :. (->) a) := Tagged 'Left (Delta a)) -> Store a (Tagged 'Left (Delta a))) -> (((:*:) a :. (->) a) := Tagged 'Left (Delta a)) -> Store a (Tagged 'Left (Delta a)) forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ a l a -> (a -> Tagged 'Left (Delta a)) -> ((:*:) a :. (->) a) := Tagged 'Left (Delta a) forall s a. s -> a -> Product s a :*: Delta a -> Tagged 'Left (Delta a) forall k (tag :: k) a. a -> Tagged tag a Tag (Delta a -> Tagged 'Left (Delta a)) -> (a -> Delta a) -> a -> Tagged 'Left (Delta a) forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . (a -> a -> Delta a forall a. a -> a -> Delta a :^: a r) instance Substructure Right Delta where type Substructural Right Delta a = a substructure :: Tagged 'Right (Delta a) :-. Substructural 'Right Delta a substructure (Delta a <-| Tagged 'Right forall (t :: * -> *) a. Extractable t => a <-| t extract -> a l :^: a r) = (((:*:) a :. (->) a) := Tagged 'Right (Delta a)) -> Store a (Tagged 'Right (Delta a)) forall p a. (((:*:) p :. (->) p) := a) -> Store p a Store ((((:*:) a :. (->) a) := Tagged 'Right (Delta a)) -> Store a (Tagged 'Right (Delta a))) -> (((:*:) a :. (->) a) := Tagged 'Right (Delta a)) -> Store a (Tagged 'Right (Delta a)) forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ a r a -> (a -> Tagged 'Right (Delta a)) -> ((:*:) a :. (->) a) := Tagged 'Right (Delta a) forall s a. s -> a -> Product s a :*: Delta a -> Tagged 'Right (Delta a) forall k (tag :: k) a. a -> Tagged tag a Tag (Delta a -> Tagged 'Right (Delta a)) -> (a -> Delta a) -> a -> Tagged 'Right (Delta a) forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . (a l a -> a -> Delta a forall a. a -> a -> Delta a :^:) instance Substructure Left t => Substructure Left (Tap (t <:.> u)) where type Substructural Left (Tap (t <:.> u)) a = Substructural Left t (u a) substructure :: Tagged 'Left (Tap (t <:.> u) a) :-. Substructural 'Left (Tap (t <:.> u)) a substructure (Tap (t <:.> u) a <-| Tagged 'Left forall (t :: * -> *) a. Extractable t => a <-| t extract -> Tap a x (<:.>) t u a xs) = (((:*:) (Substructural 'Left t (u a)) :. (->) (Substructural 'Left t (u a))) := Tagged 'Left (Tap (t <:.> u) a)) -> Store (Substructural 'Left t (u a)) (Tagged 'Left (Tap (t <:.> u) a)) forall p a. (((:*:) p :. (->) p) := a) -> Store p a Store ((((:*:) (Substructural 'Left t (u a)) :. (->) (Substructural 'Left t (u a))) := Tagged 'Left (Tap (t <:.> u) a)) -> Store (Substructural 'Left t (u a)) (Tagged 'Left (Tap (t <:.> u) a))) -> (((:*:) (Substructural 'Left t (u a)) :. (->) (Substructural 'Left t (u a))) := Tagged 'Left (Tap (t <:.> u) a)) -> Store (Substructural 'Left t (u a)) (Tagged 'Left (Tap (t <:.> u) a)) forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ forall k (f :: * -> k) (t :: * -> *) a. Substructure f t => t a :-. Substructural f t a forall (t :: * -> *) a. Substructure 'Left t => t a :-. Substructural 'Left t a sub @Left (t (u a) :-. Substructural 'Left t (u a)) -> t (u a) -> Substructural 'Left t (u a) forall src tgt. Lens src tgt -> src -> tgt ^. (<:.>) t u a -> Primary (t <:.> u) a forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run (<:.>) t u a xs Substructural 'Left t (u a) -> (Substructural 'Left t (u a) -> Tagged 'Left (Tap (t <:.> u) a)) -> ((:*:) (Substructural 'Left t (u a)) :. (->) (Substructural 'Left t (u a))) := Tagged 'Left (Tap (t <:.> u) a) forall s a. s -> a -> Product s a :*: Tap (t <:.> u) a -> Tagged 'Left (Tap (t <:.> u) a) forall k (tag :: k) a. a -> Tagged tag a Tag (Tap (t <:.> u) a -> Tagged 'Left (Tap (t <:.> u) a)) -> (Substructural 'Left t (u a) -> Tap (t <:.> u) a) -> Substructural 'Left t (u a) -> Tagged 'Left (Tap (t <:.> u) a) forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . (\Substructural 'Left t (u a) new -> forall k (f :: * -> k) (t :: * -> *) a. Substructure f t => t a :-. Substructural f t a forall (t :: * -> *) a. Substructure 'Left t => t a :-. Substructural 'Left t a sub @Left (Tap (t <:.> u) a -> Store (Substructural 'Left t (u a)) (Tap (t <:.> u) a)) -> Substructural 'Left t (u a) -> Tap (t <:.> u) a -> Tap (t <:.> u) a forall src tgt. Lens src tgt -> tgt -> src -> src .~ Substructural 'Left t (u a) new (Tap (t <:.> u) a -> Tap (t <:.> u) a) -> Tap (t <:.> u) a -> Tap (t <:.> u) a forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ a -> (<:.>) t u a -> Tap (t <:.> u) a forall (t :: * -> *) a. a -> t a -> Tap t a Tap a x (<:.>) t u a xs) instance Substructure Right t => Substructure Right (Tap (t <:.> u)) where type Substructural Right (Tap (t <:.> u)) a = Substructural Right t (u a) substructure :: Tagged 'Right (Tap (t <:.> u) a) :-. Substructural 'Right (Tap (t <:.> u)) a substructure (Tap (t <:.> u) a <-| Tagged 'Right forall (t :: * -> *) a. Extractable t => a <-| t extract -> Tap a x (<:.>) t u a xs) = (((:*:) (Substructural 'Right t (u a)) :. (->) (Substructural 'Right t (u a))) := Tagged 'Right (Tap (t <:.> u) a)) -> Store (Substructural 'Right t (u a)) (Tagged 'Right (Tap (t <:.> u) a)) forall p a. (((:*:) p :. (->) p) := a) -> Store p a Store ((((:*:) (Substructural 'Right t (u a)) :. (->) (Substructural 'Right t (u a))) := Tagged 'Right (Tap (t <:.> u) a)) -> Store (Substructural 'Right t (u a)) (Tagged 'Right (Tap (t <:.> u) a))) -> (((:*:) (Substructural 'Right t (u a)) :. (->) (Substructural 'Right t (u a))) := Tagged 'Right (Tap (t <:.> u) a)) -> Store (Substructural 'Right t (u a)) (Tagged 'Right (Tap (t <:.> u) a)) forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ forall k (f :: * -> k) (t :: * -> *) a. Substructure f t => t a :-. Substructural f t a forall (t :: * -> *) a. Substructure 'Right t => t a :-. Substructural 'Right t a sub @Right (t (u a) :-. Substructural 'Right t (u a)) -> t (u a) -> Substructural 'Right t (u a) forall src tgt. Lens src tgt -> src -> tgt ^. (<:.>) t u a -> Primary (t <:.> u) a forall (t :: * -> *) a. Interpreted t => t a -> Primary t a run (<:.>) t u a xs Substructural 'Right t (u a) -> (Substructural 'Right t (u a) -> Tagged 'Right (Tap (t <:.> u) a)) -> ((:*:) (Substructural 'Right t (u a)) :. (->) (Substructural 'Right t (u a))) := Tagged 'Right (Tap (t <:.> u) a) forall s a. s -> a -> Product s a :*: Tap (t <:.> u) a -> Tagged 'Right (Tap (t <:.> u) a) forall k (tag :: k) a. a -> Tagged tag a Tag (Tap (t <:.> u) a -> Tagged 'Right (Tap (t <:.> u) a)) -> (Substructural 'Right t (u a) -> Tap (t <:.> u) a) -> Substructural 'Right t (u a) -> Tagged 'Right (Tap (t <:.> u) a) forall (m :: * -> * -> *) b c a. Category m => m b c -> m a b -> m a c . (\Substructural 'Right t (u a) new -> forall k (f :: * -> k) (t :: * -> *) a. Substructure f t => t a :-. Substructural f t a forall (t :: * -> *) a. Substructure 'Right t => t a :-. Substructural 'Right t a sub @Right (Tap (t <:.> u) a -> Store (Substructural 'Right t (u a)) (Tap (t <:.> u) a)) -> Substructural 'Right t (u a) -> Tap (t <:.> u) a -> Tap (t <:.> u) a forall src tgt. Lens src tgt -> tgt -> src -> src .~ Substructural 'Right t (u a) new (Tap (t <:.> u) a -> Tap (t <:.> u) a) -> Tap (t <:.> u) a -> Tap (t <:.> u) a forall (m :: * -> * -> *) a b. Category m => m a b -> m a b $ a -> (<:.>) t u a -> Tap (t <:.> u) a forall (t :: * -> *) a. a -> t a -> Tap t a Tap a x (<:.>) t u a xs)