pandora 0.4.7 → 0.4.8

raw patch · 79 files changed

+986/−1092 lines, 79 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +24/−0
• Pandora/Core.hs +0/−1
• Pandora/Core/Appliable.hs +0/−6
• Pandora/Core/Functor.hs +4/−0
• Pandora/Paradigm/Controlflow/Effect/Adaptable.hs +23/−400
• Pandora/Paradigm/Controlflow/Effect/Interpreted.hs +19/−23
• Pandora/Paradigm/Controlflow/Effect/Transformer.hs +3/−3
• Pandora/Paradigm/Controlflow/Effect/Transformer/Comonadic.hs +11/−13
• Pandora/Paradigm/Controlflow/Effect/Transformer/Monadic.hs +15/−13
• Pandora/Paradigm/Controlflow/Pipeline.hs +4/−4
• Pandora/Paradigm/Inventory.hs +18/−20
• Pandora/Paradigm/Inventory/Accumulator.hs +4/−4
• Pandora/Paradigm/Inventory/Environment.hs +12/−13
• Pandora/Paradigm/Inventory/Equipment.hs +4/−4
• Pandora/Paradigm/Inventory/Imprint.hs +7/−7
• Pandora/Paradigm/Inventory/Optics.hs +21/−8
• Pandora/Paradigm/Inventory/State.hs +12/−12
• Pandora/Paradigm/Inventory/Store.hs +9/−8
• Pandora/Paradigm/Primary.hs +9/−9
• Pandora/Paradigm/Primary/Algebraic.hs +43/−30
• Pandora/Paradigm/Primary/Algebraic/Exponential.hs +10/−15
• Pandora/Paradigm/Primary/Algebraic/Product.hs +5/−5
• Pandora/Paradigm/Primary/Algebraic/Sum.hs +5/−5
• Pandora/Paradigm/Primary/Functor/Conclusion.hs +14/−14
• Pandora/Paradigm/Primary/Functor/Constant.hs +5/−5
• Pandora/Paradigm/Primary/Functor/Convergence.hs +15/−2
• Pandora/Paradigm/Primary/Functor/Edges.hs +8/−8
• Pandora/Paradigm/Primary/Functor/Fix.hs +3/−3
• Pandora/Paradigm/Primary/Functor/Identity.hs +9/−8
• Pandora/Paradigm/Primary/Functor/Maybe.hs +9/−9
• Pandora/Paradigm/Primary/Functor/Predicate.hs +20/−2
• Pandora/Paradigm/Primary/Functor/Proxy.hs +4/−4
• Pandora/Paradigm/Primary/Functor/Tagged.hs +10/−9
• Pandora/Paradigm/Primary/Functor/These.hs +6/−6
• Pandora/Paradigm/Primary/Functor/Validation.hs +19/−18
• Pandora/Paradigm/Primary/Functor/Wedge.hs +5/−5
• Pandora/Paradigm/Primary/Functor/Wye.hs +5/−5
• Pandora/Paradigm/Primary/Transformer/Backwards.hs +11/−11
• Pandora/Paradigm/Primary/Transformer/Construction.hs +19/−17
• Pandora/Paradigm/Primary/Transformer/Continuation.hs +4/−4
• Pandora/Paradigm/Primary/Transformer/Day.hs +3/−3
• Pandora/Paradigm/Primary/Transformer/Instruction.hs +16/−16
• Pandora/Paradigm/Primary/Transformer/Jack.hs +7/−7
• Pandora/Paradigm/Primary/Transformer/Jet.hs +3/−3
• Pandora/Paradigm/Primary/Transformer/Kan.hs +4/−4
• Pandora/Paradigm/Primary/Transformer/Outline.hs +4/−4
• Pandora/Paradigm/Primary/Transformer/Reverse.hs +12/−13
• Pandora/Paradigm/Primary/Transformer/Tap.hs +9/−10
• Pandora/Paradigm/Primary/Transformer/Yoneda.hs +3/−3
• Pandora/Paradigm/Schemes/TU.hs +23/−21
• Pandora/Paradigm/Schemes/TUT.hs +28/−16
• Pandora/Paradigm/Schemes/T_U.hs +5/−5
• Pandora/Paradigm/Schemes/UT.hs +26/−19
• Pandora/Paradigm/Structure.hs +37/−16
• Pandora/Paradigm/Structure/Ability.hs +1/−0
• Pandora/Paradigm/Structure/Ability/Possible.hs +7/−0
• Pandora/Paradigm/Structure/Ability/Substructure.hs +19/−3
• Pandora/Paradigm/Structure/Ability/Zipper.hs +94/−3
• Pandora/Paradigm/Structure/Modification/Comprehension.hs +8/−9
• Pandora/Paradigm/Structure/Modification/Prefixed.hs +4/−4
• Pandora/Paradigm/Structure/Some/Binary.hs +77/−53
• Pandora/Paradigm/Structure/Some/List.hs +80/−69
• Pandora/Paradigm/Structure/Some/Rose.hs +6/−5
• Pandora/Paradigm/Structure/Some/Splay.hs +9/−9
• Pandora/Paradigm/Structure/Some/Stream.hs +15/−13
• Pandora/Pattern.hs +1/−0
• Pandora/Pattern/Betwixt.hs +3/−0
• Pandora/Pattern/Functor/Bindable.hs +1/−1
• Pandora/Pattern/Functor/Comonad.hs +2/−1
• Pandora/Pattern/Functor/Contravariant.hs +7/−4
• Pandora/Pattern/Functor/Covariant.hs +23/−16
• Pandora/Pattern/Functor/Distributive.hs +1/−1
• Pandora/Pattern/Functor/Extendable.hs +2/−2
• Pandora/Pattern/Functor/Monad.hs +1/−1
• Pandora/Pattern/Functor/Traversable.hs +3/−3
• Pandora/Pattern/Morphism/Flip.hs +5/−9
• Pandora/Pattern/Morphism/Straight.hs +4/−8
• Pandora/Pattern/Transformer/Hoistable.hs +2/−3
• pandora.cabal +3/−2

@@ -605,3 +605,27 @@ * Remove `-<$$$$>-` in favor of `<$$$$>`  # 0.4.8+* Define `Zippable` type family and remove moves from `Zipper` type alias+* Add `!` infix operator as synonymous for `run`+* Remove `Appliable` module+* Generalize `Adaptable` typeclass+* Generalize `Hoistable` typeclass+* Define experimental notation for map methods of `Covariant` typeclass+* Define experimental notation for map methods of `Contravariant` typeclass+* Define `Tape` type synonymous for List and Stream zippers+* Define `only` method of `Substructure` typeclass+* Change fixity and precedense of `!` method of `Interpreted` typeclass+* Rename `*>-` `Applicative` operator to `-*-`+* Rename `-+-` `Alternative` operator to `<-+-`+* Define `-+-` method of `Alternative` typeclass+* Define experimental `intensify` method as replacement of `zoom`+* Define `#` type operator for consuming arguments+* Define experimental `Possible` type class+* Remove `magnify` and `adjust` methods+* Remove `zoom` method in favour `intensify`+* Rename `intensify` method to `zoom`+* Define `Betwixt` type family to avoid specifying intermediate categories+* Define experimental `overlook` method+* Remove `<$$$$>`, `<$$$$||=` and `=||$$$$>` operators+* Define `Effectful` typeclass to delegate instance resolution for `Adaptable`+* Change order of type parameters in `Adaptable` typeclass

@@ -1,5 +1,4 @@ module Pandora.Core (module Exports) where  import Pandora.Core.Impliable as Exports-import Pandora.Core.Appliable as Exports import Pandora.Core.Functor as Exports

@@ -1,6 +0,0 @@-module Pandora.Core.Appliable where--infixr 0 !--class Appliable m a b n c d | m a b -> n c d where-	(!) :: m a b -> n c d

@@ -1,9 +1,13 @@ module Pandora.Core.Functor where +infixl 2 # infixr 0 :=, <:=, :=>, :=:=>, ~> infixr 1 .:, :. infixr 2 ::|:., ::|.:, ::|:: infixr 9 :::++-- | Arguments consuming+type (#) t a = t a  -- | Parameter application type (:=) t a = t a

@@ -2,417 +2,40 @@  module Pandora.Paradigm.Controlflow.Effect.Adaptable where -import Pandora.Core.Functor (type (~>))-import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category (identity)+import Pandora.Core.Functor (type (#))+import Pandora.Pattern.Morphism.Straight (Straight (Straight))+import Pandora.Pattern.Semigroupoid (Semigroupoid ((.)))+import Pandora.Pattern.Category (Category (identity)) import Pandora.Pattern.Functor.Covariant (Covariant) import Pandora.Pattern.Functor.Monoidal (Monoidal)-import Pandora.Pattern.Functor.Comonad (Comonad)-import Pandora.Pattern.Functor.Monad (Monad)-import Pandora.Pattern.Transformer (Liftable (lift), Lowerable (lower), Hoistable ((/|\)))+import Pandora.Pattern.Transformer (Liftable (lift), Lowerable (lower)) import Pandora.Paradigm.Primary.Algebraic.Exponential (type (-->)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:))-import Pandora.Paradigm.Primary.Algebraic (Extractable)-import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic)+import Pandora.Paradigm.Primary.Algebraic (Extractable, Pointable, extract, point)+import Pandora.Paradigm.Primary.Functor.Identity (Identity) import Pandora.Paradigm.Controlflow.Effect.Transformer (Monadic, Comonadic, wrap, bring, (:>), (:<)) -class Adaptable t u where+class Adaptable u m t where 	{-# MINIMAL adapt #-}-	adapt :: t ~> u--type Lifting t u = (Monadic t, Liftable (->) (Schematic Monad t), Covariant (->) (->) u)-type Lowering t u = (Comonadic t, Lowerable (->) (Schematic Comonad t), Covariant (->) (->) u)-type Wrappable t u = (Monadic t, Monoidal (-->) (->) (:*:) (:*:) u)-type Bringable t u = (Comonadic t, Extractable u)--instance Adaptable t t where-	adapt = identity--instance Lifting t u => Adaptable u (t :> u) where-	adapt = lift--instance Wrappable t u => Adaptable t (t :> u) where-	adapt = wrap--instance Lowering t u => Adaptable (t :< u) u where-	adapt = lower--instance Bringable t u => Adaptable (t :< u) t where-	adapt = bring--instance-	( Liftable (->) (Schematic Monad t)-	, Covariant (->) (->) (Schematic Monad u v)-	, Wrappable u v-	) => Adaptable u (t :> u :> v) where-	adapt = lift . wrap--instance-	( Lifting t (Schematic Monad u v)-	, Lifting u v-	) => Adaptable v (t :> u :> v) where-	adapt = lift . lift--instance-	( Lowering t (Schematic Comonad u v)-	, Bringable u v-	) => Adaptable (t :< u :< v) u where-	adapt = bring . lower--instance-	( Lowering t (Schematic Comonad u v)-	, Lowering u v-	) => Adaptable (t :< u :< v) v where-	adapt = lower . lower--instance-	( Liftable (->) (Schematic Monad t)-	, Lifting t (Schematic Monad u (v :> w))-	, Lifting u (Schematic Monad v w)-	, Wrappable v w-	) => Adaptable v (t :> u :> v :> w) where-	adapt = lift . lift . wrap--instance-	( Lifting t (Schematic Monad u v)-	, Lifting t (Schematic Monad u (v :> w))-	, Lifting u (Schematic Monad v w)-	, Lifting v w-	) => Adaptable w (t :> u :> v :> w) where-	adapt = lift . lift . lift--instance-	( Lowering t (Schematic Comonad u (v :< w))-	, Lowering u (Schematic Comonad v w)-	, Bringable v w-	) => Adaptable (t :< u :< v :< w) v where-	adapt = bring . lower . lower--instance-	( Lowering t (Schematic Comonad u v)-	, Lowering t (Schematic Comonad u (v :< w))-	, Lowering u (Schematic Comonad v w)-	, Lowering v w-	) => Adaptable (t :< u :< v :< w) w where-	adapt = lower . lower . lower--instance-	( Lifting t (Schematic Monad u (v :> w :> x))-	, Lifting u (Schematic Monad v (w :> x))-	, Lifting v (Schematic Monad w x)-	, Lifting w x-	) => Adaptable x (t :> u :> v :> w :> x) where-	adapt = lift . lift . lift . lift--instance-	( Lifting t (Schematic Monad u (v :> w :> x))-	, Lifting u (Schematic Monad v (w :> x))-	, Lifting v (Schematic Monad w x)-	, Wrappable w x-	) => Adaptable w (t :> u :> v :> w :> x) where-	adapt = lift . lift . lift . wrap--instance-	( Lowering t (Schematic Comonad u (v :< w :< x))-	, Lowering u (Schematic Comonad v (w :< x))-	, Lowering v (Schematic Comonad w x)-	, Lowering w x-	) => Adaptable (t :< u :< v :< w :< x) x where-	adapt = lower . lower . lower . lower--instance-	( Lowering t (Schematic Comonad u (v :< w :< x))-	, Lowering u (Schematic Comonad v (w :< x))-	, Lowering v (Schematic Comonad w x)-	, Bringable w x-	) => Adaptable (t :< u :< v :< w :< x) w where-	adapt = bring . lower . lower . lower--instance-	( Lifting t (Schematic Monad u (v :> w :> x :> y))-	, Lifting u (Schematic Monad v (w :> x :> y))-	, Lifting v (Schematic Monad w (x :> y))-	, Lifting w (Schematic Monad x y)-	, Lifting x y-	) => Adaptable y (t :> u :> v :> w :> x :> y) where-	adapt = lift . lift . lift . lift . lift--instance-	( Lifting t (Schematic Monad u (v :> w :> x :> y))-	, Lifting u (Schematic Monad v (w :> x :> y))-	, Lifting v (Schematic Monad w (x :> y))-	, Lifting w (Schematic Monad x y)-	, Wrappable x y-	) => Adaptable x (t :> u :> v :> w :> x :> y) where-	adapt = lift . lift . lift . lift . wrap--instance-	( Lowering t (Schematic Comonad u (v :< w :< x :< y))-	, Lowering u (Schematic Comonad v (w :< x :< y))-	, Lowering v (Schematic Comonad w (x :< y))-	, Lowering w (Schematic Comonad x y)-	, Lowering x y-	) => Adaptable (t :< u :< v :< w :< x :< y) y where-	adapt = lower . lower . lower . lower . lower--instance-	( Lowering t (Schematic Comonad u (v :< w :< x :< y))-	, Lowering u (Schematic Comonad v (w :< x :< y))-	, Lowering v (Schematic Comonad w (x :< y))-	, Lowering w (Schematic Comonad x y)-	, Bringable x y-	) => Adaptable (t :< u :< v :< w :< x :< y) x where-	adapt = bring . lower . lower . lower . lower--instance-	( Lifting t (Schematic Monad u (v :> w :> x :> y :> z))-	, Lifting u (Schematic Monad v (w :> x :> y :> z))-	, Lifting v (Schematic Monad w (x :> y :> z))-	, Lifting w (Schematic Monad x (y :> z))-	, Lifting x (Schematic Monad y z)-	, Lifting y z-	) => Adaptable z (t :> u :> v :> w :> x :> y :> z) where-	adapt = lift . lift . lift . lift . lift . lift--instance-	( Lifting t (Schematic Monad u (v :> w :> x :> y :> z))-	, Lifting u (Schematic Monad v (w :> x :> y :> z))-	, Lifting v (Schematic Monad w (x :> y :> z))-	, Lifting w (Schematic Monad x (y :> z))-	, Lifting x (Schematic Monad y z)-	, Wrappable y z-	) => Adaptable y (t :> u :> v :> w :> x :> y :> z) where-	adapt = lift . lift . lift . lift . lift . wrap--instance-	( Lowering t (Schematic Comonad u (v :< w :< x :< y :< z))-	, Lowering u (Schematic Comonad v (w :< x :< y :< z))-	, Lowering v (Schematic Comonad w (x :< y :< z))-	, Lowering w (Schematic Comonad x (y :< z))-	, Lowering x (Schematic Comonad y z)-	, Lowering y z-	) => Adaptable (t :< u :< v :< w :< x :< y :< z) z where-	adapt = lower . lower . lower . lower . lower . lower--instance-	( Lowering t (Schematic Comonad u (v :< w :< x :< y :< z))-	, Lowering u (Schematic Comonad v (w :< x :< y :< z))-	, Lowering v (Schematic Comonad w (x :< y :< z))-	, Lowering w (Schematic Comonad x (y :< z))-	, Lowering x (Schematic Comonad y z)-	, Bringable y z-	) => Adaptable (t :< u :< v :< w :< x :< y :< z) y where-	adapt = bring . lower . lower . lower . lower . lower--instance-	( Lifting t (Schematic Monad u (v :> w :> x :> y :> z :> f))-	, Lifting u (Schematic Monad v (w :> x :> y :> z :> f))-	, Lifting v (Schematic Monad w (x :> y :> z :> f))-	, Lifting w (Schematic Monad x (y :> z :> f))-	, Lifting x (Schematic Monad y (z :> f))-	, Lifting y (Schematic Monad z f)-	, Lifting z f-	) => Adaptable f (t :> u :> v :> w :> x :> y :> z :> f) where-	adapt = lift . lift . lift . lift . lift . lift . lift--instance-	( Lifting t (Schematic Monad u (v :> w :> x :> y :> z :> f))-	, Lifting u (Schematic Monad v (w :> x :> y :> z :> f))-	, Lifting v (Schematic Monad w (x :> y :> z :> f))-	, Lifting w (Schematic Monad x (y :> z :> f))-	, Lifting x (Schematic Monad y (z :> f))-	, Lifting y (Schematic Monad z f)-	, Wrappable z f-	) => Adaptable z (t :> u :> v :> w :> x :> y :> z :> f) where-	adapt = lift . lift . lift . lift . lift . lift . wrap--instance-	( Lowering t (Schematic Comonad u (v :< w :< x :< y :< z :< f))-	, Lowering u (Schematic Comonad v (w :< x :< y :< z :< f))-	, Lowering v (Schematic Comonad w (x :< y :< z :< f))-	, Lowering w (Schematic Comonad x (y :< z :< f))-	, Lowering x (Schematic Comonad y (z :< f))-	, Lowering y (Schematic Comonad z f)-	, Lowering z f-	) => Adaptable (t :< u :< v :< w :< x :< y :< z :< f) f where-	adapt = lower . lower . lower . lower . lower . lower . lower--instance-	( Lowering t (Schematic Comonad u (v :< w :< x :< y :< z :< f))-	, Lowering u (Schematic Comonad v (w :< x :< y :< z :< f))-	, Lowering v (Schematic Comonad w (x :< y :< z :< f))-	, Lowering w (Schematic Comonad x (y :< z :< f))-	, Lowering x (Schematic Comonad y (z :< f))-	, Lowering y (Schematic Comonad z f)-	, Bringable z f-	) => Adaptable (t :< u :< v :< w :< x :< y :< z :< f) z where-	adapt = bring . lower . lower . lower . lower . lower . lower--instance-	( Lifting t (Schematic Monad u (v :> w :> x :> y :> z :> f :> h))-	, Lifting u (Schematic Monad v (w :> x :> y :> z :> f :> h))-	, Lifting v (Schematic Monad w (x :> y :> z :> f :> h))-	, Lifting w (Schematic Monad x (y :> z :> f :> h))-	, Lifting x (Schematic Monad y (z :> f :> h))-	, Lifting y (Schematic Monad z (f :> h))-	, Lifting z (Schematic Monad f h)-	, Lifting f h-	) => Adaptable h (t :> u :> v :> w :> x :> y :> z :> f :> h) where-	adapt = lift . lift . lift . lift . lift . lift . lift . lift--instance-	( Lifting t (Schematic Monad u (v :> w :> x :> y :> z :> f :> h))-	, Lifting u (Schematic Monad v (w :> x :> y :> z :> f :> h))-	, Lifting v (Schematic Monad w (x :> y :> z :> f :> h))-	, Lifting w (Schematic Monad x (y :> z :> f :> h))-	, Lifting x (Schematic Monad y (z :> f :> h))-	, Lifting y (Schematic Monad z (f :> h))-	, Lifting z (Schematic Monad f h)-	, Wrappable f h-	) => Adaptable f (t :> u :> v :> w :> x :> y :> z :> f :> h) where-	adapt = lift . lift . lift . lift . lift . lift . lift . wrap--instance-	( Lowering t (Schematic Comonad u (v :< w :< x :< y :< z :< f :< h))-	, Lowering u (Schematic Comonad v (w :< x :< y :< z :< f :< h))-	, Lowering v (Schematic Comonad w (x :< y :< z :< f :< h))-	, Lowering w (Schematic Comonad x (y :< z :< f :< h))-	, Lowering x (Schematic Comonad y (z :< f :< h))-	, Lowering y (Schematic Comonad z (f :< h))-	, Lowering z (Schematic Comonad f h)-	, Lowering f h-	) => Adaptable (t :< u :< v :< w :< x :< y :< z :< f :< h) h where-	adapt = lower . lower . lower . lower . lower . lower . lower . lower--instance-	( Lowering t (Schematic Comonad u (v :< w :< x :< y :< z :< f :< h))-	, Lowering u (Schematic Comonad v (w :< x :< y :< z :< f :< h))-	, Lowering v (Schematic Comonad w (x :< y :< z :< f :< h))-	, Lowering w (Schematic Comonad x (y :< z :< f :< h))-	, Lowering x (Schematic Comonad y (z :< f :< h))-	, Lowering y (Schematic Comonad z (f :< h))-	, Lowering z (Schematic Comonad f h)-	, Bringable f h-	) => Adaptable (t :< u :< v :< w :< x :< y :< z :< f :< h) f where-	adapt = bring . lower . lower . lower . lower . lower . lower . lower--instance (Covariant (->) (->) u, Hoistable ((:>) t), Adaptable u u') => Adaptable (t :> u) (t :> u') where-	adapt = (adapt /|\)+	adapt :: m (t a) (u a) -instance-	( Covariant (->) (->) v-	, Covariant (->) (->) (Schematic Monad u v)-	, Hoistable ((:>) (t :> u))-	, Hoistable (Schematic Monad t)-	, Hoistable (Schematic Monad u)-	, Adaptable v v'-	) => Adaptable (t :> u :> v) (t :> u :> v') where-	adapt = ((adapt /|\) /|\)+instance Category m => Adaptable t m t where+	adapt = identity @m -instance-	( Covariant (->) (->) u-	, Covariant (->) (->) v-	, Covariant (->) (->) w-	, Covariant (->) (->) (Schematic Monad u v)-	, Covariant (->) (->) (Schematic Monad u (v :> w))-	, Covariant (->) (->) (Schematic Monad v w)-	, Hoistable ((:>) (t :> u :> v))-	, Hoistable (Schematic Monad t)-	, Hoistable (Schematic Monad u)-	, Hoistable (Schematic Monad v)-	, Adaptable w w'-	) => Adaptable (t :> u :> v :> w) (t :> u :> v :> w') where-	adapt = (((adapt /|\) /|\) /|\)+instance {-# OVERLAPS #-} Monoidal (-->) (-->) (:*:) (:*:) u => Adaptable u (->) Identity where+	adapt = point . extract -instance-	( Covariant (->) (->) x-	, Covariant (->) (->) (Schematic Monad u (v :> (w :> x)))-	, Covariant (->) (->) (Schematic Monad v (w :> x))-	, Covariant (->) (->) (Schematic Monad w x)-	, Hoistable ((:>) (t :> u :> v))-	, Hoistable (Schematic Monad t)-	, Hoistable (Schematic Monad u)-	, Hoistable (Schematic Monad v)-	, Hoistable (Schematic Monad w)-	, Adaptable x x'-	) => Adaptable (t :> u :> v :> w :> x) (t :> u :> v :> w :> x') where-	adapt = (((adapt /|\) /|\) /|\)+class Effectful m v t u where+	effect :: m (v a) (t :> u # a) -instance-	( Covariant (->) (->) y-	, Covariant (->) (->) (Schematic Monad u (v :> (w :> (x :> y))))-	, Covariant (->) (->) (Schematic Monad v (w :> (x :> y)))-	, Covariant (->) (->) (Schematic Monad w (x :> y))-	, Covariant (->) (->) (Schematic Monad x y)-	, Hoistable ((:>) (t :> u :> v :> w))-	, Hoistable (Schematic Monad t)-	, Hoistable (Schematic Monad u)-	, Hoistable (Schematic Monad v)-	, Hoistable (Schematic Monad w)-	, Hoistable (Schematic Monad x)-	, Adaptable y y'-	) => Adaptable (t :> u :> v :> w :> x :> y) (t :> u :> v :> w :> x :> y') where-	adapt = ((((adapt /|\) /|\) /|\) /|\)+instance (Pointable u, Monadic m t) => Effectful m t t u where+	effect = wrap -instance-	( Covariant (->) (->) z-	, Covariant (->) (->) (Schematic Monad u (v :> (w :> (x :> (y :> z)))))-	, Covariant (->) (->) (Schematic Monad v (w :> (x :> (y :> z))))-	, Covariant (->) (->) (Schematic Monad w (x :> (y :> z)))-	, Covariant (->) (->) (Schematic Monad x (y :> z))-	, Covariant (->) (->) (Schematic Monad y z)-	, Hoistable ((:>) (t :> u :> v :> w))-	, Hoistable (Schematic Monad t)-	, Hoistable (Schematic Monad u)-	, Hoistable (Schematic Monad v)-	, Hoistable (Schematic Monad w)-	, Hoistable (Schematic Monad x)-	, Hoistable (Schematic Monad y)-	, Adaptable z z'-	) => Adaptable (t :> u :> v :> w :> x :> y :> z)-		(t :> u :> v :> w :> x :> y :> z') where-	adapt = (((((adapt /|\) /|\) /|\) /|\) /|\)+instance (Covariant m m u, Liftable m ((:>) t)) => Effectful m u t u where+	effect = lift -instance-	( Covariant (->) (->) f-	, Covariant (->) (->) (Schematic Monad u (v :> (w :> (x :> (y :> (z :> f))))))-	, Covariant (->) (->) (Schematic Monad v (w :> (x :> (y :> (z :> f)))))-	, Covariant (->) (->) (Schematic Monad w (x :> (y :> (z :> f))))-	, Covariant (->) (->) (Schematic Monad x (y :> (z :> f)))-	, Covariant (->) (->) (Schematic Monad y (z :> f))-	, Covariant (->) (->) (Schematic Monad z f)-	, Hoistable ((:>) (t :> u :> v :> w))-	, Hoistable (Schematic Monad t)-	, Hoistable (Schematic Monad u)-	, Hoistable (Schematic Monad v)-	, Hoistable (Schematic Monad w)-	, Hoistable (Schematic Monad x)-	, Hoistable (Schematic Monad y)-	, Hoistable (Schematic Monad z)-	, Adaptable f f'-	) => Adaptable (t :> u :> v :> w :> x :> y :> z :> f)-		(t :> u :> v :> w :> x :> y :> z :> f') where-	adapt = ((((((adapt /|\) /|\) /|\) /|\) /|\) /|\)+instance {-# OVERLAPS #-} (Semigroupoid m, Effectful m u t u, Adaptable u m v) => Effectful m v t u where+	effect = effect @m @u @t @u . adapt @u @m @v -instance-	( Covariant (->) (->) h-	, Covariant (->) (->) (Schematic Monad u (v :> (w :> (x :> (y :> (z :> (f :> h)))))))-	, Covariant (->) (->) (Schematic Monad v (w :> (x :> (y :> (z :> (f :> h))))))-	, Covariant (->) (->) (Schematic Monad w (x :> (y :> (z :> (f :> h)))))-	, Covariant (->) (->) (Schematic Monad x (y :> (z :> (f :> h))))-	, Covariant (->) (->) (Schematic Monad y (z :> (f :> h)))-	, Covariant (->) (->) (Schematic Monad z (f :> h))-	, Covariant (->) (->) (Schematic Monad f h)-	, Hoistable ((:>) (t :> u :> v :> w))-	, Hoistable (Schematic Monad t)-	, Hoistable (Schematic Monad u)-	, Hoistable (Schematic Monad v)-	, Hoistable (Schematic Monad w)-	, Hoistable (Schematic Monad x)-	, Hoistable (Schematic Monad y)-	, Hoistable (Schematic Monad z)-	, Hoistable (Schematic Monad f)-	, Adaptable h h'-	) => Adaptable (t :> u :> v :> w :> x :> y :> z :> f :> h)-		(t :> u :> v :> w :> x :> y :> z :> f :> h') where-	adapt = (((((((adapt /|\) /|\) /|\) /|\) /|\) /|\) /|\)+instance Effectful m v t u => Adaptable (t :> u) m v where+	adapt = effect @m @v @t @u

@@ -4,10 +4,11 @@ import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Core.Functor (type (:.), type (:=)) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.)))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), (<$$>), (<$$$>), (<$$$$>))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<$$>), (<$$$>)) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Paradigm.Primary.Algebraic.Exponential () +infixl 1 ! infixr 2 ||=, =||  type family Schematic (c :: (* -> * -> *) -> (* -> *) -> k) (t :: * -> *) = (r :: (* -> *) -> * -> *) | r -> t@@ -18,6 +19,9 @@ 	run :: m (t a) (Primary t a) 	unite :: m (Primary t a) (t a) +	(!) :: m (t a) (Primary t a)+	(!) = run+ 	(||=) :: (Semigroupoid m, Interpreted m u) => m (Primary t a) (Primary u b) -> m (t a) (u b) 	(||=) f = unite . f . run @@ -26,35 +30,27 @@  	(<$||=) :: (Semigroupoid m, Covariant m m j, Interpreted m u)                 => m (Primary t a) (Primary u b) -> m (j := t a) (j := u b)-	(<$||=) f = (<$>) ((||=) f)--	(<$$||=) :: (Semigroupoid m, Covariant m m j, Covariant m m k, Interpreted m u)-		=> m (Primary t a) (Primary u b) -> m (j :. k := t a) (j :. k := u b)-	(<$$||=) f = (<$$>) @m @m ((||=) f)+	(<$||=) f = (<-|-) ((||=) f) -	(<$$$||=) :: (Semigroupoid m, Covariant m m j, Covariant m m k, Covariant m m l, Interpreted m u)-		=> m (Primary t a) (Primary u b) -> m (j :. k :. l := t a) (j :. k :. l := u b)-	(<$$$||=) f = (<$$$>) @m @m @m ((||=) f)+	--(<$$||=) :: (Semigroupoid m, Covariant m m j, Covariant m m k, Interpreted m u)+	--	=> m (Primary t a) (Primary u b) -> m (j :. k := t a) (j :. k := u b)+	--(<$$||=) f = (<$$>) @m @m ((||=) f) -	(<$$$$||=) :: (Semigroupoid m, Covariant m m j, Covariant m m k, Covariant m m l, Covariant m m n, Interpreted m u)-		=> m (Primary t a) (Primary u b) -> m (j :. k :. l :. n := t a) (j :. k :. l :. n := u b)-	(<$$$$||=) f = (<$$$$>) @m @m @m @m ((||=) f)+	--(<$$$||=) :: (Semigroupoid m, Covariant m m j, Covariant m m k, Covariant m m l, Interpreted m u)+	--	=> m (Primary t a) (Primary u b) -> m (j :. k :. l := t a) (j :. k :. l := u b)+	--(-<$$$||=) f = (<$$$>) @m @m @m ((||=) f)  	(=||$>) :: (Covariant m m j, Interpreted m u) 		=> m (t a) (u b) -> m (j := Primary t a) (j := Primary u b)-	(=||$>) f = (<$>) ((=||) f)--	(=||$$>) :: (Covariant m m j, Covariant m m k, Interpreted m u)-		=> m (t a) (u b) -> m (j :. k := Primary t a) (j :. k := Primary u b)-	(=||$$>) f = (<$$>) @m @m ((=||) f)+	(=||$>) f = (<-|-) ((=||) f) -	(=||$$$>) :: (Covariant m m j, Covariant m m k, Covariant m m l, Interpreted m u)-		=> m (t a) (u b) -> m (j :. k :. l := Primary t a) (j :. k :. l := Primary u b)-	(=||$$$>) f = (<$$$>) @m @m @m ((=||) f)+	--(=||$$>) :: (Covariant m m j, Covariant m m k, Interpreted m u)+	--	=> m (t a) (u b) -> m (j :. k := Primary t a) (j :. k := Primary u b)+	--(=||$$>) f = (<$$>) @m @m ((=||) f) -	(=||$$$$>) :: (Covariant m m j, Covariant m m k, Covariant m m l, Covariant m m n, Interpreted m u)-		=> m (t a) (u b) -> m (j :. k :. l :. n := Primary t a) (j :. k :. l :. n := Primary u b)-	(=||$$$$>) f = (<$$$$>) @m @m @m @m ((=||) f)+	--(=||$$$>) :: (Covariant m m j, Covariant m m k, Covariant m m l, Interpreted m u)+	--	=> m (t a) (u b) -> m (j :. k :. l := Primary t a) (j :. k :. l := Primary u b)+	--(=||$$$>) f = (<$$$>) @m @m @m ((=||) f)  (-=:) :: (Liftable m t, Interpreted m (t u), Interpreted m (t v), Covariant m m u) 	=> m (t u a) (t v b) -> m (u a) (Primary (t v) b)

@@ -5,6 +5,6 @@  import Pandora.Pattern.Functor (Monad, Comonad) -type family Transformer c t where-	Transformer Monad t = Monadic t-	Transformer Comonad t = Comonadic t+type family Transformer c m t where+	Transformer Monad m t = Monadic m t+	Transformer Comonad m t = Comonadic m t

@@ -2,12 +2,10 @@  module Pandora.Paradigm.Controlflow.Effect.Transformer.Comonadic (Comonadic (..), (:<) (..)) where -import Pandora.Core.Appliable ((!))-import Pandora.Core.Functor (type (~>)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($)) import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<)))@@ -17,30 +15,30 @@ import Pandora.Pattern.Functor.Comonad (Comonad) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower)) import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\)))-import Pandora.Paradigm.Primary.Algebraic.Exponential (type (<--), type (-->))+import Pandora.Paradigm.Primary.Algebraic.Exponential (type (-->)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:)((:*:))) import Pandora.Paradigm.Primary.Algebraic.One (One (One)) import Pandora.Paradigm.Primary.Algebraic (Extractable, point)-import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite, (!))) -class Interpreted (->) t => Comonadic t where+class Interpreted m t => Comonadic m t where 	{-# MINIMAL bring #-}-	bring :: Extractable u => t :< u ~> t+	bring :: Extractable u => m ((t :< u) a) (t a)  infixr 3 :< newtype (:<) t u a = TC { tc :: Schematic Comonad t u a }  instance Covariant (->) (->) (Schematic Comonad t u) => Covariant (->) (->) (t :< u) where-	f <$> TC x = TC $ f <$> x+	f <-|- TC x = TC $ f <-|- x  instance Semimonoidal (-->) (:*:) (:*:) (Schematic Comonad t u) => Semimonoidal (-->) (:*:) (:*:) (t :< u) where-	mult = Straight $ \(TC f :*: TC x) -> TC $ mult @(-->) @(:*:) @(:*:) ! f :*: x+	mult = Straight $ \(TC f :*: TC x) -> TC $ mult @(-->) @(:*:) @(:*:) ! (f :*: x) -instance Monoidal (-->) (->) (:*:) (:*:) (Schematic Comonad t u) => Monoidal (-->) (->) (:*:) (:*:) (t :< u) where-	unit _ = Straight $ TC . point . ($ One)+instance Monoidal (-->) (-->) (:*:) (:*:) (Schematic Comonad t u) => Monoidal (-->) (-->) (:*:) (:*:) (t :< u) where+	unit _ = Straight $ TC . point . ($ One) . run  instance Traversable (->) (->) (Schematic Comonad t u) => Traversable (->) (->) (t :< u) where-	f <<- TC x = TC <$> f <<- x+	f <<- TC x = TC <-|- f <<- x  instance Distributive (->) (->) (Schematic Comonad t u) => Distributive (->) (->) (t :< u) where 	f -<< x = TC $ tc . f -<< x@@ -56,7 +54,7 @@ instance Lowerable (->) (Schematic Comonad t) => Lowerable (->) ((:<) t) where 	lower (TC x) = lower x -instance Hoistable (Schematic Comonad t) => Hoistable ((:<) t) where+instance Hoistable (->) (Schematic Comonad t) => Hoistable (->) ((:<) t) where 	f /|\ TC x = TC $ f /|\ x  instance (Interpreted (->) (Schematic Comonad t u)) => Interpreted (->) (t :< u) where

@@ -2,12 +2,10 @@  module Pandora.Paradigm.Controlflow.Effect.Transformer.Monadic (Monadic (..), (:>) (..)) where -import Pandora.Core.Appliable ((!))-import Pandora.Core.Functor (type (~>)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<)))@@ -19,28 +17,32 @@ import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Paradigm.Primary.Algebraic.Exponential (type (-->)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:)((:*:)))+import Pandora.Paradigm.Primary.Algebraic.Sum ((:+:)) import Pandora.Paradigm.Primary.Algebraic.One (One (One)) import Pandora.Paradigm.Primary.Algebraic (Pointable, point)-import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite, (!))) -class Interpreted (->) t => Monadic t where+class Interpreted m t => Monadic m t where 	{-# MINIMAL wrap #-}-	wrap :: Pointable u => t ~> t :> u+	wrap :: Pointable u => m (t a) ((t :> u) a)  infixr 3 :> newtype (:>) t u a = TM { tm :: Schematic Monad t u a }  instance Covariant (->) (->) (Schematic Monad t u) => Covariant (->) (->) (t :> u) where-	f <$> TM x = TM $ f <$> x+	f <-|- TM x = TM $ f <-|- x  instance Semimonoidal (-->) (:*:) (:*:) (Schematic Monad t u) => Semimonoidal (-->) (:*:) (:*:) (t :> u) where-	mult = Straight $ \(TM f :*: TM x) -> TM $ mult @(-->) @(:*:) @(:*:) ! f :*: x+	mult = Straight $ \(TM f :*: TM x) -> TM $ mult @(-->) @(:*:) @(:*:) ! (f :*: x) -instance Monoidal (-->) (->) (:*:) (:*:) (Schematic Monad t u) => Monoidal (-->) (->) (:*:) (:*:) (t :> u) where-	unit _ = Straight $ TM . point . ($ One)+instance Monoidal (-->) (-->) (:*:) (:*:) (Schematic Monad t u) => Monoidal (-->) (-->) (:*:) (:*:) (t :> u) where+	unit _ = Straight $ TM . point . ($ One) . run +instance Semimonoidal (-->) (:*:) (:+:) (Schematic Monad t u) => Semimonoidal (-->) (:*:) (:+:) (t :> u) where+	mult = Straight $ \(TM f :*: TM x) -> TM $ mult @(-->) @(:*:) @(:+:) ! (f :*: x)+ instance Traversable (->) (->) (Schematic Monad t u) => Traversable (->) (->) (t :> u) where-	f <<- TM x = TM <$> f <<- x+	f <<- TM x = TM <-|- f <<- x  instance Distributive (->) (->) (Schematic Monad t u) => Distributive (->) (->) (t :> u) where 	f -<< x = TM $ tm . f -<< x@@ -51,12 +53,12 @@ instance Extendable (->) (Schematic Monad t u) => Extendable (->) (t :> u) where 	f <<= TM x = TM $ f . TM <<= x -instance (Covariant (->) (->) (Schematic Monad t u), Monoidal (-->) (->) (:*:) (:*:) (Schematic Monad t u), Bindable (->) (t :> u)) => Monad (->) (t :> u) where+instance (Covariant (->) (->) (Schematic Monad t u), Monoidal (-->) (-->) (:*:) (:*:) (Schematic Monad t u), Bindable (->) (t :> u)) => Monad (->) (t :> u) where  instance Liftable (->) (Schematic Monad t) => Liftable (->) ((:>) t) where 	lift = TM . lift -instance Hoistable (Schematic Monad t) => Hoistable ((:>) t) where+instance Hoistable (->) (Schematic Monad t) => Hoistable (->) ((:>) t) where 	f /|\ TM x = TM $ f /|\ x  instance (Interpreted (->) (Schematic Monad t u)) => Interpreted (->) (t :> u) where

@@ -4,7 +4,7 @@ import Pandora.Pattern.Category (($), (#)) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Monoidal (Monoidal)-import Pandora.Paradigm.Primary.Algebraic.Exponential ((!.), (!..), type (<--), type (-->))+import Pandora.Paradigm.Primary.Algebraic.Exponential ((!.), (!..), type (-->)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:)) import Pandora.Paradigm.Primary.Algebraic (point) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite))@@ -43,7 +43,7 @@ yield v = Continuation $ \next -> Pipe $ \i (Consumer o) -> o v # pause next i  -- | Pipeline that does nothing-finish :: Monoidal (-->) (->) (:*:) (:*:) t => Pipeline i o t () ()+finish :: Monoidal (-->) (-->) (:*:) (:*:) t => Pipeline i o t () () finish = Continuation (Pipe (point () !..) !.)  -- | Do some effectful computation within pipeline@@ -51,14 +51,14 @@ impact action = Continuation $ \next -> Pipe $ \i o -> (\x -> pipe (next x) i o) =<< action  -- | Compose two pipelines into one-(=*=) :: forall i e o t . Monoidal (-->) (->) (:*:) (:*:) t => Pipeline i e t () () -> Pipeline e o t () () -> Pipeline i o t () ()+(=*=) :: forall i e o t . Monoidal (-->) (-->) (:*:) (:*:) t => Pipeline i e t () () -> Pipeline e o t () () -> Pipeline i o t () () p =*= q = Continuation $ \_ -> Pipe $ \i -> pipe # run q end # pause (run p end !.) i where  	end :: b -> Pipe c d () t () 	end _ = Pipe (point () !..)  -- | Run pipeline and get result-pipeline :: Monoidal (-->) (->) (:*:) (:*:) t => Pipeline i o t () () -> t ()+pipeline :: Monoidal (-->) (-->) (:*:) (:*:) t => Pipeline i o t () () -> t () pipeline p = pipe # run p (Pipe . (!..) . point) # i # o where  	i :: Producer i t ()

@@ -1,7 +1,7 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-} -module Pandora.Paradigm.Inventory (module Exports, zoom, magnify, (=<>), (~<>), adjust) where+module Pandora.Paradigm.Inventory (module Exports, zoom, overlook, (=<>), (~<>)) where  import Pandora.Paradigm.Inventory.Optics as Exports import Pandora.Paradigm.Inventory.Store as Exports@@ -11,18 +11,17 @@ import Pandora.Paradigm.Inventory.Environment as Exports import Pandora.Paradigm.Inventory.Accumulator as Exports -import Pandora.Core.Functor (type (~>)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category (($), (#), identity)+import Pandora.Pattern.Category (($))+import Pandora.Pattern.Morphism.Flip (Flip (Flip))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Adjoint (Adjoint ((-|), (|-)))-import Pandora.Pattern.Functor.Bivariant ((<->)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)))-import Pandora.Paradigm.Primary.Algebraic.Exponential ((!.), (%))+import Pandora.Paradigm.Primary.Algebraic.Exponential ((!.), (%), type (<--)) import Pandora.Paradigm.Primary.Algebraic (extract)-import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)-import Pandora.Paradigm.Controlflow.Effect.Adaptable (adapt)-import Pandora.Paradigm.Structure.Ability.Accessible (Accessible (access))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!))+import Pandora.Paradigm.Controlflow.Effect.Adaptable (Adaptable (adapt))  instance Adjoint (->) (->) (Store s) (State s) where 	(-|) :: (Store s a -> b) -> a -> State s b@@ -38,18 +37,17 @@ 	f -| x = Environment $ f . Equipment -| x 	g |- x = run . g |- run x -zoom :: Stateful bg t => Lens Identity bg ls -> State ls ~> t-zoom lens less = let restruct to = (to . Identity <-> identity @(->)) . run less . extract @Identity-	in adapt . State $ (restruct |-) . run . run lens+zoom :: forall bg ls t u result . Stateful bg t => Lens u bg ls -> State (u ls) result -> t result+zoom lens less = adapt . State $ \source -> restruct |- run (lens ! source) where -(=<>) :: Stateful src t => Lens mode src tgt -> mode tgt -> t src-lens =<> new = modify $ set lens new+	restruct :: (u ls -> bg) -> u ls -> bg :*: result+	restruct to target = run $ to <-|- Flip (less ! target) -(~<>) :: Stateful src t => Lens mode src tgt -> (mode tgt -> mode tgt) -> t src-lens ~<> f = modify $ over lens f+overlook :: (Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t) => State s result -> State (t s) (t result)+overlook (State state) = State $ \ts -> mult @(<--) @(:*:) @(:*:) ! (state <-|- ts) -magnify :: forall bg ls t . (Accessible ls bg, Stateful bg t) => t ls-magnify = zoom @bg # access @ls @bg # current+(=<>) :: Stateful src t => Lens available src tgt -> available tgt -> t src+lens =<> new = modify $ set lens new -adjust :: forall bg ls t . (Accessible ls bg, Stateful bg t) => (ls -> ls) -> t ls-adjust = zoom @bg (access @ls @bg) . modify+(~<>) :: Stateful src t => Lens available src tgt -> (available tgt -> available tgt) -> t src+lens ~<> f = modify $ over lens f

@@ -5,7 +5,7 @@ import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Monad (Monad)@@ -22,7 +22,7 @@ newtype Accumulator e a = Accumulator (e :*: a)  instance Covariant (->) (->) (Accumulator e) where-	f <$> Accumulator x = Accumulator $ f <$> x+	f <-|- Accumulator x = Accumulator $ f <-|- x  instance Semigroup e => Semimonoidal (-->) (:*:) (:*:) (Accumulator e) where 	mult = Straight $ \(x :*: y) -> Accumulator $ k # run x # run y where@@ -39,10 +39,10 @@ 	run ~(Accumulator x) = x 	unite = Accumulator -instance Monoid e => Monadic (Accumulator e) where+instance Monoid e => Monadic (->) (Accumulator e) where 	wrap = TM . UT . point . run -type Accumulated e t = Adaptable (Accumulator e) t+type Accumulated e t = Adaptable t (->) (Accumulator e)  gather :: Accumulated e t => e -> t () gather x = adapt . Accumulator $ x :*: ()

@@ -2,11 +2,10 @@  module Pandora.Paradigm.Inventory.Environment (Environment (..), Configured, env) where -import Pandora.Core.Appliable ((!)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (identity, ($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))-import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<)))@@ -21,7 +20,7 @@ import Pandora.Paradigm.Primary.Algebraic (point) import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite, (!))) import Pandora.Paradigm.Controlflow.Effect.Transformer.Monadic (Monadic (wrap), (:>) (TM)) import Pandora.Paradigm.Controlflow.Effect.Adaptable (Adaptable (adapt)) import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>))@@ -29,24 +28,24 @@ newtype Environment e a = Environment (e -> a)  instance Covariant (->) (->) (Environment e) where-	f <$> Environment x = Environment $ f . x+	f <-|- Environment x = Environment $ f . x  instance Contravariant (->) (->) (Flip Environment a) where-	f >$< Flip (Environment g) = Flip . Environment $ g . f+	f >-|- Flip (Environment g) = Flip . Environment $ g . f  instance Semimonoidal (-->) (:*:) (:*:) (Environment e) where 	mult = Straight $ Environment . (mult @(-->) !) . (run @(->) <-> run @(->)) -instance Monoidal (-->) (->) (:*:) (:*:) (Environment e) where-	unit _ = Straight $ \f -> Environment $ \_ -> f One+instance Monoidal (-->) (-->) (:*:) (:*:) (Environment e) where+	unit _ = Straight $ \f -> Environment $ \_ -> run f One  instance Distributive (->) (->) (Environment e) where-	f -<< g = Environment $ (run @(->) <$> f) -<< g+	f -<< g = Environment $ (run @(->) <-|- f) -<< g  instance Bindable (->) (Environment e) where 	f =<< Environment x = Environment $ \e -> (run % e) . f . x $ e ---instance Monad (Environment e) where+instance Monad (->) (Environment e) where  instance Divariant (->) (->) (->) Environment where 	(>->) ab cd bc = Environment $ ab >-> cd $ run bc@@ -58,10 +57,10 @@  type instance Schematic Monad (Environment e) = (<:.>) ((->) e) -instance Monadic (Environment e) where-	wrap x = TM . TU $ point <$> run x+instance Monadic (->) (Environment e) where+	wrap x = TM . TU $ point <-|- run x -type Configured e = Adaptable (Environment e)+type Configured e t = Adaptable t (->) (Environment e)  env :: Configured e t => t e env = adapt $ Environment identity

@@ -4,7 +4,7 @@  import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=))) import Pandora.Pattern.Functor.Comonad (Comonad)@@ -17,10 +17,10 @@ newtype Equipment e a = Equipment (e :*: a)  instance Covariant (->) (->) (Equipment e) where-	f <$> Equipment x = Equipment $ f <$> x+	f <-|- Equipment x = Equipment $ f <-|- x  instance Traversable (->) (->) (Equipment e) where-	f <<- Equipment x = Equipment <$> f <<- x+	f <<- Equipment x = Equipment <-|- f <<- x  instance Extendable (->) (Equipment e) where 	f <<= Equipment (e :*: x) = Equipment . (:*:) e . f . Equipment $ e :*: x@@ -32,7 +32,7 @@  type instance Schematic Comonad (Equipment e) = (<:.>) ((:*:) e) -type Equipped e t = Adaptable t (Equipment e)+type Equipped e t = Adaptable (Equipment e) (->) t  instance {-# OVERLAPS #-} Extendable (->) u => Extendable (->) ((:*:) e <:.> u) where 	f <<= TU (e :*: x) = TU . (:*:) e $ f . TU . (:*:) e <<= x

@@ -4,8 +4,8 @@  import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))-import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-))) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=))) import Pandora.Pattern.Functor.Comonad (Comonad)@@ -20,13 +20,13 @@ newtype Imprint e a = Imprint (e -> a)  instance Covariant (->) (->) (Imprint e) where-	f <$> Imprint g = Imprint $ f . g+	f <-|- Imprint g = Imprint $ f . g  instance Contravariant (->) (->) (Flip Imprint a) where-	f >$< Flip (Imprint g) = Flip . Imprint $ g . f+	f >-|- Flip (Imprint g) = Flip . Imprint $ g . f  instance Distributive (->) (->) (Imprint e) where-	f -<< g = Imprint $ (run @(->) <$> f) -<< g+	f -<< g = Imprint $ (run @(->) <-|- f) -<< g  instance Divariant (->) (->) (->) Imprint where 	(>->) ab cd bc = ab >-> cd ||= bc@@ -42,6 +42,6 @@ type instance Schematic Comonad (Imprint e) = (<.:>) ((->) e)  instance {-# OVERLAPS #-} (Semigroup e, Extendable (->) u) => Extendable (->) ((->) e <.:> u) where-	f <<= UT x = UT $ (\x' e -> f . UT . (<$>) (. (e +)) $ x') <<= x+	f <<= UT x = UT $ (\x' e -> f . UT . (<-|-) (. (e +)) $ x') <<= x -type Traceable e t = Adaptable t (Imprint e)+type Traceable e t = Adaptable t (->) (Imprint e)

@@ -5,18 +5,21 @@ import Pandora.Core.Impliable (Impliable (Arguments, imply)) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.))) import Pandora.Pattern.Category (Category (identity, ($), (#)))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Invariant (Invariant ((<$<))) import Pandora.Pattern.Functor.Divariant ((>->))+import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Representable (Representable (Representation, (<#>), tabulate)) import Pandora.Pattern.Object.Setoid (Setoid ((==)))+import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (run)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)))-import Pandora.Paradigm.Primary.Algebraic.Exponential ((!.), (%))-import Pandora.Paradigm.Primary.Algebraic (($>-), extract)+import Pandora.Paradigm.Primary.Algebraic.Exponential (type (-->), (!.), (%))+import Pandora.Paradigm.Primary.Algebraic (extract) import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity)) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing)) import Pandora.Pattern.Morphism.Flip (Flip (Flip))+import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Paradigm.Primary.Object.Boolean ((?)) import Pandora.Paradigm.Inventory.Store (Store (Store), position, look, retrofit) import Pandora.Paradigm.Schemes.P_Q_T (P_Q_T (P_Q_T))@@ -27,19 +30,27 @@ type Lens = P_Q_T (->) Store  instance Invariant (Flip (Lens available) tgt) where-	f <$< g = \(Flip (P_Q_T lens)) -> Flip . P_Q_T $ g >-> (f <$>) $ lens+	f <$< g = \(Flip (P_Q_T lens)) -> Flip . P_Q_T $ g >-> (f <-|-) $ lens  type family Convex lens where 	Convex Lens = Lens Identity  instance Semigroupoid (Lens Identity) where 	(.) :: Convex Lens between target -> Convex Lens source between -> Convex Lens source target-	P_Q_T to . P_Q_T from = P_Q_T $ \source -> (to . extract @Identity . position $ from source) $>- source+	P_Q_T to . P_Q_T from = P_Q_T $ \source ->+		let (Identity between :*: bs) = run # from source in+		let (Identity target :*: tb) = run # to between in+		Store $ Identity target :*: bs . Identity . tb  instance Category (Lens Identity) where 	identity :: Convex Lens source source 	identity = imply @(Convex Lens _ _) identity ((%) (!.)) +instance Semigroup source => Semimonoidal (-->) (:*:) (:*:) (Lens Identity source) where+	mult = Straight $ \(P_Q_T x :*: P_Q_T y) -> P_Q_T $ \source ->+		let Store (Identity xt :*: ixts) :*: Store (Identity yt :*: iyts) = x source :*: y source in+		Store $ Identity (xt :*: yt) :*: \(Identity (xt_ :*: yt_)) -> ixts (Identity xt_) + iyts (Identity yt_)+ instance Impliable (P_Q_T (->) Store Identity source target) where 	type Arguments (P_Q_T (->) Store Identity source target) = 		(source -> target) -> (source -> target -> source) -> Lens Identity source target@@ -55,9 +66,11 @@  instance Semigroupoid (Lens Maybe) where 	(.) :: Obscure Lens between target -> Obscure Lens source between -> Obscure Lens source target-	P_Q_T to . P_Q_T from = P_Q_T $ \source -> case position # from source of-		Nothing -> Store $ Nothing :*: (source !.)-		Just between -> to between $>- source+	P_Q_T to . P_Q_T from = P_Q_T $ \source -> case run # from source of+		(Nothing :*: _) -> Store $ Nothing :*: \_ -> source+		(Just between :*: mbs) -> case run # to between of+			(Nothing :*: _) -> Store $ Nothing :*: \_ -> source+			(Just target :*: mtb) -> Store $ Just target :*: mbs . Just . mtb  instance Category (Lens Maybe) where 	identity :: Obscure Lens source source

@@ -7,7 +7,7 @@ import Pandora.Core.Functor (type (:.), type (:=)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (identity, ($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Invariant (Invariant ((<$<))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit))@@ -22,7 +22,7 @@ import Pandora.Paradigm.Controlflow.Effect.Transformer.Monadic (Monadic (wrap), (:>) (TM)) import Pandora.Paradigm.Schemes.TUT (TUT (TUT), type (<:<.>:>)) import Pandora.Paradigm.Primary.Algebraic.Exponential (type (-->))-import Pandora.Paradigm.Primary.Algebraic ((:*:) ((:*:)), (*>-), delta)+import Pandora.Paradigm.Primary.Algebraic ((:*:) ((:*:)), (-*-), delta) import Pandora.Paradigm.Primary.Algebraic.One (One (One)) import Pandora.Paradigm.Primary.Algebraic (Pointable, point) @@ -30,7 +30,7 @@ newtype State s a = State ((->) s :. (:*:) s := a)  instance Covariant (->) (->) (State s) where-	f <$> x = State $ (<$>) f . run x+	f <-|- x = State $ (<-|-) f . run x  instance Semimonoidal (-->) (:*:) (:*:) (State s) where 	mult = Straight $ \(State g :*: State h) -> State $ \s ->@@ -38,11 +38,11 @@ 		let new :*: y = h old in 		new :*: x :*: y -instance Monoidal (-->) (->) (:*:) (:*:) (State s) where-	unit _ = Straight $ State . (identity @(->) -|) . ($ One)+instance Monoidal (-->) (-->) (:*:) (:*:) (State s) where+	unit _ = Straight $ State . (identity @(->) -|) . ($ One) . run  instance Bindable (->) (State s) where-	f =<< x = State $ (run . f |-) <$> run x+	f =<< x = State $ (run . f |-) <-|- run x  instance Monad (->) (State s) where @@ -56,10 +56,10 @@  type instance Schematic Monad (State s) = (->) s <:<.>:> (:*:) s -instance Monadic (State s) where-	wrap x = TM . TUT $ point <$> run x+instance Monadic (->) (State s) where+	wrap x = TM . TUT $ point <-|- run x -type Stateful s = Adaptable (State s)+type Stateful s t = Adaptable t (->) (State s)  -- | Get current value current :: Stateful s t => t s@@ -73,10 +73,10 @@ replace :: Stateful s t => s -> t s replace s = adapt . State $ \_ -> s :*: s -reconcile :: (Bindable (->) t, Stateful s t, Adaptable u t) => (s -> u s) -> t s+reconcile :: (Bindable (->) t, Stateful s t, Adaptable t (->) u) => (s -> u s) -> t s reconcile f = replace =<< adapt . f =<< current -type Memorable s t = (Covariant (->) (->) t, Pointable t,  Stateful s t)+type Memorable s t = (Covariant (->) (->) t, Pointable t, Stateful s t)  fold :: (Traversable (->) (->) t, Memorable s u) => (a -> s -> s) -> t a -> u s-fold op struct = (modify . op <<- struct) *>- current+fold op struct = current -*- modify . op <<- struct

@@ -5,7 +5,7 @@ import Pandora.Core (type (:.), type (:=), type (<:=), type (~>)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (identity, ($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), (<$$>))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-|-)) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Invariant (Invariant ((<$<)))@@ -14,10 +14,11 @@ import Pandora.Pattern.Functor.Bivariant ((<->)) import Pandora.Pattern.Functor.Divariant ((>->)) import Pandora.Pattern.Functor.Adjoint ((-|))-import Pandora.Paradigm.Primary.Algebraic.Exponential (type (<--), (%), (!.), (-.#..-))+import Pandora.Paradigm.Primary.Algebraic.Exponential (type (<--), type (-->), (%), (!.), (-.#..-)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), attached) import Pandora.Paradigm.Primary.Algebraic (extract) import Pandora.Pattern.Morphism.Flip (Flip (Flip))+import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Paradigm.Controlflow.Effect.Adaptable (Adaptable (adapt)) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite, (||=)), Schematic) import Pandora.Paradigm.Controlflow.Effect.Transformer.Comonadic (Comonadic (bring), (:<) (TC))@@ -28,19 +29,19 @@  -- TODO: Try to generalize (->) here instance Covariant (->) (->) (Store s) where-	(<$>) f = (||=) ((<$$>) @(->) @(->) f)+	(<-|-) f = (||=) (f <-|-|-)  instance Semimonoidal (<--) (:*:) (:*:) (Store s) where 	mult = Flip $ \(Store (s :*: f)) -> 		let (x :*: y) = f s in 		Store (s :*: (x !.)) :*: Store (s :*: (y !.)) -instance Monoidal (<--) (->) (:*:) (:*:) (Store s) where-	unit _ = Flip $ \(Store (s :*: f)) -> (\_ -> f s)+instance Monoidal (<--) (-->) (:*:) (:*:) (Store s) where+	unit _ = Flip $ \(Store (s :*: f)) -> Straight (\_ -> f s)  -- TODO: Try to generalize (->) here instance Extendable (->) (Store s) where-	f <<= Store x = Store $ (<$$>) @(->) @(->) f (Store -.#..- (identity @(->) -|) <$> x)+	f <<= Store x = Store $ f <-|-|- (Store -.#..- (identity @(->) -|) <-|- x)  instance Comonad (->) (Store s) where @@ -54,10 +55,10 @@  type instance Schematic Comonad (Store s) = (:*:) s <:<.>:> (->) s -instance Comonadic (Store s) where+instance Comonadic (->) (Store s) where 	bring (TC (TUT (s :*: f))) = Store $ s :*: extract f -type Storable s x = Adaptable x (Store s)+type Storable s t = Adaptable (Store s) (->) t  -- | Get current index position :: Storable s t => t a -> s

@@ -12,7 +12,7 @@ import Pandora.Core.Functor (type (:=)) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.))) import Pandora.Pattern.Category (Category (($), (#)))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Adjoint (Adjoint ((|-), (-|))) import Pandora.Pattern.Transformer.Liftable (lift) import Pandora.Pattern.Transformer.Lowerable (lower)@@ -90,16 +90,16 @@ 	type Available Left Wye = Maybe 	type Substance Left Wye = Identity 	substructure = P_Q_T $ \new -> case lower new of-		End -> Store $ Nothing :*: lift . resolve Left End . (extract <$>)-		Left x -> Store $ Just (Identity x) :*: lift . resolve Left End . (extract <$>)-		Right y -> Store $ Nothing :*: (lift # Right y !.) . (extract <$>)-		Both x y -> Store $ Just (Identity x) :*: lift . resolve (Both % y) (Right y) . (extract <$>)+		End -> Store $ Nothing :*: lift . resolve Left End . (extract <-|-)+		Left x -> Store $ Just (Identity x) :*: lift . resolve Left End . (extract <-|-)+		Right y -> Store $ Nothing :*: (lift # Right y !.) . (extract <-|-)+		Both x y -> Store $ Just (Identity x) :*: lift . resolve (Both % y) (Right y) . (extract <-|-)  instance Substructure Right Wye where 	type Available Right Wye = Maybe 	type Substance Right Wye = Identity 	substructure = P_Q_T $ \new -> case lower new of-		End -> Store $ Nothing :*: lift . resolve Right End . (extract <$>)-		Left x -> Store $ Nothing :*: (lift # Left x !.) . (extract <$>)-		Right y -> Store $ Just (Identity y) :*: lift . resolve Right End . (extract <$>)-		Both x y -> Store $ Just (Identity y) :*: lift . resolve (Both x) (Left x) . (extract <$>)+		End -> Store $ Nothing :*: lift . resolve Right End . (extract <-|-)+		Left x -> Store $ Nothing :*: (lift # Left x !.) . (extract <-|-)+		Right y -> Store $ Just (Identity y) :*: lift . resolve Right End . (extract <-|-)+		Both x y -> Store $ Just (Identity y) :*: lift . resolve (Both x) (Left x) . (extract <-|-)

@@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -module Pandora.Paradigm.Primary.Algebraic (module Exports, Applicative, Alternative, Extractable, Pointable, ($>-), ($$>-), ($$$>-), (<-*-), (*>-), forever_, (-+-), void, empty, point, extract) where+module Pandora.Paradigm.Primary.Algebraic (module Exports, Applicative, Alternative, Divisible, Decidable, Extractable, Pointable, ($>-), ($$>-), ($$$>-), (<-*-), (-*-), forever_, (<-+-), (-+-), void, empty, point, pass, extract) where  import Pandora.Paradigm.Primary.Algebraic.Exponential as Exports import Pandora.Paradigm.Primary.Algebraic.Product as Exports@@ -8,39 +8,39 @@ import Pandora.Paradigm.Primary.Algebraic.Zero as Exports import Pandora.Paradigm.Primary.Algebraic.One as Exports -import Pandora.Core.Appliable ((!)) import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Category (($)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), (<$$>), (<$$$>))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-|-), (<-|-|-|-)) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit), Unit) import Pandora.Pattern.Functor.Comonad (Comonad) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Pattern.Functor.Adjoint (Adjoint ((-|), (|-))) import Pandora.Paradigm.Primary.Functor.Proxy (Proxy (Proxy))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)+import Pandora.Paradigm.Controlflow.Effect.Interpreted ((!))  type instance Unit (:*:) = One type instance Unit (:+:) = Zero -infixl 4 <-*-+infixl 3 <-+-, -+-+infixl 4 <-*-, -*-  ($>-) :: Covariant (->) (->) t => t a -> b -> t b-x $>- r = (r !.) <$> x+x $>- r = (r !.) <-|- x  ($$>-) :: (Covariant (->) (->) t, Covariant (->) (->) u) => t (u a) -> b -> t (u b)-x $$>- r = (<$$>) @(->) @(->) (r !.) x+x $$>- r = (r !.) <-|-|- x  ($$$>-) :: (Covariant (->) (->) t, Covariant (->) (->) u, Covariant (->) (->) v) => t (u (v a)) -> b -> t (u (v b))-x $$$>- r = (<$$$>) @(->) @(->) @(->) (r !.) x+x $$$>- r = (r !.) <-|-|-|- x  void :: Covariant (->) (->) t => t a -> t () void x = x $>- ()  instance Traversable (->) (->) ((:*:) s) where-	f <<- x = (attached x :*:) <$> f (extract x)+	f <<- x = (attached x :*:) <-|- f (extract x)  instance Adjoint (->) (->) ((:*:) s) ((->) s) where 	(-|) :: ((s :*: a) -> b) -> a -> (s -> b)@@ -52,6 +52,9 @@ 	mult :: ((e -> a) :*: (e -> b)) --> (e -> (a :*: b)) 	mult = Straight $ \(g :*: h) -> \x -> g x :*: h x +instance Monoidal (-->) (-->) (:*:) (:*:) ((->) e) where+	unit _ = Straight $ (!.) . (! One)+ instance Semimonoidal (<--) (:*:) (:*:) ((->) e) where 	mult :: ((e -> a) :*: (e -> b)) <-- (e -> a :*: b) 	mult = Flip $ \f -> attached . f :*: extract . f@@ -69,51 +72,61 @@ 		Option e :*: _ -> Option e 		_ :*: Option e -> Option e -instance Monoidal (-->) (->) (:*:) (:*:) ((:+:) e) where-	unit _ = Straight $ Adoption . ($ One)+instance Monoidal (-->) (-->) (:*:) (:*:) ((:+:) e) where+	unit _ = Straight $ Adoption . (! One)  instance Semimonoidal (<--) (:*:) (:*:) ((:*:) s) where 	mult = Flip $ \(s :*: x :*: y) -> (s :*: x) :*: (s :*: y) -instance Monoidal (<--) (->) (:*:) (:*:) ((:*:) s) where-	unit _ = Flip $ \(_ :*: x) -> (\_ -> x)+instance Monoidal (<--) (-->) (:*:) (:*:) ((:*:) s) where+	unit _ = Flip $ \(_ :*: x) -> Straight (\_ -> x)  instance Comonad (->) ((:*:) s) where  instance Semimonoidal (<--) (:*:) (:*:) (Flip (:*:) a) where 	mult = Flip $ \(Flip ((sx :*: sy) :*: r)) -> Flip (sx :*: r) :*: Flip (sy :*: r) -instance Monoidal (<--) (->) (:*:) (:*:) (Flip (:*:) a) where-	unit _ = Flip $ \(Flip (s :*: _)) -> (\_ -> s)+instance Monoidal (<--) (-->) (:*:) (:*:) (Flip (:*:) a) where+	unit _ = Flip $ \(Flip (s :*: _)) -> Straight (\_ -> s) -type Applicative t = (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t, Monoidal (-->) (->) (:*:) (:*:) t)-type Alternative t = (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:+:) t, Monoidal (-->) (->) (:*:) (:+:) t)+--instance Semimonoidal (-->) (:*:) (:*:) (Flip (:*:) a) where+--mult = Straight $ \(Flip ((sx :*: sy) :*: r)) -> Flip (sx :*: r) :*: Flip (sy :*: r) +type Applicative t = (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t, Monoidal (-->) (-->) (:*:) (:*:) t)+type Alternative t = (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:+:) t, Monoidal (-->) (-->) (:*:) (:+:) t)+type Divisible t = (Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t, Monoidal (-->) (<--) (:*:) (:*:) t)+type Decidable t = (Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:+:) t, Monoidal (-->) (<--) (:*:) (:+:) t)+ (<-*-) :: (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => t (a -> b) -> t a -> t b-f <-*- x = (|-) @(->) @(->) (&) <$> run (mult @(-->) @_ @(:*:)) (f :*: x)+f <-*- x = (|-) @(->) @(->) (&) <-|- (mult @(-->) @_ @(:*:) ! (f :*: x)) +(-*-) :: (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => t b -> t a -> t b+y -*- x = (\x' y' -> y') <-|- x <-*- y+ forever_ :: (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => t a -> t b-forever_ x = let r = x *>- r in r+forever_ x = let r = r -*- x in r -(*>-) :: (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => t a -> t b -> t b-x *>- y = ((!.) %) <$> x <-*- y+(<-+-) :: (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:+:) t) => t b -> t a -> (a :+: b -> r) -> t r+y <-+- x = \f -> f <-|- (mult @(-->) ! (x :*: y)) -(-+-) :: (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:+:) t)-	=> t a -> t b -> (a :+: b -> r) -> t r-x -+- y = \f -> f <$> (mult @(-->) ! (x :*: y))+(-+-) :: (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:+:) t) => t a -> t a -> t a+y -+- x = (\r -> case r of Option rx -> rx; Adoption ry -> ry) <-|- (mult @(-->) ! (x :*: y)) -type Extractable t = Monoidal (<--) (->) (:*:) (:*:) t-type Pointable t = Monoidal (-->) (->) (:*:) (:*:) t-type Emptiable t = Monoidal (-->) (->) (:*:) (:+:) t+type Extractable t = Monoidal (<--) (-->) (:*:) (:*:) t+type Pointable t = Monoidal (-->) (-->) (:*:) (:*:) t+type Emptiable t = Monoidal (-->) (-->) (:*:) (:+:) t  extract :: Extractable t => t a -> a-extract j = run (unit @(<--) Proxy) j One+extract j = unit @(<--) @(-->) Proxy ! j ! One  point :: Pointable t => a -> t a-point x = run (unit @(-->) Proxy) (\One -> x)+point x = unit @(-->) Proxy ! (Straight $ \One -> x) +pass :: Pointable t => t ()+pass = point ()+ empty :: Emptiable t => t a-empty = unit @(-->) (Proxy @(:*:)) ! absurd+empty = unit @(-->) Proxy ! Straight absurd  --instance Appliable (->) b c (->) e d => Appliable (->) a (b -> c) (->) (a :*: e) d where --	f ! (x :*: y) = f x ! y

@@ -2,11 +2,11 @@  module Pandora.Paradigm.Primary.Algebraic.Exponential where -import Pandora.Core.Appliable (Appliable ((!)))+import Pandora.Pattern.Betwixt (Betwixt) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.))) import Pandora.Pattern.Category (Category (($), (#), identity))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))-import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-))) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Divariant (Divariant ((>->)))@@ -20,6 +20,8 @@ infixr 9 % infixl 1 & +type instance Betwixt (->) (->) = (->)+ instance Semigroupoid (->) where 	f . g = \x -> f (g x) @@ -27,10 +29,10 @@ 	identity x = x  instance Covariant (->) (->) ((->) a) where-	(<$>) = (.)+	(<-|-) = (.)  instance Distributive (->) (->) ((->) e) where-	f -<< g = \e -> (f % e) <$> g+	f -<< g = \e -> (f % e) <-|- g  instance Bindable (->) ((->) e) where 	f =<< g = \x -> f # g x # x@@ -47,22 +49,15 @@ type (<--) = Flip (->)  instance Contravariant (->) (->) ((<--) a) where-	f >$< Flip g = Flip $ g . f+	f >-|- Flip g = Flip $ g . f  type (-->) = Straight (->)  instance Covariant (->) (->) ((-->) b) where-	f <$> Straight g = Straight $ f . g--instance Appliable (->) c b (->) c b where-	f ! x = f x---- TODO: Is it possible to generalize?-instance Appliable (->) a (b -> c) (->) b (a -> c) where-	(!) f = (%) f+	f <-|- Straight g = Straight $ f . g  (-.#..-) :: (Covariant (->) target (v a), Semigroupoid v) => v c d -> target (v a (v b c)) (v a (v b d))-(-.#..-) f = (<$>) (f .)+(-.#..-) f = (<-|-) (f .)  {-# INLINE (!.) #-} (!.) :: a -> b -> a

@@ -1,9 +1,8 @@ module Pandora.Paradigm.Primary.Algebraic.Product where  import Pandora.Core.Functor (type (:=))-import Pandora.Core.Appliable ((!)) import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=))) import Pandora.Pattern.Functor.Bivariant (Bivariant ((<->)))@@ -19,16 +18,17 @@ import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Paradigm.Schemes.T_U (T_U (T_U), type (<:.:>))+import Pandora.Paradigm.Controlflow.Effect.Interpreted ((!))  infixr 0 :*:  data (:*:) s a = s :*: a  instance Covariant (->) (->) ((:*:) s) where-	f <$> ~(s :*: x) = s :*: f x+	f <-|- ~(s :*: x) = s :*: f x  instance Covariant (->) (->) (Flip (:*:) a) where-	f <$> (Flip (x :*: y)) = Flip $ f x :*: y+	f <-|- (Flip (x :*: y)) = Flip $ f x :*: y  instance Extendable (->) ((:*:) s) where 	f <<= ~(s :*: x) = s :*: f (s :*: x)@@ -62,7 +62,7 @@ instance (Group s, Group a) => Group (s :*: a) where 	invert ~(s :*: x) = invert # s :*: invert # x -instance {-# OVERLAPS #-} Semimonoidal (-->) (:*:) (:*:) t => Semimonoidal (-->) (:*:) (:*:) (t <:.:> t := (:*:)) where+instance (Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:*:) u) => Semimonoidal (-->) (:*:) (:*:) (t <:.:> u := (:*:)) where 	mult = Straight $ \(T_U (xls :*: xrs) :*: T_U (yls :*: yrs)) -> T_U $ (mult @(-->) !) (xls :*: yls) :*: (mult @(-->) !) (xrs :*: yrs)  -- TODO: Generalize (:*:) as Bivariant p

@@ -2,7 +2,7 @@  import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Bivariant (Bivariant ((<->))) import Pandora.Paradigm.Primary.Algebraic.Exponential () import Pandora.Pattern.Morphism.Flip (Flip (Flip))@@ -12,8 +12,8 @@ data (:+:) s a = Option s | Adoption a  instance Covariant (->) (->) ((:+:) s) where-	_ <$> Option s = Option s-	f <$> Adoption x = Adoption $ f x+	_ <-|- Option s = Option s+	f <-|- Adoption x = Adoption $ f x  instance Bivariant (->) (->) (->) (:+:) where 	f <-> g = \case@@ -21,8 +21,8 @@ 		Adoption x -> Adoption $ g x  instance Covariant (->) (->) (Flip (:+:) a) where-	_ <$> Flip (Adoption x) = Flip $ Adoption x-	f <$> Flip (Option y) = Flip . Option $ f y+	_ <-|- Flip (Adoption x) = Flip $ Adoption x+	f <-|- Flip (Option y) = Flip . Option $ f y  sum :: (e -> r) -> (a -> r) -> e :+: a -> r sum f _ (Option x) = f x

@@ -4,7 +4,7 @@ import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Category (identity, ($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))@@ -30,12 +30,12 @@ data Conclusion e a = Failure e | Success a  instance Covariant (->) (->) (Conclusion e) where-	f <$> Success x = Success $ f x-	_ <$> Failure y = Failure y+	f <-|- Success x = Success $ f x+	_ <-|- Failure y = Failure y  instance Covariant (->) (->) (Flip Conclusion e) where-	_ <$> Flip (Success x) = Flip $ Success x-	f <$> Flip (Failure y) = Flip . Failure $ f y+	_ <-|- Flip (Success x) = Flip $ Success x+	f <-|- Flip (Failure y) = Flip . Failure $ f y  instance Semimonoidal (-->) (:*:) (:*:) (Conclusion e) where 	mult = Straight $ \case@@ -43,19 +43,19 @@ 		Failure x :*: _ -> Failure x 		_ :*: Failure x -> Failure x -instance Monoidal (-->) (->) (:*:) (:*:) (Conclusion e) where-	unit _ = Straight $ Success . ($ One)+instance Monoidal (-->) (-->) (:*:) (:*:) (Conclusion e) where+	unit _ = Straight $ Success . ($ One) . run  instance Semigroup e => Semimonoidal (-->) (:*:) (:+:) (Conclusion e) where 	mult = Straight $ \case-		Failure _ :*: x -> Adoption <$> x-		Success x :*: _ -> Option <$> Success x+		Failure _ :*: x -> Adoption <-|- x+		Success x :*: _ -> Option <-|- Success x  instance Traversable (->) (->) (Conclusion e) where-	(<<-) :: (Covariant (->) (->) u, Monoidal (-->) (->) (:*:) (:*:) u, Semimonoidal (-->) (:*:) (:*:) u)+	(<<-) :: (Covariant (->) (->) u, Monoidal (-->) (-->) (:*:) (:*:) u, Semimonoidal (-->) (:*:) (:*:) u) 		 => (a -> u b) -> Conclusion e a -> u (Conclusion e b) 	_ <<- Failure y = point $ Failure y-	f <<- Success x = Success <$> f x+	f <<- Success x = Success <-|- f x  instance Bindable (->) (Conclusion e) where 	f =<< Success x = f x@@ -98,10 +98,10 @@  type instance Schematic Monad (Conclusion e) = (<.:>) (Conclusion e) -instance Monadic (Conclusion e) where+instance Monadic (->) (Conclusion e) where 	wrap = TM . UT . point -type Failable e = Adaptable (Conclusion e)+type Failable e t = Adaptable t (->) (Conclusion e)  failure :: Failable e t => e -> t a failure = adapt . Failure@@ -113,6 +113,6 @@ 	catch (Failure e) handle = handle e 	catch (Success x) _ = Success x -instance (Monoidal (-->) (->) (:*:) (:*:) u, Bindable (->) u) => Catchable e (Conclusion e <.:> u) where+instance (Monoidal (-->) (-->) (:*:) (:*:) u, Bindable (->) u) => Catchable e (Conclusion e <.:> u) where 	catch (UT x) handle = let conclude = conclusion # run . handle # point . Success 		in UT $ conclude =<< x

@@ -2,8 +2,8 @@  import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))-import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-))) import Pandora.Pattern.Functor.Invariant (Invariant ((<$<))) import Pandora.Pattern.Functor.Bivariant (Bivariant ((<->))) import Pandora.Pattern.Object.Setoid (Setoid ((==)))@@ -21,13 +21,13 @@ newtype Constant a b = Constant a  instance Covariant (->) (->) (Constant a) where-	_ <$> Constant x = Constant x+	_ <-|- Constant x = Constant x  instance Covariant (->) (->) (Flip Constant b) where-	f <$> Flip (Constant x) = Flip . Constant $ f x+	f <-|- Flip (Constant x) = Flip . Constant $ f x  instance Contravariant (->) (->) (Constant a) where-	_ >$< Constant x = Constant x+	_ >-|- Constant x = Constant x  instance Invariant (Constant a) where 	_ <$< _ = \(Constant x) -> Constant x

@@ -1,10 +1,23 @@ module Pandora.Paradigm.Primary.Functor.Convergence where  import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))+import Pandora.Pattern.Morphism.Straight (Straight (Straight))+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-)))+import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult))+import Pandora.Pattern.Functor.Monoidal (Monoidal (unit))+import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))+import Pandora.Pattern.Object.Monoid (Monoid (zero))+import Pandora.Paradigm.Primary.Algebraic.Exponential (type (-->), type (<--))+import Pandora.Paradigm.Primary.Algebraic.Product ((:*:)((:*:))) import Pandora.Paradigm.Primary.Algebraic ()  data Convergence r a = Convergence (a -> a -> r)  instance Contravariant (->) (->) (Convergence r) where-	f >$< Convergence g = Convergence $ \x y -> g # f x # f y+	f >-|- Convergence g = Convergence $ \x y -> g # f x # f y++instance Semigroup r => Semimonoidal (-->) (:*:) (:*:) (Convergence r) where+	mult = Straight $ \(Convergence f :*: Convergence g) -> Convergence $ \(a :*: b) (a' :*: b') -> f a a' + g b b'++instance Monoid r => Monoidal (-->) (<--) (:*:) (:*:) (Convergence r) where+	unit _ = Straight $ \_ -> Convergence $ \_ _ -> zero

@@ -1,7 +1,7 @@ module Pandora.Paradigm.Primary.Functor.Edges where  import Pandora.Pattern.Category (($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Paradigm.Primary.Algebraic.Exponential () import Pandora.Paradigm.Primary.Algebraic (point)@@ -9,16 +9,16 @@ data Edges a = Empty | Leap a | Connect a | Overlay a  instance Covariant (->) (->) Edges where-	_ <$> Empty = Empty-	f <$> Connect x = Connect $ f x-	f <$> Overlay x = Overlay $ f x-	f <$> Leap x = Leap $ f x+	_ <-|- Empty = Empty+	f <-|- Connect x = Connect $ f x+	f <-|- Overlay x = Overlay $ f x+	f <-|- Leap x = Leap $ f x  instance Traversable (->) (->) Edges where 	_ <<- Empty = point Empty-	f <<- Connect x = Connect <$> f x-	f <<- Overlay x = Overlay <$> f x-	f <<- Leap x = Leap <$> f x+	f <<- Connect x = Connect <-|- f x+	f <<- Overlay x = Overlay <-|- f x+	f <<- Leap x = Leap <-|- f x  edges :: r -> (a -> r) -> (a -> r) -> (a -> r) -> Edges a -> r edges r _ _ _ Empty = r

@@ -2,16 +2,16 @@  import Pandora.Core.Functor (type (<:=), type (:=>)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Paradigm.Primary.Algebraic.Exponential ()  newtype Fix t = Fix { unfix :: t (Fix t) }  cata :: Covariant (->) (->) t => (a <:= t) -> Fix t -> a-cata f = f . (cata f <$>) . unfix+cata f = f . (cata f <-|-) . unfix  ana :: Covariant (->) (->) t => (a :=> t) -> a -> Fix t-ana f = Fix . (ana f <$>) . f+ana f = Fix . (ana f <-|-) . f  hylo :: Covariant (->) (->) t => (b <:= t) -> (a :=> t) -> (a -> b) hylo phi psi = cata phi . ana psi

@@ -4,7 +4,7 @@ import Pandora.Pattern.Category (($)) import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit))@@ -28,26 +28,27 @@ import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Primary.Algebraic.One (One (One)) import Pandora.Paradigm.Primary.Algebraic (extract)+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)  newtype Identity a = Identity a  instance Covariant (->) (->) Identity where-	f <$> Identity x = Identity $ f x+	f <-|- Identity x = Identity $ f x  instance Semimonoidal (-->) (:*:) (:*:) Identity where 	mult = Straight $ Identity . (extract <-> extract) -instance Monoidal (-->) (->) (:*:) (:*:) Identity where-	unit _ = Straight $ Identity . ($ One)+instance Monoidal (-->) (-->) (:*:) (:*:) Identity where+	unit _ = Straight $ Identity . ($ One) . run  instance Semimonoidal (<--) (:*:) (:*:) Identity where 	mult = Flip $ \(Identity (x :*: y)) -> Identity x :*: Identity y -instance Monoidal (<--) (->) (:*:) (:*:) Identity where-	unit _ = Flip $ \(Identity x) -> (\_ -> x)+instance Monoidal (<--) (-->) (:*:) (:*:) Identity where+	unit _ = Flip $ \(Identity x) -> Straight (\_ -> x)  instance Traversable (->) (->) Identity where-	f <<- Identity x = Identity <$> f x+	f <<- Identity x = Identity <-|- f x  instance Bindable (->) Identity where 	f =<< Identity x = f x@@ -66,7 +67,7 @@  instance Adjoint (->) (->) Identity Identity where 	f -| x = Identity . f . Identity $ x-	g |- x = extract . extract . (g <$>) $ x+	g |- x = extract . extract . (g <-|-) $ x  instance Setoid a => Setoid (Identity a) where 	Identity x == Identity y = x == y

@@ -5,7 +5,7 @@ import Pandora.Pattern.Category (identity, ($)) import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))@@ -33,8 +33,8 @@ data Maybe a = Nothing | Just a  instance Covariant (->) (->) Maybe where-	f <$> Just x = Just $ f x-	_ <$> Nothing = Nothing+	f <-|- Just x = Just $ f x+	_ <-|- Nothing = Nothing  instance Semimonoidal (-->) (:*:) (:*:) Maybe where 	mult = Straight $ \case@@ -48,10 +48,10 @@ 		Nothing :*: Just y -> Just $ Adoption y 		Nothing :*: Nothing -> Nothing -instance Monoidal (-->) (->) (:*:) (:*:) Maybe where-	unit _ = Straight $ Just . ($ One)+instance Monoidal (-->) (-->) (:*:) (:*:) Maybe where+	unit _ = Straight $ Just . ($ One) . run -instance Monoidal (-->) (->) (:*:) (:+:) Maybe where+instance Monoidal (-->) (-->) (:*:) (:+:) Maybe where 	unit _ = Straight $ \_ -> Nothing  -- TODO: Check laws@@ -62,7 +62,7 @@  instance Traversable (->) (->) Maybe where 	_ <<- Nothing = point Nothing-	f <<- Just x = Just <$> f x+	f <<- Just x = Just <-|- f x  instance Bindable (->) Maybe where 	f =<< Just x = f x@@ -108,7 +108,7 @@ 	run = identity 	unite = identity -instance Monadic Maybe where+instance Monadic (->) Maybe where 	wrap = TM . UT . point  instance Monotonic a (Maybe a) where@@ -119,7 +119,7 @@ 	reduce f r (Just x) = reduce f r x 	reduce _ r Nothing = r -type Optional = Adaptable Maybe+type Optional t = Adaptable t (->) Maybe  nothing :: Optional t => t a nothing = adapt Nothing

@@ -3,9 +3,16 @@ import Pandora.Core.Functor (type (~>), type (:=>)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($))-import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))+import Pandora.Pattern.Morphism.Straight (Straight (Straight))+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-)))+import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult))+import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Object.Setoid (Setoid ((==)))+import Pandora.Pattern.Object.Ringoid (Ringoid ((*))) import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False), bool)+import Pandora.Paradigm.Primary.Algebraic.Product ((:*:)((:*:)))+import Pandora.Paradigm.Primary.Algebraic.Sum ((:+:)(Option, Adoption))+import Pandora.Paradigm.Primary.Algebraic.Exponential (type (-->), type (<--)) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite))  newtype Predicate a = Predicate (a -> Boolean)@@ -16,7 +23,18 @@ 	unite = Predicate  instance Contravariant (->) (->) Predicate where-	f >$< Predicate g = Predicate $ g . f+	f >-|- Predicate g = Predicate $ g . f++instance Semimonoidal (-->) (:*:) (:*:) Predicate where+	mult = Straight $ \(Predicate f :*: Predicate g) -> Predicate $ \(x :*: y) -> f x * g y++instance Monoidal (-->) (<--) (:*:) (:*:) Predicate where+	unit _ = Straight $ \_ -> Predicate $ \_ -> True++instance Semimonoidal (-->) (:*:) (:+:) Predicate where+	mult = Straight $ \(Predicate f :*: Predicate g) -> Predicate $ \case+		Option x -> f x+		Adoption y -> g y  equate :: Setoid a => a :=> Predicate equate x = Predicate (== x)

@@ -1,7 +1,7 @@ module Pandora.Paradigm.Primary.Functor.Proxy where -import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))-import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-))) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=)))@@ -11,10 +11,10 @@ data Proxy a = Proxy  instance Covariant (->) (->) Proxy where-	_ <$> Proxy = Proxy+	_ <-|- Proxy = Proxy  instance Contravariant (->) (->) Proxy where-	_ >$< _ = Proxy+	_ >-|- _ = Proxy  instance Distributive (->) (->) Proxy where 	_ -<< _ = Proxy

@@ -5,7 +5,7 @@ import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Category (($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))@@ -28,6 +28,7 @@ import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Primary.Algebraic.One (One (One)) import Pandora.Paradigm.Primary.Algebraic (extract)+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)  newtype Tagged tag a = Tag a @@ -35,28 +36,28 @@ type (:#) tag = Tagged tag  instance Covariant (->) (->) (Tagged tag) where-	f <$> Tag x = Tag $ f x+	f <-|- Tag x = Tag $ f x  instance Covariant (->) (->) (Flip Tagged a) where-	_ <$> Flip (Tag x) = Flip $ Tag x+	_ <-|- Flip (Tag x) = Flip $ Tag x  instance Semimonoidal (-->) (:*:) (:*:) (Tagged tag) where 	mult = Straight $ Tag . (extract <-> extract) -instance Monoidal (-->) (->) (:*:) (:*:) (Tagged tag) where-	unit _ = Straight $ Tag . ($ One)+instance Monoidal (-->) (-->) (:*:) (:*:) (Tagged tag) where+	unit _ = Straight $ Tag . ($ One) . run  instance Semimonoidal (<--) (:*:) (:*:) (Tagged tag) where 	mult = Flip $ \(Tag (x :*: y)) -> Tag x :*: Tag y -instance Monoidal (<--) (->) (:*:) (:*:) (Tagged tag) where-	unit _ = Flip $ \(Tag x) -> (\_ -> x)+instance Monoidal (<--) (-->) (:*:) (:*:) (Tagged tag) where+	unit _ = Flip $ \(Tag x) -> Straight (\_ -> x)  instance Traversable (->) (->) (Tagged tag) where-	f <<- Tag x = Tag <$> f x+	f <<- Tag x = Tag <-|- f x  instance Distributive (->) (->) (Tagged tag) where-	f -<< x = Tag $ extract . f <$> x+	f -<< x = Tag $ extract . f <-|- x  instance Bindable (->) (Tagged tag) where 	f =<< Tag x = f x

@@ -1,7 +1,7 @@ module Pandora.Paradigm.Primary.Functor.These where  import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Paradigm.Primary.Algebraic.Exponential ()@@ -10,14 +10,14 @@ data These e a = This a | That e | These e a  instance Covariant (->) (->) (These e) where-	f <$> This x = This $ f x-	_ <$> That y = That y-	f <$> These y x = These y $ f x+	f <-|- This x = This $ f x+	_ <-|- That y = That y+	f <-|- These y x = These y $ f x  instance Traversable (->) (->) (These e) where-	f <<- This x = This <$> f x+	f <<- This x = This <-|- f x 	_ <<- That y = point $ That y-	f <<- These y x = These y <$> f x+	f <<- These y x = These y <-|- f x  instance (Semigroup e, Semigroup a) => Semigroup (These e a) where 	This x + This x' = This # x + x'

@@ -2,7 +2,7 @@  import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))@@ -19,24 +19,25 @@ import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Paradigm.Primary.Object.Boolean (Boolean (False)) import Pandora.Paradigm.Primary.Object.Ordering (Ordering (Less, Greater))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)  data Validation e a = Flaws e | Validated a  instance Covariant (->) (->) (Validation e) where-	_ <$> Flaws e = Flaws e-	f <$> Validated x = Validated $ f x-	_ <$> Flaws e = Flaws e-	f <$> Validated x = Validated $ f x-	_ <$> Flaws e = Flaws e-	f <$> Validated x = Validated $ f x+	_ <-|- Flaws e = Flaws e+	f <-|- Validated x = Validated $ f x+	_ <-|- Flaws e = Flaws e+	f <-|- Validated x = Validated $ f x+	_ <-|- Flaws e = Flaws e+	f <-|- Validated x = Validated $ f x  instance Covariant (->) (->) (Flip Validation a) where-	f <$> Flip (Flaws e) = Flip . Flaws $ f e-	_ <$> Flip (Validated x) = Flip $ Validated x-	f <$> Flip (Flaws e) = Flip . Flaws $ f e-	_ <$> Flip (Validated x) = Flip $ Validated x-	f <$> Flip (Flaws e) = Flip . Flaws $ f e-	_ <$> Flip (Validated x) = Flip $ Validated x+	f <-|- Flip (Flaws e) = Flip . Flaws $ f e+	_ <-|- Flip (Validated x) = Flip $ Validated x+	f <-|- Flip (Flaws e) = Flip . Flaws $ f e+	_ <-|- Flip (Validated x) = Flip $ Validated x+	f <-|- Flip (Flaws e) = Flip . Flaws $ f e+	_ <-|- Flip (Validated x) = Flip $ Validated x  instance Semigroup e => Semimonoidal (-->) (:*:) (:*:) (Validation e) where 	mult = Straight $ \case@@ -45,16 +46,16 @@ 		Validated _ :*: Flaws y -> Flaws y 		Flaws x :*: Validated _ -> Flaws x -instance Semigroup e => Monoidal (-->) (->) (:*:) (:*:) (Validation e) where-	unit _ = Straight $ Validated . ($ One)+instance Semigroup e => Monoidal (-->) (-->) (:*:) (:*:) (Validation e) where+	unit _ = Straight $ Validated . ($ One) . run  instance Semigroup e => Semimonoidal (-->) (:*:) (:+:) (Validation e) where 	mult = Straight $ \case-		Flaws _ :*: y -> Adoption <$> y-		Validated x :*: _ -> Option <$> Validated x+		Flaws _ :*: y -> Adoption <-|- y+		Validated x :*: _ -> Option <-|- Validated x  instance Traversable (->) (->) (Validation e) where-	f <<- Validated x = Validated <$> f x+	f <<- Validated x = Validated <-|- f x 	_ <<- Flaws e = point $ Flaws e  instance Bivariant (->) (->) (->) Validation where

@@ -1,7 +1,7 @@ module Pandora.Paradigm.Primary.Functor.Wedge where  import Pandora.Pattern.Category (($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Paradigm.Primary.Algebraic.Exponential () import Pandora.Paradigm.Primary.Algebraic (point)@@ -9,14 +9,14 @@ data Wedge e a = Nowhere | Here e | There a  instance Covariant (->) (->) (Wedge e) where-	_ <$> Nowhere = Nowhere-	_ <$> Here x = Here x-	f <$> There x = There $ f x+	_ <-|- Nowhere = Nowhere+	_ <-|- Here x = Here x+	f <-|- There x = There $ f x  instance Traversable (->) (->) (Wedge e) where 	_ <<- Nowhere = point Nowhere 	_ <<- Here x = point $ Here x-	f <<- There x = There <$> f x+	f <<- There x = There <-|- f x  wedge :: (e -> r) -> (a -> r) -> r -> Wedge e a -> r wedge f _ _ (Here x) = f x

@@ -2,7 +2,7 @@  import Pandora.Core.Functor (type (~>)) import Pandora.Pattern.Category ((#), ($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Monoid (Monoid (zero))@@ -14,10 +14,10 @@ data Wye a = End | Left a | Right a | Both a a  instance Covariant (->) (->) Wye where-	_ <$> End = End-	f <$> Left x = Left # f x-	f <$> Right y = Right # f y-	f <$> Both x y = Both # f x # f y+	_ <-|- End = End+	f <-|- Left x = Left # f x+	f <-|- Right y = Right # f y+	f <-|- Both x y = Both # f x # f y  instance Semimonoidal (<--) (:*:) (:*:) Wye where 	mult = Flip $ \case

@@ -2,8 +2,8 @@  import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))-import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))@@ -24,29 +24,29 @@ newtype Backwards t a = Backwards (t a)  instance Covariant (->) (->) t => Covariant (->) (->) (Backwards t) where-	f <$> Backwards x = Backwards $ f <$> x+	f <-|- Backwards x = Backwards $ f <-|- x  -- TODO: check that effects evaluation goes in opposite order instance (Semimonoidal (-->) (:*:) (:*:) t, Covariant (->) (->) t) => Semimonoidal (-->) (:*:) (:*:) (Backwards t) where-	mult = Straight $ \(Backwards x :*: Backwards y) -> Backwards # ((:*:) %) <$> y <-*- x+	mult = Straight $ \(Backwards x :*: Backwards y) -> Backwards # ((:*:) %) <-|- y <-*- x -instance (Covariant (->) (->) t, Monoidal (-->) (->) (:*:) (:*:) t) => Monoidal (-->) (->) (:*:) (:*:) (Backwards t) where-	unit _ = Straight $ Backwards . point . ($ One)+instance (Covariant (->) (->) t, Monoidal (-->) (-->) (:*:) (:*:) t) => Monoidal (-->) (-->) (:*:) (:*:) (Backwards t) where+	unit _ = Straight $ Backwards . point . ($ One) . run  instance (Semimonoidal (<--) (:*:) (:*:) t, Covariant (->) (->) t) => Semimonoidal (<--) (:*:) (:*:) (Backwards t) where 	mult = Flip $ (Backwards <-> Backwards) . run (mult @(<--)) . run -instance (Covariant (->) (->) t, Monoidal (<--) (->) (:*:) (:*:) t) => Monoidal (<--) (->) (:*:) (:*:) (Backwards t) where-	unit _ = Flip $ \(Backwards x) -> (\_ -> extract x)+instance (Covariant (->) (->) t, Monoidal (<--) (-->) (:*:) (:*:) t) => Monoidal (<--) (-->) (:*:) (:*:) (Backwards t) where+	unit _ = Flip $ \(Backwards x) -> Straight (\_ -> extract x)  instance Traversable (->) (->) t => Traversable (->) (->) (Backwards t) where-	f <<- Backwards x = Backwards <$> f <<- x+	f <<- Backwards x = Backwards <-|- f <<- x  instance Distributive (->) (->) t => Distributive (->) (->) (Backwards t) where 	f -<< x = Backwards $ run . f -<< x  instance Contravariant (->) (->) t => Contravariant (->) (->) (Backwards t) where-	f >$< Backwards x = Backwards $ f >$< x+	f >-|- Backwards x = Backwards $ f >-|- x  instance Interpreted (->) (Backwards t) where 	type Primary (Backwards t) a = t a@@ -59,5 +59,5 @@ instance Lowerable (->) Backwards where 	lower = run -instance Hoistable Backwards where+instance Hoistable (->) Backwards where 	f /|\ Backwards x = Backwards $ f x

@@ -3,10 +3,9 @@ module Pandora.Paradigm.Primary.Transformer.Construction where  import Pandora.Core.Functor (type (:.), type (:=), type (:=>), type (~>))-import Pandora.Core.Appliable ((!)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), (<$$>))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-|-), (<-|-)) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)), (-<<-<<-))@@ -27,7 +26,7 @@ import Pandora.Paradigm.Primary.Algebraic (empty) import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!)) import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (reduce)) import Pandora.Paradigm.Schemes (type (<:.>)) @@ -36,34 +35,37 @@ data Construction t a = Construct a (t :. Construction t := a)  instance Covariant (->) (->) t => Covariant (->) (->) (Construction t) where-	f <$> ~(Construct x xs) = Construct # f x # (<$$>) @(->) @(->) f xs+	f <-|- ~(Construct x xs) = Construct # f x # f <-|-|- xs  instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => Semimonoidal (-->) (:*:) (:*:) (Construction t) where-	mult = Straight $ \(Construct x xs :*: Construct y ys) -> Construct (x :*: y) $ (mult @(-->) !) <$> (mult @(-->) ! xs :*: ys)+	mult = Straight $ \(Construct x xs :*: Construct y ys) -> Construct # (x :*: y) # (mult @(-->) !) <-|- (mult @(-->) ! (xs :*: ys))  instance (Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t) => Semimonoidal (<--) (:*:) (:*:) (Construction t) where 	mult = Flip $ \(Construct (x :*: y) xys) -> (Construct x <-> Construct y)-		$ (mult @(<--) !) $ (mult @(<--) !) <$> xys+		$ (mult @(<--) !) $ (mult @(<--) !) <-|- xys -instance (Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t) => Monoidal (<--) (->) (:*:) (:*:) (Construction t) where-	unit _ = Flip $ \(Construct x _) -> (\_ -> x)+instance (Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t) => Monoidal (<--) (-->) (:*:) (:*:) (Construction t) where+	unit _ = Flip $ \(Construct x _) -> Straight (\_ -> x) -instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t, Monoidal (-->) (->) (:*:) (:+:) t) => Monoidal (-->) (->) (:*:) (:*:) (Construction t) where-	unit _ = Straight $ \f -> Construct # f One # empty+--instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:+:) t) => Semimonoidal (-->) (:*:) (:+:) (Construction t) where+	--mult = Straight $ \(Construct x xs :*: Construct y ys) -> +instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t, Monoidal (-->) (-->) (:*:) (:+:) t) => Monoidal (-->) (-->) (:*:) (:*:) (Construction t) where+	unit _ = Straight $ \f -> Construct # run f One # empty+ instance Traversable (->) (->) t => Traversable (->) (->) (Construction t) where-	f <<- ~(Construct x xs) = Construct <$> f x <-*- f -<<-<<- xs+	f <<- ~(Construct x xs) = Construct <-|- f x <-*- f -<<-<<- xs  instance Covariant (->) (->) t => Extendable (->) (Construction t) where-	f <<= x = Construct # f x # (f <<=) <$> deconstruct x+	f <<= x = Construct # f x # (f <<=) <-|- deconstruct x  instance (Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t) => Comonad (->) (Construction t) where  instance (forall u . Semimonoidal (<--) (:*:) (:*:) u) => Lowerable (->) Construction where-	lower x = extract <$> deconstruct x+	lower x = extract <-|- deconstruct x -instance (forall u . Semimonoidal (<--) (:*:) (:*:) u) => Hoistable Construction where-	f /|\ x = Construct # extract x $ f # (f /|\) <$> deconstruct x+instance (forall u . Semimonoidal (<--) (:*:) (:*:) u, forall u . Covariant (->) (->) u) => Hoistable (->) Construction where+	f /|\ x = Construct # extract x $ (/|\) @(->) f <-|- f (deconstruct x)  instance (Setoid a, forall b . Setoid b => Setoid (t b), Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t) => Setoid (Construction t a) where 	x == y = (extract x == extract y) * (deconstruct x == deconstruct y)@@ -85,7 +87,7 @@  -- Generate a construction from seed using effectful computation (.-+) :: Covariant (->) (->) t => a :=> t -> a :=> Construction t-f .-+ x = Construct x $ (f .-+) <$> f x+f .-+ x = Construct x $ (f .-+) <-|- f x -section :: (Comonad (->) t, Monoidal (<--) (->) (:*:) (:*:) t) => t ~> Construction t+section :: (Comonad (->) t, Monoidal (<--) (-->) (:*:) (:*:) t) => t ~> Construction t section xs = Construct # extract xs $ section <<= xs

@@ -5,7 +5,7 @@ import Pandora.Core.Functor (type (:.), type (:=), type (::|:.)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Monoidal (Monoidal) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Monad (Monad)@@ -23,7 +23,7 @@ 	unite = Continuation  instance Covariant (->) (->) t => Covariant (->) (->) (Continuation r t) where-	f <$> Continuation continuation = Continuation $ continuation . (. f)+	f <-|- Continuation continuation = Continuation $ continuation . (. f)  instance Covariant (->) (->) t => Bindable (->) (Continuation r t) where 	f =<< x = Continuation $ \g -> run x $ \y -> run # f y # g@@ -42,8 +42,8 @@ reset = lift . (run % point)  -- | Capture the continuation up to the nearest enclosing 'reset' and pass it-shift :: Monoidal (-->) (->) (:*:) (:*:) t => ((a -> t r) -> Continuation r t r) -> Continuation r t a+shift :: Monoidal (-->) (-->) (:*:) (:*:) t => ((a -> t r) -> Continuation r t r) -> Continuation r t a shift f = Continuation $ (run % point) . f -interruptable :: Monoidal (-->) (->) (:*:) (:*:) t => ((a -> Continuation a t a) -> Continuation a t a) -> t a+interruptable :: Monoidal (-->) (-->) (:*:) (:*:) t => ((a -> Continuation a t a) -> Continuation a t a) -> t a interruptable = (run % point) . cwcc

@@ -3,7 +3,7 @@ module Pandora.Paradigm.Primary.Transformer.Day where  import Pandora.Pattern.Category ((#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=))) import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Paradigm.Primary.Algebraic.Exponential ((!..), (-.#..-))@@ -11,12 +11,12 @@ data Day t u a = forall b c . Day (t b) (u c) (b -> c -> a)  instance Covariant (->) (->) (Day t u) where-	f <$> Day tb uc g = Day tb uc # f -.#..- g+	f <-|- Day tb uc g = Day tb uc # f -.#..- g  instance (Extendable (->) t, Extendable (->) u) => Extendable (->) (Day t u) where 	f <<= day@(Day tb uc _) = Day tb uc (f day !..) -instance Hoistable (Day t) where+instance Hoistable (->) (Day t) where 	g /|\ Day tb uc bca = Day tb # g uc # bca  data Day_ category source target t u r = forall a b .

@@ -3,11 +3,10 @@ module Pandora.Paradigm.Primary.Transformer.Instruction where  import Pandora.Core.Functor (type (:.), type (:=))-import Pandora.Core.Appliable ((!)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($)) import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), (<$$>))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-|-)) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)), (-<<-<<-))@@ -20,40 +19,41 @@ import Pandora.Paradigm.Primary.Algebraic.Product ((:*:)((:*:))) import Pandora.Paradigm.Primary.Algebraic.One (One (One)) import Pandora.Paradigm.Primary.Algebraic (point)+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!))  data Instruction t a = Enter a | Instruct (t :. Instruction t := a)  instance Covariant (->) (->) t => Covariant (->) (->) (Instruction t) where-	f <$> Enter x = Enter $ f x-	f <$> Instruct xs = Instruct $ (<$$>) @(->) @(->) f xs+	f <-|- Enter x = Enter $ f x+	f <-|- Instruct xs = Instruct $ f <-|-|- xs  instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => Semimonoidal (-->) (:*:) (:*:) (Instruction t) where 	mult = Straight $ \case 		Enter x :*: Enter y -> Enter $ x :*: y-		Enter x :*: Instruct y -> (x :*:) <$> Instruct y-		Instruct x :*: Enter y -> (:*: y) <$> Instruct x-		Instruct x :*: Instruct y -> Instruct $ (mult @(-->) !) <$> (mult @(-->) ! x :*: y)+		Enter x :*: Instruct y -> (x :*:) <-|- Instruct y+		Instruct x :*: Enter y -> (:*: y) <-|- Instruct x+		Instruct x :*: Instruct y -> Instruct $ (mult @(-->) !) <-|- (mult @(-->) ! (x :*: y)) -instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => Monoidal (-->) (->) (:*:) (:*:) (Instruction t) where-	unit _ = Straight $ Enter . ($ One)+instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => Monoidal (-->) (-->) (:*:) (:*:) (Instruction t) where+	unit _ = Straight $ Enter . ($ One) . run  instance Covariant (->) (->) t => Bindable (->) (Instruction t) where 	f =<< Enter x = f x-	f =<< Instruct xs = Instruct $ (f =<<) <$> xs+	f =<< Instruct xs = Instruct $ (f =<<) <-|- xs  instance Monad (->) t => Monad (->) (Instruction t) where  instance Traversable (->) (->) t => Traversable (->) (->) (Instruction t) where-	f <<- Enter x = Enter <$> f x-	f <<- Instruct xs = Instruct <$> f -<<-<<- xs+	f <<- Enter x = Enter <-|- f x+	f <<- Instruct xs = Instruct <-|- f -<<-<<- xs  instance Liftable (->) Instruction where-	lift x = Instruct $ Enter <$> x+	lift x = Instruct $ Enter <-|- x -instance (forall t . Bindable (->) t, forall t . Monoidal (-->) (->) (:*:) (:*:) t) => Lowerable (->) Instruction where+instance (forall t . Bindable (->) t, forall t . Monoidal (-->) (-->) (:*:) (:*:) t) => Lowerable (->) Instruction where 	lower (Enter x) = point x 	lower (Instruct xs) = lower =<< xs -instance (forall v . Covariant (->) (->) v) => Hoistable Instruction where+instance (forall v . Covariant (->) (->) v) => Hoistable (->) Instruction where 	_ /|\ Enter x = Enter x-	f /|\ Instruct xs = Instruct $ (f /|\) <$> f xs+	f /|\ Instruct xs = Instruct $ (f /|\) <-|- f xs

@@ -4,7 +4,7 @@  import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (identity, ($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-)) import Pandora.Pattern.Functor.Monoidal (Monoidal) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<)))@@ -22,14 +22,14 @@ data Jack t a = It a | Other (t a)  instance Covariant (->) (->) t => Covariant (->) (->) (Jack t) where-	f <$> It x = It $ f x-	f <$> Other y = Other $ f <$> y+	f <-|- It x = It $ f x+	f <-|- Other y = Other $ f <-|- y  instance Traversable (->) (->) t => Traversable (->) (->) (Jack t) where-	f <<- It x = It <$> f x-	f <<- Other y = Other <$> f <<- y+	f <<- It x = It <-|- f x+	f <<- Other y = Other <-|- f <<- y -instance (Monoidal (-->) (->) (:*:) (:*:) t, Bindable (->) t) => Bindable (->) (Jack t) where+instance (Monoidal (-->) (-->) (:*:) (:*:) t, Bindable (->) t) => Bindable (->) (Jack t) where 	f =<< It x = f x 	f =<< Other x = Other $ jack point identity . f =<< x @@ -40,7 +40,7 @@ instance Liftable (->) Jack where 	lift = Other -instance Hoistable Jack where+instance Hoistable (->) Jack where 	_ /|\ It x = It x 	f /|\ Other x = Other $ f x 

@@ -2,14 +2,14 @@  module Pandora.Paradigm.Primary.Transformer.Jet where -import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), (<$$>))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-|-), (<-|-)) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)), (-<<-<<-)) import Pandora.Paradigm.Primary.Algebraic ((<-*-))  data Jet t a = Jet a (Jet t (t a))  instance Covariant (->) (->) t => Covariant (->) (->) (Jet t) where-	f <$> Jet x xs = Jet (f x) ((<$$>) @(->) @(->) f xs)+	f <-|- Jet x xs = Jet (f x) (f <-|-|- xs)  instance Traversable (->) (->) t => Traversable (->) (->) (Jet t) where-	f <<- Jet x xs = Jet <$> f x <-*- f -<<-<<- xs+	f <<- Jet x xs = Jet <-|- f x <-*- f -<<-<<- xs

@@ -2,8 +2,8 @@  import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($))-import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite)) import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right)) @@ -12,7 +12,7 @@ data instance Kan Left t u b a = Lan ((t b -> a) -> u b)  instance Contravariant (->) (->) (Kan Left t u b) where-	f >$< Lan x = Lan $ x . (f .)+	f >-|- Lan x = Lan $ x . (f .)  instance Interpreted (->) (Kan Left t u b) where 	type Primary (Kan Left t u b) a = (t b -> a) -> u b@@ -22,7 +22,7 @@ data instance Kan Right t u b a = Ran ((a -> t b) -> u b)  instance Covariant (->) (->) (Kan Right t u b) where-	f <$> Ran x = Ran $ x . (. f)+	f <-|- Ran x = Ran $ x . (. f)  instance Interpreted (->) (Kan Right t u b) where 	type Primary (Kan Right t u b) a = (a -> t b) -> u b

@@ -4,7 +4,7 @@  import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (identity, ($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Paradigm.Primary.Algebraic.Exponential ()@@ -14,12 +14,12 @@ 	Outlined :: t a -> Outline t (a -> b) -> Outline t b  instance Covariant (->) (->) (Outline t) where-	f <$> Line a = Line $ f a-	f <$> Outlined x y = Outlined x # (.) f <$> y+	f <-|- Line a = Line $ f a+	f <-|- Outlined x y = Outlined x # (.) f <-|- y  instance Liftable (->) Outline where 	lift t = Outlined t (Line identity) -instance Hoistable Outline where+instance Hoistable (->) Outline where 	_ /|\ Line x = Line x 	f /|\ Outlined x y = Outlined # f x # f /|\ y

@@ -2,11 +2,10 @@  module Pandora.Paradigm.Primary.Transformer.Reverse where -import Pandora.Core.Appliable ((!)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))-import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))@@ -22,33 +21,33 @@ import Pandora.Paradigm.Primary.Algebraic (point, extract) import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite, (!)))  newtype Reverse t a = Reverse (t a)  instance Covariant (->) (->) t => Covariant (->) (->) (Reverse t) where-	f <$> Reverse x = Reverse # f <$> x+	f <-|- Reverse x = Reverse # f <-|- x  instance (Semimonoidal (-->) (:*:) (:*:) t, Covariant (->) (->) t) => Semimonoidal (-->) (:*:) (:*:) (Reverse t) where-	mult = Straight $ \(Reverse x :*: Reverse y) -> Reverse ! mult @(-->) ! (x :*: y)+	mult = Straight $ \(Reverse x :*: Reverse y) -> Reverse $ mult @(-->) ! (x :*: y) -instance (Covariant (->) (->) t, Monoidal (-->) (->) (:*:) (:*:) t) => Monoidal (-->) (->) (:*:) (:*:) (Reverse t) where-	unit _ = Straight $ Reverse . point . ($ One)+instance (Covariant (->) (->) t, Monoidal (-->) (-->) (:*:) (:*:) t) => Monoidal (-->) (-->) (:*:) (:*:) (Reverse t) where+	unit _ = Straight $ Reverse . point . ($ One) . run  instance (Semimonoidal (<--) (:*:) (:*:) t, Covariant (->) (->) t) => Semimonoidal (<--) (:*:) (:*:) (Reverse t) where 	mult = Flip $ (Reverse <-> Reverse) . run (mult @(<--)) . run -instance (Covariant (->) (->) t, Monoidal (<--) (->) (:*:) (:*:) t) => Monoidal (<--) (->) (:*:) (:*:) (Reverse t) where-	unit _ = Flip $ \(Reverse x) -> (\_ -> extract x)+instance (Covariant (->) (->) t, Monoidal (<--) (-->) (:*:) (:*:) t) => Monoidal (<--) (-->) (:*:) (:*:) (Reverse t) where+	unit _ = Flip $ \(Reverse x) -> Straight (\_ -> extract x)  instance Traversable (->) (->) t => Traversable (->) (->) (Reverse t) where-	f <<- Reverse x = Reverse <$> run (Backwards . f <<- x)+	f <<- Reverse x = Reverse <-|- run (Backwards . f <<- x)  instance Distributive (->) (->) t => Distributive (->) (->) (Reverse t) where 	f -<< x = Reverse $ run . f -<< x  instance Contravariant (->) (->) t => Contravariant (->) (->) (Reverse t) where-	f >$< Reverse x = Reverse # f >$< x+	f >-|- Reverse x = Reverse # f >-|- x  instance Interpreted (->) (Reverse t) where 	type Primary (Reverse t) a = t a@@ -61,5 +60,5 @@ instance Lowerable (->) Reverse where 	lower = run -instance Hoistable Reverse where+instance Hoistable (->) Reverse where 	f /|\ Reverse x = Reverse # f x

@@ -3,10 +3,9 @@ module Pandora.Paradigm.Primary.Transformer.Tap where  import Pandora.Core.Functor (type (:=))-import Pandora.Core.Appliable ((!)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))@@ -16,7 +15,7 @@ import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower)) import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Paradigm.Inventory.Store (Store (Store))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!)) import Pandora.Paradigm.Primary.Algebraic ((<-*-), extract) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), twosome) import Pandora.Paradigm.Primary.Algebraic.Exponential (type (<--), type (-->), (%))@@ -33,20 +32,20 @@ data Tap t a = Tap a (t a)  instance Covariant (->) (->) t => Covariant (->) (->) (Tap t) where-	f <$> Tap x xs = Tap # f x # f <$> xs+	f <-|- Tap x xs = Tap # f x # f <-|- xs  instance Semimonoidal (-->) (:*:) (:*:) t => Semimonoidal (-->) (:*:) (:*:) (Tap t) where-	mult = Straight $ \(Tap x xs :*: Tap y ys) -> Tap (x :*: y) $ mult @(-->) ! xs :*: ys+	mult = Straight $ \(Tap x xs :*: Tap y ys) -> Tap # (x :*: y) # (mult @(-->) ! (xs :*: ys))  instance Semimonoidal (<--) (:*:) (:*:) t => Semimonoidal (<--) (:*:) (:*:) (Tap t) where 	mult = Flip $ \(Tap (x :*: y) xys) -> 		(Tap x <-> Tap y) $ mult @(<--) ! xys -instance Semimonoidal (<--) (:*:) (:*:) t => Monoidal (<--) (->) (:*:) (:*:) (Tap t) where-	unit _ = Flip $ \(Tap x _) -> (\_ -> x)+instance Semimonoidal (<--) (:*:) (:*:) t => Monoidal (<--) (-->) (:*:) (:*:) (Tap t) where+	unit _ = Flip $ \(Tap x _) -> Straight (\_ -> x)  instance Traversable (->) (->) t => Traversable (->) (->) (Tap t) where-	f <<- Tap x xs = Tap <$> f x <-*- f <<- xs+	f <<- Tap x xs = Tap <-|- f x <-*- f <<- xs  instance (Semimonoidal (<--) (:*:) (:*:) t, Extendable (->) t, Covariant (->) (->) t) => Extendable (->) (Tap t) where 	f <<= x = Tap # f x $ f . Tap (extract x) <<= lower x@@ -54,7 +53,7 @@ instance Lowerable (->) Tap where 	lower (Tap _ xs) = xs -instance Hoistable Tap where+instance Hoistable (->) Tap where 	f /|\ Tap x xs = Tap x # f xs  instance {-# OVERLAPS #-} Semimonoidal (-->) (:*:) (:*:) t => Semimonoidal (-->) (:*:) (:*:) (Tap (t <:.:> t := (:*:))) where@@ -63,7 +62,7 @@  instance {-# OVERLAPS #-} Traversable (->) (->) t => Traversable (->) (->) (Tap (t <:.:> t := (:*:))) where 	f <<- Tap x (T_U (future :*: past)) = (\past' x' future' -> Tap x' $ twosome # future' # run past')-		<$> f <<- Reverse past <-*- f x <-*- f <<- future+		<-|- f <<- Reverse past <-*- f x <-*- f <<- future  instance (Covariant (->) (->) t) => Substructure Root (Tap (t <:.:> t := (:*:))) where 	type Available Root (Tap (t <:.:> t := (:*:))) = Identity

@@ -3,7 +3,7 @@ module Pandora.Paradigm.Primary.Transformer.Yoneda where  import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Paradigm.Primary.Algebraic.Exponential () @@ -11,7 +11,7 @@ 	{ yoneda :: forall b . (a -> b) -> t b }  instance Covariant (->) (->) (Yoneda t) where-	f <$> x = Yoneda (\k -> yoneda x (k . f))+	f <-|- x = Yoneda (\k -> yoneda x (k . f))  instance Liftable (->) Yoneda where-	lift x = Yoneda (<$> x)+	lift x = Yoneda (<-|- x)

@@ -1,10 +1,12 @@+{-# LANGUAGE UndecidableInstances #-}+ module Pandora.Paradigm.Schemes.TU where  import Pandora.Core.Functor (type (:.), type (:=), type (~>))-import Pandora.Core.Appliable ((!))-import Pandora.Pattern.Semigroupoid ((.))+import Pandora.Pattern.Betwixt (Betwixt)+import Pandora.Pattern.Semigroupoid (Semigroupoid ((.))) import Pandora.Pattern.Category (($), identity)-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), (<$$>))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-|-)) import Pandora.Pattern.Functor.Contravariant (Contravariant) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit))@@ -15,7 +17,7 @@ import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower)) import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\)))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite, (||=)))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite, (!), (||=))) import Pandora.Paradigm.Primary.Algebraic.Exponential (type (<--), type (-->)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Primary.Algebraic.Sum ((:+:) (Option, Adoption), sum)@@ -38,41 +40,41 @@ 	run ~(TU x) = x 	unite = TU -instance (Covariant m m t, Covariant m m u, Interpreted m (t <:.> u)) => Covariant m m (t <:.> u) where-	(<$>) f = (||=) ((<$$>) @m @m f)+instance (Semigroupoid m, Covariant (Betwixt m m) m t, Covariant m (Betwixt m m) u, Interpreted m (t <:.> u)) => Covariant m m (t <:.> u) where+	(<-|-) f = (||=) ((<-|-|-) f)  instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:*:) u) => Semimonoidal (-->) (:*:) (:*:) (t <:.> u) where-	mult = Straight $ TU . (<$>) (mult @(-->) !) . (mult @(-->) !) . (run @(->) <-> run @(->))+	mult = Straight $ TU . (<-|-) (mult @(-->) !) . (mult @(-->) !) . (run @(->) <-> run @(->)) -instance (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) u, Monoidal (-->) (->) (:*:) (:*:) t, Monoidal (-->) (->) (:*:) (:*:) u) => Monoidal (-->) (->) (:*:) (:*:) (t <:.> u) where-	unit _ = Straight $ TU . point . point . ($ One)+instance (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) u, Monoidal (-->) (-->) (:*:) (:*:) t, Monoidal (-->) (-->) (:*:) (:*:) u) => Monoidal (-->) (-->) (:*:) (:*:) (t <:.> u) where+	unit _ = Straight $ TU . point . point . ($ One) . run -instance (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:+:) t) => Semimonoidal (-->) (:*:) (:+:) (t <:.> u) where-	mult = Straight $ \(TU x :*: TU y) -> TU $ sum (Option <$>) (Adoption <$>) <$> (mult @(-->) ! x :*: y)+instance (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:+:) u) => Semimonoidal (-->) (:*:) (:+:) (t <:.> u) where+	mult = Straight $ \(TU x :*: TU y) -> TU $ (mult @(-->) @(:*:) @(:+:)) <-|- (mult @(-->) @(:*:) @(:*:) ! (x :*: y)) -instance (Covariant (->) (->) t, Covariant (->) (->) u, Monoidal (-->) (->) (:*:) (:+:) t) => Monoidal (-->) (->) (:*:) (:+:) (t <:.> u) where+instance (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:+:) u, Monoidal (-->) (-->) (:*:) (:+:) t) => Monoidal (-->) (-->) (:*:) (:+:) (t <:.> u) where 	unit _ = Straight $ \_ -> TU empty  instance (Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t, Semimonoidal (<--) (:*:) (:*:) u) => Semimonoidal (<--) (:*:) (:*:) (t <:.> u) where-	mult = Flip $ \(TU xys) -> (TU <-> TU) . (mult @(<--) !) $ (mult @(<--) !) <$> xys+	mult = Flip $ \(TU xys) -> (TU <-> TU) . (mult @(<--) !) $ (mult @(<--) !) <-|- xys -instance (Covariant (->) (->) t, Monoidal (<--) (->) (:*:) (:*:) t, Monoidal (<--) (->) (:*:) (:*:) u) => Monoidal (<--) (->) (:*:) (:*:) (t <:.> u) where-	unit _ = Flip $ \(TU x) -> (\_ -> extract $ extract x)+instance (Covariant (->) (->) t, Monoidal (<--) (-->) (:*:) (:*:) t, Monoidal (<--) (-->) (:*:) (:*:) u) => Monoidal (<--) (-->) (:*:) (:*:) (t <:.> u) where+	unit _ = Flip $ \(TU x) -> Straight (\_ -> extract $ extract x)  instance (Traversable (->) (->) t, Traversable (->) (->) u) => Traversable (->) (->) (t <:.> u) where-	f <<- x = TU <$> f -<<-<<- run x+	f <<- x = TU <-|- f -<<-<<- run x  instance (Bindable (->) t, Distributive (->) (->) t, Covariant (->) (->) u, Bindable (->) u) => Bindable (->) (t <:.> u) where-	f =<< TU x = TU $ (\i -> (identity =<<) <$> run . f -<< i) =<< x+	f =<< TU x = TU $ (\i -> (identity =<<) <-|- run . f -<< i) =<< x -instance Monoidal (-->) (->) (:*:) (:*:) t => Liftable (->) (TU Covariant Covariant t) where+instance Monoidal (-->) (-->) (:*:) (:*:) t => Liftable (->) (TU Covariant Covariant t) where 	lift :: Covariant (->) (->) u => u ~> t <:.> u 	lift = TU . point -instance Monoidal (<--) (->) (:*:) (:*:) t => Lowerable (->) (TU Covariant Covariant t) where+instance Monoidal (<--) (-->) (:*:) (:*:) t => Lowerable (->) (TU Covariant Covariant t) where 	lower :: t <:.> u ~> u 	lower (TU x) = extract x -instance Covariant (->) (->) t => Hoistable (TU Covariant Covariant t) where+instance Covariant (->) (->) t => Hoistable (->) (TU Covariant Covariant t) where 	(/|\) :: u ~> v -> (t <:.> u ~> t <:.> v)-	f /|\ TU x = TU $ f <$> x+	f /|\ TU x = TU $ f <-|- x

@@ -1,14 +1,17 @@+{-# LANGUAGE UndecidableInstances #-}+ module Pandora.Paradigm.Schemes.TUT where  import Pandora.Core.Functor (type (:.), type (:=), type (~>))-import Pandora.Core.Appliable ((!))-import Pandora.Pattern.Semigroupoid ((.))+import Pandora.Pattern.Betwixt (Betwixt)+import Pandora.Pattern.Semigroupoid (Semigroupoid ((.))) import Pandora.Pattern.Category (identity, ($))-import Pandora.Pattern.Functor.Covariant (Covariant, Covariant ((<$>)), (<$$>), (<$$$>))+import Pandora.Pattern.Functor.Covariant (Covariant, Covariant ((<-|-)), (<-|-|-), (<-|-|-|-)) import Pandora.Pattern.Functor.Contravariant (Contravariant) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Bivariant ((<->))@@ -16,12 +19,13 @@ import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower)) import Pandora.Paradigm.Primary.Algebraic.Exponential (type (<--), type (-->))-import Pandora.Paradigm.Primary.Algebraic.Product ((:*:)((:*:)))+import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)))+import Pandora.Paradigm.Primary.Algebraic.Sum ((:+:) (Option, Adoption)) import Pandora.Paradigm.Primary.Algebraic.One (One (One)) import Pandora.Paradigm.Primary.Algebraic (point, extract) import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite, (||=)))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite, (!), (||=)))  newtype TUT ct ct' cu t t' u a = TUT (t :. u :. t' := a) @@ -41,26 +45,34 @@ 	run ~(TUT x) = x 	unite = TUT -instance (Covariant m m t, Covariant m m u, Covariant m m t', Interpreted m (t <:<.>:> t' := u)) => Covariant m m (t <:<.>:> t' := u) where-	(<$>) f = (||=) ((<$$$>) @m @m @m f)+instance (Semigroupoid m, Covariant (Betwixt (Betwixt m m) m) m t, Covariant (Betwixt m (Betwixt m m)) (Betwixt (Betwixt m m) m) u, Covariant m (Betwixt m (Betwixt m m)) t', Interpreted m (t <:<.>:> t' := u)) => Covariant m m (t <:<.>:> t' := u) where+	(<-|-) f = (||=) ((<-|-|-|-) f) -instance (Covariant (->) (->) t, Covariant (->) (->) t', Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:*:) u, Semimonoidal (-->) (:*:) (:*:) t') => Semimonoidal (-->) (:*:) (:*:) (t <:<.>:> t' := u) where-	mult = Straight $ TUT . (<$$>) @_ @(->) (mult @(-->) !) . (<$>) (mult @(-->) !) . (mult @(-->) !) . (run @(->) <-> run @(->))+instance (Adjoint (->) (->) t' t, Bindable (->) u) => Semimonoidal (-->) (:*:) (:*:) (t <:<.>:> t' := u) where+	mult = Straight $ \(TUT x :*: TUT y) -> TUT ((((\r -> (<-|-|-|-) (r :*:) y) |-) =<<) <-|- x)  instance (Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t, Covariant (->) (->) u, Semimonoidal (<--) (:*:) (:*:) u, Covariant (->) (->) t', Semimonoidal (<--) (:*:) (:*:) t') => Semimonoidal (<--) (:*:) (:*:) (t <:<.>:> t' := u) where-	mult = Flip $ (TUT <-> TUT) . (mult @(<--) !) . (<$>) (mult @(<--) !) . (<$$>) @_ @(->) (mult @(<--) !) . run+	mult = Flip $ (TUT <-> TUT) . (mult @(<--) !) . (<-|-) (mult @(<--) !) . (<-|-|-) @_ @(->) (mult @(<--) !) . run -instance (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (<--) (:*:) (:*:) t, Semimonoidal (<--) (:*:) (:*:) t', Monoidal (<--) (->) (:*:) (:*:) u, Adjoint (->) (->) t t') => Monoidal (<--) (->) (:*:) (:*:) (t <:<.>:> t' := u) where-	unit _ = Flip $ \(TUT xys) -> (\_ -> (extract |-) xys)+instance (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (<--) (:*:) (:*:) t, Semimonoidal (<--) (:*:) (:*:) t', Monoidal (<--) (-->) (:*:) (:*:) u, Adjoint (->) (->) t t') => Monoidal (<--) (-->) (:*:) (:*:) (t <:<.>:> t' := u) where+	unit _ = Flip $ \(TUT xys) -> Straight (\_ -> (extract |-) xys) +-- TODO: generalize on (->) and (:*:)+instance {-# OVERLAPS #-} (Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:+:) u) => Semimonoidal (-->) (:*:) (:+:) ((->) s <:<.>:> (:*:) s := u) where+ mult = Straight $ \(TUT x :*: TUT y) -> TUT $ product_over_sum <-|-|- mult @(-->) @(:*:) @(:+:) <-|- (mult @(-->) @(:*:) @(:*:) ! (x :*: y))++product_over_sum :: (s :*: a) :+: (s :*: b) -> s :*: (a :+: b)+product_over_sum (Option (s :*: x)) = s :*: Option x+product_over_sum (Adoption (s :*: y)) = s :*: Adoption y+ instance (Covariant (->) (->) t, Covariant (->) (->) t', Adjoint (->) (->) t' t, Bindable (->) u) => Bindable (->) (t <:<.>:> t' := u) where-	f =<< x = TUT $ ((run . f |-) =<<) <$> run x+	f =<< x = TUT $ ((run . f |-) =<<) <-|- run x -instance (Covariant (->) (->) t, Covariant (->) (->) u, Covariant (->) (->) t', Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:*:) t', Monoidal (-->) (->) (:*:) (:*:) u, Adjoint (->) (->) t' t) => Monoidal (-->) (->) (:*:) (:*:) (t <:<.>:> t' := u) where-	unit _ = Straight $ unite . (point -|) . ($ One)+instance (Bindable (->) u, Monoidal (-->) (-->) (:*:) (:*:) u, Adjoint (->) (->) t' t) => Monoidal (-->) (-->) (:*:) (:*:) (t <:<.>:> t' := u) where+	unit _ = Straight $ unite . (point -|) . ($ One) . run  instance (Adjoint (->) (->) t' t, Extendable (->) u) => Extendable (->) (t' <:<.>:> t := u) where-	f <<= x = TUT $ ((f . unite -|) <<=) <$> run x+	f <<= x = TUT $ ((f . unite -|) <<=) <-|- run x  instance (Adjoint (->) (->) t' t, Distributive (->) (->) t) => Liftable (->) (t <:<.>:> t') where 	lift :: Covariant (->) (->) u => u ~> t <:<.>:> t' := u

@@ -1,8 +1,8 @@ module Pandora.Paradigm.Schemes.T_U where  import Pandora.Core.Functor (type (:=))-import Pandora.Pattern.Functor.Covariant (Covariant, Covariant ((<$>)))-import Pandora.Pattern.Functor.Contravariant (Contravariant, Contravariant ((>$<)))+import Pandora.Pattern.Functor.Covariant (Covariant, Covariant ((<-|-)))+import Pandora.Pattern.Functor.Contravariant (Contravariant, Contravariant ((>-|-))) import Pandora.Pattern.Functor.Bivariant (Bivariant ((<->))) import Pandora.Pattern.Functor.Divariant (Divariant ((>->))) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite, (||=)))@@ -22,10 +22,10 @@ 	unite = T_U  instance (forall i . Covariant (->) (->) (p i), Bivariant (->) (->) (->) p,  Covariant (->) (->) t, Covariant (->) (->) u) => Covariant (->) (->) (t <:.:> u := p) where-	f <$> x = (f <$>) <-> (f <$>) ||= x+	f <-|- x = (f <-|-) <-> (f <-|-) ||= x  instance (Divariant (->) (->) (->) p, Contravariant (->) (->) t, Covariant (->) (->) u) => Covariant (->) (->) (t >:.:> u := p) where-	f <$> x = (f >$<) >-> (f <$>) ||= x+	f <-|- x = (f >-|-) >-> (f <-|-) ||= x  instance (forall i . Covariant (->) (->) (p i), Bivariant (->) (->) (->) p, Contravariant (->) (->) t, Contravariant (->) (->) u) => Contravariant (->) (->) (t >:.:< u := p) where-	f >$< x = (f >$<) <-> (f >$<) ||= x+	f >-|- x = (f >-|-) <-> (f >-|-) ||= x

@@ -1,11 +1,13 @@+{-# LANGUAGE UndecidableInstances #-}+ module Pandora.Paradigm.Schemes.UT where  import Pandora.Core.Functor (type (:.), type (:=), type (~>))-import Pandora.Core.Appliable ((!))-import Pandora.Pattern.Semigroupoid ((.))+import Pandora.Pattern.Betwixt (Betwixt)+import Pandora.Pattern.Semigroupoid (Semigroupoid ((.))) import Pandora.Pattern.Category (($), identity) import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), (<$$>))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-|-)) import Pandora.Pattern.Functor.Contravariant (Contravariant) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit))@@ -14,10 +16,12 @@ import Pandora.Pattern.Functor.Bivariant ((<->)) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite, (||=)))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite, (!), (||=))) import Pandora.Paradigm.Primary.Algebraic.Exponential (type (<--), type (-->))+import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)))+import Pandora.Paradigm.Primary.Algebraic.Sum ((:+:) (Option, Adoption), sum) import Pandora.Paradigm.Primary.Algebraic.One (One (One))-import Pandora.Paradigm.Primary.Algebraic ((:*:) ((:*:)), point, extract)+import Pandora.Paradigm.Primary.Algebraic (point, extract) import Pandora.Pattern.Morphism.Flip (Flip (Flip))  newtype UT ct cu t u a = UT (u :. t := a)@@ -34,28 +38,31 @@ 	run ~(UT x) = x 	unite = UT -instance (Covariant m m t, Covariant m m u, Interpreted m (t <.:> u)) => Covariant m m (t <.:> u) where-	(<$>) f = (||=) ((<$$>) @m @m f)+instance (Semigroupoid m, Covariant m (Betwixt m m) t, Covariant (Betwixt m m) m u, Interpreted m (t <.:> u)) => Covariant m m (t <.:> u) where+	(<-|-) f = (||=) ((<-|-|-) f)  instance (Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:*:) u) => Semimonoidal (-->) (:*:) (:*:) (t <.:> u) where-	mult = Straight $ UT . (<$>) (mult @(-->) !) . (mult @(-->) !) . (run @(->) <-> run @(->))+	mult = Straight $ UT . (<-|-) (mult @(-->) !) . (mult @(-->) !) . (run @(->) <-> run @(->)) -instance (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) u, Monoidal (-->) (->) (:*:) (:*:) t, Monoidal (-->) (->) (:*:) (:*:) u) => Monoidal (-->) (->) (:*:) (:*:) (t <.:> u) where-	unit _ = Straight $ UT . point . point . ($ One)+instance (Covariant (->) (->) u, Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) u, Semimonoidal (-->) (:*:) (:+:) t) => Semimonoidal (-->) (:*:) (:+:) (t <.:> u) where+	mult = Straight $ \(UT x :*: UT y) -> UT $ (mult @(-->) @(:*:) @(:+:)) <-|- (mult @(-->) @(:*:) @(:*:) ! (x :*: y)) -instance (Traversable (->) (->) t, Bindable (->) t, Semimonoidal (-->) (:*:) (:*:) u, Monoidal (-->) (->) (:*:) (:*:) u, Bindable (->) u) => Bindable (->) (t <.:> u) where-	f =<< UT x = UT $ ((identity =<<) <$>) . (run . f <<-) =<< x+instance (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) u, Monoidal (-->) (-->) (:*:) (:*:) t, Monoidal (-->) (-->) (:*:) (:*:) u) => Monoidal (-->) (-->) (:*:) (:*:) (t <.:> u) where+	unit _ = Straight $ UT . point . point . ($ One) . run +instance (Traversable (->) (->) t, Bindable (->) t, Semimonoidal (-->) (:*:) (:*:) u, Monoidal (-->) (-->) (:*:) (:*:) u, Bindable (->) u) => Bindable (->) (t <.:> u) where+	f =<< UT x = UT $ ((identity =<<) <-|-) . (run . f <<-) =<< x+ instance (Covariant (->) (->) u, Semimonoidal (<--) (:*:) (:*:) t, Semimonoidal (<--) (:*:) (:*:) u) => Semimonoidal (<--) (:*:) (:*:) (t <.:> u) where-	mult = Flip $ \(UT xys) -> (UT <-> UT) . (mult @(<--) !) $ (mult @(<--) !) <$> xys+	mult = Flip $ \(UT xys) -> (UT <-> UT) . (mult @(<--) !) $ (mult @(<--) !) <-|- xys -instance (Covariant (->) (->) u, Monoidal (<--) (->) (:*:) (:*:) t, Monoidal (<--) (->) (:*:) (:*:) u) => Monoidal (<--) (->) (:*:) (:*:) (t <.:> u) where-	unit _ = Flip $ \(UT x) -> (\_ -> extract $ extract x)+instance (Covariant (->) (->) u, Monoidal (<--) (-->) (:*:) (:*:) t, Monoidal (<--) (-->) (:*:) (:*:) u) => Monoidal (<--) (-->) (:*:) (:*:) (t <.:> u) where+	unit _ = Flip $ \(UT x) -> Straight (\_ -> extract $ extract x) -instance Monoidal (-->) (->) (:*:) (:*:) t => Liftable (->) (UT Covariant Covariant t) where+instance Monoidal (-->) (-->) (:*:) (:*:) t => Liftable (->) (UT Covariant Covariant t) where 	lift :: Covariant (->) (->) u => u ~> t <.:> u-	lift x = UT $ point <$> x+	lift x = UT $ point <-|- x -instance Monoidal (<--) (->) (:*:) (:*:) t => Lowerable (->) (UT Covariant Covariant t) where+instance Monoidal (<--) (-->) (:*:) (:*:) t => Lowerable (->) (UT Covariant Covariant t) where 	lower :: Covariant (->) (->) u => t <.:> u ~> u-	lower (UT x) = extract <$> x+	lower (UT x) = extract <-|- x

@@ -1,3 +1,4 @@+{-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}  module Pandora.Paradigm.Structure (module Exports) where@@ -9,12 +10,12 @@  import Pandora.Core.Functor (type (:=)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Category (($), (#), identity)+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.Controlflow.Effect.Interpreted (run, (||=))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (||=), (!)) import Pandora.Paradigm.Inventory.Optics () import Pandora.Paradigm.Inventory.Store (Store (Store)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), attached, twosome)@@ -46,28 +47,31 @@  instance Morphable (Into (Preorder (Construction Maybe))) (Construction Wye) where 	type Morphing (Into (Preorder (Construction Maybe))) (Construction Wye) = Construction Maybe-	morphing (premorph -> Construct x End) = Construct x Nothing-	morphing (premorph -> Construct x (Left lst)) = Construct x . Just $ into @(Preorder (Nonempty List)) lst-	morphing (premorph -> Construct x (Right rst)) = Construct x . Just $ into @(Preorder (Nonempty List)) rst-	morphing (premorph -> Construct x (Both lst rst)) = Construct x . Just $ into @(Preorder (Nonempty List)) lst + into @(Preorder (Nonempty List)) rst+	morphing nonempty_binary = case premorph nonempty_binary of+		Construct x End -> Construct x Nothing+		Construct x (Left lst) -> Construct x . Just $ into @(Preorder (Nonempty List)) lst+		Construct x (Right rst) -> Construct x . Just $ into @(Preorder (Nonempty List)) rst+		Construct x (Both lst rst) -> Construct x . Just $ into @(Preorder (Nonempty List)) lst + into @(Preorder (Nonempty List)) rst  instance Morphable (Into (Inorder (Construction Maybe))) (Construction Wye) where 	type Morphing (Into (Inorder (Construction Maybe))) (Construction Wye) = Construction Maybe-	morphing (premorph -> Construct x End) = Construct x Nothing-	morphing (premorph -> Construct x (Left lst)) = into @(Inorder (Nonempty List)) lst + Construct x Nothing-	morphing (premorph -> Construct x (Right rst)) = Construct x Nothing + into @(Inorder (Nonempty List)) rst-	morphing (premorph -> Construct x (Both lst rst)) = into @(Inorder (Nonempty List)) lst + Construct x Nothing + into @(Inorder (Nonempty List)) rst+	morphing nonempty_binary = case premorph nonempty_binary of+		Construct x End -> Construct x Nothing+		Construct x (Left lst) -> into @(Inorder (Nonempty List)) lst + Construct x Nothing+		Construct x (Right rst) -> Construct x Nothing + into @(Inorder (Nonempty List)) rst+		Construct x (Both lst rst) -> into @(Inorder (Nonempty List)) lst + Construct x Nothing + into @(Inorder (Nonempty List)) rst  instance Morphable (Into (Postorder (Construction Maybe))) (Construction Wye) where 	type Morphing (Into (Postorder (Construction Maybe))) (Construction Wye) = Construction Maybe-	morphing (premorph -> Construct x End) = Construct x Nothing-	morphing (premorph -> Construct x (Left lst)) = into @(Postorder (Nonempty List)) lst + Construct x Nothing-	morphing (premorph -> Construct x (Right rst)) = into @(Postorder (Nonempty List)) rst + Construct x Nothing-	morphing (premorph -> Construct x (Both lst rst)) = into @(Postorder (Nonempty List)) lst + into @(Postorder (Nonempty List)) rst + Construct x Nothing+	morphing nonempty_binary = case premorph nonempty_binary of+		Construct x End -> Construct x Nothing+		Construct x (Left lst) -> into @(Postorder (Nonempty List)) lst + Construct x Nothing+		Construct x (Right rst) -> into @(Postorder (Nonempty List)) rst + Construct x Nothing+		Construct x (Both lst rst) -> into @(Postorder (Nonempty List)) lst + into @(Postorder (Nonempty List)) rst + Construct x 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+	morphing (premorph -> xs) = (into @(o ds) <-|-) ||= xs  instance Substructure Left (Flip (:*:) a) where 	type Available Left (Flip (:*:) a) = Identity@@ -89,6 +93,23 @@  instance {-# OVERLAPS #-} Accessible b a => Accessible b (s :*: a) where 	access = access @b . access @a++instance Accessible a (Identity a) where+	access = P_Q_T $ \(Identity x) -> Store $ Identity x :*: identity++instance Possible a (Maybe a) where+	perhaps = P_Q_T $ \x -> Store $ x :*: identity++instance Accessible target source => Possible target (Maybe source) where+	perhaps = let lst = access @target @source in P_Q_T $ \case+		Just source -> let (Identity target :*: its) = run $ lst ! source in+			Store $ Just target :*: (its . Identity <-|-)+		Nothing -> Store $ Nothing :*: \_ -> Nothing++instance Accessible (Maybe target) source => Possible target source where+	perhaps = let lst = access @(Maybe target) @source in P_Q_T $ \source ->+		let target :*: imts = run $ lst ! source in+			Store $ extract target :*: imts . Identity  instance (Covariant (->) (->) t) => Substructure Left (t <:.:> t := (:*:)) where 	type Available Left (t <:.:> t := (:*:)) = Identity

@@ -4,6 +4,7 @@ import Pandora.Paradigm.Structure.Ability.Zipper as Exports import Pandora.Paradigm.Structure.Ability.Substructure as Exports import Pandora.Paradigm.Structure.Ability.Morphable as Exports+import Pandora.Paradigm.Structure.Ability.Possible as Exports import Pandora.Paradigm.Structure.Ability.Accessible as Exports import Pandora.Paradigm.Structure.Ability.Nullable as Exports import Pandora.Paradigm.Structure.Ability.Nonempty as Exports

@@ -0,0 +1,7 @@+module Pandora.Paradigm.Structure.Ability.Possible where++import Pandora.Paradigm.Primary.Functor.Maybe (Maybe)+import Pandora.Paradigm.Inventory.Optics (Lens)++class Possible target source where+	perhaps :: Lens Maybe source target

@@ -4,14 +4,20 @@ module Pandora.Paradigm.Structure.Ability.Substructure where  import Pandora.Core.Functor (type (:=))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Semigroupoid (Semigroupoid ((.)))+import Pandora.Pattern.Category (($), identity)+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Divariant ((>->)) import Pandora.Pattern.Transformer.Liftable (lift) import Pandora.Pattern.Transformer.Lowerable (lower) import Pandora.Paradigm.Controlflow.Effect.Interpreted ((||=))-import Pandora.Paradigm.Inventory.Optics (type (#=@))+import Pandora.Paradigm.Inventory.Store (Store (Store))+import Pandora.Paradigm.Inventory.Optics (Lens, Convex, type (#=@))+import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)))+import Pandora.Paradigm.Primary.Functor.Identity (Identity) import Pandora.Paradigm.Primary.Functor.Tagged (Tagged) import Pandora.Paradigm.Schemes.TU (type (<:.>))+import Pandora.Paradigm.Schemes.P_Q_T (P_Q_T (P_Q_T))  data Segment a = Root a | Tail a @@ -24,4 +30,14 @@ 	substructure :: (Tagged segment <:.> structure) #=@ Substance segment structure := Available segment structure  	sub :: (Covariant (->) (->) structure) => structure #=@ Substance segment structure := Available segment structure-	sub = lift @(->) >-> (lower @(->) <$>) ||= substructure @segment @structure+	sub = lift @(->) >-> (lower @(->) <-|-) ||= substructure @segment @structure++-- TODO: generalize `available` and then rename to `singleton`+-- The main problem is that we should handle (Maybe target -> sourse)+-- For Convex Lens: we can ignore Identity cause we can wrap/unwrap its value+-- For Obscure Lens: if we got nothing -> nothing should change+only :: forall segment structure element . (Covariant (->) (->) structure, Substructured segment structure Identity Identity) => Convex Lens (structure element) element+only = inner . ((sub @segment) :: Convex Lens (structure element) (Identity element)) where++	inner :: Convex Lens (Identity element) element+	inner = P_Q_T $ \x -> Store $ x :*: identity

@@ -1,10 +1,101 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TypeSynonymInstances #-}+ module Pandora.Paradigm.Structure.Ability.Zipper where -import Pandora.Core.Functor (type (:::))-import Pandora.Paradigm.Structure.Ability.Morphable (Morphable, Morph (Rotate))+import Pandora.Core.Functor (type (:=), type (:::))+import Pandora.Pattern.Morphism.Flip (Flip (Flip))+import Pandora.Pattern.Morphism.Straight (Straight (Straight))+import Pandora.Pattern.Semigroupoid ((.))+import Pandora.Pattern.Category (($), (#))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult))+import Pandora.Pattern.Functor.Monoidal (Monoidal (unit))+import Pandora.Pattern.Transformer.Liftable (lift)+import Pandora.Pattern.Transformer.Lowerable (lower)+import Pandora.Paradigm.Primary.Algebraic (extract)+import Pandora.Paradigm.Primary.Algebraic.Exponential (type (<--), type (-->), (%))+import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), twosome)+import Pandora.Paradigm.Primary.Algebraic ((<-*-))+import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity))+import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right))+import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>))+import Pandora.Paradigm.Schemes.T_U (T_U (T_U), type (<:.:>))+import Pandora.Paradigm.Schemes.P_Q_T (P_Q_T (P_Q_T))+import Pandora.Paradigm.Structure.Ability.Morphable (Morphable, Morph (Rotate), Vertical (Up, Down))+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Available, Substance, substructure), Segment (Root), sub)+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!), (||=))+import Pandora.Paradigm.Inventory.Store (Store (Store))+import Pandora.Paradigm.Inventory.Optics (set, view) -type family Zipper (structure :: * -> *) (moves :: k) = (result :: * -> *) | result -> structure+class Zippable (structure :: * -> *) where+	type Breadcrumbs structure :: * -> * +type Zipper (structure :: * -> *) = Identity <:.:> Breadcrumbs structure := (:*:)++type Breadcrumbed structure t = (Zippable structure, Breadcrumbs structure ~ t)++instance {-# OVERLAPS #-} Semimonoidal (<--) (:*:) (:*:) t => Semimonoidal (<--) (:*:) (:*:) (Identity <:.:> t := (:*:)) where+	mult = Flip $ \(T_U (Identity (x :*: y) :*: xys)) ->+		let xs :*: ys = mult @(<--) ! xys in+			T_U (Identity x :*: xs) :*: T_U (Identity y :*: ys)++instance {-# OVERLAPS #-} Semimonoidal (<--) (:*:) (:*:) t => Monoidal (<--) (-->) (:*:) (:*:) (Identity <:.:> t := (:*:)) where+	unit _ = Flip $ \(T_U (Identity x :*: _)) -> Straight (\_ -> x)+ type family Fastenable structure rs where 	Fastenable structure (r ::: rs) = (Morphable (Rotate r) structure, Fastenable structure rs) 	Fastenable structure r = Morphable (Rotate r) structure++type Tape t = Identity <:.:> (t <:.:> t := (:*:)) := (:*:)++-- TODO: It's too fragile to define such an instance without any hints about zippers?+-- Should we wrap Zipper in Tagged Zippable?+instance Covariant (->) (->) t => Substructure Root (Tape t) where+	type Available Root (Tape t) = Identity+	type Substance Root (Tape t) = Identity+	substructure = P_Q_T $ \zipper -> case run # lower zipper of+		 Identity x :*: xs -> Store $ Identity (Identity x) :*: lift . T_U . (:*: xs) . extract++instance Covariant (->) (->) t => Substructure Left (Tape t) where+	type Available Left (Tape t) = Identity+	type Substance Left (Tape t) = t+	substructure = P_Q_T $ \zipper -> case run # lower zipper of+		Identity x :*: T_U (ls :*: rs) -> Store $ Identity ls :*: lift . T_U . (Identity x :*:) . T_U . (:*: rs) . extract++instance Covariant (->) (->) t => Substructure Right (Tape t) where+	type Available Right (Tape t) = Identity+	type Substance Right (Tape t) = t+	substructure = P_Q_T $ \zipper -> case run # lower zipper of+		Identity x :*: T_U (ls :*: rs) -> Store $ Identity rs :*: lift . T_U . (Identity x :*:) . T_U . (ls :*:) . extract++instance Covariant (->) (->) t => Substructure Up (Tape t <:.> Tape t) where+	type Available Up (Tape t <:.> Tape t) = Identity+	type Substance Up (Tape t <:.> Tape t) = t <:.> Tape t+	substructure = P_Q_T $ \x -> case run . run . extract . run # x of+		Identity focused :*: T_U (d :*: u) -> +			Store $ Identity (TU u) :*: lift . TU . twosome (Identity focused) . twosome d . run . extract++instance Covariant (->) (->) t => Substructure Down (Tape t <:.> Tape t) where+	type Available Down (Tape t <:.> Tape t) = Identity+	type Substance Down (Tape t <:.> Tape t) = t <:.> Tape t+	substructure = P_Q_T $ \ii -> case run . run . extract . run # ii of+		Identity focused :*: T_U (d :*: u) -> +			Store $ Identity (TU d) :*: lift . TU . twosome (Identity focused) . (twosome % u) . run . extract++instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => Substructure Left (Tape t <:.> Tape t) where+	type Available Left (Tape t <:.> Tape t) = Identity+	type Substance Left (Tape t <:.> Tape t) = Tape t <:.> t+	substructure = P_Q_T $ \ii ->+		let target = (extract . view (sub @Left) <-|-) ||= (lower ii) in+		let updated new = set (sub @Left) . Identity <-|- new <-*- run (lower ii) in+		Store $ Identity target :*: lift . (updated ||=) . extract++instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => Substructure Right (Tape t <:.> Tape t) where+	type Available Right (Tape t <:.> Tape t) = Identity+	type Substance Right (Tape t <:.> Tape t) = Tape t <:.> t+	substructure = P_Q_T $ \ii ->+		let target = (extract . view (sub @Right) <-|-) ||= lower ii in+		let updated new = set (sub @Right) . Identity <-|- new <-*- run (lower ii) in+		Store $ Identity target :*: lift . (updated ||=) . extract

@@ -4,12 +4,11 @@ module Pandora.Paradigm.Structure.Modification.Comprehension where  import Pandora.Core.Functor (type (:=))-import Pandora.Core.Appliable ((!)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($)) import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))-import Pandora.Pattern.Functor.Contravariant ((>$<))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Pattern.Functor.Contravariant ((>-|-)) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))@@ -21,7 +20,7 @@ import Pandora.Pattern.Object.Setoid (Setoid ((==))) import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite, (!))) import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>)) import Pandora.Paradigm.Schemes.T_U (T_U (T_U), type (<:.:>)) import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Push), premorph)@@ -39,15 +38,15 @@ 	unite = Comprehension  instance Covariant (->) (->) (t <:.> Construction t) => Covariant (->) (->) (Comprehension t) where-	f <$> Comprehension x = Comprehension $ f <$> x+	f <-|- Comprehension x = Comprehension $ f <-|- x  instance Traversable (->) (->) (t <:.> Construction t) => Traversable (->) (->) (Comprehension t) where-	f <<- Comprehension x = Comprehension <$> f <<- x+	f <<- Comprehension x = Comprehension <-|- f <<- x  instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) right t, Semimonoidal (-->) (:*:) right (t <:.> Construction t)) => Semimonoidal (-->) (:*:) right (Comprehension t) where 	mult = Straight $ Comprehension . (mult @(-->) @(:*:) @right !) . (run @(->) <-> run @(->)) -instance (Covariant (->) (->) t, Monoidal (-->) (->) (:*:) (:+:) t) => Monoidal (-->) (->) (:*:) (:+:) (Comprehension t) where+instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:*:) (Construction t), Semimonoidal (-->) (:*:) (:+:) t, Semimonoidal (-->) (:*:) (:+:) (Construction t), Monoidal (-->) (-->) (:*:) (:+:) t) => Monoidal (-->) (-->) (:*:) (:+:) (Comprehension t) where 	unit _ = Straight $ \_ -> Comprehension empty  instance (forall a . Semigroup (t <:.> Construction t := a), Bindable (->) t) => Bindable (->) (Comprehension t) where@@ -62,9 +61,9 @@ instance Monoid (t <:.> Construction t := a) => Monoid (Comprehension t a) where 	zero = Comprehension zero -instance (Covariant (->) (->) t, Monoidal (-->) (->) (:*:) (:*:) t)  => Morphable Push (Comprehension t) where+instance (Covariant (->) (->) t, Monoidal (-->) (-->) (:*:) (:*:) t) => Morphable Push (Comprehension t) where 	type Morphing Push (Comprehension t) = Identity <:.:> Comprehension t := (->) 	morphing (run . premorph -> xs) = T_U $ \(Identity x) -> Comprehension . lift . Construct x . run $ xs  instance Nullable (t <:.> Construction t) => Nullable (Comprehension t) where-	null = run @(->) >$< null+	null = run @(->) >-|- null

@@ -5,7 +5,7 @@  import Pandora.Core.Functor (type (:.), type (:=)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), (<$$>))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-|-)) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)), (-<<-<<-)) import Pandora.Paradigm.Primary.Algebraic (extract) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:))@@ -22,13 +22,13 @@  -- TODO: Try to generalize (->) here instance Covariant (->) (->) t => Covariant (->) (->) (Prefixed t k) where-	(<$>) f = (||=) ((<$$>) @(->) @(->) f)+	(<-|-) f = (||=) (f <-|-|-)  instance Traversable (->) (->) t => Traversable (->) (->) (Prefixed t k) where-	f <<- Prefixed x = Prefixed <$> f -<<-<<- x+	f <<- Prefixed x = Prefixed <-|- f -<<-<<- x  instance Covariant (->) (->) t => Morphable (Into t) (Prefixed t k) where 	type Morphing (Into t) (Prefixed t k) = t-	morphing (run . premorph -> prefixed) = extract <$> prefixed+	morphing (run . premorph -> prefixed) = extract <-|- prefixed  type instance Nonempty (Prefixed t k) = Prefixed (Nonempty t) k

@@ -2,10 +2,10 @@  module Pandora.Paradigm.Structure.Some.Binary where -import Pandora.Core.Functor (type (:=), type (:=>), type (:::))+import Pandora.Core.Functor (type (~>), type (:=), type (:=>)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Pattern.Functor.Bindable ((=<<)) import Pandora.Pattern.Transformer.Liftable (lift)@@ -14,7 +14,7 @@ import Pandora.Paradigm.Primary () import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), type (:*:), attached, twosome) import Pandora.Paradigm.Primary.Algebraic.Exponential ((%), (&))-import Pandora.Paradigm.Primary.Algebraic (($$$>-), (<-*-), extract)+import Pandora.Paradigm.Primary.Algebraic (($$$>-), (<-*-), extract, point) import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False)) import Pandora.Paradigm.Primary.Object.Ordering (order) import Pandora.Paradigm.Primary.Functor (Comparison)@@ -34,16 +34,16 @@ import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), morph, premorph 	, Morph (Rotate, Into, Insert, Lookup, Vary, Key, Element), Vertical (Up, Down), lookup, vary) import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Available, Substance, substructure), Segment (Root), sub)-import Pandora.Paradigm.Structure.Ability.Zipper (Zipper)+import Pandora.Paradigm.Structure.Ability.Zipper (Zippable (Breadcrumbs)) import Pandora.Paradigm.Structure.Modification.Prefixed (Prefixed (Prefixed))  type Binary = Maybe <:.> Construction Wye  instance {-# OVERLAPS #-} Traversable (->) (->) (Construction Wye) where-	f <<- (Construct x (Left l)) = Construct <$> f x <-*- (Left <$> f <<- l)-	f <<- (Construct x (Right r)) = Construct <$> f x <-*- (Right <$> f <<- r)-	f <<- (Construct x (Both l r)) = Construct <$> f x <-*- (Both <$> f <<- l <-*- f <<- r)-	f <<- (Construct x End) = Construct % End <$> f x+	f <<- (Construct x (Left l)) = Construct <-|- f x <-*- (Left <-|- f <<- l)+	f <<- (Construct x (Right r)) = Construct <-|- f x <-*- (Right <-|- f <<- r)+	f <<- (Construct x (Both l r)) = Construct <-|- f x <-*- (Both <-|- f <<- l <-*- f <<- r)+	f <<- (Construct x End) = Construct % End <-|- f x  --rebalance :: Chain a => (Wye :. Construction Wye := a) -> Nonempty Binary a --rebalance (Both x y) = extract x <=> extract y & order@@ -70,14 +70,14 @@ 	type Substance Left Binary = Construction Wye 	substructure = P_Q_T $ \bintree -> case run . lower # bintree of 		Nothing -> Store $ Nothing :*: lift . TU-		Just tree -> lift . lift @(->) <$> run (sub @Left) tree+		Just tree -> lift . lift @(->) <-|- run (sub @Left) tree  instance Substructure Right Binary where 	type Available Right Binary = Maybe 	type Substance Right Binary = Construction Wye 	substructure = P_Q_T $ \bintree -> case run . extract . run # bintree of 		Nothing -> Store $ Nothing :*: lift . TU-		Just tree -> lift . lift @(->) <$> run (sub @Right) tree+		Just tree -> lift . lift @(->) <-|- run (sub @Right) tree  -------------------------------------- Non-empty binary tree --------------------------------------- @@ -125,21 +125,23 @@  instance Chain k => Morphable (Lookup Key) (Prefixed Binary k) where 	type Morphing (Lookup Key) (Prefixed Binary k) = (->) k <:.> Maybe-	morphing (run . run . premorph -> Nothing) = TU $ \_ -> Nothing-	morphing (run . run . premorph -> Just tree) = TU $ \key ->-		let root = extract tree in key <=> attached root & order (Just # extract root)-			(lookup @Key key . Prefixed =<< view # sub @Left # tree)-			(lookup @Key key . Prefixed =<< view # sub @Right # tree)+	morphing prefixed_tree = case run . run . premorph $ prefixed_tree of+		Nothing -> TU $ \_ -> Nothing+		Just tree -> TU $ \key ->+			let root = extract tree in key <=> attached root & order (Just # extract root)+				(lookup @Key key . Prefixed =<< view # sub @Left # tree)+				(lookup @Key key . Prefixed =<< view # sub @Right # tree)  instance Chain k => Morphable (Vary Element) (Prefixed Binary k) where 	type Morphing (Vary Element) (Prefixed Binary k) = ((:*:) k <:.> Identity) <:.:> Prefixed Binary k := (->)-	morphing (run . run . premorph -> Nothing) = T_U $ \(TU (key :*: Identity value)) -> Prefixed . lift . leaf $ key :*: value-	morphing (run . run . premorph -> Just tree) = T_U $ \(TU (key :*: Identity value)) ->-		let continue = ((vary @Element @k @_ @(Prefixed Binary _) key value =||) =||)-		in let root = extract tree in Prefixed . lift $ key <=> attached root & order-			# over (sub @Root) ($$$>- value) tree-			# over (sub @Left) continue tree-			# over (sub @Right) continue tree+	morphing prefixed_tree = case run . run . premorph $ prefixed_tree of+		Nothing -> T_U $ \(TU (key :*: Identity value)) -> Prefixed . lift . leaf $ key :*: value+		Just tree -> T_U $ \(TU (key :*: Identity value)) ->+			let continue = ((vary @Element @k @_ @(Prefixed Binary _) key value =||) =||)+			in let root = extract tree in Prefixed . lift $ key <=> attached root & order+				# over (sub @Root) ($$$>- value) tree+				# over (sub @Left) continue tree+				# over (sub @Right) continue tree  ---------------------------------- Prefixed non-empty binary tree ---------------------------------- @@ -155,45 +157,67 @@ data Biforked a = Top | Leftward a | Rightward a  instance Covariant (->) (->) Biforked where-	_ <$> Top = Top-	f <$> Leftward l = Leftward $ f l-	f <$> Rightward r = Rightward $ f r+	_ <-|- Top = Top+	f <-|- Leftward l = Leftward $ f l+	f <-|- Rightward r = Rightward $ f r +instance Traversable (->) (->) Biforked where+	_ <<- Top = point Top+	f <<- Leftward l = Leftward <-|- f l+	f <<- Rightward r = Rightward <-|- f r+ type Bifurcation = Biforked <:.> Construction Biforked  type Bicursor = Identity <:.:> Binary := (:*:) -type instance Zipper (Construction Wye) (Up ::: Down Left ::: Down Right) =-	Construction Wye <:.:> Bifurcation <:.> Bicursor := (:*:)+instance Zippable (Construction Wye) where+	type Breadcrumbs (Construction Wye) = (Wye <:.> Construction Wye) <:.:> (Bifurcation <:.> Bicursor) := (:*:) -instance Morphable (Rotate Up) (Construction Wye <:.:> Bifurcation <:.> Bicursor := (:*:)) where-	type Morphing (Rotate Up) (Construction Wye <:.:> Bifurcation <:.> Bicursor := (:*:))-		= Maybe <:.> (Construction Wye <:.:> Bifurcation <:.> Bicursor := (:*:))-	morphing (run . premorph -> focused :*: TU (TU (Rightward (Construct (T_U (Identity parent :*: rest)) next)))) =-		lift $ twosome # Construct parent (resolve # Both focused # Left focused # run rest) # TU (TU next)-	morphing (run . premorph -> focused :*: TU (TU (Rightward (Construct (T_U (Identity parent :*: rest)) next)))) =-		lift $ twosome # Construct parent (resolve # Both % focused # Right focused # run rest) # TU (TU next)-	morphing (premorph -> T_U (_ :*: TU (TU Top))) = TU Nothing+_focused_part_to_nonempty_binary_tree :: (Identity <:.:> Wye <:.> Construction Wye := (:*:)) ~> Construction Wye+_focused_part_to_nonempty_binary_tree (T_U (Identity x :*: xs)) = Construct x # run xs -instance Morphable (Rotate (Down Left)) (Construction Wye <:.:> Bifurcation <:.> Bicursor := (:*:)) where-	type Morphing (Rotate (Down Left)) (Construction Wye <:.:> Bifurcation <:.> Bicursor := (:*:))-		= Maybe <:.> (Construction Wye <:.:> Bifurcation <:.> Bicursor := (:*:))-	morphing (run . premorph -> Construct x (Left lst) :*: TU (TU next)) =-		lift . twosome lst . TU . TU . Leftward $ Construct # twosome (Identity x) (TU Nothing) # next-	morphing (run . premorph -> Construct x (Both lst rst) :*: TU (TU next)) =-		lift . twosome lst . TU . TU . Leftward $ Construct # twosome (Identity x) (lift rst) # next-	morphing (run . premorph -> Construct _ (Right _) :*: _) = TU Nothing-	morphing (run . premorph -> Construct _ End :*: _) = TU Nothing+instance Morphable (Rotate Up) ((Identity <:.:> Wye <:.> Construction Wye := (:*:)) <:.:> (Bifurcation <:.> Bicursor) := (:*:)) where+	type Morphing (Rotate Up) ((Identity <:.:> Wye <:.> Construction Wye := (:*:)) <:.:> (Bifurcation <:.> Bicursor) := (:*:))+		= Maybe <:.> ((Identity <:.:> Wye <:.> Construction Wye := (:*:)) <:.:> Bifurcation <:.> Bicursor := (:*:))+	morphing zipper = case run # premorph zipper of+		focused :*: TU (TU (Rightward (Construct (T_U (Identity parent :*: rest)) next))) ->+			lift . twosome % TU (TU next) $ twosome # Identity parent $ TU $ resolve+				# Both (_focused_part_to_nonempty_binary_tree focused)+				# Left (_focused_part_to_nonempty_binary_tree focused)+				# run rest+		focused :*: TU (TU (Leftward (Construct (T_U (Identity parent :*: rest)) next))) ->+			lift . twosome % TU (TU next) $ twosome # Identity parent $ TU $ resolve+				# Both % _focused_part_to_nonempty_binary_tree focused+				# Right (_focused_part_to_nonempty_binary_tree focused)+				# run rest+		_ -> TU Nothing -instance Morphable (Rotate (Down Right)) (Construction Wye <:.:> Bifurcation <:.> Bicursor := (:*:)) where-	type Morphing (Rotate (Down Right)) (Construction Wye <:.:> Bifurcation <:.> Bicursor := (:*:))-		= Maybe <:.> (Construction Wye <:.:> Bifurcation <:.> Bicursor := (:*:))-	morphing (run . premorph -> Construct x (Right rst) :*: TU (TU next)) =-		lift . twosome rst . TU . TU . Rightward $ Construct # twosome (Identity x) (TU Nothing) # next-	morphing (run . premorph -> Construct x (Both lst rst) :*: TU (TU next)) =-		lift . twosome rst . TU . TU . Rightward $ Construct # twosome (Identity x) (lift lst) # next-	morphing (run . premorph -> Construct _ (Left _) :*: _) = TU Nothing-	morphing (run . premorph -> Construct _ End :*: _) = TU Nothing+_nonempty_binary_tree_to_focused_part :: Construction Wye ~> Identity <:.:> Wye <:.> Construction Wye := (:*:)+_nonempty_binary_tree_to_focused_part (Construct x xs) = twosome # Identity x # TU xs++instance Morphable (Rotate (Down Left)) ((Identity <:.:> Wye <:.> Construction Wye := (:*:)) <:.:> (Bifurcation <:.> Bicursor) := (:*:)) where+	type Morphing (Rotate (Down Left)) ((Identity <:.:> Wye <:.> Construction Wye := (:*:)) <:.:> (Bifurcation <:.> Bicursor) := (:*:))+		= Maybe <:.> ((Identity <:.:> Wye <:.> Construction Wye := (:*:)) <:.:> Bifurcation <:.> Bicursor := (:*:))+	morphing zipper = case run # premorph zipper of+		T_U (Identity x :*: TU (Left lst)) :*: TU (TU next) ->+			lift . twosome (_nonempty_binary_tree_to_focused_part lst)+				. TU . TU . Leftward $ Construct # twosome (Identity x) (TU Nothing) # next+		T_U (Identity x :*: TU (Both lst rst)) :*: TU (TU next) ->+			lift . twosome (_nonempty_binary_tree_to_focused_part lst)+				. TU . TU . Leftward $ Construct # twosome (Identity x) (lift rst) # next+		_ -> TU Nothing++instance Morphable (Rotate (Down Right)) ((Identity <:.:> Wye <:.> Construction Wye := (:*:)) <:.:> (Bifurcation <:.> Bicursor) := (:*:)) where+	type Morphing (Rotate (Down Right)) ((Identity <:.:> Wye <:.> Construction Wye := (:*:)) <:.:> (Bifurcation <:.> Bicursor) := (:*:))+		= Maybe <:.> ((Identity <:.:> Wye <:.> Construction Wye := (:*:)) <:.:> Bifurcation <:.> Bicursor := (:*:))+	morphing zipper = case run # premorph zipper of+		T_U (Identity x :*: TU (Right rst)) :*: TU (TU next) ->+			lift . twosome (_nonempty_binary_tree_to_focused_part rst)+				. TU . TU . Rightward $ Construct # twosome (Identity x) (TU Nothing) # next+		T_U (Identity x :*: TU (Both lst rst)) :*: TU (TU next) ->+			lift . twosome (_nonempty_binary_tree_to_focused_part rst)+				. TU . TU . Rightward $ Construct # twosome (Identity x) (lift lst) # next+		_ -> TU Nothing  leaf :: a :=> Nonempty Binary leaf x = Construct x End

@@ -2,11 +2,11 @@  module Pandora.Paradigm.Structure.Some.List where -import Pandora.Core.Functor (type (:.), type (:=), type (:::))+import Pandora.Core.Functor (type (:.), type (:=)) import Pandora.Core.Impliable (imply) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($), (#), identity)-import Pandora.Pattern.Functor.Covariant (Covariant, Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant, Covariant ((<-|-))) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<)))@@ -18,9 +18,7 @@ import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Monoid (Monoid (zero)) import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False), (?))-import Pandora.Paradigm.Primary.Object.Numerator (Numerator (Numerator))-import Pandora.Paradigm.Primary.Object.Denumerator (Denumerator (Single))-import Pandora.Paradigm.Primary.Algebraic ((<-*-), (-.#..-), extract)+import Pandora.Paradigm.Primary.Algebraic ((<-*-), (-.#..-), extract, point, empty) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), attached, twosome) import Pandora.Paradigm.Primary.Algebraic.Exponential ((%)) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing))@@ -28,7 +26,6 @@ import Pandora.Paradigm.Primary.Functor.Predicate (Predicate (Predicate)) import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct, (.-+))-import Pandora.Paradigm.Primary.Transformer.Tap (Tap (Tap)) import Pandora.Paradigm.Primary.Transformer.Reverse (Reverse (Reverse)) import Pandora.Paradigm.Inventory.State (State, fold, modify) import Pandora.Paradigm.Inventory.Store (Store (Store))@@ -39,7 +36,7 @@ import Pandora.Paradigm.Schemes.P_Q_T (P_Q_T (P_Q_T)) import Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty) import Pandora.Paradigm.Structure.Ability.Nullable (Nullable (null))-import Pandora.Paradigm.Structure.Ability.Zipper (Zipper)+import Pandora.Paradigm.Structure.Ability.Zipper (Zippable (Breadcrumbs), Zipper) import Pandora.Paradigm.Structure.Ability.Monotonic (resolve) import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing) 	, Morph (Rotate, Into, Push, Pop, Delete, Find, Lookup, Element, Key)@@ -74,21 +71,24 @@  instance Morphable (Find Element) List where 	type Morphing (Find Element) List = Predicate <:.:> Maybe := (->)-	morphing (premorph -> TU Nothing) = T_U $ \_ -> Nothing-	morphing (premorph -> TU (Just (Construct x xs))) = T_U $ \p ->-		run p x ? Just x $ find @Element @List @Maybe # p # TU xs+	morphing list = case run # premorph list of+		Nothing -> T_U $ \_ -> Nothing+		Just (Construct x xs) -> T_U $ \p -> run p x ? Just x+			$ find @Element @List @Maybe # p # TU xs  instance Morphable (Delete First) List where 	type Morphing (Delete First) List = Predicate <:.:> List := (->)-	morphing (premorph -> TU Nothing) = T_U $ \_ -> TU Nothing-	morphing (premorph -> TU (Just (Construct x xs))) = T_U $ \p ->-		run p x ? TU xs $ lift . Construct x . run . filter @First @List p $ TU xs+	morphing list = case run # premorph list of+		Nothing -> T_U $ \_ -> TU Nothing+		Just (Construct x xs) -> T_U $ \p -> run p x ? TU xs+			$ lift . Construct x . run . filter @First @List p $ TU xs  instance Morphable (Delete All) List where 	type Morphing (Delete All) List = Predicate <:.:> List := (->)-	morphing (premorph -> TU Nothing) = T_U $ \_ -> TU Nothing-	morphing (premorph -> TU (Just (Construct x xs))) = T_U $ \p ->-		run p x ? filter @All @List p (TU xs) $ lift . Construct x . run . filter @All @List p $ TU xs+	morphing list = case run # premorph list of+		Nothing -> T_U $ \_ -> TU Nothing+		Just (Construct x xs) -> T_U $ \p -> run p x ? filter @All @List p (TU xs)+			$ lift . Construct x . run . filter @All @List p $ TU xs  instance Stack List where @@ -106,7 +106,7 @@ 	type Available Tail List = Identity 	type Substance Tail List = List 	substructure = P_Q_T $ \x -> case run . extract . run $ x of-		Just ns -> lift . lift @(->) <$> run (sub @Tail) ns+		Just ns -> lift . lift @(->) <-|- run (sub @Tail) ns 		Nothing -> Store $ Identity zero :*: lift . identity . extract  -- | Transform any traversable structure into a stack@@ -130,6 +130,13 @@ 	type Morphing (Into List) (Construction Maybe) = List 	morphing = lift . premorph +instance Morphable (Into List) (Construction Maybe <:.> Maybe) where+	type Morphing (Into List) (Construction Maybe <:.> Maybe) = List+	morphing nonempty_list_with_maybe_elements = case run . premorph # nonempty_list_with_maybe_elements of+		Construct (Just x) (Just xs) -> item @Push x # into @List (TU @Covariant @Covariant xs)+		Construct (Just x) Nothing -> point x+		Construct Nothing Nothing -> TU Nothing -- empty+ instance Morphable Push (Construction Maybe) where 	type Morphing Push (Construction Maybe) = Identity <:.:> Construction Maybe := (->) 	morphing (premorph -> xs) = T_U $ \(Identity x) -> Construct x $ Just xs@@ -152,97 +159,101 @@  ----------------------------------------- Zipper of list ------------------------------------------- -type instance Zipper List (Left ::: Right) = Tap (List <:.:> List := (:*:))+instance Zippable List where+	type Breadcrumbs List = (List <:.:> List := (:*:)) -instance {-# OVERLAPS #-} Traversable (->) (->) (Tap (List <:.:> List := (:*:))) where-	f <<- Tap x (T_U (future :*: past)) = (\past' x' future' -> Tap x' $ twosome # future' # run past')-		<$> f <<- Reverse past <-*- f x <-*- f <<- future+instance {-# OVERLAPS #-} Traversable (->) (->) (Identity <:.:> (List <:.:> List := (:*:)) := (:*:)) where+	f <<- T_U (Identity x :*: T_U (future :*: past)) = (\past' x' future' -> twosome (Identity x') $ twosome # future' # run past')+		<-|- f <<- Reverse past <-*- f x <-*- f <<- future -instance {-# OVERLAPS #-} Extendable (->) (Tap (List <:.:> List := (:*:))) where+instance {-# OVERLAPS #-} Extendable (->) (Identity <:.:> (List <:.:> List := (:*:)) := (:*:)) where 	f <<= z = let move rtt = TU . deconstruct $ run . rtt .-+ z in-		Tap # f z $ twosome # f <$> move (rotate @Left) # f <$> move (rotate @Right)+		twosome (Identity # f z) $ twosome # f <-|- move (rotate @Left) # f <-|- move (rotate @Right) -instance Morphable (Rotate Left) (Tap (List <:.:> List := (:*:))) where-	type Morphing (Rotate Left) (Tap (List <:.:> List := (:*:))) = Maybe <:.> Tap (List <:.:> List := (:*:))-	morphing (premorph -> Tap x (T_U (future :*: past))) =+instance Morphable (Rotate Left) (Identity <:.:> (List <:.:> List := (:*:)) := (:*:)) where+	type Morphing (Rotate Left) (Identity <:.:> (List <:.:> List := (:*:)) := (:*:)) = Maybe <:.> (Identity <:.:> (List <:.:> List := (:*:)) := (:*:))+	morphing (premorph -> T_U (Identity x :*: T_U (future :*: past))) = 		let subtree = twosome # extract (view (sub @Tail) future) # item @Push x past in-		TU $ (Tap . extract) % subtree <$> view (sub @Root) future+		TU $ (twosome . Identity . extract) % subtree <-|- view (sub @Root) future -instance Morphable (Rotate Right) (Tap (List <:.:> List := (:*:))) where-	type Morphing (Rotate Right) (Tap (List <:.:> List := (:*:))) = Maybe <:.> Tap (List <:.:> List := (:*:))-	morphing (premorph -> Tap x (T_U (future :*: past))) =+instance Morphable (Rotate Right) (Identity <:.:> (List <:.:> List := (:*:)) := (:*:)) where+	type Morphing (Rotate Right) (Identity <:.:> (List <:.:> List := (:*:)) := (:*:)) = Maybe <:.> (Identity <:.:> (List <:.:> List := (:*:)) := (:*:))+	morphing (premorph -> T_U (Identity x :*: T_U (future :*: past))) = 		let subtree = twosome # item @Push x future # extract (view (sub @Tail) past) in-		TU $ (Tap . extract) % subtree <$> view (sub @Root) past+		TU $ (twosome . Identity . extract) % subtree <-|- view (sub @Root) past -instance Morphable (Into (Tap (List <:.:> List := (:*:)))) List where-	type Morphing (Into (Tap (List <:.:> List := (:*:)))) List = Maybe <:.> Tap (List <:.:> List := (:*:))-	morphing (premorph -> list) = (into @(Zipper List (Left ::: Right)) <$>) ||= list+instance Morphable (Into (Identity <:.:> (List <:.:> List := (:*:)) := (:*:))) List where+	type Morphing (Into (Identity <:.:> (List <:.:> List := (:*:)) := (:*:))) List = Maybe <:.> (Identity <:.:> (List <:.:> List := (:*:)) := (:*:))+	morphing (premorph -> list) = (into @(Zipper List) <-|-) ||= list -instance Morphable (Into List) (Tap (List <:.:> List := (:*:))) where-	type Morphing (Into List) (Tap (List <:.:> List := (:*:))) = List-	morphing (premorph -> Tap x (T_U (future :*: past))) = attached $ run @(->) @(State _)+instance Morphable (Into List) (Identity <:.:> (List <:.:> List := (:*:)) := (:*:)) where+	type Morphing (Into List) (Identity <:.:> (List <:.:> List := (:*:)) := (:*:)) = List+	morphing (premorph -> T_U (Identity x :*: T_U (future :*: past))) = attached $ run @(->) @(State _) 		# modify . item @Push @List <<- past 		# item @Push x future -instance Morphable (Into (Comprehension Maybe)) (Tap (List <:.:> List := (:*:))) where-	type Morphing (Into (Comprehension Maybe)) (Tap (List <:.:> List := (:*:))) = Comprehension Maybe-	morphing (premorph -> Tap x (T_U (future :*: past))) = attached $ run @(->) @(State _)+instance Morphable (Into (Comprehension Maybe)) (Identity <:.:> (List <:.:> List := (:*:)) := (:*:)) where+	type Morphing (Into (Comprehension Maybe)) (Identity <:.:> (List <:.:> List := (:*:)) := (:*:)) = Comprehension Maybe+	morphing (premorph -> T_U (Identity x :*: T_U (future :*: past))) = attached $ run @(->) @(State _) 		# modify . item @Push @(Comprehension Maybe) <<- past 		# item @Push x (Comprehension future)  ------------------------------------- Zipper of non-empty list ------------------------------------- -type instance Zipper (Construction Maybe) (Left ::: Right) = Tap (Construction Maybe <:.:> Construction Maybe := (:*:))+instance Zippable (Construction Maybe) where+	type Breadcrumbs (Construction Maybe) = (Construction Maybe <:.:> Construction Maybe := (:*:)) -instance Morphable (Rotate Left) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where-	type Morphing (Rotate Left) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) =-		Maybe <:.> Tap (Construction Maybe <:.:> Construction Maybe := (:*:))-	morphing (premorph -> Tap x (T_U (future :*: past))) = TU $ Tap (extract future) . twosome % item @Push x past <$> deconstruct future+instance Morphable (Rotate Left) (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:)) where+	type Morphing (Rotate Left) (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:)) =+		Maybe <:.> (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:))+	morphing (premorph -> T_U (Identity x :*: T_U (future :*: past))) = TU $ T_U . (Identity (extract future) :*:) . twosome % item @Push x past <-|- deconstruct future -instance Morphable (Rotate Right) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where-	type Morphing (Rotate Right) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) =-		Maybe <:.> Tap (Construction Maybe <:.:> Construction Maybe := (:*:))-	morphing (premorph -> Tap x (T_U (future :*: past))) = TU $ Tap (extract past) . twosome (item @Push x future) <$> deconstruct past+instance Morphable (Rotate Right) (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:)) where+	type Morphing (Rotate Right) (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:)) =+		Maybe <:.> (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:))+	morphing (premorph -> T_U (Identity x :*: T_U (future :*: past))) = TU $ T_U . (Identity (extract past) :*:) . twosome (item @Push x future) <-|- deconstruct past -instance Morphable (Into (Tap (List <:.:> List := (:*:)))) (Construction Maybe) where-	type Morphing (Into (Tap (List <:.:> List := (:*:)))) (Construction Maybe) = Tap (List <:.:> List := (:*:))-	morphing (premorph -> ne) = Tap # extract ne $ twosome # extract (view # sub @Tail # ne) # zero+instance Morphable (Into (Identity <:.:> (List <:.:> List := (:*:)) := (:*:))) (Construction Maybe) where+	type Morphing (Into (Identity <:.:> (List <:.:> List := (:*:)) := (:*:))) (Construction Maybe) = Identity <:.:> (List <:.:> List := (:*:)) := (:*:)+	morphing (premorph -> ne) = twosome # Identity (extract ne) $ twosome # extract (view # sub @Tail # ne) # zero -instance Morphable (Into (Tap (List <:.:> List := (:*:)))) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where-	type Morphing (Into (Tap (List <:.:> List := (:*:)))) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) = Tap (List <:.:> List := (:*:))-	morphing (premorph -> zipper) = Tap # extract zipper $ lift @(->) <-> lift @(->) ||= lower zipper+instance Morphable (Into (Identity <:.:> (List <:.:> List := (:*:)) := (:*:))) (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:)) where+	type Morphing (Into (Identity <:.:> (List <:.:> List := (:*:)) := (:*:))) (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:)) =+		Identity <:.:> (List <:.:> List := (:*:)) := (:*:)+	morphing (premorph -> zipper) = ((lift @(->) <-> lift @(->) ||=) <-|-) ||= zipper -instance Morphable (Into (Tap (Construction Maybe <:.:> Construction Maybe := (:*:)))) (Tap (List <:.:> List := (:*:))) where-	type Morphing (Into (Tap (Construction Maybe <:.:> Construction Maybe := (:*:)))) (Tap (List <:.:> List := (:*:))) =-		Maybe <:.> Tap (Construction Maybe <:.:> Construction Maybe := (:*:))-	morphing (premorph -> zipper) = let spread x y = (:*:) <$> x <-*- y in TU $-		Tap (extract zipper) . T_U <$> ((spread |-) . (run @(->) <-> run @(->)) . run $ lower zipper)+instance Morphable (Into (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:))) (Identity <:.:> (List <:.:> List := (:*:)) := (:*:)) where+	type Morphing (Into (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:))) (Identity <:.:> (List <:.:> List := (:*:)) := (:*:)) =+		Maybe <:.> (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:))+	morphing (premorph -> zipper) = let spread x y = (:*:) <-|- x <-*- y in+		TU $ T_U . (Identity (extract zipper) :*:) . T_U <-|- ((spread |-) . (run @(->) <-> run @(->)) . run . extract $ run zipper) -instance Morphable (Into (Construction Maybe)) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where-	type Morphing (Into (Construction Maybe)) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) = Construction Maybe-	morphing (premorph -> Tap x (T_U (future :*: past))) = attached $ run @(->) @(State _)+instance Morphable (Into (Construction Maybe)) (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:)) where+	type Morphing (Into (Construction Maybe)) (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:)) = Construction Maybe+	morphing (premorph -> T_U (Identity x :*: T_U (future :*: past))) = attached $ run @(->) @(State _) 		# modify . item @Push @(Nonempty List) <<- past 		# item @Push x future -instance Morphable (Into List) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where-	type Morphing (Into List) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) = List-	morphing (premorph -> Tap x (T_U (future :*: past))) = attached $ run @(->) @(State _)+instance Morphable (Into List) (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:)) where+	type Morphing (Into List) (Identity <:.:> (Construction Maybe <:.:> Construction Maybe := (:*:)) := (:*:)) = List+	morphing (premorph -> T_U (Identity x :*: T_U (future :*: past))) = attached $ run @(->) @(State _) 		# modify . item @Push @List <<- past 		# item @Push x (lift future)  ------------------------------------ Zipper of combinative list ------------------------------------ -type instance Zipper (Comprehension Maybe) (Left ::: Right) = Tap (Comprehension Maybe <:.:> Comprehension Maybe := (:*:))+instance Zippable (Comprehension Maybe) where+	type Breadcrumbs (Comprehension Maybe) = (Comprehension Maybe <:.:> Comprehension Maybe := (:*:))  ----------------------------------------- Prefixed list --------------------------------------------  instance Setoid key => Morphable (Lookup Key) (Prefixed List key) where 	type Morphing (Lookup Key) (Prefixed List key) = (->) key <:.> Maybe-	morphing (run . premorph -> list) = TU $ \key -> lookup @Key key =<< Prefixed <$> run list +	morphing (run . premorph -> list) = TU $ \key -> lookup @Key key =<< Prefixed <-|- run list  ------------------------------------ Prefixed non-empty list ---------------------------------------  instance Setoid key => Morphable (Lookup Key) (Prefixed (Construction Maybe) key) where 	type Morphing (Lookup Key) (Prefixed (Construction Maybe) key) = (->) key <:.> Maybe-	morphing (run . premorph -> Construct x xs) = TU $ \key -> extract <$> search key where+	morphing (run . premorph -> Construct x xs) = TU $ \key -> extract <-|- search key where 		search key = key == attached x ? Just x $ find @Element # Predicate ((key ==) . attached) =<< xs

@@ -5,7 +5,7 @@ import Pandora.Core.Functor (type (:.), type (:=)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Contravariant ((>$<))+import Pandora.Pattern.Functor.Contravariant ((>-|-)) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Transformer.Liftable (lift) import Pandora.Pattern.Transformer.Lowerable (lower)@@ -39,7 +39,7 @@ --	type Available Root Rose = Maybe --	type Substance Root Rose = Identity --	substructure = P_Q_T $ \rose -> case run # lower rose of---		Nothing -> Store $ Nothing :*: TU . Tag . TU . ((Construct % empty) . extract <$>)+--		Nothing -> Store $ Nothing :*: TU . Tag . TU . ((Construct % empty) . extract <-|-) --		Just nonempty_rose -> Store $ Just (Identity # extract nonempty_rose) :*: \case --			Just (Identity new) -> lift . TU . Just . Construct new $ deconstruct nonempty_rose --			Nothing -> lift empty@@ -70,8 +70,9 @@  instance Setoid k => Morphable (Lookup Key) (Prefixed Rose k) where 	type Morphing (Lookup Key) (Prefixed Rose k) = (->) (Nonempty List k) <:.> Maybe-	morphing (run . premorph -> TU Nothing) = TU $ \_ -> Nothing-	morphing (run . premorph -> TU (Just tree)) = TU $ find_rose_sub_tree % tree+	morphing prefixed_rose_tree = case run # premorph prefixed_rose_tree of+		TU Nothing -> TU $ \_ -> Nothing+		TU (Just tree) -> TU $ find_rose_sub_tree % tree  -- TODO: Ineffiecient - we iterate over all branches in subtree, but we need to short-circuit on the first matching part of --instance Setoid k => Morphable (Vary Element) (Prefixed Rose k) where@@ -102,4 +103,4 @@ find_rose_sub_tree (Construct k (Just ks)) tree = k != attached (extract tree) ? Nothing $ find_rose_sub_tree ks =<< subtree where  	subtree :: Maybe :. Nonempty Rose := k :*: a-	subtree = find @Element # attached . extract >$< equate (extract ks) # deconstruct tree+	subtree = find @Element # attached . extract >-|- equate (extract ks) # deconstruct tree

@@ -6,7 +6,7 @@ import Pandora.Core.Functor (type (~>), type (:.), type (:=)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Paradigm.Primary () import Pandora.Paradigm.Primary.Algebraic ((<-*-), extract)@@ -54,27 +54,27 @@ instance Morphable (Rotate (Left Zig)) (Construction Wye) where 	type Morphing (Rotate (Left Zig)) (Construction Wye) = Binary 	morphing :: forall a . (:#) (Rotate (Left Zig)) <:.> Construction Wye := a -> Binary a-	morphing (premorph -> Construct x xs) = TU $ Construct <$> parent <-*- Just nodes where+	morphing (premorph -> Construct x xs) = TU $ Construct <-|- parent <-*- Just nodes where  		nodes :: Wye :. Nonempty Binary := a 		nodes = into @Wye . twosome (branch @Left xs) . Just . Construct x-			. into @Wye $ twosome (branch @Left =<< deconstruct <$> branch @Right xs)-				(branch @Right =<< deconstruct <$> branch @Right xs)+			. into @Wye $ twosome (branch @Left =<< deconstruct <-|- branch @Right xs)+				(branch @Right =<< deconstruct <-|- branch @Right xs)  		parent :: Maybe a-		parent = extract <$> branch @Right xs+		parent = extract <-|- branch @Right xs  instance Morphable (Rotate (Right Zig)) (Construction Wye) where 	type Morphing (Rotate (Right Zig)) (Construction Wye) = Binary 	morphing :: forall a . (:#) (Rotate (Right Zig)) <:.> Construction Wye := a -> Binary a-	morphing (premorph -> Construct x xs) = TU $ Construct <$> parent <-*- Just nodes where+	morphing (premorph -> Construct x xs) = TU $ Construct <-|- parent <-*- Just nodes where  		nodes :: Wye :. Nonempty Binary := a-		nodes = into @Wye . twosome (branch @Left =<< deconstruct <$> branch @Left xs) . Just . Construct x-			. into @Wye $ twosome (branch @Right =<< deconstruct <$> branch @Left xs) # branch @Right xs+		nodes = into @Wye . twosome (branch @Left =<< deconstruct <-|- branch @Left xs) . Just . Construct x+			. into @Wye $ twosome (branch @Right =<< deconstruct <-|- branch @Left xs) # branch @Right xs  		parent :: Maybe a-		parent = extract <$> branch @Left xs+		parent = extract <-|- branch @Left xs  -- TODO: Morphing ... = Conclussion Error <:.> Nonempty Binary instance Morphable (Rotate (Left (Zig Zig))) (Construction Wye) where

@@ -2,39 +2,41 @@  module Pandora.Paradigm.Structure.Some.Stream where -import Pandora.Core.Functor (type (:=), type (:=>), type (:::))+import Pandora.Core.Functor (type (:=), type (:=>)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=))) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), twosome) import Pandora.Paradigm.Primary.Algebraic (extract) import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity)) import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct, (.-+))-import Pandora.Paradigm.Primary.Transformer.Tap (Tap (Tap)) import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Rotate), premorph, rotate)-import Pandora.Paradigm.Structure.Ability.Zipper (Zipper)+import Pandora.Paradigm.Structure.Ability.Zipper (Zippable (Breadcrumbs)) import Pandora.Paradigm.Schemes.T_U (T_U (T_U), type (<:.:>)) import Pandora.Paradigm.Primary.Algebraic (point)+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)  type Stream = Construction Identity -type instance Zipper (Construction Identity) (Left ::: Right) = Tap (Stream <:.:> Stream := (:*:))+instance Zippable (Construction Identity) where+	type Breadcrumbs (Construction Identity) = Stream <:.:> Stream := (:*:) -instance Morphable (Rotate Left) (Tap (Stream <:.:> Stream := (:*:))) where-	type Morphing (Rotate Left) (Tap (Stream <:.:> Stream := (:*:))) = Tap (Stream <:.:> Stream := (:*:))-	morphing (premorph -> Tap x (T_U (bs :*: fs))) = Tap # extract bs+instance Morphable (Rotate Left) (Identity <:.:> (Stream <:.:> Stream := (:*:)) := (:*:)) where+	type Morphing (Rotate Left) (Identity <:.:> (Stream <:.:> Stream := (:*:)) := (:*:)) =+		Identity <:.:> (Stream <:.:> Stream := (:*:)) := (:*:)+	morphing (run . premorph -> Identity x :*: T_U (bs :*: fs)) = twosome # Identity (extract bs) 		$ twosome # extract (deconstruct bs) # Construct x (point fs) -instance Morphable (Rotate Right) (Tap (Stream <:.:> Stream := (:*:))) where-	type Morphing (Rotate Right) (Tap (Stream <:.:> Stream := (:*:))) = Tap (Stream <:.:> Stream := (:*:))-	morphing (premorph -> Tap x (T_U (bs :*: fs))) = Tap # extract fs+instance Morphable (Rotate Right) (Identity <:.:> (Stream <:.:> Stream := (:*:)) := (:*:)) where+	type Morphing (Rotate Right) (Identity <:.:> (Stream <:.:> Stream := (:*:)) := (:*:)) = Identity <:.:> (Stream <:.:> Stream := (:*:)) := (:*:)+	morphing (run . premorph -> Identity x :*: T_U (bs :*: fs)) = twosome # Identity (extract fs) 		$ twosome # Construct x (point bs) # extract (deconstruct fs) -instance {-# OVERLAPS #-} Extendable (->) (Tap (Stream <:.:> Stream := (:*:))) where+instance {-# OVERLAPS #-} Extendable (->) (Identity <:.:> (Stream <:.:> Stream := (:*:)) := (:*:)) where 	f <<= z = let move rtt = extract . deconstruct $ point . rtt .-+ z-		in f <$> Tap z (twosome # (move $ rotate @Left) # (move $ rotate @Right))+		in f <-|- T_U (Identity z :*: twosome # move (rotate @Left) # move (rotate @Right))  repeat :: a :=> Stream repeat x = Construct x . Identity $ repeat x

@@ -1,5 +1,6 @@ module Pandora.Pattern (module Exports) where +import Pandora.Pattern.Betwixt as Exports import Pandora.Pattern.Object as Exports import Pandora.Pattern.Transformer as Exports import Pandora.Pattern.Functor as Exports

@@ -0,0 +1,3 @@+module Pandora.Pattern.Betwixt (Betwixt) where++type family Betwixt (source :: * -> * -> *) (target :: * -> * -> *) = (betwixt :: * -> * -> *) | betwixt -> source target

@@ -6,7 +6,7 @@  {- | > When providing a new instance, you should ensure it satisfies :-> * Interchange: t >>= f = join (f <$> t)+> * Interchange: t >>= f = join (f <-|- t) -}  class Covariant source source t => Bindable source t where

@@ -1,5 +1,6 @@ module Pandora.Pattern.Functor.Comonad where +import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Functor.Monoidal (Monoidal) import Pandora.Pattern.Functor.Extendable (Extendable) import Pandora.Paradigm.Primary.Algebraic.Exponential (type (<--))@@ -15,4 +16,4 @@ > * Associativity: extend f . extend g ≡ extend (f . extend g) -} -class (Monoidal (<--) source (:*:) (:*:) t, Extendable source t) => Comonad source t+class (Monoidal (<--) (Straight source) (:*:) (:*:) t, Extendable source t) => Comonad source t

@@ -2,13 +2,16 @@  import Pandora.Pattern.Category (Category) -infixl 4 >$<+infixl 4 >-|-, >$<  {- | > When providing a new instance, you should ensure it satisfies:-> * Identity morphism: (identity >$<) ≡ identity-> * Interpreted of morphisms: (f >$<) . (g >$<) ≡ (g . f >$<)+> * Identity morphism: (identity >-|-) ≡ identity+> * Interpreted of morphisms: (f >-|-) . (g >-|-) ≡ (g . f >-|-) -}  class (Category source, Category target) => Contravariant source target t where-	(>$<) :: source a b -> target (t b) (t a)+	(>-|-) :: source a b -> target (t b) (t a)++(>$<) :: Contravariant source target t => source a b -> target (t b) (t a)+(>$<) = (>-|-)

@@ -2,32 +2,39 @@  module Pandora.Pattern.Functor.Covariant where +import Pandora.Pattern.Betwixt (Betwixt) import Pandora.Pattern.Semigroupoid (Semigroupoid) -infixl 4 <$>-infixl 3 <$$>-infixl 4 <$$$>+infixl 4 <-|-, <$>+infixl 3 <-|-|-, <$$>+infixl 4 <-|-|-|-, <$$$>  {- | > When providing a new instance, you should ensure it satisfies:-> * Identity morphism: (identity <$>) ≡ identity-> * Interpreted of morphisms: (f . g <$>) ≡ (f <$>) . (g <$>)+> * Identity morphism: (identity <-|-) ≡ identity+> * Interpreted of morphisms: (f . g <-|-) ≡ (f <-|-) . (g <-|-) -}  class (Semigroupoid source, Semigroupoid target) => Covariant source target t where-	(<$>) :: source a b -> target (t a) (t b)+	(<-|-) :: source a b -> target (t a) (t b) -(<$$>) :: forall source between target t u a b-	. (Covariant source between u, Covariant between target t)+(<-|-|-) :: forall source target t u a b+	. (Covariant source (Betwixt source target) u, Covariant (Betwixt source target) target t) 	=> source a b -> target (t (u a)) (t (u b))-(<$$>) s = ((<$>) ((<$>) @source @between @u s))+(<-|-|-) s = ((<-|-) ((<-|-) @source @(Betwixt source target) @u s)) -(<$$$>) :: forall source between1 between2 target t u v a b-	. (Covariant source between1 v, Covariant between1 between2 u, Covariant between2 target t)+(<-|-|-|-) :: forall source target t u v a b+	. (Covariant source (Betwixt source (Betwixt source target)) v, Covariant (Betwixt source (Betwixt source target)) (Betwixt (Betwixt source target) target) u, Covariant (Betwixt (Betwixt source target) target) target t) 	=> source a b -> target (t (u (v a))) (t (u (v b)))-(<$$$>) s = ((<$>) @between2 @target ((<$>) @between1 @between2 @u ((<$>) @source @between1 @v s)))+(<-|-|-|-) s = ((<-|-) @(Betwixt (Betwixt source target) target) @target ((<-|-) @(Betwixt source (Betwixt source target)) @(Betwixt (Betwixt source target) target) @u ((<-|-) @source @(Betwixt source (Betwixt source target)) @v s))) -(<$$$$>) :: forall source between1 between2 between3 target t u v w a b-	. (Covariant source between1 w, Covariant between1 between2 v, Covariant between2 between3 u, Covariant between3 target t)-	=> source a b -> target (t (u (v (w a)))) (t (u (v (w b))))-(<$$$$>) s = ((<$>) @between3 @target @t ((<$>) @between2 @between3 @u ((<$>) @between1 @between2 @v ((<$>) @source @between1 @w s))))+(<$>) :: Covariant source target t => source a b -> target (t a) (t b)+(<$>) = (<-|-)++(<$$>) :: (Covariant source (Betwixt source target) u, Covariant (Betwixt source target) target t) => source a b -> target (t (u a)) (t (u b))+(<$$>) = (<-|-|-)++(<$$$>) :: forall source target t u v a b+	. (Covariant source (Betwixt source (Betwixt source target)) v, Covariant (Betwixt source (Betwixt source target)) (Betwixt (Betwixt source target) target) u, Covariant (Betwixt (Betwixt source target) target) target t)+	=> source a b -> target (t (u (v a))) (t (u (v b)))+(<$$$>) s = (<-|-|-|-) s

@@ -7,7 +7,7 @@  > When providing a new instance, you should ensure it satisfies: > * Identity morphism: (identity -<<) . (identity -<<) ≡ identity-> * Interchange collection: (f -<<) ≡ (identity -<<) . (f <$>)+> * Interchange collection: (f -<<) ≡ (identity -<<) . (f <-|-) -}  infixl 5 -<<

@@ -6,8 +6,8 @@  {- | > When providing a new instance, you should ensure it satisfies:-> * Duplication interchange: (f -<$$>-) . (identity <<=) ≡ (identity <<=) . (f <$>)-> * Extension interchange: (f <<=) ≡ (f <$>) . (identity <<=)+> * Duplication interchange: (f -<-|-|--) . (identity <<=) ≡ (identity <<=) . (f <-|-)+> * Extension interchange: (f <<=) ≡ (f <-|-) . (identity <<=) -}  class Covariant source source t => Extendable source t where

@@ -20,7 +20,7 @@ --infixl 1 >>=-, ->>= --infixr 1 -=<<, =<<- -class (Covariant category category t, Monoidal (Straight category) category (:*:) (:*:) t, Bindable category t) => Monad category t where+class (Covariant category category t, Monoidal (Straight category) (Straight category) (:*:) (:*:) t, Bindable category t) => Monad category t where 	--(>>=-) :: t a -> t b -> t a 	--(>>=-) x y = x >>= \r -> y >>= \_ -> point r 	--(->>=) :: t a -> t b -> t b

@@ -11,7 +11,7 @@  > When providing a new instance, you should ensure it satisfies: > * Numeratority of traversing: g . (f <<--) ≡ (g . f <<--)-> * Numeratority of sequencing: f . (identity <<--)= (identity <<--) . (f <$>)+> * Numeratority of sequencing: f . (identity <<--)= (identity <<--) . (f <-|-) > * Preserving point: p (point x) ≡ point x > * Preserving apply: f (x <-*- y) ≡ f x <-*- f y -}@@ -19,9 +19,9 @@ infixl 5 <<-, -<<-<<-  class Covariant source target t => Traversable source target t where-	(<<-) :: (Covariant source target u, Monoidal (Straight source) target (:*:) (:*:) u) => source a (u b) -> target (t a) (u (t b))+	(<<-) :: (Covariant source target u, Monoidal (Straight source) (Straight target) (:*:) (:*:) u) => source a (u b) -> target (t a) (u (t b))  (-<<-<<-) :: forall t u v category a b .-	(Traversable category category t, Covariant category category u, Monoidal (Straight category) category (:*:) (:*:) u, Traversable category category v)+	(Traversable category category t, Covariant category category u, Monoidal (Straight category) (Straight category) (:*:) (:*:) u, Traversable category category v) 	=> category a (u b) -> category (v (t a)) (u (v (t b))) (-<<-<<-) f = ((<<-) ((<<-) @category @category @t f))

@@ -2,9 +2,8 @@  import Pandora.Pattern.Semigroupoid (Semigroupoid ((.))) import Pandora.Pattern.Category (Category (identity))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))-import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))-import Pandora.Core.Appliable (Appliable ((!)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-)))  newtype Flip (v :: * -> * -> *) a e = Flip (v e a) @@ -15,13 +14,10 @@ 	identity = Flip identity  instance (Category m, Covariant m m t) => Contravariant (Flip m) m t where-	(>$<) (Flip f) = (<$>) f+	(>-|-) (Flip f) = (<-|-) f  instance (Category m, Covariant m m t) => Contravariant m (Flip m) t where-	(>$<) f = Flip ((<$>) f)+	(>-|-) f = Flip ((<-|-) f)  instance (Category m, Covariant m m t) => Covariant  (Flip m) (Flip m) t where-	(<$>) (Flip f) = Flip ((<$>) f)--instance Appliable (Flip m) b c m c b where-	(!) (Flip m) = m+	(<-|-) (Flip f) = Flip ((<-|-) f)

@@ -2,8 +2,7 @@  import Pandora.Pattern.Semigroupoid (Semigroupoid ((.))) import Pandora.Pattern.Category (Category (identity))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))-import Pandora.Core.Appliable (Appliable ((!)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))  newtype Straight (v :: * -> * -> *) a e = Straight (v a e) @@ -14,13 +13,10 @@ 	identity = Straight identity  instance Covariant m m t => Covariant (Straight m) m t where-	(<$>) (Straight f) = (<$>) f+	(<-|-) (Straight f) = (<-|-) f  instance Covariant m m t => Covariant m (Straight m) t where-	(<$>) f = Straight ((<$>) f)+	(<-|-) f = Straight ((<-|-) f)  instance Covariant m m t => Covariant (Straight m) (Straight m) t where-	(<$>) (Straight f) = Straight ((<$>) f)--instance Appliable (Straight m) c b m c b where-	(!) (Straight m) = m+	(<-|-) (Straight f) = Straight ((<-|-) f)

@@ -1,6 +1,5 @@ module Pandora.Pattern.Transformer.Hoistable (Hoistable (..)) where -import Pandora.Core.Functor (type (~>)) import Pandora.Pattern.Functor.Covariant (Covariant)  {- |@@ -11,6 +10,6 @@  infixr 5 /|\ -class Hoistable t where+class Hoistable m t where 	{-# MINIMAL (/|\) #-}-	(/|\) :: (Covariant (->) (->) u) => u ~> v -> t u ~> t v+	(/|\) :: Covariant m m u => (forall a . m (u a) (v a)) -> (forall a . m (t u a) (t v a))

@@ -1,5 +1,5 @@ name:                pandora-version:             0.4.7+version:             0.4.8 synopsis:            A box of patterns and paradigms description:         Humble attempt to define a library for problem solving based on math abstractions. homepage:            https://github.com/iokasimov/pandora@@ -23,7 +23,6 @@     Pandora.Core     Pandora.Core.Functor     Pandora.Core.Impliable-    Pandora.Core.Appliable      Pandora.Paradigm     -- Basic constructions@@ -108,6 +107,7 @@     Pandora.Paradigm.Structure.Ability     Pandora.Paradigm.Structure.Ability.Morphable     Pandora.Paradigm.Structure.Ability.Accessible+    Pandora.Paradigm.Structure.Ability.Possible     Pandora.Paradigm.Structure.Ability.Substructure     Pandora.Paradigm.Structure.Ability.Nonempty     Pandora.Paradigm.Structure.Ability.Nullable@@ -133,6 +133,7 @@     Pandora.Paradigm.Primary.Linear.Matrix      Pandora.Pattern+    Pandora.Pattern.Betwixt 	-- Algebra typeclasses     Pandora.Pattern.Semigroupoid     Pandora.Pattern.Category