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