{-# 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.Category (($), (.))
import Pandora.Pattern.Functor.Covariant (Covariant (comap))
import Pandora.Pattern.Functor.Extractable (extract)
import Pandora.Pattern.Functor.Pointable (point)
import Pandora.Pattern.Transformer.Liftable (lift)
import Pandora.Pattern.Object.Semigroup ((+))
import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, unite)
import Pandora.Paradigm.Inventory.Optics ((|>))
import Pandora.Paradigm.Inventory.Store (Store (Store))
import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False))
-- import Pandora.Paradigm.Primary.Functor.Delta (Delta ((:^:)))
import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity))
import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing))
import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag))
import Pandora.Paradigm.Primary.Functor.Predicate (Predicate (Predicate))
import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)), type (:*:), attached)
import Pandora.Paradigm.Primary.Functor.Wye (Wye (Both, Left, Right, End))
import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct))
import Pandora.Paradigm.Primary.Transformer.Tap (Tap (Tap))
import Pandora.Paradigm.Schemes.TU (type (<:.>))

instance Monotonic s a => Monotonic s (s :*: a) where
	reduce :: (s -> r -> r) -> r -> (s :*: a) -> r
reduce s -> r -> r
f r
r s :*: a
x = (s -> r -> r) -> r -> a -> r
forall a e r. Monotonic a e => (a -> r -> r) -> r -> e -> r
reduce 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 Nullable Maybe where
	null :: (Predicate :. Maybe) := a
null = (Maybe a -> Boolean) -> (Predicate :. Maybe) := a
forall a. (a -> Boolean) -> Predicate a
Predicate ((Maybe a -> Boolean) -> (Predicate :. Maybe) := a)
-> (Maybe a -> Boolean) -> (Predicate :. Maybe) := a
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ \case { Just a
_ -> Boolean
True ; Maybe a
_ -> Boolean
False }

instance Substructure Right (Product s) where
	type Substructural Right (Product s) = Identity
	substructure :: Lens
  ((<:.>) (Tagged 'Right) (Product s) a)
  (Substructural 'Right (Product s) a)
substructure (Product s a <:= Tagged 'Right
forall (t :: * -> *) a. Extractable t => a <:= t
extract (Product s a <:= Tagged 'Right)
-> ((<:.>) (Tagged 'Right) (Product s) a
    -> Tagged 'Right (Product s a))
-> (<:.>) (Tagged 'Right) (Product s) a
-> Product s a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged 'Right) (Product s) a -> Tagged 'Right (Product s a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run -> s
s :*: a
x) =
		(((:*:) (Identity a) :. (->) (Identity a))
 := (<:.>) (Tagged 'Right) (Product s) a)
-> Store (Identity a) ((<:.>) (Tagged 'Right) (Product s) a)
forall s a. (((:*:) s :. (->) s) := a) -> Store s a
Store ((((:*:) (Identity a) :. (->) (Identity a))
  := (<:.>) (Tagged 'Right) (Product s) a)
 -> Store (Identity a) ((<:.>) (Tagged 'Right) (Product s) a))
-> (((:*:) (Identity a) :. (->) (Identity a))
    := (<:.>) (Tagged 'Right) (Product s) a)
-> Store (Identity a) ((<:.>) (Tagged 'Right) (Product s) a)
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a -> Identity a
forall a. a -> Identity a
Identity a
x Identity a
-> (Identity a -> (<:.>) (Tagged 'Right) (Product s) a)
-> ((:*:) (Identity a) :. (->) (Identity a))
   := (<:.>) (Tagged 'Right) (Product s) a
forall s a. s -> a -> Product s a
:*: Product s a -> (<:.>) (Tagged 'Right) (Product s) a
forall (t :: (* -> *) -> * -> *) (u :: * -> *).
(Liftable t, Covariant u) =>
u ~> t u
lift (Product s a -> (<:.>) (Tagged 'Right) (Product s) a)
-> (Identity a -> Product s a)
-> Identity 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
:*:) (a -> Product s a)
-> (Identity a -> a) -> Identity a -> Product s a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Identity a -> a
forall (t :: * -> *) a. Extractable t => a <:= t
extract

-- instance Substructure Left Delta where
-- 	type Substructural Left Delta = Identity
-- 	substructure (extract . run -> l :^: r) =
-- 		Store $ Identity l :*: lift . (:^: r) . extract
--
-- instance Substructure Right Delta where
-- 	type Substructural Right Delta = Identity
-- 	substructure (extract . run -> l :^: r) =
-- 		Store $ Identity r :*: lift . (l :^:) . extract
--
-- instance Covariant t => Substructure Left (Delta <:.> t) where
-- 	type Substructural Left (Delta <:.> t) = t
-- 	substructure (run . extract . run -> l :^: r) =
-- 		Store $ r :*: lift . unite . (l :^:)
--
-- instance Covariant t => Substructure Right (Delta <:.> t) where
-- 	type Substructural Right (Delta <:.> t) = t
-- 	substructure (run . extract . run -> l :^: r) =
-- 		Store $ l :*: lift . unite . (:^: r)

instance Covariant t => Substructure Tail (Tap t) where
	type Substructural Tail (Tap t) = t
	substructure :: Lens
  ((<:.>) (Tagged 'Tail) (Tap t) a) (Substructural 'Tail (Tap t) a)
substructure (Tap t a <:= Tagged 'Tail
forall (t :: * -> *) a. Extractable t => a <:= t
extract (Tap t a <:= Tagged 'Tail)
-> ((<:.>) (Tagged 'Tail) (Tap t) a -> Tagged 'Tail (Tap t a))
-> (<:.>) (Tagged 'Tail) (Tap t) a
-> Tap t a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged 'Tail) (Tap t) a -> Tagged 'Tail (Tap t a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run -> Tap a
x t a
xs) =
		(((:*:) (t a) :. (->) (t a)) := (<:.>) (Tagged 'Tail) (Tap t) a)
-> Store (t a) ((<:.>) (Tagged 'Tail) (Tap t) a)
forall s a. (((:*:) s :. (->) s) := a) -> Store s a
Store ((((:*:) (t a) :. (->) (t a)) := (<:.>) (Tagged 'Tail) (Tap t) a)
 -> Store (t a) ((<:.>) (Tagged 'Tail) (Tap t) a))
-> (((:*:) (t a) :. (->) (t a)) := (<:.>) (Tagged 'Tail) (Tap t) a)
-> Store (t a) ((<:.>) (Tagged 'Tail) (Tap t) a)
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ t a
xs t a
-> (t a -> (<:.>) (Tagged 'Tail) (Tap t) a)
-> ((:*:) (t a) :. (->) (t a)) := (<:.>) (Tagged 'Tail) (Tap t) a
forall s a. s -> a -> Product s a
:*: Tap t a -> (<:.>) (Tagged 'Tail) (Tap t) a
forall (t :: (* -> *) -> * -> *) (u :: * -> *).
(Liftable t, Covariant u) =>
u ~> t u
lift (Tap t a -> (<:.>) (Tagged 'Tail) (Tap t) a)
-> (t a -> Tap t a) -> t a -> (<:.>) (Tagged 'Tail) (Tap t) a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. a -> t a -> Tap t a
forall (t :: * -> *) a. a -> t a -> Tap t a
Tap a
x

instance Morphable Preorder (Construction Wye) where
	type Morphing Preorder (Construction Wye) = Construction Maybe
	morphing :: (<:.>) (Tagged 'Preorder) (Construction Wye) a
-> Morphing 'Preorder (Construction Wye) a
morphing (Construction Wye a <:= Tagged 'Preorder
forall (t :: * -> *) a. Extractable t => a <:= t
extract (Construction Wye a <:= Tagged 'Preorder)
-> ((<:.>) (Tagged 'Preorder) (Construction Wye) a
    -> Tagged 'Preorder (Construction Wye a))
-> (<:.>) (Tagged 'Preorder) (Construction Wye) a
-> Construction Wye a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged 'Preorder) (Construction Wye) a
-> Tagged 'Preorder (Construction Wye a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run -> Construct a
x Wye (Construction Wye a)
End) = a -> ((Maybe :. Construction Maybe) := a) -> Construction Maybe a
forall (t :: * -> *) a.
a -> ((t :. Construction t) := a) -> Construction t a
Construct a
x (Maybe :. Construction Maybe) := a
forall a. Maybe a
Nothing
	morphing (Construction Wye a <:= Tagged 'Preorder
forall (t :: * -> *) a. Extractable t => a <:= t
extract (Construction Wye a <:= Tagged 'Preorder)
-> ((<:.>) (Tagged 'Preorder) (Construction Wye) a
    -> Tagged 'Preorder (Construction Wye a))
-> (<:.>) (Tagged 'Preorder) (Construction Wye) a
-> Construction Wye a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged 'Preorder) (Construction Wye) a
-> Tagged 'Preorder (Construction Wye a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run -> Construct a
x (Left Construction Wye a
lst)) = a -> ((Maybe :. Construction Maybe) := a) -> Construction Maybe a
forall (t :: * -> *) a.
a -> ((t :. Construction t) := a) -> Construction t a
Construct a
x (((Maybe :. Construction Maybe) := a) -> Construction Maybe a)
-> (Construction Maybe a -> (Maybe :. Construction Maybe) := a)
-> Construction Maybe a
-> Construction Maybe a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Construction Maybe a -> (Maybe :. Construction Maybe) := a
forall a. a -> Maybe a
Just (Construction Maybe a -> Construction Maybe a)
-> Construction Maybe a -> Construction Maybe a
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ Construction Wye a -> Morphing 'Preorder (Construction Wye) a
forall k (f :: k) (t :: * -> *). Morphable f t => t ~> Morphing f t
morph @Preorder Construction Wye a
lst
	morphing (Construction Wye a <:= Tagged 'Preorder
forall (t :: * -> *) a. Extractable t => a <:= t
extract (Construction Wye a <:= Tagged 'Preorder)
-> ((<:.>) (Tagged 'Preorder) (Construction Wye) a
    -> Tagged 'Preorder (Construction Wye a))
-> (<:.>) (Tagged 'Preorder) (Construction Wye) a
-> Construction Wye a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged 'Preorder) (Construction Wye) a
-> Tagged 'Preorder (Construction Wye a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run -> Construct a
x (Right Construction Wye a
rst)) = a -> ((Maybe :. Construction Maybe) := a) -> Construction Maybe a
forall (t :: * -> *) a.
a -> ((t :. Construction t) := a) -> Construction t a
Construct a
x (((Maybe :. Construction Maybe) := a) -> Construction Maybe a)
-> (Construction Maybe a -> (Maybe :. Construction Maybe) := a)
-> Construction Maybe a
-> Construction Maybe a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Construction Maybe a -> (Maybe :. Construction Maybe) := a
forall a. a -> Maybe a
Just (Construction Maybe a -> Construction Maybe a)
-> Construction Maybe a -> Construction Maybe a
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ Construction Wye a -> Morphing 'Preorder (Construction Wye) a
forall k (f :: k) (t :: * -> *). Morphable f t => t ~> Morphing f t
morph @Preorder Construction Wye a
rst
	morphing (Construction Wye a <:= Tagged 'Preorder
forall (t :: * -> *) a. Extractable t => a <:= t
extract (Construction Wye a <:= Tagged 'Preorder)
-> ((<:.>) (Tagged 'Preorder) (Construction Wye) a
    -> Tagged 'Preorder (Construction Wye a))
-> (<:.>) (Tagged 'Preorder) (Construction Wye) a
-> Construction Wye a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged 'Preorder) (Construction Wye) a
-> Tagged 'Preorder (Construction Wye a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run -> Construct a
x (Both Construction Wye a
lst Construction Wye a
rst)) = a -> ((Maybe :. Construction Maybe) := a) -> Construction Maybe a
forall (t :: * -> *) a.
a -> ((t :. Construction t) := a) -> Construction t a
Construct a
x (((Maybe :. Construction Maybe) := a) -> Construction Maybe a)
-> (Construction Maybe a -> (Maybe :. Construction Maybe) := a)
-> Construction Maybe a
-> Construction Maybe a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. Construction Maybe a -> (Maybe :. Construction Maybe) := a
forall a. a -> Maybe a
Just (Construction Maybe a -> Construction Maybe a)
-> Construction Maybe a -> Construction Maybe a
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ Construction Wye a -> Morphing 'Preorder (Construction Wye) a
forall k (f :: k) (t :: * -> *). Morphable f t => t ~> Morphing f t
morph @Preorder Construction Wye a
lst Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ Construction Wye a -> Morphing 'Preorder (Construction Wye) a
forall k (f :: k) (t :: * -> *). Morphable f t => t ~> Morphing f t
morph @Preorder Construction Wye a
rst

instance Morphable Inorder (Construction Wye) where
	type Morphing Inorder (Construction Wye) = Construction Maybe
	morphing :: (<:.>) (Tagged 'Inorder) (Construction Wye) a
-> Morphing 'Inorder (Construction Wye) a
morphing (Construction Wye a <:= Tagged 'Inorder
forall (t :: * -> *) a. Extractable t => a <:= t
extract (Construction Wye a <:= Tagged 'Inorder)
-> ((<:.>) (Tagged 'Inorder) (Construction Wye) a
    -> Tagged 'Inorder (Construction Wye a))
-> (<:.>) (Tagged 'Inorder) (Construction Wye) a
-> Construction Wye a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged 'Inorder) (Construction Wye) a
-> Tagged 'Inorder (Construction Wye a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run -> Construct a
x Wye (Construction Wye a)
End) = a :=> Construction Maybe
forall (t :: * -> *) a. Pointable t => a :=> t
point a
x
	morphing (Construction Wye a <:= Tagged 'Inorder
forall (t :: * -> *) a. Extractable t => a <:= t
extract (Construction Wye a <:= Tagged 'Inorder)
-> ((<:.>) (Tagged 'Inorder) (Construction Wye) a
    -> Tagged 'Inorder (Construction Wye a))
-> (<:.>) (Tagged 'Inorder) (Construction Wye) a
-> Construction Wye a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged 'Inorder) (Construction Wye) a
-> Tagged 'Inorder (Construction Wye a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run -> Construct a
x (Left Construction Wye a
lst)) = Construction Wye a -> Morphing 'Inorder (Construction Wye) a
forall k (f :: k) (t :: * -> *). Morphable f t => t ~> Morphing f t
morph @Inorder Construction Wye a
lst Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ a :=> Construction Maybe
forall (t :: * -> *) a. Pointable t => a :=> t
point a
x
	morphing (Construction Wye a <:= Tagged 'Inorder
forall (t :: * -> *) a. Extractable t => a <:= t
extract (Construction Wye a <:= Tagged 'Inorder)
-> ((<:.>) (Tagged 'Inorder) (Construction Wye) a
    -> Tagged 'Inorder (Construction Wye a))
-> (<:.>) (Tagged 'Inorder) (Construction Wye) a
-> Construction Wye a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged 'Inorder) (Construction Wye) a
-> Tagged 'Inorder (Construction Wye a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run -> Construct a
x (Right Construction Wye a
rst)) = a :=> Construction Maybe
forall (t :: * -> *) a. Pointable t => a :=> t
point a
x Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ Construction Wye a -> Morphing 'Inorder (Construction Wye) a
forall k (f :: k) (t :: * -> *). Morphable f t => t ~> Morphing f t
morph @Inorder Construction Wye a
rst
	morphing (Construction Wye a <:= Tagged 'Inorder
forall (t :: * -> *) a. Extractable t => a <:= t
extract (Construction Wye a <:= Tagged 'Inorder)
-> ((<:.>) (Tagged 'Inorder) (Construction Wye) a
    -> Tagged 'Inorder (Construction Wye a))
-> (<:.>) (Tagged 'Inorder) (Construction Wye) a
-> Construction Wye a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged 'Inorder) (Construction Wye) a
-> Tagged 'Inorder (Construction Wye a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run -> Construct a
x (Both Construction Wye a
lst Construction Wye a
rst)) = Construction Wye a -> Morphing 'Inorder (Construction Wye) a
forall k (f :: k) (t :: * -> *). Morphable f t => t ~> Morphing f t
morph @Inorder Construction Wye a
lst Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ a :=> Construction Maybe
forall (t :: * -> *) a. Pointable t => a :=> t
point a
x Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ Construction Wye a -> Morphing 'Inorder (Construction Wye) a
forall k (f :: k) (t :: * -> *). Morphable f t => t ~> Morphing f t
morph @Inorder Construction Wye a
rst

instance Morphable Postorder (Construction Wye) where
	type Morphing Postorder (Construction Wye) = Construction Maybe
	morphing :: (<:.>) (Tagged 'Postorder) (Construction Wye) a
-> Morphing 'Postorder (Construction Wye) a
morphing (Construction Wye a <:= Tagged 'Postorder
forall (t :: * -> *) a. Extractable t => a <:= t
extract (Construction Wye a <:= Tagged 'Postorder)
-> ((<:.>) (Tagged 'Postorder) (Construction Wye) a
    -> Tagged 'Postorder (Construction Wye a))
-> (<:.>) (Tagged 'Postorder) (Construction Wye) a
-> Construction Wye a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged 'Postorder) (Construction Wye) a
-> Tagged 'Postorder (Construction Wye a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run -> Construct a
x Wye (Construction Wye a)
End) = a :=> Construction Maybe
forall (t :: * -> *) a. Pointable t => a :=> t
point a
x
	morphing (Construction Wye a <:= Tagged 'Postorder
forall (t :: * -> *) a. Extractable t => a <:= t
extract (Construction Wye a <:= Tagged 'Postorder)
-> ((<:.>) (Tagged 'Postorder) (Construction Wye) a
    -> Tagged 'Postorder (Construction Wye a))
-> (<:.>) (Tagged 'Postorder) (Construction Wye) a
-> Construction Wye a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged 'Postorder) (Construction Wye) a
-> Tagged 'Postorder (Construction Wye a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run -> Construct a
x (Left Construction Wye a
lst)) = Construction Wye a -> Morphing 'Postorder (Construction Wye) a
forall k (f :: k) (t :: * -> *). Morphable f t => t ~> Morphing f t
morph @Postorder Construction Wye a
lst Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ a :=> Construction Maybe
forall (t :: * -> *) a. Pointable t => a :=> t
point a
x
	morphing (Construction Wye a <:= Tagged 'Postorder
forall (t :: * -> *) a. Extractable t => a <:= t
extract (Construction Wye a <:= Tagged 'Postorder)
-> ((<:.>) (Tagged 'Postorder) (Construction Wye) a
    -> Tagged 'Postorder (Construction Wye a))
-> (<:.>) (Tagged 'Postorder) (Construction Wye) a
-> Construction Wye a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged 'Postorder) (Construction Wye) a
-> Tagged 'Postorder (Construction Wye a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run -> Construct a
x (Right Construction Wye a
rst)) = Construction Wye a -> Morphing 'Postorder (Construction Wye) a
forall k (f :: k) (t :: * -> *). Morphable f t => t ~> Morphing f t
morph @Postorder Construction Wye a
rst Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ a :=> Construction Maybe
forall (t :: * -> *) a. Pointable t => a :=> t
point a
x
	morphing (Construction Wye a <:= Tagged 'Postorder
forall (t :: * -> *) a. Extractable t => a <:= t
extract (Construction Wye a <:= Tagged 'Postorder)
-> ((<:.>) (Tagged 'Postorder) (Construction Wye) a
    -> Tagged 'Postorder (Construction Wye a))
-> (<:.>) (Tagged 'Postorder) (Construction Wye) a
-> Construction Wye a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged 'Postorder) (Construction Wye) a
-> Tagged 'Postorder (Construction Wye a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run -> Construct a
x (Both Construction Wye a
lst Construction Wye a
rst)) = Construction Wye a -> Morphing 'Postorder (Construction Wye) a
forall k (f :: k) (t :: * -> *). Morphable f t => t ~> Morphing f t
morph @Postorder Construction Wye a
lst Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ Construction Wye a -> Morphing 'Postorder (Construction Wye) a
forall k (f :: k) (t :: * -> *). Morphable f t => t ~> Morphing f t
morph @Postorder Construction Wye a
rst Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ a :=> Construction Maybe
forall (t :: * -> *) a. Pointable t => a :=> t
point a
x

instance Morphable o (Construction Wye) => Morphable o Binary where
	type Morphing o Binary = Maybe <:.> Morphing o (Construction Wye)
	morphing :: (<:.>) (Tagged o) Binary a -> Morphing o Binary a
morphing = ((Maybe :. Morphing o (Construction Wye)) := a)
-> TU Covariant Covariant Maybe (Morphing o (Construction Wye)) a
forall (t :: * -> *) a. Interpreted t => Primary t a -> t a
unite (((Maybe :. Morphing o (Construction Wye)) := a)
 -> TU Covariant Covariant Maybe (Morphing o (Construction Wye)) a)
-> ((<:.>) (Tagged o) Binary a
    -> (Maybe :. Morphing o (Construction Wye)) := a)
-> (<:.>) (Tagged o) Binary a
-> TU Covariant Covariant Maybe (Morphing o (Construction Wye)) a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (Construction Wye a -> Morphing o (Construction Wye) a)
-> Maybe (Construction Wye a)
-> (Maybe :. Morphing o (Construction Wye)) := a
forall (t :: * -> *) a b. Covariant t => (a -> b) -> t a -> t b
comap (forall k (f :: k) (t :: * -> *). Morphable f t => t ~> Morphing f t
forall (t :: * -> *). Morphable o t => t ~> Morphing o t
morph @o) (Maybe (Construction Wye a)
 -> (Maybe :. Morphing o (Construction Wye)) := a)
-> ((<:.>) (Tagged o) Binary a -> Maybe (Construction Wye a))
-> (<:.>) (Tagged o) Binary a
-> (Maybe :. Morphing o (Construction Wye)) := a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. TU Covariant Covariant Maybe (Construction Wye) a
-> Maybe (Construction Wye a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run (TU Covariant Covariant Maybe (Construction Wye) a
 -> Maybe (Construction Wye a))
-> ((<:.>) (Tagged o) Binary a
    -> TU Covariant Covariant Maybe (Construction Wye) a)
-> (<:.>) (Tagged o) Binary a
-> Maybe (Construction Wye a)
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. TU Covariant Covariant Maybe (Construction Wye) a <:= Tagged o
forall (t :: * -> *) a. Extractable t => a <:= t
extract (TU Covariant Covariant Maybe (Construction Wye) a <:= Tagged o)
-> ((<:.>) (Tagged o) Binary a
    -> Tagged o (TU Covariant Covariant Maybe (Construction Wye) a))
-> (<:.>) (Tagged o) Binary a
-> TU Covariant Covariant Maybe (Construction Wye) a
forall (m :: * -> * -> *) b c a.
Category m =>
m b c -> m a b -> m a c
. (<:.>) (Tagged o) Binary a
-> Tagged o (TU Covariant Covariant Maybe (Construction Wye) a)
forall (t :: * -> *) a. Interpreted t => t a -> Primary t a
run

instance Focusable Left (Product s) where
	type Focusing Left (Product s) a = s
	focusing :: Tagged 'Left (Product s a) :-. Focusing 'Left (Product s) a
focusing (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 s a. (((:*:) s :. (->) s) := a) -> Store s 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 Focusable Right (Product s) where
	type Focusing Right (Product s) a = a
	focusing :: Tagged 'Right (Product s a) :-. Focusing 'Right (Product s) a
focusing (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 s a. (((:*:) s :. (->) s) := a) -> Store s 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 Accessible s (s :*: a) where
	access :: (s :*: a) :-. s
access ~(s
s :*: a
x) = (((:*:) s :. (->) s) := (s :*: a)) -> Store s (s :*: a)
forall s a. (((:*:) s :. (->) s) := a) -> Store s a
Store ((((:*:) s :. (->) s) := (s :*: a)) -> Store s (s :*: a))
-> (((:*:) s :. (->) s) := (s :*: a)) -> Store s (s :*: a)
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ s
s s -> (s -> s :*: a) -> ((:*:) s :. (->) s) := (s :*: a)
forall s a. s -> a -> Product s a
:*: (s -> a -> s :*: a
forall s a. s -> a -> Product s a
:*: a
x)

instance Accessible a (s :*: a) where
	access :: (s :*: a) :-. a
access ~(s
s :*: a
x) = (((:*:) a :. (->) a) := (s :*: a)) -> Store a (s :*: a)
forall s a. (((:*:) s :. (->) s) := a) -> Store s a
Store ((((:*:) a :. (->) a) := (s :*: a)) -> Store a (s :*: a))
-> (((:*:) a :. (->) a) := (s :*: a)) -> Store a (s :*: a)
forall (m :: * -> * -> *) a b. Category m => m a b -> m a b
$ a
x a -> (a -> s :*: a) -> ((:*:) a :. (->) a) := (s :*: a)
forall s a. s -> a -> Product s a
:*: (s
s s -> a -> s :*: a
forall s a. s -> a -> Product s a
:*:)

instance {-# OVERLAPS #-} Accessible b a => Accessible b (s :*: a) where
	access :: (s :*: a) :-. b
access = forall src. Accessible a src => src :-. a
forall tgt src. Accessible tgt src => src :-. tgt
access @a ((s :*: a) :-. a) -> Lens a b -> (s :*: a) :-. b
forall src old new. Lens src old -> Lens old new -> Lens src new
|> forall src. Accessible b src => src :-. b
forall tgt src. Accessible tgt src => src :-. tgt
access @b