{-# LANGUAGE UndecidableInstances #-}
{-# 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.Modification as Exports
import Pandora.Paradigm.Structure.Some as Exports

import Pandora.Core.Interpreted (run, (<~))
import Pandora.Pattern.Semigroupoid ((.))
import Pandora.Pattern.Category ((<--), (<---), identity)
import Pandora.Pattern.Kernel (constant)
import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))
import Pandora.Pattern.Transformer.Liftable (lift)
import Pandora.Pattern.Transformer.Lowerable (lower)
import Pandora.Pattern.Object.Semigroup ((+))
import Pandora.Paradigm.Inventory.Some.Optics ()
import Pandora.Paradigm.Inventory.Some.Store (Store (Store))
import Pandora.Paradigm.Algebraic.Exponential ((%))
import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)), type (<:*:>), attached)
import Pandora.Paradigm.Algebraic.Sum ((:+:) (Option, Adoption))
import Pandora.Paradigm.Algebraic (extract)
import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly))
import Pandora.Paradigm.Primary.Functor.Conclusion (Conclusion (Failure, Success), conclusion)
import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing))
import Pandora.Paradigm.Primary.Functor.Wye (Wye (Both, Left_, Right_, End))
import Pandora.Paradigm.Primary.Functor.Wedge (Wedge (Nowhere, Here, There))
import Pandora.Paradigm.Primary.Functor.These (These (This, That, These))
import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct))
import Pandora.Paradigm.Primary.Linear.Vector (Vector (Scalar, Vector))
import Pandora.Pattern.Morphism.Flip (Flip (Flip))
import Pandora.Paradigm.Primary.Transformer.Tap (Tap (Tap))
import Pandora.Paradigm.Schemes.TT (TT (TT))
import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>))
import Pandora.Paradigm.Schemes.P_Q_T (P_Q_T (P_Q_T))

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 (r -> a -> r) -> r -> a -> r
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- 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 (m a b) (m a b)
<-- (s :*: a) -> a
forall (t :: * -> *) a. Extractable t => t a -> a
extract s :*: a
x

instance Morphable (Into Maybe) (Conclusion e) where
	type Morphing (Into Maybe) (Conclusion e) = Maybe
	morphing :: (<::>) (Tagged ('Into Maybe)) (Conclusion e) a
-> Morphing ('Into Maybe) (Conclusion e) a
morphing = (e -> Maybe a) -> (a -> Maybe a) -> Conclusion e a -> Maybe a
forall e r a. (e -> r) -> (a -> r) -> Conclusion e a -> r
conclusion (Maybe a -> e -> Maybe a
forall (m :: * -> * -> *) a i. Kernel m => m a (m i a)
constant Maybe a
forall a. Maybe a
Nothing) a -> Maybe a
forall a. a -> Maybe a
Just (Conclusion e a -> Maybe a)
-> ((<::>) (Tagged ('Into Maybe)) (Conclusion e) a
    -> Conclusion e a)
-> (<::>) (Tagged ('Into Maybe)) (Conclusion e) a
-> Maybe a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Into Maybe)) (Conclusion e) a -> Conclusion e a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph

instance Morphable (Into (Conclusion e)) Maybe where
	type Morphing (Into (Conclusion e)) Maybe = (->) e <:.> Conclusion e
	morphing :: (<::>) (Tagged ('Into (Conclusion e))) Maybe a
-> Morphing ('Into (Conclusion e)) Maybe a
morphing ((<::>) (Tagged ('Into (Conclusion e))) Maybe a -> Maybe a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Just a
x) = (((->) e :. Conclusion e) >>> a)
-> TU Covariant Covariant ((->) e) (Conclusion e) 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 ((((->) e :. Conclusion e) >>> a)
 -> TU Covariant Covariant ((->) e) (Conclusion e) a)
-> (((->) e :. Conclusion e) >>> a)
-> TU Covariant Covariant ((->) e) (Conclusion e) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \e
_ -> a -> Conclusion e a
forall e a. a -> Conclusion e a
Success a
x
	morphing ((<::>) (Tagged ('Into (Conclusion e))) Maybe a -> Maybe a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Maybe a
Nothing) = (((->) e :. Conclusion e) >>> a)
-> TU Covariant Covariant ((->) e) (Conclusion e) 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 ((((->) e :. Conclusion e) >>> a)
 -> TU Covariant Covariant ((->) e) (Conclusion e) a)
-> (((->) e :. Conclusion e) >>> a)
-> TU Covariant Covariant ((->) e) (Conclusion e) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \e
e -> ((->) e :. Conclusion e) >>> a
forall e a. e -> Conclusion e a
Failure e
e

instance Morphable (Into (Flip Conclusion e)) Maybe where
	type Morphing (Into (Flip Conclusion e)) Maybe = (->) e <:.> Flip Conclusion e
	morphing :: (<::>) (Tagged ('Into (Flip Conclusion e))) Maybe a
-> Morphing ('Into (Flip Conclusion e)) Maybe a
morphing (Maybe a -> Maybe a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (Maybe a -> Maybe a)
-> ((<::>) (Tagged ('Into (Flip Conclusion e))) Maybe a -> Maybe a)
-> (<::>) (Tagged ('Into (Flip Conclusion e))) Maybe a
-> Maybe a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Into (Flip Conclusion e))) Maybe a -> Maybe a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Just a
x) = (((->) e :. Flip Conclusion e) >>> a)
-> TU Covariant Covariant ((->) e) (Flip Conclusion e) 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 ((((->) e :. Flip Conclusion e) >>> a)
 -> TU Covariant Covariant ((->) e) (Flip Conclusion e) a)
-> (((->) e :. Flip Conclusion e) >>> a)
-> TU Covariant Covariant ((->) e) (Flip Conclusion e) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \e
_ -> Conclusion a e -> Flip Conclusion e a
forall (v :: * -> * -> *) a e. v e a -> Flip v a e
Flip (Conclusion a e -> Flip Conclusion e a)
-> Conclusion a e -> Flip Conclusion e a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a -> Conclusion a e
forall e a. e -> Conclusion e a
Failure a
x
	morphing (Maybe a -> Maybe a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (Maybe a -> Maybe a)
-> ((<::>) (Tagged ('Into (Flip Conclusion e))) Maybe a -> Maybe a)
-> (<::>) (Tagged ('Into (Flip Conclusion e))) Maybe a
-> Maybe a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Into (Flip Conclusion e))) Maybe a -> Maybe a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Maybe a
Nothing) = (((->) e :. Flip Conclusion e) >>> a)
-> TU Covariant Covariant ((->) e) (Flip Conclusion e) 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 ((((->) e :. Flip Conclusion e) >>> a)
 -> TU Covariant Covariant ((->) e) (Flip Conclusion e) a)
-> (((->) e :. Flip Conclusion e) >>> a)
-> TU Covariant Covariant ((->) e) (Flip Conclusion e) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- Conclusion a e -> Flip Conclusion e a
forall (v :: * -> * -> *) a e. v e a -> Flip v a e
Flip (Conclusion a e -> Flip Conclusion e a)
-> (e -> Conclusion a e) -> ((->) e :. Flip Conclusion e) >>> a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. e -> Conclusion a e
forall e a. a -> Conclusion e a
Success

instance Morphable (Into (Left_ Maybe)) Wye where
	type Morphing (Into (Left_ Maybe)) Wye = Maybe
	morphing :: (<::>) (Tagged ('Into ('Left_ Maybe))) Wye a
-> Morphing ('Into ('Left_ Maybe)) Wye a
morphing ((<::>) (Tagged ('Into ('Left_ Maybe))) Wye a -> Wye a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Both a
ls a
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
ls
	morphing ((<::>) (Tagged ('Into ('Left_ Maybe))) Wye a -> Wye a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Left_ a
ls) = a -> Maybe a
forall a. a -> Maybe a
Just a
ls
	morphing ((<::>) (Tagged ('Into ('Left_ Maybe))) Wye a -> Wye a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Right_ a
_) = Morphing ('Into ('Left_ Maybe)) Wye a
forall a. Maybe a
Nothing
	morphing ((<::>) (Tagged ('Into ('Left_ Maybe))) Wye a -> Wye a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Wye a
End) = Morphing ('Into ('Left_ Maybe)) Wye a
forall a. Maybe a
Nothing

instance Morphable (Into (Right_ Maybe)) Wye where
	type Morphing (Into (Right_ Maybe)) Wye = Maybe
	morphing :: (<::>) (Tagged ('Into ('Right_ Maybe))) Wye a
-> Morphing ('Into ('Right_ Maybe)) Wye a
morphing ((<::>) (Tagged ('Into ('Right_ Maybe))) Wye a -> Wye a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Both a
_ a
rs) = a -> Maybe a
forall a. a -> Maybe a
Just a
rs
	morphing ((<::>) (Tagged ('Into ('Right_ Maybe))) Wye a -> Wye a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Left_ a
_) = Morphing ('Into ('Right_ Maybe)) Wye a
forall a. Maybe a
Nothing
	morphing ((<::>) (Tagged ('Into ('Right_ Maybe))) Wye a -> Wye a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Right_ a
rs) = a -> Maybe a
forall a. a -> Maybe a
Just a
rs
	morphing ((<::>) (Tagged ('Into ('Right_ Maybe))) Wye a -> Wye a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Wye a
End) = Morphing ('Into ('Right_ Maybe)) Wye a
forall a. Maybe a
Nothing

instance Morphable (Into (This Maybe)) (These e) where
	type Morphing (Into (This Maybe)) (These e) = Maybe
	morphing :: (<::>) (Tagged ('Into ('This Maybe))) (These e) a
-> Morphing ('Into ('This Maybe)) (These e) a
morphing ((<::>) (Tagged ('Into ('This Maybe))) (These e) a -> These e a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> This a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
	morphing ((<::>) (Tagged ('Into ('This Maybe))) (These e) a -> These e a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> That e
_) = Morphing ('Into ('This Maybe)) (These e) a
forall a. Maybe a
Nothing
	morphing ((<::>) (Tagged ('Into ('This Maybe))) (These e) a -> These e a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> These e
_ a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

instance Morphable (Into (That Maybe)) (Flip These a) where
	type Morphing (Into (That Maybe)) (Flip These a) = Maybe
	morphing :: (<::>) (Tagged ('Into ('That Maybe))) (Flip These a) a
-> Morphing ('Into ('That Maybe)) (Flip These a) a
morphing (Flip These a a -> These a a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (Flip These a a -> These a a)
-> ((<::>) (Tagged ('Into ('That Maybe))) (Flip These a) a
    -> Flip These a a)
-> (<::>) (Tagged ('Into ('That Maybe))) (Flip These a) a
-> These a a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Into ('That Maybe))) (Flip These a) a
-> Flip These a a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> This a
_) = Morphing ('Into ('That Maybe)) (Flip These a) a
forall a. Maybe a
Nothing
	morphing (Flip These a a -> These a a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (Flip These a a -> These a a)
-> ((<::>) (Tagged ('Into ('That Maybe))) (Flip These a) a
    -> Flip These a a)
-> (<::>) (Tagged ('Into ('That Maybe))) (Flip These a) a
-> These a a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Into ('That Maybe))) (Flip These a) a
-> Flip These a a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> That a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
	morphing (Flip These a a -> These a a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (Flip These a a -> These a a)
-> ((<::>) (Tagged ('Into ('That Maybe))) (Flip These a) a
    -> Flip These a a)
-> (<::>) (Tagged ('Into ('That Maybe))) (Flip These a) a
-> These a a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Into ('That Maybe))) (Flip These a) a
-> Flip These a a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> These a
y a
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
y

instance Morphable (Into (Here Maybe)) (Flip Wedge a) where
	type Morphing (Into (Here Maybe)) (Flip Wedge a) = Maybe
	morphing :: (<::>) (Tagged ('Into ('Here Maybe))) (Flip Wedge a) a
-> Morphing ('Into ('Here Maybe)) (Flip Wedge a) a
morphing (Flip Wedge a a -> Wedge a a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (Flip Wedge a a -> Wedge a a)
-> ((<::>) (Tagged ('Into ('Here Maybe))) (Flip Wedge a) a
    -> Flip Wedge a a)
-> (<::>) (Tagged ('Into ('Here Maybe))) (Flip Wedge a) a
-> Wedge a a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Into ('Here Maybe))) (Flip Wedge a) a
-> Flip Wedge a a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Wedge a a
Nowhere) = Morphing ('Into ('Here Maybe)) (Flip Wedge a) a
forall a. Maybe a
Nothing
	morphing (Flip Wedge a a -> Wedge a a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (Flip Wedge a a -> Wedge a a)
-> ((<::>) (Tagged ('Into ('Here Maybe))) (Flip Wedge a) a
    -> Flip Wedge a a)
-> (<::>) (Tagged ('Into ('Here Maybe))) (Flip Wedge a) a
-> Wedge a a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Into ('Here Maybe))) (Flip Wedge a) a
-> Flip Wedge a a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Here a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x
	morphing (Flip Wedge a a -> Wedge a a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (Flip Wedge a a -> Wedge a a)
-> ((<::>) (Tagged ('Into ('Here Maybe))) (Flip Wedge a) a
    -> Flip Wedge a a)
-> (<::>) (Tagged ('Into ('Here Maybe))) (Flip Wedge a) a
-> Wedge a a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Into ('Here Maybe))) (Flip Wedge a) a
-> Flip Wedge a a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> There a
_) = Morphing ('Into ('Here Maybe)) (Flip Wedge a) a
forall a. Maybe a
Nothing

instance Morphable (Into (There Maybe)) (Wedge e) where
	type Morphing (Into (There Maybe)) (Wedge e) = Maybe
	morphing :: (<::>) (Tagged ('Into ('There Maybe))) (Wedge e) a
-> Morphing ('Into ('There Maybe)) (Wedge e) a
morphing ((<::>) (Tagged ('Into ('There Maybe))) (Wedge e) a -> Wedge e a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Wedge e a
Nowhere) = Morphing ('Into ('There Maybe)) (Wedge e) a
forall a. Maybe a
Nothing
	morphing ((<::>) (Tagged ('Into ('There Maybe))) (Wedge e) a -> Wedge e a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Here e
_) = Morphing ('Into ('There Maybe)) (Wedge e) a
forall a. Maybe a
Nothing
	morphing ((<::>) (Tagged ('Into ('There Maybe))) (Wedge e) a -> Wedge e a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> There a
x) = a -> Maybe a
forall a. a -> Maybe a
Just a
x

instance Morphable (Into Wye) (Maybe <:*:> Maybe) where
	type Morphing (Into Wye) (Maybe <:*:> Maybe) = Wye
	morphing :: (<::>) (Tagged ('Into Wye)) (Maybe <:*:> Maybe) a
-> Morphing ('Into Wye) (Maybe <:*:> Maybe) a
morphing ((<:*:>) Maybe Maybe a -> Maybe a :*: Maybe a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run ((<:*:>) Maybe Maybe a -> Maybe a :*: Maybe a)
-> ((<::>) (Tagged ('Into Wye)) (Maybe <:*:> Maybe) a
    -> (<:*:>) Maybe Maybe a)
-> (<::>) (Tagged ('Into Wye)) (Maybe <:*:> Maybe) a
-> Maybe a :*: Maybe a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Into Wye)) (Maybe <:*:> Maybe) a
-> (<:*:>) Maybe Maybe a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Just a
x :*: Just a
y) = a -> a -> Wye a
forall a. a -> a -> Wye a
Both a
x a
y
	morphing ((<:*:>) Maybe Maybe a -> Maybe a :*: Maybe a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run ((<:*:>) Maybe Maybe a -> Maybe a :*: Maybe a)
-> ((<::>) (Tagged ('Into Wye)) (Maybe <:*:> Maybe) a
    -> (<:*:>) Maybe Maybe a)
-> (<::>) (Tagged ('Into Wye)) (Maybe <:*:> Maybe) a
-> Maybe a :*: Maybe a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Into Wye)) (Maybe <:*:> Maybe) a
-> (<:*:>) Maybe Maybe a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Maybe a
Nothing :*: Just a
y) = a -> Wye a
forall a. a -> Wye a
Right_ a
y
	morphing ((<:*:>) Maybe Maybe a -> Maybe a :*: Maybe a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run ((<:*:>) Maybe Maybe a -> Maybe a :*: Maybe a)
-> ((<::>) (Tagged ('Into Wye)) (Maybe <:*:> Maybe) a
    -> (<:*:>) Maybe Maybe a)
-> (<::>) (Tagged ('Into Wye)) (Maybe <:*:> Maybe) a
-> Maybe a :*: Maybe a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Into Wye)) (Maybe <:*:> Maybe) a
-> (<:*:>) Maybe Maybe a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Just a
x :*: Maybe a
Nothing) = a -> Wye a
forall a. a -> Wye a
Left_ a
x
	morphing ((<:*:>) Maybe Maybe a -> Maybe a :*: Maybe a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run ((<:*:>) Maybe Maybe a -> Maybe a :*: Maybe a)
-> ((<::>) (Tagged ('Into Wye)) (Maybe <:*:> Maybe) a
    -> (<:*:>) Maybe Maybe a)
-> (<::>) (Tagged ('Into Wye)) (Maybe <:*:> Maybe) a
-> Maybe a :*: Maybe a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (<::>) (Tagged ('Into Wye)) (Maybe <:*:> Maybe) a
-> (<:*:>) Maybe Maybe a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Maybe a
Nothing :*: Maybe a
Nothing) = Morphing ('Into Wye) (Maybe <:*:> Maybe) a
forall a. Wye a
End

instance Substructure Left_ Wye where
	type Substance Left_ Wye = Maybe
	substructure :: Lens (Substance 'Left_ Wye) ((<:.>) (Tagged 'Left_) Wye a) a
substructure = ((<:.>) (Tagged 'Left_) Wye a
 -> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a))
-> P_Q_T (->) Store Maybe ((<:.>) (Tagged 'Left_) Wye a) a
forall (p :: * -> * -> *) (q :: * -> * -> *) (t :: * -> *) a b.
p a (q (t b) a) -> P_Q_T p q t a b
P_Q_T (((<:.>) (Tagged 'Left_) Wye a
  -> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a))
 -> P_Q_T (->) Store Maybe ((<:.>) (Tagged 'Left_) Wye a) a)
-> ((<:.>) (Tagged 'Left_) Wye a
    -> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a))
-> P_Q_T (->) Store Maybe ((<:.>) (Tagged 'Left_) Wye a) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \(<:.>) (Tagged 'Left_) Wye a
new -> case (<:.>) (Tagged 'Left_) Wye a -> Wye a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Lowerable cat t, Covariant cat cat u) =>
cat (t u a) (u a)
lower (<:.>) (Tagged 'Left_) Wye a
new of
		Wye a
End -> (((:*:) (Maybe a) :. (->) (Maybe a))
 >>> (<:.>) (Tagged 'Left_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe a) :. (->) (Maybe a))
  >>> (<:.>) (Tagged 'Left_) Wye a)
 -> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a))
-> (((:*:) (Maybe a) :. (->) (Maybe a))
    >>> (<:.>) (Tagged 'Left_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- Maybe a
forall a. Maybe a
Nothing Maybe a
-> (Maybe a -> (<:.>) (Tagged 'Left_) Wye a)
-> ((:*:) (Maybe a) :. (->) (Maybe a))
   >>> (<:.>) (Tagged 'Left_) Wye a
forall s a. s -> a -> s :*: a
:*: Wye a -> (<:.>) (Tagged 'Left_) Wye a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Liftable cat t, Covariant cat cat u) =>
cat (u a) (t u a)
lift (Wye a -> (<:.>) (Tagged 'Left_) Wye a)
-> (Maybe a -> Wye a) -> Maybe a -> (<:.>) (Tagged 'Left_) Wye a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (a -> Wye a) -> Wye a -> Maybe a -> Wye a
forall a e r. Monotonic a e => (a -> r) -> r -> e -> r
resolve a -> Wye a
forall a. a -> Wye a
Left_ Wye a
forall a. Wye a
End
		Left_ a
x -> (((:*:) (Maybe a) :. (->) (Maybe a))
 >>> (<:.>) (Tagged 'Left_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe a) :. (->) (Maybe a))
  >>> (<:.>) (Tagged 'Left_) Wye a)
 -> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a))
-> (((:*:) (Maybe a) :. (->) (Maybe a))
    >>> (<:.>) (Tagged 'Left_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- a -> Maybe a
forall a. a -> Maybe a
Just a
x Maybe a
-> (Maybe a -> (<:.>) (Tagged 'Left_) Wye a)
-> ((:*:) (Maybe a) :. (->) (Maybe a))
   >>> (<:.>) (Tagged 'Left_) Wye a
forall s a. s -> a -> s :*: a
:*: Wye a -> (<:.>) (Tagged 'Left_) Wye a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Liftable cat t, Covariant cat cat u) =>
cat (u a) (t u a)
lift (Wye a -> (<:.>) (Tagged 'Left_) Wye a)
-> (Maybe a -> Wye a) -> Maybe a -> (<:.>) (Tagged 'Left_) Wye a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (a -> Wye a) -> Wye a -> Maybe a -> Wye a
forall a e r. Monotonic a e => (a -> r) -> r -> e -> r
resolve a -> Wye a
forall a. a -> Wye a
Left_ Wye a
forall a. Wye a
End
		Right_ a
y -> (((:*:) (Maybe a) :. (->) (Maybe a))
 >>> (<:.>) (Tagged 'Left_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe a) :. (->) (Maybe a))
  >>> (<:.>) (Tagged 'Left_) Wye a)
 -> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a))
-> (((:*:) (Maybe a) :. (->) (Maybe a))
    >>> (<:.>) (Tagged 'Left_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- Maybe a
forall a. Maybe a
Nothing Maybe a
-> (Maybe a -> (<:.>) (Tagged 'Left_) Wye a)
-> ((:*:) (Maybe a) :. (->) (Maybe a))
   >>> (<:.>) (Tagged 'Left_) Wye a
forall s a. s -> a -> s :*: a
:*: Wye a -> (<:.>) (Tagged 'Left_) Wye a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Liftable cat t, Covariant cat cat u) =>
cat (u a) (t u a)
lift (Wye a -> (<:.>) (Tagged 'Left_) Wye a)
-> (Maybe a -> Wye a) -> Maybe a -> (<:.>) (Tagged 'Left_) Wye a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Wye a -> Maybe a -> Wye a
forall (m :: * -> * -> *) a i. Kernel m => m a (m i a)
constant (a -> Wye a
forall a. a -> Wye a
Right_ a
y)
		Both a
x a
y -> (((:*:) (Maybe a) :. (->) (Maybe a))
 >>> (<:.>) (Tagged 'Left_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe a) :. (->) (Maybe a))
  >>> (<:.>) (Tagged 'Left_) Wye a)
 -> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a))
-> (((:*:) (Maybe a) :. (->) (Maybe a))
    >>> (<:.>) (Tagged 'Left_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Left_) Wye a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- a -> Maybe a
forall a. a -> Maybe a
Just a
x Maybe a
-> (Maybe a -> (<:.>) (Tagged 'Left_) Wye a)
-> ((:*:) (Maybe a) :. (->) (Maybe a))
   >>> (<:.>) (Tagged 'Left_) Wye a
forall s a. s -> a -> s :*: a
:*: Wye a -> (<:.>) (Tagged 'Left_) Wye a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Liftable cat t, Covariant cat cat u) =>
cat (u a) (t u a)
lift (Wye a -> (<:.>) (Tagged 'Left_) Wye a)
-> (Maybe a -> Wye a) -> Maybe a -> (<:.>) (Tagged 'Left_) Wye a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (a -> Wye a) -> Wye a -> Maybe a -> Wye a
forall a e r. Monotonic a e => (a -> r) -> r -> e -> r
resolve (a -> a -> Wye a
forall a. a -> a -> Wye a
Both (a -> a -> Wye a) -> a -> a -> Wye a
forall a b c. (a -> b -> c) -> b -> a -> c
% a
y) (a -> Wye a
forall a. a -> Wye a
Right_ a
y)

instance Substructure Right_ Wye where
	type Substance Right_ Wye = Maybe
	substructure :: Lens (Substance 'Right_ Wye) ((<:.>) (Tagged 'Right_) Wye a) a
substructure = ((<:.>) (Tagged 'Right_) Wye a
 -> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a))
-> P_Q_T (->) Store Maybe ((<:.>) (Tagged 'Right_) Wye a) a
forall (p :: * -> * -> *) (q :: * -> * -> *) (t :: * -> *) a b.
p a (q (t b) a) -> P_Q_T p q t a b
P_Q_T (((<:.>) (Tagged 'Right_) Wye a
  -> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a))
 -> P_Q_T (->) Store Maybe ((<:.>) (Tagged 'Right_) Wye a) a)
-> ((<:.>) (Tagged 'Right_) Wye a
    -> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a))
-> P_Q_T (->) Store Maybe ((<:.>) (Tagged 'Right_) Wye a) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \(<:.>) (Tagged 'Right_) Wye a
new -> case (<:.>) (Tagged 'Right_) Wye a -> Wye a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Lowerable cat t, Covariant cat cat u) =>
cat (t u a) (u a)
lower (<:.>) (Tagged 'Right_) Wye a
new of
		Wye a
End -> (((:*:) (Maybe a) :. (->) (Maybe a))
 >>> (<:.>) (Tagged 'Right_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe a) :. (->) (Maybe a))
  >>> (<:.>) (Tagged 'Right_) Wye a)
 -> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a))
-> (((:*:) (Maybe a) :. (->) (Maybe a))
    >>> (<:.>) (Tagged 'Right_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- Maybe a
forall a. Maybe a
Nothing Maybe a
-> (Maybe a -> (<:.>) (Tagged 'Right_) Wye a)
-> ((:*:) (Maybe a) :. (->) (Maybe a))
   >>> (<:.>) (Tagged 'Right_) Wye a
forall s a. s -> a -> s :*: a
:*: Wye a -> (<:.>) (Tagged 'Right_) Wye a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Liftable cat t, Covariant cat cat u) =>
cat (u a) (t u a)
lift (Wye a -> (<:.>) (Tagged 'Right_) Wye a)
-> (Maybe a -> Wye a) -> Maybe a -> (<:.>) (Tagged 'Right_) Wye a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (a -> Wye a) -> Wye a -> Maybe a -> Wye a
forall a e r. Monotonic a e => (a -> r) -> r -> e -> r
resolve a -> Wye a
forall a. a -> Wye a
Right_ Wye a
forall a. Wye a
End
		Left_ a
x -> (((:*:) (Maybe a) :. (->) (Maybe a))
 >>> (<:.>) (Tagged 'Right_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe a) :. (->) (Maybe a))
  >>> (<:.>) (Tagged 'Right_) Wye a)
 -> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a))
-> (((:*:) (Maybe a) :. (->) (Maybe a))
    >>> (<:.>) (Tagged 'Right_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- Maybe a
forall a. Maybe a
Nothing Maybe a
-> (Maybe a -> (<:.>) (Tagged 'Right_) Wye a)
-> ((:*:) (Maybe a) :. (->) (Maybe a))
   >>> (<:.>) (Tagged 'Right_) Wye a
forall s a. s -> a -> s :*: a
:*: Wye a -> (<:.>) (Tagged 'Right_) Wye a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Liftable cat t, Covariant cat cat u) =>
cat (u a) (t u a)
lift (Wye a -> (<:.>) (Tagged 'Right_) Wye a)
-> (Maybe a -> Wye a) -> Maybe a -> (<:.>) (Tagged 'Right_) Wye a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Wye a -> Maybe a -> Wye a
forall (m :: * -> * -> *) a i. Kernel m => m a (m i a)
constant (a -> Wye a
forall a. a -> Wye a
Left_ a
x)
		Right_ a
y -> (((:*:) (Maybe a) :. (->) (Maybe a))
 >>> (<:.>) (Tagged 'Right_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe a) :. (->) (Maybe a))
  >>> (<:.>) (Tagged 'Right_) Wye a)
 -> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a))
-> (((:*:) (Maybe a) :. (->) (Maybe a))
    >>> (<:.>) (Tagged 'Right_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- a -> Maybe a
forall a. a -> Maybe a
Just a
y Maybe a
-> (Maybe a -> (<:.>) (Tagged 'Right_) Wye a)
-> ((:*:) (Maybe a) :. (->) (Maybe a))
   >>> (<:.>) (Tagged 'Right_) Wye a
forall s a. s -> a -> s :*: a
:*: Wye a -> (<:.>) (Tagged 'Right_) Wye a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Liftable cat t, Covariant cat cat u) =>
cat (u a) (t u a)
lift (Wye a -> (<:.>) (Tagged 'Right_) Wye a)
-> (Maybe a -> Wye a) -> Maybe a -> (<:.>) (Tagged 'Right_) Wye a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (a -> Wye a) -> Wye a -> Maybe a -> Wye a
forall a e r. Monotonic a e => (a -> r) -> r -> e -> r
resolve a -> Wye a
forall a. a -> Wye a
Right_ Wye a
forall a. Wye a
End
		Both a
x a
y -> (((:*:) (Maybe a) :. (->) (Maybe a))
 >>> (<:.>) (Tagged 'Right_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe a) :. (->) (Maybe a))
  >>> (<:.>) (Tagged 'Right_) Wye a)
 -> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a))
-> (((:*:) (Maybe a) :. (->) (Maybe a))
    >>> (<:.>) (Tagged 'Right_) Wye a)
-> Store (Maybe a) ((<:.>) (Tagged 'Right_) Wye a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- a -> Maybe a
forall a. a -> Maybe a
Just a
y Maybe a
-> (Maybe a -> (<:.>) (Tagged 'Right_) Wye a)
-> ((:*:) (Maybe a) :. (->) (Maybe a))
   >>> (<:.>) (Tagged 'Right_) Wye a
forall s a. s -> a -> s :*: a
:*: Wye a -> (<:.>) (Tagged 'Right_) Wye a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Liftable cat t, Covariant cat cat u) =>
cat (u a) (t u a)
lift (Wye a -> (<:.>) (Tagged 'Right_) Wye a)
-> (Maybe a -> Wye a) -> Maybe a -> (<:.>) (Tagged 'Right_) Wye a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (a -> Wye a) -> Wye a -> Maybe a -> Wye a
forall a e r. Monotonic a e => (a -> r) -> r -> e -> r
resolve (a -> a -> Wye a
forall a. a -> a -> Wye a
Both a
x) (a -> Wye a
forall a. a -> Wye a
Left_ a
x)

instance (Covariant (->) (->) t) => Substructure Rest (Tap t) where
	type Substance Rest (Tap t) = t
	substructure :: Lens (Substance 'Rest (Tap t)) ((<:.>) (Tagged 'Rest) (Tap t) a) a
substructure = ((<:.>) (Tagged 'Rest) (Tap t) a
 -> Store (t a) ((<:.>) (Tagged 'Rest) (Tap t) a))
-> P_Q_T (->) Store t ((<:.>) (Tagged 'Rest) (Tap t) a) a
forall (p :: * -> * -> *) (q :: * -> * -> *) (t :: * -> *) a b.
p a (q (t b) a) -> P_Q_T p q t a b
P_Q_T (((<:.>) (Tagged 'Rest) (Tap t) a
  -> Store (t a) ((<:.>) (Tagged 'Rest) (Tap t) a))
 -> P_Q_T (->) Store t ((<:.>) (Tagged 'Rest) (Tap t) a) a)
-> ((<:.>) (Tagged 'Rest) (Tap t) a
    -> Store (t a) ((<:.>) (Tagged 'Rest) (Tap t) a))
-> P_Q_T (->) Store t ((<:.>) (Tagged 'Rest) (Tap t) a) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \(<:.>) (Tagged 'Rest) (Tap t) a
tap -> case Tagged 'Rest (Tap t a) -> Tap t a
forall (t :: * -> *) a. Extractable t => t a -> a
extract (Tagged 'Rest (Tap t a) -> Tap t a)
-> Tagged 'Rest (Tap t a) -> Tap t a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- (<:.>) (Tagged 'Rest) (Tap t) a -> Tagged 'Rest (Tap t a)
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (<:.>) (Tagged 'Rest) (Tap t) a
tap of
		Tap a
x t a
xs -> (((:*:) (t a) :. (->) (t a)) >>> (<:.>) (Tagged 'Rest) (Tap t) a)
-> Store (t a) ((<:.>) (Tagged 'Rest) (Tap t) a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (t a) :. (->) (t a)) >>> (<:.>) (Tagged 'Rest) (Tap t) a)
 -> Store (t a) ((<:.>) (Tagged 'Rest) (Tap t) a))
-> (((:*:) (t a) :. (->) (t a))
    >>> (<:.>) (Tagged 'Rest) (Tap t) a)
-> Store (t a) ((<:.>) (Tagged 'Rest) (Tap t) a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- t a
xs t a
-> (t a -> (<:.>) (Tagged 'Rest) (Tap t) a)
-> ((:*:) (t a) :. (->) (t a)) >>> (<:.>) (Tagged 'Rest) (Tap t) a
forall s a. s -> a -> s :*: a
:*: Tap t a -> (<:.>) (Tagged 'Rest) (Tap t) a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Liftable cat t, Covariant cat cat u) =>
cat (u a) (t u a)
lift (Tap t a -> (<:.>) (Tagged 'Rest) (Tap t) a)
-> (t a -> Tap t a) -> t a -> (<:.>) (Tagged 'Rest) (Tap t) a
forall (m :: * -> * -> *) b c a.
Semigroupoid 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 (Into (Preorder (Construction Maybe))) (Construction Wye) where
	type Morphing (Into (Preorder (Construction Maybe))) (Construction Wye) = Construction Maybe
	morphing :: (<::>)
  (Tagged ('Into ('Preorder (Construction Maybe))))
  (Construction Wye)
  a
-> Morphing
     ('Into ('Preorder (Construction Maybe))) (Construction Wye) a
morphing (<::>)
  (Tagged ('Into ('Preorder (Construction Maybe))))
  (Construction Wye)
  a
nonempty_binary = case (<::>)
  (Tagged ('Into ('Preorder (Construction Maybe))))
  (Construction Wye)
  a
-> Construction Wye a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph (<::>)
  (Tagged ('Into ('Preorder (Construction Maybe))))
  (Construction Wye)
  a
nonempty_binary of
		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
		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.
Semigroupoid 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 (m a b) (m a b)
<-- Construction Wye a
-> Morphing
     ('Into ('Preorder (Nonempty List))) (Construction Wye) a
forall a (mod :: a) (struct :: * -> *).
Morphable ('Into mod) struct =>
struct ~> Morphing ('Into mod) struct
into @(Preorder (Nonempty List)) Construction Wye a
lst
		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.
Semigroupoid 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 (m a b) (m a b)
<-- Construction Wye a
-> Morphing
     ('Into ('Preorder (Nonempty List))) (Construction Wye) a
forall a (mod :: a) (struct :: * -> *).
Morphable ('Into mod) struct =>
struct ~> Morphing ('Into mod) struct
into @(Preorder (Nonempty List)) Construction Wye a
rst
		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.
Semigroupoid 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 (m a b) (m a b)
<-- Construction Wye a
-> Morphing
     ('Into ('Preorder (Nonempty List))) (Construction Wye) a
forall a (mod :: a) (struct :: * -> *).
Morphable ('Into mod) struct =>
struct ~> Morphing ('Into mod) struct
into @(Preorder (Nonempty List)) Construction Wye a
lst Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ Construction Wye a
-> Morphing
     ('Into ('Preorder (Nonempty List))) (Construction Wye) a
forall a (mod :: a) (struct :: * -> *).
Morphable ('Into mod) struct =>
struct ~> Morphing ('Into mod) struct
into @(Preorder (Nonempty List)) Construction Wye a
rst

instance Morphable (Into (Inorder (Construction Maybe))) (Construction Wye) where
	type Morphing (Into (Inorder (Construction Maybe))) (Construction Wye) = Construction Maybe
	morphing :: (<::>)
  (Tagged ('Into ('Inorder (Construction Maybe))))
  (Construction Wye)
  a
-> Morphing
     ('Into ('Inorder (Construction Maybe))) (Construction Wye) a
morphing (<::>)
  (Tagged ('Into ('Inorder (Construction Maybe))))
  (Construction Wye)
  a
nonempty_binary = case (<::>)
  (Tagged ('Into ('Inorder (Construction Maybe))))
  (Construction Wye)
  a
-> Construction Wye a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph (<::>)
  (Tagged ('Into ('Inorder (Construction Maybe))))
  (Construction Wye)
  a
nonempty_binary of
		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
		Construct a
x (Left_ Construction Wye a
lst) -> Construction Wye a
-> Morphing ('Into ('Inorder (Nonempty List))) (Construction Wye) a
forall a (mod :: a) (struct :: * -> *).
Morphable ('Into mod) struct =>
struct ~> Morphing ('Into mod) struct
into @(Inorder (Nonempty List)) Construction Wye a
lst Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ 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
		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
forall a. Maybe a
Nothing Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ Construction Wye a
-> Morphing ('Into ('Inorder (Nonempty List))) (Construction Wye) a
forall a (mod :: a) (struct :: * -> *).
Morphable ('Into mod) struct =>
struct ~> Morphing ('Into mod) struct
into @(Inorder (Nonempty List)) Construction Wye a
rst
		Construct a
x (Both Construction Wye a
lst Construction Wye a
rst) -> Construction Wye a
-> Morphing ('Into ('Inorder (Nonempty List))) (Construction Wye) a
forall a (mod :: a) (struct :: * -> *).
Morphable ('Into mod) struct =>
struct ~> Morphing ('Into mod) struct
into @(Inorder (Nonempty List)) Construction Wye a
lst Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ 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 Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ Construction Wye a
-> Morphing ('Into ('Inorder (Nonempty List))) (Construction Wye) a
forall a (mod :: a) (struct :: * -> *).
Morphable ('Into mod) struct =>
struct ~> Morphing ('Into mod) struct
into @(Inorder (Nonempty List)) Construction Wye a
rst

instance Morphable (Into (Postorder (Construction Maybe))) (Construction Wye) where
	type Morphing (Into (Postorder (Construction Maybe))) (Construction Wye) = Construction Maybe
	morphing :: (<::>)
  (Tagged ('Into ('Postorder (Construction Maybe))))
  (Construction Wye)
  a
-> Morphing
     ('Into ('Postorder (Construction Maybe))) (Construction Wye) a
morphing (<::>)
  (Tagged ('Into ('Postorder (Construction Maybe))))
  (Construction Wye)
  a
nonempty_binary = case (<::>)
  (Tagged ('Into ('Postorder (Construction Maybe))))
  (Construction Wye)
  a
-> Construction Wye a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph (<::>)
  (Tagged ('Into ('Postorder (Construction Maybe))))
  (Construction Wye)
  a
nonempty_binary of
		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
		Construct a
x (Left_ Construction Wye a
lst) -> Construction Wye a
-> Morphing
     ('Into ('Postorder (Nonempty List))) (Construction Wye) a
forall a (mod :: a) (struct :: * -> *).
Morphable ('Into mod) struct =>
struct ~> Morphing ('Into mod) struct
into @(Postorder (Nonempty List)) Construction Wye a
lst Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ 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
		Construct a
x (Right_ Construction Wye a
rst) -> Construction Wye a
-> Morphing
     ('Into ('Postorder (Nonempty List))) (Construction Wye) a
forall a (mod :: a) (struct :: * -> *).
Morphable ('Into mod) struct =>
struct ~> Morphing ('Into mod) struct
into @(Postorder (Nonempty List)) Construction Wye a
rst Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ 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
		Construct a
x (Both Construction Wye a
lst Construction Wye a
rst) -> Construction Wye a
-> Morphing
     ('Into ('Postorder (Nonempty List))) (Construction Wye) a
forall a (mod :: a) (struct :: * -> *).
Morphable ('Into mod) struct =>
struct ~> Morphing ('Into mod) struct
into @(Postorder (Nonempty List)) Construction Wye a
lst Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ Construction Wye a
-> Morphing
     ('Into ('Postorder (Nonempty List))) (Construction Wye) a
forall a (mod :: a) (struct :: * -> *).
Morphable ('Into mod) struct =>
struct ~> Morphing ('Into mod) struct
into @(Postorder (Nonempty List)) Construction Wye a
rst Construction Maybe a
-> Construction Maybe a -> Construction Maybe a
forall a. Semigroup a => a -> a -> a
+ 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

-- instance Morphable (Into (o ds)) (Construction Wye) => Morphable (Into (o ds)) Binary where
	-- type Morphing (Into (o ds)) Binary = Maybe <:.> Morphing (Into (o ds)) (Construction Wye)
	-- morphing (premorph -> xs) = (into @(o ds) <-|-) =#- xs

instance Substructure Left_ (Flip (:*:) a) where
	type Substance Left_ (Flip (:*:) a) = Exactly
	substructure :: Lens
  (Substance 'Left_ (Flip (:*:) a))
  ((<:.>) (Tagged 'Left_) (Flip (:*:) a) a)
  a
substructure = ((<:.>) (Tagged 'Left_) (Flip (:*:) a) a
 -> Store (Exactly a) ((<:.>) (Tagged 'Left_) (Flip (:*:) a) a))
-> P_Q_T
     (->) Store Exactly ((<:.>) (Tagged 'Left_) (Flip (:*:) a) a) a
forall (p :: * -> * -> *) (q :: * -> * -> *) (t :: * -> *) a b.
p a (q (t b) a) -> P_Q_T p q t a b
P_Q_T (((<:.>) (Tagged 'Left_) (Flip (:*:) a) a
  -> Store (Exactly a) ((<:.>) (Tagged 'Left_) (Flip (:*:) a) a))
 -> P_Q_T
      (->) Store Exactly ((<:.>) (Tagged 'Left_) (Flip (:*:) a) a) a)
-> ((<:.>) (Tagged 'Left_) (Flip (:*:) a) a
    -> Store (Exactly a) ((<:.>) (Tagged 'Left_) (Flip (:*:) a) a))
-> P_Q_T
     (->) Store Exactly ((<:.>) (Tagged 'Left_) (Flip (:*:) a) a) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \(<:.>) (Tagged 'Left_) (Flip (:*:) a) a
product -> case Flip (:*:) a a -> a :*: a
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (Flip (:*:) a a -> a :*: a) -> Flip (:*:) a a -> a :*: a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- (<:.>) (Tagged 'Left_) (Flip (:*:) a) a -> Flip (:*:) a a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Lowerable cat t, Covariant cat cat u) =>
cat (t u a) (u a)
lower (<:.>) (Tagged 'Left_) (Flip (:*:) a) a
product of
		a
s :*: a
x -> (((:*:) (Exactly a) :. (->) (Exactly a))
 >>> (<:.>) (Tagged 'Left_) (Flip (:*:) a) a)
-> Store (Exactly a) ((<:.>) (Tagged 'Left_) (Flip (:*:) a) a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Exactly a) :. (->) (Exactly a))
  >>> (<:.>) (Tagged 'Left_) (Flip (:*:) a) a)
 -> Store (Exactly a) ((<:.>) (Tagged 'Left_) (Flip (:*:) a) a))
-> (((:*:) (Exactly a) :. (->) (Exactly a))
    >>> (<:.>) (Tagged 'Left_) (Flip (:*:) a) a)
-> Store (Exactly a) ((<:.>) (Tagged 'Left_) (Flip (:*:) a) a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- a -> Exactly a
forall a. a -> Exactly a
Exactly a
s Exactly a
-> (Exactly a -> (<:.>) (Tagged 'Left_) (Flip (:*:) a) a)
-> ((:*:) (Exactly a) :. (->) (Exactly a))
   >>> (<:.>) (Tagged 'Left_) (Flip (:*:) a) a
forall s a. s -> a -> s :*: a
:*: Flip (:*:) a a -> (<:.>) (Tagged 'Left_) (Flip (:*:) a) a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Liftable cat t, Covariant cat cat u) =>
cat (u a) (t u a)
lift (Flip (:*:) a a -> (<:.>) (Tagged 'Left_) (Flip (:*:) a) a)
-> (Exactly a -> Flip (:*:) a a)
-> Exactly a
-> (<:.>) (Tagged 'Left_) (Flip (:*:) a) a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (a :*: a) -> Flip (:*:) a a
forall (v :: * -> * -> *) a e. v e a -> Flip v a e
Flip ((a :*: a) -> Flip (:*:) a a)
-> (Exactly a -> a :*: a) -> Exactly a -> Flip (:*:) a a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (a -> a -> a :*: a
forall s a. s -> a -> s :*: a
:*: a
x) (a -> a :*: a) -> (Exactly a -> a) -> Exactly a -> a :*: a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Exactly a -> a
forall (t :: * -> *) a. Extractable t => t a -> a
extract

instance Substructure Right_ ((:*:) s) where
	type Substance Right_ ((:*:) s) = Exactly
	substructure :: Lens
  (Substance 'Right_ ((:*:) s))
  ((<:.>) (Tagged 'Right_) ((:*:) s) a)
  a
substructure = ((<:.>) (Tagged 'Right_) ((:*:) s) a
 -> Store (Exactly a) ((<:.>) (Tagged 'Right_) ((:*:) s) a))
-> P_Q_T (->) Store Exactly ((<:.>) (Tagged 'Right_) ((:*:) s) a) a
forall (p :: * -> * -> *) (q :: * -> * -> *) (t :: * -> *) a b.
p a (q (t b) a) -> P_Q_T p q t a b
P_Q_T (((<:.>) (Tagged 'Right_) ((:*:) s) a
  -> Store (Exactly a) ((<:.>) (Tagged 'Right_) ((:*:) s) a))
 -> P_Q_T
      (->) Store Exactly ((<:.>) (Tagged 'Right_) ((:*:) s) a) a)
-> ((<:.>) (Tagged 'Right_) ((:*:) s) a
    -> Store (Exactly a) ((<:.>) (Tagged 'Right_) ((:*:) s) a))
-> P_Q_T (->) Store Exactly ((<:.>) (Tagged 'Right_) ((:*:) s) a) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \(<:.>) (Tagged 'Right_) ((:*:) s) a
product -> case (<:.>) (Tagged 'Right_) ((:*:) s) a -> s :*: a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Lowerable cat t, Covariant cat cat u) =>
cat (t u a) (u a)
lower (<:.>) (Tagged 'Right_) ((:*:) s) a
product of
		s
s :*: a
x -> (((:*:) (Exactly a) :. (->) (Exactly a))
 >>> (<:.>) (Tagged 'Right_) ((:*:) s) a)
-> Store (Exactly a) ((<:.>) (Tagged 'Right_) ((:*:) s) a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Exactly a) :. (->) (Exactly a))
  >>> (<:.>) (Tagged 'Right_) ((:*:) s) a)
 -> Store (Exactly a) ((<:.>) (Tagged 'Right_) ((:*:) s) a))
-> (((:*:) (Exactly a) :. (->) (Exactly a))
    >>> (<:.>) (Tagged 'Right_) ((:*:) s) a)
-> Store (Exactly a) ((<:.>) (Tagged 'Right_) ((:*:) s) a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- a -> Exactly a
forall a. a -> Exactly a
Exactly a
x Exactly a
-> (Exactly a -> (<:.>) (Tagged 'Right_) ((:*:) s) a)
-> ((:*:) (Exactly a) :. (->) (Exactly a))
   >>> (<:.>) (Tagged 'Right_) ((:*:) s) a
forall s a. s -> a -> s :*: a
:*: (s :*: a) -> (<:.>) (Tagged 'Right_) ((:*:) s) a
forall (cat :: * -> * -> *) (t :: (* -> *) -> * -> *) (u :: * -> *)
       a.
(Liftable cat t, Covariant cat cat u) =>
cat (u a) (t u a)
lift ((s :*: a) -> (<:.>) (Tagged 'Right_) ((:*:) s) a)
-> (Exactly a -> s :*: a)
-> Exactly a
-> (<:.>) (Tagged 'Right_) ((:*:) s) a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. (s
s s -> a -> s :*: a
forall s a. s -> a -> s :*: a
:*:) (a -> s :*: a) -> (Exactly a -> a) -> Exactly a -> s :*: a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Exactly a -> a
forall (t :: * -> *) a. Extractable t => t a -> a
extract

instance Accessible s (s :*: a) where
	access :: Lens Exactly (s :*: a) s
access = ((s :*: a) -> Store (Exactly s) (s :*: a))
-> Lens Exactly (s :*: a) s
forall (p :: * -> * -> *) (q :: * -> * -> *) (t :: * -> *) a b.
p a (q (t b) a) -> P_Q_T p q t a b
P_Q_T (((s :*: a) -> Store (Exactly s) (s :*: a))
 -> Lens Exactly (s :*: a) s)
-> ((s :*: a) -> Store (Exactly s) (s :*: a))
-> Lens Exactly (s :*: a) s
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \(s
s :*: a
x) -> (((:*:) (Exactly s) :. (->) (Exactly s)) >>> (s :*: a))
-> Store (Exactly s) (s :*: a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Exactly s) :. (->) (Exactly s)) >>> (s :*: a))
 -> Store (Exactly s) (s :*: a))
-> (((:*:) (Exactly s) :. (->) (Exactly s)) >>> (s :*: a))
-> Store (Exactly s) (s :*: a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- s -> Exactly s
forall a. a -> Exactly a
Exactly s
s Exactly s
-> (Exactly s -> s :*: a)
-> ((:*:) (Exactly s) :. (->) (Exactly s)) >>> (s :*: a)
forall s a. s -> a -> s :*: a
:*: (s -> a -> s :*: a
forall s a. s -> a -> s :*: a
:*: a
x) (s -> s :*: a) -> (Exactly s -> s) -> Exactly s -> s :*: a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Exactly s -> s
forall (t :: * -> *) a. Extractable t => t a -> a
extract

instance Accessible a (s :*: a) where
	access :: Lens Exactly (s :*: a) a
access = ((s :*: a) -> Store (Exactly a) (s :*: a))
-> Lens Exactly (s :*: a) a
forall (p :: * -> * -> *) (q :: * -> * -> *) (t :: * -> *) a b.
p a (q (t b) a) -> P_Q_T p q t a b
P_Q_T (((s :*: a) -> Store (Exactly a) (s :*: a))
 -> Lens Exactly (s :*: a) a)
-> ((s :*: a) -> Store (Exactly a) (s :*: a))
-> Lens Exactly (s :*: a) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \(s
s :*: a
x) -> (((:*:) (Exactly a) :. (->) (Exactly a)) >>> (s :*: a))
-> Store (Exactly a) (s :*: a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Exactly a) :. (->) (Exactly a)) >>> (s :*: a))
 -> Store (Exactly a) (s :*: a))
-> (((:*:) (Exactly a) :. (->) (Exactly a)) >>> (s :*: a))
-> Store (Exactly a) (s :*: a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- a -> Exactly a
forall a. a -> Exactly a
Exactly a
x Exactly a
-> (Exactly a -> s :*: a)
-> ((:*:) (Exactly a) :. (->) (Exactly a)) >>> (s :*: a)
forall s a. s -> a -> s :*: a
:*: (s
s s -> a -> s :*: a
forall s a. s -> a -> s :*: a
:*:) (a -> s :*: a) -> (Exactly a -> a) -> Exactly a -> s :*: a
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Exactly a -> a
forall (t :: * -> *) a. Extractable t => t a -> a
extract

instance {-# OVERLAPS #-} Accessible b a => Accessible b (s :*: a) where
	access :: Lens Exactly (s :*: a) b
access = forall source. Accessible b source => Lens Exactly source b
forall target source.
Accessible target source =>
Lens Exactly source target
access @b Lens Exactly a b
-> P_Q_T (->) Store Exactly (s :*: a) a -> Lens Exactly (s :*: a) b
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. forall source. Accessible a source => Lens Exactly source a
forall target source.
Accessible target source =>
Lens Exactly source target
access @a

-- TODO: Causes overlapping instances error when target is (a :*: b), it's better to use some wrapper instead
-- instance {-# OVERLAPS #-} (Accessible a s, Accessible b s) => Accessible (a :*: b) s where
	-- access = mult @(-->) @(:*:) @(:*:) <~ (access @a :*: access @b)

instance Accessible a (Exactly a) where
	access :: Lens Exactly (Exactly a) a
access = (Exactly a -> Store (Exactly a) (Exactly a))
-> Lens Exactly (Exactly a) a
forall (p :: * -> * -> *) (q :: * -> * -> *) (t :: * -> *) a b.
p a (q (t b) a) -> P_Q_T p q t a b
P_Q_T ((Exactly a -> Store (Exactly a) (Exactly a))
 -> Lens Exactly (Exactly a) a)
-> (Exactly a -> Store (Exactly a) (Exactly a))
-> Lens Exactly (Exactly a) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \(Exactly a
x) -> (((:*:) (Exactly a) :. (->) (Exactly a)) >>> Exactly a)
-> Store (Exactly a) (Exactly a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Exactly a) :. (->) (Exactly a)) >>> Exactly a)
 -> Store (Exactly a) (Exactly a))
-> (((:*:) (Exactly a) :. (->) (Exactly a)) >>> Exactly a)
-> Store (Exactly a) (Exactly a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- a -> Exactly a
forall a. a -> Exactly a
Exactly a
x Exactly a
-> (Exactly a -> Exactly a)
-> ((:*:) (Exactly a) :. (->) (Exactly a)) >>> Exactly a
forall s a. s -> a -> s :*: a
:*: Exactly a -> Exactly a
forall (m :: * -> * -> *) a. Category m => m a a
identity

instance Possible a (Maybe a) where
	perhaps :: Lens Maybe (Maybe a) a
perhaps = (Maybe a -> Store (Maybe a) (Maybe a)) -> Lens Maybe (Maybe a) a
forall (p :: * -> * -> *) (q :: * -> * -> *) (t :: * -> *) a b.
p a (q (t b) a) -> P_Q_T p q t a b
P_Q_T ((Maybe a -> Store (Maybe a) (Maybe a)) -> Lens Maybe (Maybe a) a)
-> (Maybe a -> Store (Maybe a) (Maybe a)) -> Lens Maybe (Maybe a) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \Maybe a
x -> (((:*:) (Maybe a) :. (->) (Maybe a)) >>> Maybe a)
-> Store (Maybe a) (Maybe a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe a) :. (->) (Maybe a)) >>> Maybe a)
 -> Store (Maybe a) (Maybe a))
-> (((:*:) (Maybe a) :. (->) (Maybe a)) >>> Maybe a)
-> Store (Maybe a) (Maybe a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- Maybe a
x Maybe a
-> (Maybe a -> Maybe a)
-> ((:*:) (Maybe a) :. (->) (Maybe a)) >>> Maybe a
forall s a. s -> a -> s :*: a
:*: Maybe a -> Maybe a
forall (m :: * -> * -> *) a. Category m => m a a
identity

instance {-# OVERLAPS #-} Possible a (o :+: a) where
	perhaps :: Lens Maybe (o :+: a) a
perhaps = ((o :+: a) -> Store (Maybe a) (o :+: a)) -> Lens Maybe (o :+: a) a
forall (p :: * -> * -> *) (q :: * -> * -> *) (t :: * -> *) a b.
p a (q (t b) a) -> P_Q_T p q t a b
P_Q_T (((o :+: a) -> Store (Maybe a) (o :+: a))
 -> Lens Maybe (o :+: a) a)
-> ((o :+: a) -> Store (Maybe a) (o :+: a))
-> Lens Maybe (o :+: a) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \case
		Option o
s -> (((:*:) (Maybe a) :. (->) (Maybe a)) >>> (o :+: a))
-> Store (Maybe a) (o :+: a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe a) :. (->) (Maybe a)) >>> (o :+: a))
 -> Store (Maybe a) (o :+: a))
-> (((:*:) (Maybe a) :. (->) (Maybe a)) >>> (o :+: a))
-> Store (Maybe a) (o :+: a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- Maybe a
forall a. Maybe a
Nothing Maybe a
-> (Maybe a -> o :+: a)
-> ((:*:) (Maybe a) :. (->) (Maybe a)) >>> (o :+: a)
forall s a. s -> a -> s :*: a
:*: (forall r. Monotonic a (Maybe a) => (a -> r) -> r -> Maybe a -> r
forall a e r. Monotonic a e => (a -> r) -> r -> e -> r
resolve @a @(Maybe a) ((a -> o :+: a) -> (o :+: a) -> Maybe a -> o :+: a)
-> (a -> o :+: a) -> (o :+: a) -> Maybe a -> o :+: a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a -> o :+: a
forall o a. a -> o :+: a
Adoption ((o :+: a) -> Maybe a -> o :+: a)
-> (o :+: a) -> Maybe a -> o :+: a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- o -> o :+: a
forall o a. o -> o :+: a
Option o
s)
		Adoption a
x -> (((:*:) (Maybe a) :. (->) (Maybe a)) >>> (o :+: a))
-> Store (Maybe a) (o :+: a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe a) :. (->) (Maybe a)) >>> (o :+: a))
 -> Store (Maybe a) (o :+: a))
-> (((:*:) (Maybe a) :. (->) (Maybe a)) >>> (o :+: a))
-> Store (Maybe a) (o :+: a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- a -> Maybe a
forall a. a -> Maybe a
Just a
x Maybe a
-> (Maybe a -> o :+: a)
-> ((:*:) (Maybe a) :. (->) (Maybe a)) >>> (o :+: a)
forall s a. s -> a -> s :*: a
:*: (forall r. Monotonic a (Maybe a) => (a -> r) -> r -> Maybe a -> r
forall a e r. Monotonic a e => (a -> r) -> r -> e -> r
resolve @a @(Maybe a) ((a -> o :+: a) -> (o :+: a) -> Maybe a -> o :+: a)
-> (a -> o :+: a) -> (o :+: a) -> Maybe a -> o :+: a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a -> o :+: a
forall o a. a -> o :+: a
Adoption ((o :+: a) -> Maybe a -> o :+: a)
-> (o :+: a) -> Maybe a -> o :+: a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a -> o :+: a
forall o a. a -> o :+: a
Adoption a
x)

instance {-# OVERLAPS #-} Possible o (o :+: a) where
	perhaps :: Lens Maybe (o :+: a) o
perhaps = ((o :+: a) -> Store (Maybe o) (o :+: a)) -> Lens Maybe (o :+: a) o
forall (p :: * -> * -> *) (q :: * -> * -> *) (t :: * -> *) a b.
p a (q (t b) a) -> P_Q_T p q t a b
P_Q_T (((o :+: a) -> Store (Maybe o) (o :+: a))
 -> Lens Maybe (o :+: a) o)
-> ((o :+: a) -> Store (Maybe o) (o :+: a))
-> Lens Maybe (o :+: a) o
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \case
		Option o
s -> (((:*:) (Maybe o) :. (->) (Maybe o)) >>> (o :+: a))
-> Store (Maybe o) (o :+: a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe o) :. (->) (Maybe o)) >>> (o :+: a))
 -> Store (Maybe o) (o :+: a))
-> (((:*:) (Maybe o) :. (->) (Maybe o)) >>> (o :+: a))
-> Store (Maybe o) (o :+: a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- o -> Maybe o
forall a. a -> Maybe a
Just o
s Maybe o
-> (Maybe o -> o :+: a)
-> ((:*:) (Maybe o) :. (->) (Maybe o)) >>> (o :+: a)
forall s a. s -> a -> s :*: a
:*: (forall r. Monotonic o (Maybe o) => (o -> r) -> r -> Maybe o -> r
forall a e r. Monotonic a e => (a -> r) -> r -> e -> r
resolve @o @(Maybe o) ((o -> o :+: a) -> (o :+: a) -> Maybe o -> o :+: a)
-> (o -> o :+: a) -> (o :+: a) -> Maybe o -> o :+: a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- o -> o :+: a
forall o a. o -> o :+: a
Option ((o :+: a) -> Maybe o -> o :+: a)
-> (o :+: a) -> Maybe o -> o :+: a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- o -> o :+: a
forall o a. o -> o :+: a
Option o
s)
		Adoption a
x -> (((:*:) (Maybe o) :. (->) (Maybe o)) >>> (o :+: a))
-> Store (Maybe o) (o :+: a)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe o) :. (->) (Maybe o)) >>> (o :+: a))
 -> Store (Maybe o) (o :+: a))
-> (((:*:) (Maybe o) :. (->) (Maybe o)) >>> (o :+: a))
-> Store (Maybe o) (o :+: a)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- Maybe o
forall a. Maybe a
Nothing Maybe o
-> (Maybe o -> o :+: a)
-> ((:*:) (Maybe o) :. (->) (Maybe o)) >>> (o :+: a)
forall s a. s -> a -> s :*: a
:*: (forall r. Monotonic o (Maybe o) => (o -> r) -> r -> Maybe o -> r
forall a e r. Monotonic a e => (a -> r) -> r -> e -> r
resolve @o @(Maybe o) ((o -> o :+: a) -> (o :+: a) -> Maybe o -> o :+: a)
-> (o -> o :+: a) -> (o :+: a) -> Maybe o -> o :+: a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- o -> o :+: a
forall o a. o -> o :+: a
Option ((o :+: a) -> Maybe o -> o :+: a)
-> (o :+: a) -> Maybe o -> o :+: a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- a -> o :+: a
forall o a. a -> o :+: a
Adoption a
x)

instance Accessible target source => Possible target (Maybe source) where
	perhaps :: Lens Maybe (Maybe source) target
perhaps = let lst :: Lens Exactly source target
lst = Accessible target source => Lens Exactly source target
forall target source.
Accessible target source =>
Lens Exactly source target
access @target @source in (Maybe source -> Store (Maybe target) (Maybe source))
-> Lens Maybe (Maybe source) target
forall (p :: * -> * -> *) (q :: * -> * -> *) (t :: * -> *) a b.
p a (q (t b) a) -> P_Q_T p q t a b
P_Q_T ((Maybe source -> Store (Maybe target) (Maybe source))
 -> Lens Maybe (Maybe source) target)
-> (Maybe source -> Store (Maybe target) (Maybe source))
-> Lens Maybe (Maybe source) target
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \case
		Just source
source -> let (Exactly target
target :*: Exactly target -> source
its) = Store (Exactly target) source
-> Exactly target :*: (Exactly target -> source)
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (Lens Exactly source target
lst Lens Exactly source target
-> source -> Store (Exactly target) source
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
<~ source
source) in
			(((:*:) (Maybe target) :. (->) (Maybe target)) >>> Maybe source)
-> Store (Maybe target) (Maybe source)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe target) :. (->) (Maybe target)) >>> Maybe source)
 -> Store (Maybe target) (Maybe source))
-> (((:*:) (Maybe target) :. (->) (Maybe target)) >>> Maybe source)
-> Store (Maybe target) (Maybe source)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- target -> Maybe target
forall a. a -> Maybe a
Just target
target Maybe target
-> (Maybe target -> Maybe source)
-> ((:*:) (Maybe target) :. (->) (Maybe target)) >>> Maybe source
forall s a. s -> a -> s :*: a
:*: (Exactly target -> source
its (Exactly target -> source)
-> (target -> Exactly target) -> target -> source
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. target -> Exactly target
forall a. a -> Exactly a
Exactly (target -> source) -> Maybe target -> Maybe source
forall (source :: * -> * -> *) (target :: * -> * -> *)
       (t :: * -> *) a b.
Covariant source target t =>
source a b -> target (t a) (t b)
<-|-)
		Maybe source
Nothing -> (((:*:) (Maybe target) :. (->) (Maybe target)) >>> Maybe source)
-> Store (Maybe target) (Maybe source)
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe target) :. (->) (Maybe target)) >>> Maybe source)
 -> Store (Maybe target) (Maybe source))
-> (((:*:) (Maybe target) :. (->) (Maybe target)) >>> Maybe source)
-> Store (Maybe target) (Maybe source)
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- Maybe target
forall a. Maybe a
Nothing Maybe target
-> (Maybe target -> Maybe source)
-> ((:*:) (Maybe target) :. (->) (Maybe target)) >>> Maybe source
forall s a. s -> a -> s :*: a
:*: \Maybe target
_ -> Maybe source
forall a. Maybe a
Nothing

instance Accessible (Maybe target) source => Possible target source where
	perhaps :: Lens Maybe source target
perhaps = let lst :: Lens Exactly source (Maybe target)
lst = Accessible (Maybe target) source =>
Lens Exactly source (Maybe target)
forall target source.
Accessible target source =>
Lens Exactly source target
access @(Maybe target) @source in (source -> Store (Maybe target) source) -> Lens Maybe source target
forall (p :: * -> * -> *) (q :: * -> * -> *) (t :: * -> *) a b.
p a (q (t b) a) -> P_Q_T p q t a b
P_Q_T ((source -> Store (Maybe target) source)
 -> Lens Maybe source target)
-> (source -> Store (Maybe target) source)
-> Lens Maybe source target
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- \source
source ->
		let Exactly (Maybe target)
target :*: Exactly (Maybe target) -> source
imts = Store (Exactly (Maybe target)) source
-> Exactly (Maybe target) :*: (Exactly (Maybe target) -> source)
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
run (Lens Exactly source (Maybe target)
lst Lens Exactly source (Maybe target)
-> source -> Store (Exactly (Maybe target)) source
forall (m :: * -> * -> *) (t :: * -> *) a.
Interpreted m t =>
(m < t a) < Primary t a
<~ source
source) in
			(((:*:) (Maybe target) :. (->) (Maybe target)) >>> source)
-> Store (Maybe target) source
forall s a. (((:*:) s :. (->) s) >>> a) -> Store s a
Store ((((:*:) (Maybe target) :. (->) (Maybe target)) >>> source)
 -> Store (Maybe target) source)
-> (((:*:) (Maybe target) :. (->) (Maybe target)) >>> source)
-> Store (Maybe target) source
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<--- Exactly (Maybe target) -> Maybe target
forall (t :: * -> *) a. Extractable t => t a -> a
extract Exactly (Maybe target)
target Maybe target
-> (Maybe target -> source)
-> ((:*:) (Maybe target) :. (->) (Maybe target)) >>> source
forall s a. s -> a -> s :*: a
:*: Exactly (Maybe target) -> source
imts (Exactly (Maybe target) -> source)
-> (Maybe target -> Exactly (Maybe target))
-> Maybe target
-> source
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Maybe target -> Exactly (Maybe target)
forall a. a -> Exactly a
Exactly

instance Morphable (Into List) (Vector r) where
	type Morphing (Into List) (Vector r) = List
	morphing :: (<::>) (Tagged ('Into List)) (Vector r) a
-> Morphing ('Into List) (Vector r) a
morphing ((<::>) (Tagged ('Into List)) (Vector r) a -> Vector r a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Scalar r
x) = ((Maybe :. Construction Maybe) >>> r)
-> TT Covariant Covariant Maybe (Construction Maybe) r
forall k k k k (ct :: k) (ct' :: k) (t :: k -> *) (t' :: k -> k)
       (a :: k).
((t :. t') >>> a) -> TT ct ct' t t' a
TT (((Maybe :. Construction Maybe) >>> r)
 -> TT Covariant Covariant Maybe (Construction Maybe) r)
-> (Construction Maybe r -> (Maybe :. Construction Maybe) >>> r)
-> Construction Maybe r
-> TT Covariant Covariant Maybe (Construction Maybe) r
forall (m :: * -> * -> *) b c a.
Semigroupoid m =>
m b c -> m a b -> m a c
. Construction Maybe r -> (Maybe :. Construction Maybe) >>> r
forall a. a -> Maybe a
Just (Construction Maybe r
 -> TT Covariant Covariant Maybe (Construction Maybe) r)
-> Construction Maybe r
-> TT Covariant Covariant Maybe (Construction Maybe) r
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- r -> ((Maybe :. Construction Maybe) >>> r) -> Construction Maybe r
forall (t :: * -> *) a.
a -> ((t :. Construction t) >>> a) -> Construction t a
Construct r
x (Maybe :. Construction Maybe) >>> r
forall a. Maybe a
Nothing
	morphing ((<::>) (Tagged ('Into List)) (Vector r) a -> Vector r a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Vector a
x Vector r a
xs) = a :=:=> List
forall k (mod :: k) (struct :: * -> *) a.
Morphed mod struct ((Exactly <:.:> struct) >>>>>> (->)) =>
a :=:=> struct
item @Push a
x (TT Covariant Covariant Maybe (Construction Maybe) a
 -> TT Covariant Covariant Maybe (Construction Maybe) a)
-> TT Covariant Covariant Maybe (Construction Maybe) a
-> TT Covariant Covariant Maybe (Construction Maybe) a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- Vector r a -> Morphing ('Into List) (Vector r) a
forall a (mod :: a) (struct :: * -> *).
Morphable ('Into mod) struct =>
struct ~> Morphing ('Into mod) struct
into @List Vector r a
xs

instance Morphable (Into (Construction Maybe)) (Vector r) where
	type Morphing (Into (Construction Maybe)) (Vector r) = Construction Maybe
	morphing :: (<::>) (Tagged ('Into (Construction Maybe))) (Vector r) a
-> Morphing ('Into (Construction Maybe)) (Vector r) a
morphing ((<::>) (Tagged ('Into (Construction Maybe))) (Vector r) a
-> Vector r a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Scalar r
x) = r -> ((Maybe :. Construction Maybe) >>> r) -> Construction Maybe r
forall (t :: * -> *) a.
a -> ((t :. Construction t) >>> a) -> Construction t a
Construct r
x (Maybe :. Construction Maybe) >>> r
forall a. Maybe a
Nothing
	morphing ((<::>) (Tagged ('Into (Construction Maybe))) (Vector r) a
-> Vector r a
forall k (mod :: k) (struct :: * -> *).
Morphable mod struct =>
(Tagged mod <::> struct) ~> struct
premorph -> Vector a
x Vector r a
xs) = a :=:=> Construction Maybe
forall k (mod :: k) (struct :: * -> *) a.
Morphed mod struct ((Exactly <:.:> struct) >>>>>> (->)) =>
a :=:=> struct
item @Push a
x (Construction Maybe a -> Construction Maybe a)
-> Construction Maybe a -> Construction Maybe a
forall (m :: * -> * -> *) a b. Category m => m (m a b) (m a b)
<-- Vector r a -> Morphing ('Into (Nonempty List)) (Vector r) a
forall a (mod :: a) (struct :: * -> *).
Morphable ('Into mod) struct =>
struct ~> Morphing ('Into mod) struct
into @(Nonempty List) Vector r a
xs