pandora 0.5.1 → 0.5.2

raw patch · 80 files changed

+1297/−1172 lines, 80 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +28/−0
• Pandora/Core/Functor.hs +6/−5
• Pandora/Paradigm/Controlflow/Effect/Adaptable.hs +3/−3
• Pandora/Paradigm/Controlflow/Effect/Conditional.hs +15/−9
• Pandora/Paradigm/Controlflow/Effect/Interpreted.hs +33/−22
• Pandora/Paradigm/Controlflow/Effect/Transformer/Comonadic.hs +13/−9
• Pandora/Paradigm/Controlflow/Effect/Transformer/Monadic.hs +16/−10
• Pandora/Paradigm/Controlflow/Observable.hs +10/−8
• Pandora/Paradigm/Controlflow/Pipeline.hs +13/−13
• Pandora/Paradigm/Inventory.hs +14/−13
• Pandora/Paradigm/Inventory/Some/Accumulator.hs +8/−8
• Pandora/Paradigm/Inventory/Some/Equipment.hs +6/−5
• Pandora/Paradigm/Inventory/Some/Imprint.hs +7/−6
• Pandora/Paradigm/Inventory/Some/Optics.hs +33/−23
• Pandora/Paradigm/Inventory/Some/Provision.hs +2/−2
• Pandora/Paradigm/Inventory/Some/State.hs +3/−3
• Pandora/Paradigm/Inventory/Some/Store.hs +10/−10
• Pandora/Paradigm/Primary.hs +36/−30
• Pandora/Paradigm/Primary/Algebraic.hs +23/−144
• Pandora/Paradigm/Primary/Algebraic/Exponential.hs +5/−5
• Pandora/Paradigm/Primary/Algebraic/Functor.hs +143/−0
• Pandora/Paradigm/Primary/Algebraic/Product.hs +12/−5
• Pandora/Paradigm/Primary/Algebraic/Sum.hs +8/−1
• Pandora/Paradigm/Primary/Functor.hs +0/−3
• Pandora/Paradigm/Primary/Functor/Conclusion.hs +11/−11
• Pandora/Paradigm/Primary/Functor/Constant.hs +7/−7
• Pandora/Paradigm/Primary/Functor/Convergence.hs +4/−5
• Pandora/Paradigm/Primary/Functor/Edges.hs +4/−4
• Pandora/Paradigm/Primary/Functor/Endo.hs +2/−2
• Pandora/Paradigm/Primary/Functor/Exactly.hs +18/−21
• Pandora/Paradigm/Primary/Functor/Maybe.hs +16/−16
• Pandora/Paradigm/Primary/Functor/Predicate.hs +7/−6
• Pandora/Paradigm/Primary/Functor/Tagged.hs +4/−4
• Pandora/Paradigm/Primary/Functor/These.hs +10/−10
• Pandora/Paradigm/Primary/Functor/Validation.hs +13/−12
• Pandora/Paradigm/Primary/Functor/Wedge.hs +3/−3
• Pandora/Paradigm/Primary/Functor/Wye.hs +18/−19
• Pandora/Paradigm/Primary/Linear/Matrix.hs +2/−3
• Pandora/Paradigm/Primary/Linear/Vector.hs +6/−7
• Pandora/Paradigm/Primary/Transformer/Backwards.hs +9/−9
• Pandora/Paradigm/Primary/Transformer/Construction.hs +18/−19
• Pandora/Paradigm/Primary/Transformer/Continuation.hs +14/−13
• Pandora/Paradigm/Primary/Transformer/Day.hs +4/−4
• Pandora/Paradigm/Primary/Transformer/Instruction.hs +14/−13
• Pandora/Paradigm/Primary/Transformer/Jack.hs +7/−8
• Pandora/Paradigm/Primary/Transformer/Jet.hs +5/−4
• Pandora/Paradigm/Primary/Transformer/Kan.hs +4/−3
• Pandora/Paradigm/Primary/Transformer/Outline.hs +4/−5
• Pandora/Paradigm/Primary/Transformer/Reverse.hs +6/−6
• Pandora/Paradigm/Primary/Transformer/Tap.hs +27/−28
• Pandora/Paradigm/Primary/Transformer/Yoneda.hs +2/−1
• Pandora/Paradigm/Schemes.hs +7/−6
• Pandora/Paradigm/Schemes/TT.hs +18/−14
• Pandora/Paradigm/Schemes/TU.hs +18/−15
• Pandora/Paradigm/Schemes/TUT.hs +29/−25
• Pandora/Paradigm/Schemes/TUVW.hs +3/−3
• Pandora/Paradigm/Schemes/T_U.hs +3/−3
• Pandora/Paradigm/Schemes/UT.hs +16/−13
• Pandora/Paradigm/Schemes/UTU.hs +3/−3
• Pandora/Paradigm/Structure.hs +37/−53
• Pandora/Paradigm/Structure/Ability/Monotonic.hs +2/−2
• Pandora/Paradigm/Structure/Ability/Morphable.hs +19/−17
• Pandora/Paradigm/Structure/Ability/Substructure.hs +24/−15
• Pandora/Paradigm/Structure/Ability/Zipper.hs +49/−53
• Pandora/Paradigm/Structure/Interface/Set.hs +7/−6
• Pandora/Paradigm/Structure/Modification/Comprehension.hs +17/−16
• Pandora/Paradigm/Structure/Modification/Prefixed.hs +3/−4
• Pandora/Paradigm/Structure/Modification/Turnover.hs +1/−2
• Pandora/Paradigm/Structure/Some/Binary.hs +126/−112
• Pandora/Paradigm/Structure/Some/List.hs +107/−120
• Pandora/Paradigm/Structure/Some/Rose.hs +33/−31
• Pandora/Paradigm/Structure/Some/Splay.hs +55/−55
• Pandora/Paradigm/Structure/Some/Stream.hs +9/−8
• Pandora/Pattern/Category.hs +1/−4
• Pandora/Pattern/Functor/Covariant.hs +13/−7
• Pandora/Pattern/Object/Group.hs +1/−1
• Pandora/Pattern/Object/Ringoid.hs +1/−1
• Pandora/Pattern/Object/Semigroup.hs +1/−1
• Pandora/Pattern/Object/Setoid.hs +6/−1
• pandora.cabal +2/−1

@@ -692,3 +692,31 @@ * Change precedence for `:+:` * Rename 'forever_' to 'loop' * Remove `Nullable` typeclass++# 0.5.2+* Remove `#` operator from `Category` typeclass+* Change precedence for `==` and `!=`+* Remove `Conditional` typeclass ant its `?` operator+* Define `Conditional` typeclass with `iff` method+* Define `<~` length encoding operators in `Interpreted` class+* Define `<-|-` length encoding operators in `Covariant` class+* Remove `!` operator from `Interpreted` class+* Change precedence fro `:*:` operator - from 6 to 8+* Move `Simplification` type family to `Primary` module+* Refactor `Substructure` class: remove `Available` type family+* Rename `#` type operator to `<` and lower its precedence+* Define `>` operator for type application+* Define `<` operator for type parameters passing+* Remove `:=` type operator+* Change precedence fro `+`, `-`, `*` operators - to 9+* Define `<-||-` length encoding operators in `Algebraic` module+* Define `>-||-` length encoding operators in `Algebraic` module+* Define `Horizontal` type and use it in binary tree zipper+* Define `?==` operator as replacemet for if statement+* Define `<:*:>`, `>:*:>`, `<:*:<`, `>:*:<` type synonyms+* Define `<:+:>`, `>:+:>`, `<:+:<`, `>:+:<` type synonyms+* Define `Functor` module in `Algebraic`+* Change definition of binary tree+* Change `Zipper` definition - tag it++# 0.5.3

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

@@ -1,7 +1,7 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Controlflow.Effect.Adaptable where -import Pandora.Core.Functor (type (#))+import Pandora.Core.Functor (type (>), type (<)) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.))) import Pandora.Pattern.Category (Category (identity)) import Pandora.Pattern.Functor.Covariant (Covariant)@@ -15,7 +15,7 @@  class Adaptable u m t where 	{-# MINIMAL adapt #-}-	adapt :: m (t a) (u a)+	adapt :: m < t a < u a  instance Category m => Adaptable t m t where 	adapt = identity @m@@ -24,7 +24,7 @@ 	adapt = point . extract  class Effectful m v t u where-	effect :: m (v a) (t :> u # a)+	effect :: m (v a) (t :> u > a)  instance (Pointable u, Monadic m t) => Effectful m t t u where 	effect = wrap

@@ -4,15 +4,21 @@ import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False)) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing)) -infixr 1 ?+class Conditional prompt clause where+	iff :: clause -> a -> a -> a -class Conditional clause where-	(?) :: clause -> a -> a -> a+instance Conditional True Boolean where+	iff True x _ = x+	iff False _ y = y -instance Conditional Boolean where-	(?) True x _ = x-	(?) False _ y = y+instance Conditional False Boolean where+	iff False x _ = x+	iff True _ y = y -instance Conditional (Maybe a) where-	(?) (Just _) x _ = x-	(?) Nothing _ y = y+instance Conditional Just (Maybe a) where+	iff (Just _) x _ = x+	iff Nothing _ y = y++instance Conditional Nothing (Maybe a) where+	iff Nothing x _ = x+	iff (Just _) _ y = y

@@ -1,60 +1,76 @@ module Pandora.Paradigm.Controlflow.Effect.Interpreted where +import Pandora.Core.Functor (type (<), type (>)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Morphism.Flip (Flip (Flip))-import Pandora.Core.Functor (type (:=)) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.)))-import Pandora.Pattern.Category (identity) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Paradigm.Primary.Algebraic.Exponential () -infixl 0 ! infixr 2 =#-, -#= +infixl 1 <~~~~~~~~~+infixl 2 <~~~~~~~~+infixl 3 <~~~~~~~+infixl 4 <~~~~~~+infixl 5 <~~~~~+infixl 6 <~~~~+infixl 7 <~~~+infixl 8 <~~+infixl 9 <~+ type family Schematic (c :: (* -> * -> *) -> (* -> *) -> k) (t :: * -> *) = (r :: (* -> *) -> * -> *) | r -> t  class Interpreted m t where 	{-# MINIMAL run, unite #-} 	type Primary t a :: *-	run :: m (t a) (Primary t a)-	unite :: m (Primary t a) (t a)+	run :: m < t a < Primary t a+	unite :: m < Primary t a < t a -	(!) :: m (t a) (Primary t a)-	(!) = run+	(<~~~~~~~~~), (<~~~~~~~~), (<~~~~~~~), (<~~~~~~), (<~~~~~), (<~~~~), (<~~~), (<~~), (<~) :: m < t a < Primary t a+	(<~~~~~~~~~) = run+	(<~~~~~~~~) = run+	(<~~~~~~~) = run+	(<~~~~~~) = run+	(<~~~~~) = run+	(<~~~~) = run+	(<~~~) = run+	(<~~) = run+	(<~) = run -	(=#-) :: (Semigroupoid m, Interpreted m u) => m (Primary t a) (Primary u b) -> m (t a) (u b)+	(=#-) :: (Semigroupoid m, Interpreted m u) => m < Primary t a < Primary u b -> m < t a < u b 	(=#-) f = unite . f . run -	(-#=) :: (Semigroupoid m, Interpreted m u) => m (t a) (u b) -> m (Primary t a) (Primary u b)+	(-#=) :: (Semigroupoid m, Interpreted m u) => m < t a < u b -> m < Primary t a < Primary u b 	(-#=) f = run . f . unite  	(<$=#-) :: (Semigroupoid m, Covariant m m j, Interpreted m u)-                => m (Primary t a) (Primary u b) -> m (j := t a) (j := u b)+                => 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)+	--	=> 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, Interpreted m u)-	--	=> m (Primary t a) (Primary u b) -> m (j :. k :. l := t a) (j :. k :. l := u b)+	--	=> 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)+		=> 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)+	--	=> 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, Interpreted m u)-	--	=> m (t a) (u b) -> m (j :. k :. l := Primary t a) (j :. k :. l := Primary u b)+	--	=> 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)+(-=:) :: (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 (-=:) f = run . f . lift  instance Interpreted (->) (Flip v a) where@@ -66,8 +82,3 @@ 	type Primary (Straight v e) a = v e a 	run ~(Straight x) = x 	unite = Straight--instance Interpreted (->) ((->) e) where-	type Primary ((->) e) a = e -> a-	run = identity-	unite = identity

@@ -1,7 +1,9 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Controlflow.Effect.Transformer.Comonadic (Comonadic (..), (:<) (..)) where +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.Semimonoidal (Semimonoidal (mult))@@ -17,35 +19,37 @@ 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 m t => Comonadic m t where 	{-# MINIMAL bring #-}-	bring :: Extractable u => m ((t :< u) a) (t a)+	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) . run+	unit _ = Straight <-- TC . point . (<-- One) . run  instance Traversable (->) (->) (Schematic Comonad t u) => Traversable (->) (->) (t :< u) where 	f <<- TC x = TC <-|- f <<- x  instance Distributive (->) (->) (Schematic Comonad t u) => Distributive (->) (->) (t :< u) where-	f -<< x = TC ! tc . f --<< x+	f -<< x = TC <--- tc . f --<< x  instance Bindable (->) (Schematic Comonad t u) => Bindable (->) (t :< u) where-	f =<< TC x = TC ! tc . f ==<< x+	f =<< TC x = TC <--- tc . f ==<< x  instance Extendable (->) (Schematic Comonad t u) => Extendable (->) (t :< u) where-	f <<= TC x = TC ! f . TC <<== x+	f <<= TC x = TC <--- f . TC <<== x  instance (Extractable (t :< u), Extendable (->) (t :< u)) => Comonad (->) (t :< u) where @@ -53,7 +57,7 @@ 	lower (TC x) = lower x  instance Hoistable (->) (Schematic Comonad t) => Hoistable (->) ((:<) t) where-	f /|\ TC x = TC ! f /|\ x+	f /|\ TC x = TC (f /|\ x)  instance (Interpreted (->) (Schematic Comonad t u)) => Interpreted (->) (t :< u) where 	type Primary (t :< u) a = Primary (Schematic Comonad t u) a

@@ -1,8 +1,10 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Controlflow.Effect.Transformer.Monadic (Monadic (..), (:>) (..)) where +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.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit))@@ -18,38 +20,42 @@ 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 m t => Monadic m t where 	{-# MINIMAL wrap #-}-	wrap :: Pointable u => m (t a) ((t :> u) a)+	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) . run+	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)+	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  instance Distributive (->) (->) (Schematic Monad t u) => Distributive (->) (->) (t :> u) where-	f -<< x = TM ! tm . f --<< x+	f -<< x = TM <--- tm . f --<< x  instance Bindable (->) (Schematic Monad t u) => Bindable (->) (t :> u) where-	f =<< TM x = TM ! tm . f ==<< x+	f =<< TM x = TM <--- tm . f ==<< x  instance Extendable (->) (Schematic Monad t u) => Extendable (->) (t :> u) where-	f <<= TM x = TM ! f . TM <<== x+	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 @@ -57,7 +63,7 @@ 	lift = TM . lift  instance Hoistable (->) (Schematic Monad t) => Hoistable (->) ((:>) t) where-	f /|\ TM x = TM ! f /|\ x+	f /|\ TM x = TM (f /|\ x)  instance (Interpreted (->) (Schematic Monad t u)) => Interpreted (->) (t :> u) where 	type Primary (t :> u) a = Primary (Schematic Monad t u) a

@@ -1,23 +1,25 @@ module Pandora.Paradigm.Controlflow.Observable (Observable, observe, 	notify, follow, subscribe, watch, (.:~.), (.:~*), (*:~.), (*:~*)) where +import Pandora.Core.Functor (type (<)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((#))+import Pandora.Pattern.Category ((<--), (<---)) import Pandora.Paradigm.Primary.Algebraic (Applicative, loop) import Pandora.Paradigm.Primary.Transformer.Continuation (Continuation (Continuation))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!))+import Pandora.Paradigm.Controlflow.Effect.Interpreted ((<~~))  newtype Capture r t a = Capture { captured :: t r } -type Observable t a r = Continuation r (Capture r t) a+type Observable t a r = Continuation r < Capture r t < a  -- | Make continuation observable observe :: Continuation r t a -> Observable t a r-observe action = Continuation ! \h -> Capture ! run action # captured . h+observe action = Continuation <-- \h ->+	Capture <--- action <~~ captured . h  -- | Listen only first event, call back just once notify :: Observable t a r -> (a -> t r) -> t r-notify r action = captured ! run r # Capture . action+notify r action = captured <--- r <~~ Capture . action  -- | Infix version of 'notify' (.:~.) :: Observable t a r -> (a -> t r) -> t r@@ -25,7 +27,7 @@  -- | Listen only first event, call back loop follow :: Applicative t => Observable t a r -> (a -> t r) -> t r-follow r action = captured ! run r # Capture . loop . action+follow obs action = captured <--- obs <~~ Capture . loop . action  -- | Infix version of 'follow' (.:~*) :: Applicative t => Observable t a r -> (a -> t r) -> t r@@ -33,7 +35,7 @@  -- | Listen all events from action, call back just once subscribe :: Applicative t => Observable t a r -> (a -> t r) -> t r-subscribe r action = loop ! captured ! run r # Capture . action+subscribe r action = loop <--- captured <--- r <~~ Capture . action  -- | Infix version of 'subscribe' (*:~.) :: Applicative t => Observable t a r -> (a -> t r) -> t r@@ -41,7 +43,7 @@  -- | Listen all events from action, call back loop watch :: Applicative t => Observable t a r -> (a -> t r) -> t r-watch r action = loop ! captured ! run r # Capture . loop . action+watch r action = loop <--- captured <--- r <~~ Capture . loop . action  -- | Infix version of 'watch' (*:~*) :: Applicative t => Observable t a r -> (a -> t r) -> t r

@@ -1,14 +1,14 @@ module Pandora.Paradigm.Controlflow.Pipeline (Pipeline, await, yield, finish, impact, (=*=), pipeline) where  import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((#))+import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Kernel (constant) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Monoidal (Monoidal) 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, (!)))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite)) import Pandora.Paradigm.Primary.Transformer.Continuation (Continuation (Continuation))  newtype Producer i t r = Producer { produce :: Consumer i t r -> t r }@@ -30,40 +30,40 @@ type Pipeline i o t a r = Continuation r (Pipe i o r t) a  pause :: (() -> Pipe i o r t a) -> Producer i t r -> Producer o t r-pause next ik = Producer ! \ok -> (pipe ! next ()) ik ok+pause next ik = Producer <-- \ok -> (pipe <-- next ()) ik ok  suspend :: (i -> Pipe i o r t a) -> Consumer o t r -> Consumer i t r-suspend next ok = Consumer ! \v ik -> pipe # next v # ik # ok+suspend next ok = Consumer <-- \v ik -> pipe <-- next v <-- ik <-- ok  -- | Take incoming value from pipeline await :: Pipeline i o t i r-await = Continuation ! \next -> Pipe ! \(Producer i) o -> i # suspend next o+await = Continuation <-- \next -> Pipe <-- \(Producer i) o -> i <-- suspend next o  -- | Give a value to the future consuming yield :: o -> Pipeline i o t () r-yield v = Continuation ! \next -> Pipe ! \i (Consumer o) -> o v # pause next i+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 = Continuation (constant # Pipe (constant . constant # point ()))+finish = Continuation (constant <-- Pipe (constant . constant <-- point ()))  -- | Do some effectful computation within pipeline impact :: Bindable (->) t => t a -> Pipeline i o t a a-impact action = Continuation ! \next -> Pipe ! \i o -> (\x -> pipe (next x) i o) =<< action+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 () ()-p =*= q = Continuation ! \_ -> Pipe ! \i -> pipe # run q end # pause (constant # run p end) i where+p =*= q = Continuation <-- \_ -> Pipe <-- \i -> pipe <-- run q end <-- pause (constant <-- run p end) i where  	end :: b -> Pipe c d () t ()-	end _ = Pipe (constant . constant # point ())+	end _ = Pipe (constant . constant <-- point ())  -- | Run pipeline and get result pipeline :: Monoidal (-->) (-->) (:*:) (:*:) t => Pipeline i o t () () -> t ()-pipeline p = pipe # run p (Pipe . constant . constant . point) # i # o where+pipeline p = pipe <-- run p (Pipe . constant . constant . point) <-- i <-- o where  	i :: Producer i t ()-	i = Producer ! \o' -> produce i o'+	i = Producer <-- \o' -> produce i o'  	o :: Consumer o t ()-	o = Consumer ! \v i' -> consume o v i'+	o = Consumer <-- \v i' -> consume o v i'

@@ -7,32 +7,33 @@  import Pandora.Core.Functor (type (~>)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((#), (<--))+import Pandora.Pattern.Category ((<--), (<---)) import Pandora.Pattern.Kernel (constant) 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.Paradigm.Primary.Functor.Exactly (Exactly (Exactly), Simplification)+import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly)) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Primary.Algebraic.Exponential ((%), type (<--)) import Pandora.Paradigm.Primary.Algebraic (Pointable, extract)-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!))+import Pandora.Paradigm.Primary (Simplification)+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-	f -| x = State ! \s -> (:*:) s . f . Store ! s :*: constant x+	f -| x = State <-- \s -> (:*:) s . f . Store <--- s :*: constant x 	(|-) :: (a -> State s b) -> Store s a -> b-	g |- Store (s :*: f) = extract . (run % s) . g ! f s+	g |- Store (s :*: f) = extract . (run % s) . g <-- f s  instance Adjoint (->) (->) (Accumulator e) (Imprint e) where-	f -| x = Imprint ! f . Accumulator --| x+	f -| x = Imprint <--- f . Accumulator --| x 	g |- x = run . g |-- run x  instance Adjoint (->) (->) (Equipment e) (Provision e) where-	f -| x = Provision ! f . Equipment --| x+	f -| x = Provision <--- f . Equipment --| x 	g |- x = run . g |-- run x  class Zoomable (tool :: * -> * -> *) (available :: * -> *) where@@ -40,25 +41,25 @@  instance Zoomable State Exactly where 	zoom :: forall bg ls t result . Stateful bg t => Convex Lens bg ls -> State ls result -> t result-	zoom lens less = adapt . State ! \source -> restruct |- run (lens ! source) where+	zoom lens less = adapt . State <-- \source -> restruct |- run (lens <~ source) where  		restruct :: (Exactly ls -> bg) -> Exactly ls -> bg :*: result-		restruct to (Exactly target) = run # to . Exactly <-|- Flip (less ! target)+		restruct to (Exactly target) = run <--- to . Exactly <-|- Flip (less <~ target)  instance Zoomable State Maybe where 	zoom :: forall bg ls t result . Stateful bg t => Obscure Lens bg ls -> State (Maybe ls) result -> t result-	zoom lens less = adapt . State ! \source -> restruct |- run (lens ! source) where+	zoom lens less = adapt . State <-- \source -> restruct |- run (lens <~ source) where  		restruct :: (Maybe ls -> bg) -> Maybe ls -> bg :*: result 		restruct to target = run (to <-|-- Flip <-- run less target)  overlook :: (Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t) => State s result -> State (t s) (t result)-overlook (State state) = State ! \ts -> mult @(<--) @(:*:) @(:*:) ! (state <-|- ts)+overlook (State state) = State <-- \ts -> mult @(<--) @(:*:) @(:*:) <~ (state <-|- ts)  (=<>) :: (Pointable available, Stateful src t) 	=> Lens available src tgt -> tgt -> t src-lens =<> new = adapt (modify @State ! set @(Lens _) new lens)+lens =<> new = adapt (modify @State <-- set @(Lens _) new lens)  (~<>) :: (Pointable available, Covariant (->) (->) available, Gettable (Lens available), Stateful src t) 	=> Lens available src tgt -> (tgt -> tgt) -> t src-lens ~<> f = adapt (modify @State ! modify @(Lens _) f lens)+lens ~<> f = adapt (modify @State <-- modify @(Lens _) f lens)

@@ -3,7 +3,7 @@  import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((#))+import Pandora.Pattern.Category ((<--), (<---)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<)))@@ -13,7 +13,7 @@ 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 (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.UT (UT (UT), type (<.:>))@@ -21,15 +21,15 @@ 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-		k ~(ex :*: x') ~(ey :*: y') = ex + ey :*: x' :*: y'+	mult = Straight <-- \(x :*: y) -> Accumulator <--- k <-- run x <-- run y where+		k ~(ex :*: x') ~(ey :*: y') = (ex + ey) :*: x' :*: y'  instance Semigroup e => Bindable (->) (Accumulator e) where-	f =<< Accumulator (e :*: x) = let e' :*: b = run @(->) ! f x in-		Accumulator ! e + e':*: b+	f =<< Accumulator (e :*: x) = let e' :*: b = run @(->) <-- f x in+		Accumulator <--- (e + e') :*: b  type instance Schematic Monad (Accumulator e) = (<.:>) ((:*:) e) @@ -44,4 +44,4 @@ type Accumulated e t = Adaptable t (->) (Accumulator e)  gather :: Accumulated e t => e -> t ()-gather x = adapt . Accumulator ! x :*: ()+gather x = adapt . Accumulator <--- x :*: ()

@@ -2,6 +2,7 @@ module Pandora.Paradigm.Inventory.Some.Equipment (Equipment (..), retrieve) where  import Pandora.Pattern.Semigroupoid ((.))+import Pandora.Pattern.Category ((<---), (<-----)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=), (<<==)))@@ -9,20 +10,20 @@ import Pandora.Paradigm.Primary.Algebraic () import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), attached) import Pandora.Paradigm.Controlflow.Effect.Adaptable (Adaptable (adapt))-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.Inventory.Ability.Gettable (Gettable (Getting, get)) import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>))  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  instance Extendable (->) (Equipment e) where-	f <<= Equipment (e :*: x) = Equipment . (:*:) e . f . Equipment ! e :*: x+	f <<= Equipment (e :*: x) = Equipment . (:*:) e . f . Equipment <----- e :*: x  instance Interpreted (->) (Equipment e) where 	type Primary (Equipment e) a = e :*: a@@ -34,11 +35,11 @@ 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+	f <<= TU (e :*: x) = TU . (:*:) e <--- f . TU . (:*:) e <<== x  retrieve :: Equipped e t => t a -> e retrieve = attached . run @(->) @(Equipment _) . adapt  instance Gettable Equipment where 	type Getting Equipment e output = Equipment e output -> e-	get (Equipment (e :*: x)) = e+	get (Equipment (e :*: _)) = e

@@ -2,6 +2,7 @@ module Pandora.Paradigm.Inventory.Some.Imprint (Imprint (..), Traceable) where  import Pandora.Pattern.Semigroupoid ((.))+import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-))) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<)))@@ -10,23 +11,23 @@ import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Paradigm.Primary.Algebraic () import Pandora.Pattern.Morphism.Flip (Flip (Flip))-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.Adaptable (Adaptable) import Pandora.Paradigm.Schemes.UT (UT (UT), type (<.:>))  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 Semigroup e => Extendable (->) (Imprint e) where-	f <<= Imprint x = Imprint ! \e -> f . Imprint ! x . (e +)+	f <<= Imprint x = Imprint <-- \e -> f . Imprint <-- x . (e +)  instance Interpreted (->) (Imprint e) where 	type Primary (Imprint e) a = (->) e a@@ -36,6 +37,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)

@@ -4,21 +4,20 @@  import Pandora.Core.Impliable (Impliable (Arguments, imply)) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.)))-import Pandora.Pattern.Category (Category (identity, (<--), (<---), (<-----)))+import Pandora.Pattern.Category (Category (identity, (<--), (<---), (<-----), (<-------))) import Pandora.Pattern.Kernel (Kernel (constant))-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.Representable (Representable (Representation, (<#>), tabulate))-import Pandora.Pattern.Object.Setoid (Setoid ((==)))-import Pandora.Paradigm.Controlflow.Effect.Conditional (Conditional ((?)))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (run, (!)))+import Pandora.Pattern.Object.Setoid (Setoid ((?==)))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (run, (<~))) import Pandora.Paradigm.Inventory.Ability.Gettable (Gettable (Getting, get)) import Pandora.Paradigm.Inventory.Ability.Settable (Settable (Setting, set)) import Pandora.Paradigm.Inventory.Ability.Modifiable (Modifiable (Modification, modify)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Primary.Algebraic.Exponential (type (-->), (%))-import Pandora.Paradigm.Primary.Algebraic (Pointable, point, extract, (>-|-<-|-))+import Pandora.Paradigm.Primary.Algebraic (Pointable, point, extract, (>-||-----), (>-|-<-|-)) import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly)) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing)) import Pandora.Pattern.Morphism.Flip (Flip (Flip))@@ -32,7 +31,7 @@ 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 Exactly@@ -42,7 +41,7 @@ 	P_Q_T to . P_Q_T from = P_Q_T <-- \source -> 		let (Exactly between :*: bs) = run <-- from source in 		let (Exactly target :*: tb) = run <-- to between in-		Store <----- Exactly target :*: bs . Exactly . tb+		Store <--- Exactly target :*: bs . Exactly . tb  instance Category (Lens Exactly) where 	identity :: Convex Lens source source@@ -51,14 +50,14 @@ instance Semimonoidal (-->) (:*:) (:*:) (Lens Exactly source) where 	mult = Straight <-- \(P_Q_T x :*: P_Q_T y) -> P_Q_T <-- \source -> 		let Store (Exactly xt :*: ixts) :*: Store (Exactly yt :*: _) = x source :*: y source in-		Store <----- Exactly (xt :*: yt) :*: \(Exactly (xt_ :*: yt_)) ->+		Store <--- Exactly (xt :*: yt) :*: \(Exactly (xt_ :*: yt_)) -> 			let modified = ixts <-- Exactly xt_ in 			extract <--- run <-- y modified <--- Exactly yt_  instance Impliable (P_Q_T (->) Store Exactly source target) where 	type Arguments (P_Q_T (->) Store Exactly source target) = 		(source -> target) -> (source -> target -> source) -> Lens Exactly source target-	imply getter setter = P_Q_T <-- \source -> Store <----- Exactly <-- getter source :*: setter source . extract+	imply getter setter = P_Q_T <-- \source -> Store <--- (Exactly <-- getter source) :*: setter source . extract  type family Obscure lens where 	Obscure Lens = Lens Maybe@@ -66,15 +65,15 @@ instance Impliable (P_Q_T (->) Store Maybe source target) where 	type Arguments (P_Q_T (->) Store Maybe source target) = 		(source -> Maybe target) -> (source -> Maybe target -> source) -> Lens Maybe source target-	imply getter setter = P_Q_T <-- \source -> Store <----- getter source :*: setter source+	imply getter setter = P_Q_T <-- \source -> Store <--- getter source :*: setter source  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 run <-- from source of-		Nothing :*: _ -> Store <----- Nothing :*: \_ -> source+		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+			Nothing :*: _ -> Store <--- Nothing :*: \_ -> source+			Just target :*: mtb -> Store <--- Just target :*: mbs . Just . mtb  instance Category (Lens Maybe) where 	identity :: Obscure Lens source source@@ -83,9 +82,11 @@ -- Lens as natural transformation type (#=@) source target available = forall a . Lens available (source a) (target a) +type (@>>>) source target = forall a . Lens target (source a) a+ -- | Representable based lens represent :: forall t a . (Representable t, Setoid (Representation t)) => Representation t -> Convex Lens (t a) a-represent r = imply @(Convex Lens (t a) a) (r <#>) (\source target -> tabulate ! \r' -> r' == r ? target ! r' <#> source)+represent r = imply @(Convex Lens (t a) a) (r <#>) (\source target -> tabulate <-- \r' -> r' ?== r <----- target <----- r' <#> source)  class Lensic previous next where 	type Lensally previous next :: * -> *@@ -98,29 +99,38 @@ instance Lensic Maybe Exactly where 	type Lensally Maybe Exactly = Maybe 	P_Q_T from >>> P_Q_T to = P_Q_T <-- \source -> case run <-- from source of-		Nothing :*: _ -> Store <----- Nothing :*: \_ -> source+		Nothing :*: _ -> Store <--- Nothing :*: \_ -> source 		Just between :*: mbs -> case run <-- to between of-			Exactly target :*: itb -> Store <----- Just target :*: \mt -> mbs <--- itb . Exactly <-|- mt+			Exactly target :*: itb -> Store <--- Just target :*: \mt -> mbs <--- itb . Exactly <-|- mt  instance Lensic Exactly Maybe where 	type Lensally Exactly Maybe = Maybe 	P_Q_T from >>> P_Q_T to = P_Q_T <-- \source -> case run <-- from source of 		Exactly between :*: ibs -> case run <-- to between of-			Just target :*: mtb -> Store <----- Just target :*: ibs . Exactly . mtb-			Nothing :*: _ -> Store <----- Nothing :*: constant source+			Just target :*: mtb -> Store <--- Just target :*: ibs . Exactly . mtb+			Nothing :*: _ -> Store <--- Nothing :*: constant source  instance Gettable (Lens Exactly) where 	type instance Getting (Lens Exactly) source target = Lens Exactly source target -> source -> target-	get lens = extract @Exactly . position @_ @(Store _) . run lens+	get lens source = extract @Exactly . position @_ @(Store _) <-- lens <~ source  instance Gettable (Lens Maybe) where 	type instance Getting (Lens Maybe) source target = Lens Maybe source target -> source -> Maybe target-	get lens = position @_ @(Store _) . run lens+	get lens source = position @_ @(Store _) <-- lens <~ source  instance Pointable t => Settable (Lens t) where 	type instance Setting (Lens t) source target = target -> Lens t source target -> source -> source-	set new lens source = look @(t _) <-- point new <-- run lens source+	set new lens source = look @(t _) <-- point new <-- lens <~ source  instance (Gettable (Lens t), Covariant (->) (->) t, Pointable t) => Modifiable (Lens t) where 	type instance Modification (Lens t) source target = (target -> target) -> Lens t source target -> source -> source-	modify f lens = extract . retrofit (f <-|-) . run lens+	modify f lens source = extract . retrofit (f <-|-) <-- lens <~ source++view :: Lens i source target -> source -> i target+view lens source = position @_ @(Store _) <-- lens <~ source++replace :: forall i source target . i target -> Lens i source target -> source -> source+replace new lens source = look @(i _) <-- new <-- lens <~ source++mutate :: (i target -> i target) -> Lens i source target -> source -> source+mutate mut lens source = extract . retrofit mut <-- lens <~ source

@@ -17,7 +17,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.Inventory.Ability.Gettable (Gettable (Getting, get))@@ -32,7 +32,7 @@ 	f >-|- Flip (Provision g) = Flip . Provision <-- g . f  instance Semimonoidal (-->) (:*:) (:*:) (Provision e) where-	mult = Straight <-- Provision . (mult @(-->) !) . (run <-||-) . (run @(->) <-|-)+	mult = Straight <-- Provision . (mult @(-->) <~) . (run <-||-) . (run @(->) <-|-)  instance Monoidal (-->) (-->) (:*:) (:*:) (Provision e) where 	unit _ = Straight <-- \f -> Provision <-- \_ -> run f One

@@ -3,7 +3,7 @@  import Pandora.Pattern.Morphism.Flip (Flip) import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Core.Functor (type (:.), type (:=))+import Pandora.Core.Functor (type (:.), type (>)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category ((<--), (<---), identity) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))@@ -27,7 +27,7 @@ import Pandora.Paradigm.Primary.Algebraic (Pointable, point, (<-||-), (>-||-))  -- | Effectful computation with a variable-newtype State s a = State ((->) s :. (:*:) s := a)+newtype State s a = State ((->) s :. (:*:) s > a)  instance Covariant (->) (->) (State s) where 	f <-|- x = State <--- (<-|-) f . run x@@ -50,7 +50,7 @@ 	f <!< g = (((g >-||-) . ((f <-||-) <-|-) =#-) =#-)  instance Interpreted (->) (State s) where-	type Primary (State s) a = (->) s :. (:*:) s := a+	type Primary (State s) a = (->) s :. (:*:) s > a 	run ~(State x) = x 	unite = State 

@@ -1,9 +1,9 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Inventory.Some.Store where -import Pandora.Core (type (:.), type (:=), type (<:=), type (~>))+import Pandora.Core (type (:.), type (>), type (<:=), type (~>)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((-->), identity)+import Pandora.Pattern.Category ((<--), (<---), (<----), identity) import Pandora.Pattern.Kernel (constant) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-|-)) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult))@@ -18,28 +18,28 @@ 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.Interpreted (Interpreted (Primary, run, unite, (=#-)), Schematic) import Pandora.Paradigm.Controlflow.Effect.Transformer.Comonadic (Comonadic (bring), (:<) (TC)) import Pandora.Paradigm.Schemes.TUT (TUT (TUT), type (<:<.>:>))  -- | Context based computation on value-newtype Store s a = Store ((:*:) s :. (->) s := a)+newtype Store s a = Store ((:*:) s :. (->) s > a)  -- TODO: Try to generalize (->) here instance Covariant (->) (->) (Store s) where 	(<-|-) f = (=#-) (f <-|-|-)  instance Semimonoidal (<--) (:*:) (:*:) (Store s) where-	mult = Flip ! \(Store (s :*: f)) ->+	mult = Flip <-- \(Store (s :*: f)) -> 		let (x :*: y) = f s in 		Store (s :*: constant x) :*: Store (s :*: constant y)  instance Monoidal (<--) (-->) (:*:) (:*:) (Store s) where-	unit _ = Flip ! Straight . constant . ((-->) |-) . run+	unit _ = Flip <-- Straight . constant . ((<--) |-) . run  -- 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 @@ -47,14 +47,14 @@ 	f <!< g = (((f <-||-) . ((g >-||-) <-|-) =#-) =#-)  instance Interpreted (->) (Store s) where-	type Primary (Store s) a = (:*:) s :. (->) s := a+	type Primary (Store s) a = (:*:) s :. (->) s > a 	run ~(Store x) = x 	unite = Store  type instance Schematic Comonad (Store s) = (:*:) s <:<.>:> (->) s  instance Comonadic (->) (Store s) where-	bring (TC (TUT (s :*: f))) = Store ! s :*: extract f+	bring (TC (TUT (s :*: f))) = Store <--- s :*: extract f  type Storable s t = Adaptable (Store s) (->) t @@ -68,4 +68,4 @@  -- | Change index with function retrofit :: (s -> s) -> Store s ~> Store s-retrofit g (Store (s :*: f)) = Store ! g s :*: f+retrofit g (Store (s :*: f)) = Store <--- g s :*: f

@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-module Pandora.Paradigm.Primary (module Exports, twosome) where+module Pandora.Paradigm.Primary (module Exports, Simplification, twosome) where  import Pandora.Paradigm.Primary.Linear as Exports import Pandora.Paradigm.Primary.Transformer as Exports@@ -9,24 +9,24 @@  import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Core.Functor (type (:=))+import Pandora.Core.Functor (type (:.), type (>)) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.)))+import Pandora.Pattern.Category ((<--), (<---)) import Pandora.Pattern.Kernel (Kernel (constant)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Adjoint (Adjoint ((|-), (-|))) import Pandora.Pattern.Transformer.Liftable (lift) import Pandora.Pattern.Transformer.Lowerable (lower)-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!))-import Pandora.Paradigm.Controlflow.Effect.Conditional (Conditional ((?)))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (<~)) import Pandora.Paradigm.Inventory.Some.Store (Store (Store))-import Pandora.Paradigm.Schemes (TU (TU), T_U (T_U), P_Q_T (P_Q_T), type (<:.>), type (<:.:>))+import Pandora.Paradigm.Schemes (TU (TU), T_U (T_U), UT, TUT, P_Q_T (P_Q_T), type (<:.>), type (<:.:>)) import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (resolve)) import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Into), premorph)-import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Available, Substance, substructure))+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substance, substructure))  instance Adjoint (->) (->) (Flip (:*:) s) ((->) s) where-	f -| x = \s -> f . Flip ! x :*: s+	f -| x = \s -> f . Flip <--- x :*: s 	f |- Flip (x :*: s) = f x s  instance Morphable (Into Maybe) (Conclusion e) where@@ -35,13 +35,13 @@  instance Morphable (Into (Conclusion e)) Maybe where 	type Morphing (Into (Conclusion e)) Maybe = (->) e <:.> Conclusion e-	morphing (premorph -> Just x) = TU ! \_ -> Success x-	morphing (premorph -> Nothing) = TU ! \e -> Failure e+	morphing (premorph -> Just x) = TU <-- \_ -> Success x+	morphing (premorph -> Nothing) = TU <-- \e -> Failure e  instance Morphable (Into (Flip Conclusion e)) Maybe where 	type Morphing (Into (Flip Conclusion e)) Maybe = (->) e <:.> Flip Conclusion e-	morphing (run . premorph -> Just x) = TU ! \_ -> Flip ! Failure x-	morphing (run . premorph -> Nothing) = TU ! Flip . Success+	morphing (run . premorph -> Just x) = TU <-- \_ -> Flip <-- Failure x+	morphing (run . premorph -> Nothing) = TU <-- Flip . Success  instance Morphable (Into (Left Maybe)) Wye where 	type Morphing (Into (Left Maybe)) Wye = Maybe@@ -81,33 +81,39 @@ 	morphing (premorph -> Here _) = Nothing 	morphing (premorph -> There x) = Just x -instance Morphable (Into Wye) (Maybe <:.:> Maybe := (:*:)) where-	type Morphing (Into Wye) (Maybe <:.:> Maybe := (:*:)) = Wye+instance Morphable (Into Wye) (Maybe <:.:> Maybe > (:*:)) where+	type Morphing (Into Wye) (Maybe <:.:> Maybe > (:*:)) = Wye 	morphing (run . premorph -> Just x :*: Just y) = Both x y 	morphing (run . premorph -> Nothing :*: Just y) = Right y 	morphing (run . premorph -> Just x :*: Nothing) = Left x 	morphing (run . premorph -> Nothing :*: Nothing) = End  instance Substructure Left Wye where-	type Available Left Wye = Maybe-	type Substance Left Wye = Exactly-	substructure = P_Q_T ! \new -> case lower new of-		End -> Store ! Nothing :*: lift . resolve Left End . (extract <-|-)-		Left x -> Store ! Just (Exactly x) :*: lift . resolve Left End . (extract <-|-)-		Right y -> Store ! Nothing :*: lift . constant (Right y) . (extract <-|-)-		Both x y -> Store ! Just (Exactly x) :*: lift . resolve (Both % y) (Right y) . (extract <-|-)+	type Substance Left Wye = Maybe+	substructure = P_Q_T <-- \new -> case lower new of+		End -> Store <--- Nothing :*: lift . resolve Left End+		Left x -> Store <--- Just x :*: lift . resolve Left End+		Right y -> Store <--- Nothing :*: lift . constant (Right y)+		Both x y -> Store <--- Just x :*: lift . resolve (Both % y) (Right y)  instance Substructure Right Wye where-	type Available Right Wye = Maybe-	type Substance Right Wye = Exactly-	substructure = P_Q_T ! \new -> case lower new of-		End -> Store ! Nothing :*: lift . resolve Right End . (extract <-|-)-		Left x -> Store ! Nothing :*: lift . constant (Left x) . (extract <-|-)-		Right y -> Store ! Just (Exactly y) :*: lift . resolve Right End . (extract <-|-)-		Both x y -> Store ! Just (Exactly y) :*: lift . resolve (Both x) (Left x) . (extract <-|-)+	type Substance Right Wye = Maybe+	substructure = P_Q_T <-- \new -> case lower new of+		End -> Store <--- Nothing :*: lift . resolve Right End+		Left x -> Store <--- Nothing :*: lift . constant (Left x)+		Right y -> Store <--- Just y :*: lift . resolve Right End+		Both x y -> Store <--- Just y :*: lift . resolve (Both x) (Left x) -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)+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)  twosome :: t a -> u a -> (<:.:>) t u (:*:) a-twosome x y = T_U ! x :*: y+twosome x y = T_U <--- x :*: y++type family Simplification (t :: * -> *) (a :: *) where+	Simplification Exactly a = a+	Simplification (TU _ _ t u) a = t :. u > a+	Simplification (UT _ _ t u) a = u :. t > a+	Simplification (TUT _ _ _ t t' u) a = t :. u :. t' > a+	Simplification (T_U _ _ p t u) a = p (t a) (u a)+	Simplification t a = t a

@@ -1,194 +1,73 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-module Pandora.Paradigm.Primary.Algebraic (module Exports, Applicative, Alternative, Divisible, Decidable, Extractable, Pointable, (!>-), (!!>-), (!!!>-), (<-*-), (<-*--), (<-*---), (<-*----), (<-*-----), (<-*-----), (<-*------), (<-*-------), (<-*--------), (.-*-), (.-*--), (.-*---), (.-*----), (.-*-----), (.-*-----), (.-*------), (.-*-------), (.-*--------), (<-*-*-), (.-*-*-), loop, (<-+-), (.-+-), void, empty, point, pass, extract, (<-||-), (>-||-), (<-|-<-|-), (<-|->-|-), (>-|-<-|-), (>-|->-|-)) where+module Pandora.Paradigm.Primary.Algebraic (module Exports) where +import Pandora.Paradigm.Primary.Algebraic.Functor as Exports import Pandora.Paradigm.Primary.Algebraic.Exponential as Exports import Pandora.Paradigm.Primary.Algebraic.Product as Exports import Pandora.Paradigm.Primary.Algebraic.Sum as Exports import Pandora.Paradigm.Primary.Algebraic.Zero as Exports import Pandora.Paradigm.Primary.Algebraic.One as Exports -import Pandora.Core.Functor (type (:=))+import Pandora.Core.Functor (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.Kernel (constant)-import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-|-), (<-|-|-|-))-import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-)))+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.Monoidal (Monoidal (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.Schemes.T_U (T_U (T_U), type (<:.:>))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted ((!), (-#=)))--type instance Unit (:*:) = One-type instance Unit (:+:) = Zero--infixl 1 <-*--------, .-*---------infixl 2 <-*-------, .-*--------infixl 3 <-*------, .-*-------infixl 4 <-*-----, .-*------infixl 5 <-*----, .-*-----infixl 6 <-*---, .-*----infixl 7 <-*--, .-*--, <-*-*-, .-*-*--infixl 8 <-*-, .-*--infixl 8 <-+-, .-+--infixl 8 <-||-, >-||--infixl 6 <-|-<-|-, <-|->-|-, >-|-<-|-, >-|->-|---(!>-) :: Covariant (->) (->) t => t a -> b -> t b-x !>- r = constant r <-|- x--(!!>-) :: (Covariant (->) (->) t, Covariant (->) (->) u) => t (u a) -> b -> t (u b)-x !!>- r = constant r <-|-|- x--(!!!>-) :: (Covariant (->) (->) t, Covariant (->) (->) u, Covariant (->) (->) v) => t (u (v a)) -> b -> t (u (v b))-x !!!>- r = constant r <-|-|-|- x--void :: Covariant (->) (->) t => t a -> t ()-void x = constant () <-|- x+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted ((<~))) -instance (Semimonoidal (<--) (:*:) (:*:) t, Semimonoidal (<--) (:*:) (:*:) u) => Semimonoidal (<--) (:*:) (:*:) (t <:.:> u := (:*:)) where-	mult = Flip ! \(T_U lrxys) ->+instance (Semimonoidal (<--) (:*:) (:*:) t, Semimonoidal (<--) (:*:) (:*:) u) => Semimonoidal (<--) (:*:) (:*:) (t <:*:> u) where+	mult = Flip <-- \(T_U lrxys) -> 		-- TODO: I need matrix transposing here-		let ((lxs :*: lys) :*: (rxs :*: rys)) = (((mult @(<--) !) :*: (mult @(<--) !)) <-|-<-|-) lrxys in+		let ((lxs :*: lys) :*: (rxs :*: rys)) = (mult @(<--) <~) <-||-- (mult @(<--) <~) <-|- lrxys in 		T_U (lxs :*: rxs) :*: T_U (lys :*: rys)  instance Traversable (->) (->) ((:*:) s) where 	f <<- x = (attached x :*:) <-|- f (extract x) -instance Adjoint (->) (->) ((:*:) s) ((->) s) where-	(-|) :: ((s :*: a) -> b) -> a -> (s -> b)-	f -| x = \s -> f (s :*: x)-	(|-) :: (a -> s -> b) -> (s :*: a) -> b-	f |- ~(s :*: x) = f x s- instance Semimonoidal (-->) (:*:) (:*:) ((->) e) where 	mult :: ((e -> a) :*: (e -> b)) --> (e -> (a :*: b))-	mult = Straight ! \(g :*: h) -> \x -> g x :*: h x+	mult = Straight <-- \(g :*: h) -> \x -> g x :*: h x  instance Monoidal (-->) (-->) (:*:) (:*:) ((->) e) where-	unit _ = Straight ! constant . (! One)+	unit _ = Straight <-- constant . (<~ One)  instance Semimonoidal (<--) (:*:) (:*:) ((->) e) where 	mult :: ((e -> a) :*: (e -> b)) <-- (e -> a :*: b)-	mult = Flip ! \f -> attached . f :*: extract . f+	mult = Flip <-- \f -> attached . f :*: extract . f  instance Semimonoidal (-->) (:*:) (:+:) ((:+:) e) where 	mult :: ((e :+: a) :*: (e :+: b)) --> (e :+: a :+: b)-	mult = Straight ! \case+	mult = Straight <-- \case 		Option _ :*: Option e' -> Option e'-		Option _ :*: Adoption y -> Adoption ! Adoption y-		Adoption x :*: _ -> Adoption ! Option x+		Option _ :*: Adoption y -> Adoption <-- Adoption y+		Adoption x :*: _ -> Adoption <-- Option x  instance Semimonoidal (-->) (:*:) (:*:) ((:+:) e) where-	mult = Straight ! \case-		Adoption x :*: Adoption y -> Adoption ! x :*: y+	mult = Straight <-- \case+		Adoption x :*: Adoption y -> Adoption <--- x :*: y 		Option e :*: _ -> Option e 		_ :*: Option e -> Option e  instance Monoidal (-->) (-->) (:*:) (:*:) ((:+:) e) where-	unit _ = Straight ! Adoption . (! One)+	unit _ = Straight <-- Adoption . (<~ One)  instance Semimonoidal (<--) (:*:) (:*:) ((:*:) s) where-	mult = Flip ! \(s :*: x :*: y) -> (s :*: x) :*: (s :*: y)+	mult = Flip <-- \(s :*: x :*: y) -> (s :*: x) :*: (s :*: y)  instance Monoidal (<--) (-->) (:*:) (:*:) ((:*:) s) where-	unit _ = Flip ! \(_ :*: x) -> Straight (\_ -> x)+	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)+	mult = Flip <-- \(Flip ((sx :*: sy) :*: r)) -> Flip (sx :*: r) :*: Flip (sy :*: r)  instance Monoidal (<--) (-->) (:*:) (:*:) (Flip (:*:) a) where-	unit _ = Flip ! \(Flip (s :*: _)) -> Straight (\_ -> s)----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 = (|-) @(->) @(->) (&) <-|- (mult @(-->) @_ @(:*:) ! (f :*: x))-f <-*------- x = (|-) @(->) @(->) (&) <-|- (mult @(-->) @_ @(:*:) ! (f :*: x))-f <-*------ x = (|-) @(->) @(->) (&) <-|- (mult @(-->) @_ @(:*:) ! (f :*: x))-f <-*----- x = (|-) @(->) @(->) (&) <-|- (mult @(-->) @_ @(:*:) ! (f :*: x))-f <-*---- x = (|-) @(->) @(->) (&) <-|- (mult @(-->) @_ @(:*:) ! (f :*: x))-f <-*--- x = (|-) @(->) @(->) (&) <-|- (mult @(-->) @_ @(:*:) ! (f :*: x))-f <-*-- x = (|-) @(->) @(->) (&) <-|- (mult @(-->) @_ @(:*:) ! (f :*: x))-f <-*- x = (|-) @(->) @(->) (&) <-|- (mult @(-->) @_ @(:*:) ! (f :*: x))--(<-*-*-) :: (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:*:) u) => t (u (a -> b)) -> t (u a) -> t (u b)-f <-*-*- x = (<-*-) <-|- f <-*- x--(.-*--------), (.-*-------), (.-*------), (.-*-----), (.-*----), (.-*---), (.-*--), (.-*-) :: (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => t b -> t a -> t b-y .-*-------- x = (\_ y' -> y') <-|- x <-*- y-y .-*------- x = (\_ y' -> y') <-|- x <-*- y-y .-*------ x = (\_ y' -> y') <-|- x <-*- y-y .-*----- x = (\_ y' -> y') <-|- x <-*- y-y .-*---- x = (\_ y' -> y') <-|- x <-*- y-y .-*--- x = (\_ y' -> y') <-|- x <-*- y-y .-*-- x = (\_ y' -> y') <-|- x <-*- y-y .-*- x = (\_ y' -> y') <-|- x <-*- y--(.-*-*-) :: (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:*:) u) => t (u b) -> t (u a) -> t (u b)-y .-*-*- x = (\_ y' -> y') <-|-|- x <-*-*- y--loop :: (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => t a -> t b-loop x = let r = r .-*- x in r--(<-+-) :: (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 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--extract :: Extractable t => t a -> a-extract j = unit @(<--) @(-->) Proxy ! j ! One--point :: Pointable t => a -> t a-point x = unit @(-->) Proxy ! (Straight ! \One -> x)--pass :: Pointable t => t ()-pass = point ()--empty :: Emptiable t => t a-empty = unit @(-->) Proxy ! Straight absurd--(<-||-) :: forall (m :: * -> * -> *) (p :: * -> * -> *) a b c .-	(Covariant m m (Flip p c), Interpreted m (Flip p c)) => m a b -> m (p a c) (p b c)-(<-||-) f = (-#=) @m @(Flip p c) ((<-|-) f)--(>-||-) :: forall (m :: * -> * -> *) (p :: * -> * -> *) a b c .-	(Contravariant m m (Flip p c), Interpreted m (Flip p c)) => m a b -> m (p b c) (p a c)-(>-||-) f = (-#=) @m @(Flip p c) ((>-|-) f)--(<-|-<-|-) :: forall (m :: * -> * -> *) (p :: * -> * -> *) a b c d .-	(Covariant m m (p a), Covariant m m (Flip p d), Interpreted m (Flip p d))-	=> m a b :*: m c d -> m (p a c) (p b d)-(<-|-<-|-) (f :*: g) = (-#=) @m @(Flip p d) ((<-|-) f) . ((<-|-) g)--(<-|->-|-) :: forall (m :: * -> * -> *) (p :: * -> * -> *) a b c d .-	(Covariant m m (Flip p c), Contravariant m m (p a), Interpreted m (Flip p c))-	=> m a b :*: m c d -> m (p a d) (p b c)-(<-|->-|-) (f :*: g) = (-#=) @m @(Flip p c) ((<-|-) f) . ((>-|-) g)--(>-|-<-|-) :: forall (m :: * -> * -> *) (p :: * -> * -> *) a b c d .-	(Contravariant m m (Flip p d), Covariant m m (p b), Interpreted m (Flip p d))-	=> m a b :*: m c d -> m (p b c) (p a d)-(>-|-<-|-) (f :*: g) = (-#=) @m @(Flip p d) ((>-|-) f) . ((<-|-) g)--(>-|->-|-) :: forall (m :: * -> * -> *) (p :: * -> * -> *) a b c d .-	(Contravariant m m (p b), Contravariant m m (Flip p c), Interpreted m (Flip p c))-	=> m a b :*: m c d -> m (p b d) (p a c)-(>-|->-|-) (f :*: g) = (-#=) @m @(Flip p c) ((>-|-) f) . ((>-|-) g)+	unit _ = Flip <-- \(Flip (s :*: _)) -> Straight (\_ -> s)

@@ -3,7 +3,7 @@  import Pandora.Pattern.Betwixt (Betwixt) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.)))-import Pandora.Pattern.Category (Category ((#), identity))+import Pandora.Pattern.Category (Category ((<--), identity)) import Pandora.Pattern.Kernel (Kernel (constant)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-)))@@ -33,10 +33,10 @@ 	(<-|-) = (.)  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+	f =<< g = \x -> f <-- g x <-- x  instance Semigroup r => Semigroup (e -> r) where 	f + g = \e -> f e + g e@@ -47,12 +47,12 @@ 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)+	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 .)

@@ -0,0 +1,143 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+module Pandora.Paradigm.Primary.Algebraic.Functor where++import Pandora.Pattern.Semigroupoid ((.))+import Pandora.Pattern.Category ((<--))+import Pandora.Pattern.Kernel (constant)+import Pandora.Pattern.Morphism.Flip (Flip)+import Pandora.Pattern.Morphism.Straight (Straight (Straight))+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), Unit)+import Pandora.Pattern.Functor.Adjoint (Adjoint ((-|), (|-)))+import Pandora.Paradigm.Primary.Functor.Proxy (Proxy (Proxy))+import Pandora.Paradigm.Primary.Algebraic.Exponential (type (-->), type (<--), (&))+import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)))+import Pandora.Paradigm.Primary.Algebraic.Sum ((:+:) (Option, Adoption))+import Pandora.Paradigm.Primary.Algebraic.Zero (Zero, absurd)+import Pandora.Paradigm.Primary.Algebraic.One (One (One))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted ((<~), (<~~~), (-#=)))++infixl 1 <-*--------, .-*--------, <-||--------, >-||--------+infixl 2 <-*-------, .-*-------, <-||-------, >-||-------+infixl 3 <-*------, .-*------, <-||------, >-||------+infixl 4 <-*-----, .-*-----, <-||-----, >-||-----+infixl 5 <-*----, .-*----, <-||----, >-||----+infixl 6 <-*---, .-*---, <-||---, >-||---+infixl 7 <-*--, .-*--, <-*-*-, .-*-*-, <-||--, >-||--+infixl 8 <-*-, .-*-, <-+-, .-+-, <-||-, >-||-++infixl 6 <-|-<-|-, <-|->-|-, >-|-<-|-, >-|->-|-++type instance Unit (:*:) = One+type instance Unit (:+:) = Zero++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)++instance Adjoint (->) (->) ((:*:) s) ((->) s) where+	(-|) :: ((s :*: a) -> b) -> a -> (s -> b)+	f -| x = \s -> f (s :*: x)+	(|-) :: (a -> s -> b) -> (s :*: a) -> b+	f |- ~(s :*: x) = f x s++(<-*--------), (<-*-------), (<-*------), (<-*-----), (<-*----), (<-*---), (<-*--), (<-*-) :: (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => t (a -> b) -> t a -> t b+f <-*-------- x = (|-) @(->) @(->) (&) <-|--- mult @(-->) @_ @(:*:) <~~~ f :*: x+f <-*------- x = (|-) @(->) @(->) (&) <-|--- mult @(-->) @_ @(:*:) <~~~ f :*: x+f <-*------ x = (|-) @(->) @(->) (&) <-|--- mult @(-->) @_ @(:*:) <~~~ f :*: x+f <-*----- x = (|-) @(->) @(->) (&) <-|--- mult @(-->) @_ @(:*:) <~~~ f :*: x+f <-*---- x = (|-) @(->) @(->) (&) <-|--- mult @(-->) @_ @(:*:) <~~~ f :*: x+f <-*--- x = (|-) @(->) @(->) (&) <-|--- mult @(-->) @_ @(:*:) <~~~ f :*: x+f <-*-- x = (|-) @(->) @(->) (&) <-|--- mult @(-->) @_ @(:*:) <~~~ f :*: x+f <-*- x = (|-) @(->) @(->) (&) <-|--- mult @(-->) @_ @(:*:) <~~~ f :*: x++(.-*--------), (.-*-------), (.-*------), (.-*-----), (.-*----), (.-*---), (.-*--), (.-*-) :: (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => t b -> t a -> t b+y .-*-------- x = (\_ y' -> y') <-|- x <-*- y+y .-*------- x = (\_ y' -> y') <-|- x <-*- y+y .-*------ x = (\_ y' -> y') <-|- x <-*- y+y .-*----- x = (\_ y' -> y') <-|- x <-*- y+y .-*---- x = (\_ y' -> y') <-|- x <-*- y+y .-*--- x = (\_ y' -> y') <-|- x <-*- y+y .-*-- x = (\_ y' -> y') <-|- x <-*- y+y .-*- x = (\_ y' -> y') <-|- x <-*- y++(<-*-*-) :: (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:*:) u) => t (u (a -> b)) -> t (u a) -> t (u b)+f <-*-*- x = (<-*-) <-|- f <-*- x++(.-*-*-) :: (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:*:) u) => t (u b) -> t (u a) -> t (u b)+y .-*-*- x = (\_ y' -> 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 a -> t a+y .-+- x = (\r -> case r of Option rx -> rx; Adoption ry -> ry) <-|--- mult @(-->) <~~~ x :*: y++loop :: (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => t a -> t b+loop x = let r = r .-*- x in r++type Extractable t = Monoidal (<--) (-->) (:*:) (:*:) t+type Pointable t = Monoidal (-->) (-->) (:*:) (:*:) t+type Emptiable t = Monoidal (-->) (-->) (:*:) (:+:) t++extract :: Extractable t => t a -> a+extract j = unit @(<--) @(-->) Proxy <~ j <~ One++point :: Pointable t => a -> t a+point x = unit @(-->) Proxy <~~~ Straight <-- \One -> x++pass :: Pointable t => t ()+pass = point ()++empty :: Emptiable t => t a+empty = unit @(-->) Proxy <~ Straight absurd++(<-||-), (<-||--), (<-||---), (<-||----), (<-||-----), (<-||------), (<-||-------), (<-||--------)+	:: forall (m :: * -> * -> *) (p :: * -> * -> *) a b c .+	(Covariant m m (Flip p c), Interpreted m (Flip p c)) => m a b -> m (p a c) (p b c)+(<-||--------) f = (-#=) @m @(Flip p c) ((<-|-) f)+(<-||-------) f = (-#=) @m @(Flip p c) ((<-|-) f)+(<-||------) f = (-#=) @m @(Flip p c) ((<-|-) f)+(<-||-----) f = (-#=) @m @(Flip p c) ((<-|-) f)+(<-||----) f = (-#=) @m @(Flip p c) ((<-|-) f)+(<-||---) f = (-#=) @m @(Flip p c) ((<-|-) f)+(<-||--) f = (-#=) @m @(Flip p c) ((<-|-) f)+(<-||-) f = (-#=) @m @(Flip p c) ((<-|-) f)++(>-||-), (>-||--), (>-||---), (>-||----), (>-||-----), (>-||------), (>-||-------), (>-||--------)+	:: forall (m :: * -> * -> *) (p :: * -> * -> *) a b c .+	(Contravariant m m (Flip p c), Interpreted m (Flip p c)) => m a b -> m (p b c) (p a c)+(>-||--------) f = (-#=) @m @(Flip p c) ((>-|-) f)+(>-||-------) f = (-#=) @m @(Flip p c) ((>-|-) f)+(>-||------) f = (-#=) @m @(Flip p c) ((>-|-) f)+(>-||-----) f = (-#=) @m @(Flip p c) ((>-|-) f)+(>-||----) f = (-#=) @m @(Flip p c) ((>-|-) f)+(>-||---) f = (-#=) @m @(Flip p c) ((>-|-) f)+(>-||--) f = (-#=) @m @(Flip p c) ((>-|-) f)+(>-||-) f = (-#=) @m @(Flip p c) ((>-|-) f)++(<-|-<-|-) :: forall (m :: * -> * -> *) (p :: * -> * -> *) a b c d .+	(Covariant m m (p a), Covariant m m (Flip p d), Interpreted m (Flip p d))+	=> m a b :*: m c d -> m (p a c) (p b d)+(<-|-<-|-) (f :*: g) = (-#=) @m @(Flip p d) ((<-|-) f) . ((<-|-) g)++(<-|->-|-) :: forall (m :: * -> * -> *) (p :: * -> * -> *) a b c d .+	(Covariant m m (Flip p c), Contravariant m m (p a), Interpreted m (Flip p c))+	=> m a b :*: m c d -> m (p a d) (p b c)+(<-|->-|-) (f :*: g) = (-#=) @m @(Flip p c) ((<-|-) f) . ((>-|-) g)++(>-|-<-|-) :: forall (m :: * -> * -> *) (p :: * -> * -> *) a b c d .+	(Contravariant m m (Flip p d), Covariant m m (p b), Interpreted m (Flip p d))+	=> m a b :*: m c d -> m (p b c) (p a d)+(>-|-<-|-) (f :*: g) = (-#=) @m @(Flip p d) ((>-|-) f) . ((<-|-) g)++(>-|->-|-) :: forall (m :: * -> * -> *) (p :: * -> * -> *) a b c d .+	(Contravariant m m (p b), Contravariant m m (Flip p c), Interpreted m (Flip p c))+	=> m a b :*: m c d -> m (p b d) (p a c)+(>-|->-|-) (f :*: g) = (-#=) @m @(Flip p c) ((>-|-) f) . ((>-|-) g)++void :: Covariant (->) (->) t => t a -> t ()+void x = constant () <-|- x

@@ -1,5 +1,6 @@ module Pandora.Paradigm.Primary.Algebraic.Product where +import Pandora.Core.Functor (type (>)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=))) import Pandora.Pattern.Object.Setoid (Setoid ((==)))@@ -11,9 +12,10 @@ import Pandora.Pattern.Object.Lattice (Lattice) import Pandora.Pattern.Object.Group (Group (invert)) import Pandora.Pattern.Morphism.Flip (Flip (Flip))-import Pandora.Paradigm.Controlflow.Effect.Interpreted ((!))+import Pandora.Paradigm.Controlflow.Effect.Interpreted ()+import Pandora.Paradigm.Schemes.T_U (type (<:.:>), type (>:.:>), type (<:.:<), type (>:.:<)) -infixr 6 :*:+infixr 8 :*:  data (:*:) s a = s :*: a @@ -21,7 +23,7 @@ 	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)@@ -30,13 +32,13 @@ 	~(sx :*: x) == ~(sy :*: y) = (sx == sy) * (x == y)  instance (Semigroup s, Semigroup a) => Semigroup (s :*: a) where-	~(sx :*: x) + ~(sy :*: y) = sx + sy :*: x + y+	~(sx :*: x) + ~(sy :*: y) = (sx + sy) :*: (x + y)  instance (Monoid s, Monoid a) => Monoid (s :*: a) where 	zero = zero :*: zero  instance (Ringoid s, Ringoid a) => Ringoid (s :*: a) where-	~(sx :*: x) * ~(sy :*: y) = sx * sy :*: x * y+	~(sx :*: x) * ~(sy :*: y) = (sx * sy) :*: (x * y)  instance (Quasiring s, Quasiring a) => Quasiring (s :*: a) where 	one = one :*: one@@ -60,3 +62,8 @@  attached :: a :*: b -> a attached ~(x :*: _) = x++type (<:*:>) t u = t <:.:> u > (:*:)+type (>:*:>) t u = t >:.:> u > (:*:)+type (<:*:<) t u = t <:.:< u > (:*:)+type (>:*:<) t u = t >:.:< u > (:*:)

@@ -1,12 +1,14 @@ module Pandora.Paradigm.Primary.Algebraic.Sum where +import Pandora.Core.Functor (type (>)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Paradigm.Primary.Algebraic.Exponential () import Pandora.Pattern.Morphism.Flip (Flip (Flip))+import Pandora.Paradigm.Schemes.T_U (type (<:.:>), type (>:.:>), type (<:.:<), type (>:.:<)) -infixr 5 :+:+infixr 7 :+:  data (:+:) o a = Option o | Adoption a @@ -26,3 +28,8 @@ bitraverse_sum :: Covariant (->) (->) t => (e -> t e') -> (a -> t a') -> (e :+: a) -> t (e' :+: a') bitraverse_sum f _ (Option x) = Option <-|- f x bitraverse_sum _ g (Adoption x) = Adoption <-|- g x++type (<:+:>) t u = t <:.:> u > (:+:)+type (>:+:>) t u = t >:.:> u > (:+:)+type (<:+:<) t u = t <:.:< u > (:+:)+type (>:+:<) t u = t >:.:< u > (:+:)

@@ -21,6 +21,3 @@  type Equivalence = Convergence Boolean type Comparison = Convergence Ordering---- match :: Predicate a -> (a -> r) -> a -> r -> r :*: a--- match (Predicate p) f x r = p x ? (f x :*: x) ! r :*: x

@@ -3,7 +3,7 @@ import Pandora.Core.Functor (type (~>)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Pattern.Category (identity, (<--), (<---), (<-----))+import Pandora.Pattern.Category (identity, (<--), (<---)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit))@@ -18,7 +18,7 @@ import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Primary.Algebraic.Sum ((:+:) (Option, Adoption)) import Pandora.Pattern.Morphism.Flip (Flip (Flip))-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.UT (UT (UT), type (<.:>))@@ -34,19 +34,19 @@  instance Covariant (->) (->) (Flip Conclusion e) where 	_ <-|- Flip (Success x) = Flip <-- Success x-	f <-|- Flip (Failure y) = Flip . Failure <--- f y+	f <-|- Flip (Failure y) = Flip . Failure <-- f y  instance Semimonoidal (-->) (:*:) (:*:) (Conclusion e) where-	mult = Straight ! \case-		Success x :*: Success y -> Success ! x :*: y+	mult = Straight <-- \case+		Success x :*: Success y -> Success <--- x :*: y 		Failure x :*: _ -> Failure x 		_ :*: Failure x -> Failure x  instance Monoidal (-->) (-->) (:*:) (:*:) (Conclusion e) where-	unit _ = Straight <--- Success . (<-- One) . run+	unit _ = Straight <--- Success . (<~ One)  instance Semigroup e => Semimonoidal (-->) (:*:) (:+:) (Conclusion e) where-	mult = Straight ! \case+	mult = Straight <-- \case 		Failure _ :*: x -> Adoption <-|- x 		Success x :*: _ -> Option <-|- Success x @@ -74,8 +74,8 @@ 	Success _ <=> Failure _ = Greater  instance (Semigroup e, Semigroup a) => Semigroup (Conclusion e a) where-	Success x + Success y = Success <----- x + y-	Failure x + Failure y = Failure <----- x + y+	Success x + Success y = Success <-- x + y+	Failure x + Failure y = Failure <-- x + y 	Failure _ + Success y = Success y 	Success x + Failure _ = Success x @@ -110,5 +110,5 @@ 	catch (Success x) _ = Success x  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+	catch (UT x) handle = let conclude = conclusion <-- run . handle <-- point . Success+		in UT <-- conclude =<< x

@@ -1,6 +1,7 @@ module Pandora.Paradigm.Primary.Functor.Constant where  import Pandora.Pattern.Semigroupoid ((.))+import Pandora.Pattern.Category ((<--), (<---)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-))) import Pandora.Pattern.Functor.Invariant (Invariant ((<!<)))@@ -15,7 +16,6 @@ import Pandora.Pattern.Object.Group (Group (invert)) import Pandora.Paradigm.Primary.Algebraic.Exponential () import Pandora.Pattern.Morphism.Flip (Flip (Flip))-import Pandora.Paradigm.Controlflow.Effect.Interpreted ((!))  newtype Constant a b = Constant a @@ -23,7 +23,7 @@ 	_ <-|- 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@@ -38,24 +38,24 @@ 	Constant x <=> Constant y = x <=> y  instance Semigroup a => Semigroup (Constant a b) where-	Constant x + Constant y = Constant ! x + y+	Constant x + Constant y = Constant <-- x + y  instance Monoid a => Monoid (Constant a b) where 	 zero = Constant zero  instance Ringoid a => Ringoid (Constant a b) where-	Constant x * Constant y = Constant ! x * y+	Constant x * Constant y = Constant <--- x * y  instance Quasiring a => Quasiring (Constant a b) where 	 one = Constant one  instance Infimum a => Infimum (Constant a b) where-	Constant x /\ Constant y = Constant ! x /\ y+	Constant x /\ Constant y = Constant <-- x /\ y  instance Supremum a => Supremum (Constant a b) where-	Constant x \/ Constant y = Constant ! x \/ y+	Constant x \/ Constant y = Constant <-- x \/ y  instance Lattice a => Lattice (Constant a b) where  instance Group a => Group (Constant a b) where-	invert (Constant x) = Constant ! invert x+	invert (Constant x) = Constant <-- invert x

@@ -1,6 +1,6 @@ module Pandora.Paradigm.Primary.Functor.Convergence where -import Pandora.Pattern.Category ((#))+import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult))@@ -10,15 +10,14 @@ import Pandora.Paradigm.Primary.Algebraic.Exponential (type (-->), type (<--)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:)((:*:))) import Pandora.Paradigm.Primary.Algebraic ()-import Pandora.Paradigm.Controlflow.Effect.Interpreted ((!))  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'+	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+	unit _ = Straight <-- \_ -> Convergence <-- \_ _ -> zero

@@ -1,18 +1,18 @@ module Pandora.Paradigm.Primary.Functor.Edges where +import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Paradigm.Primary.Algebraic.Exponential () import Pandora.Paradigm.Primary.Algebraic (point)-import Pandora.Paradigm.Controlflow.Effect.Interpreted ((!))  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+	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

@@ -1,7 +1,7 @@ module Pandora.Paradigm.Primary.Functor.Endo where  import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category (identity, (#))+import Pandora.Pattern.Category (identity, (<--)) import Pandora.Pattern.Functor.Invariant (Invariant ((<!<))) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Monoid (Monoid (zero))@@ -21,7 +21,7 @@ 	f <!< g = (((g :*: f) >-|-<-|-) =#-)  instance Semigroup (Endo a) where-	Endo f + Endo g = Endo # g . f+	Endo f + Endo g = Endo <-- g . f  instance Monoid (Endo a) where 	zero = Endo identity

@@ -1,7 +1,7 @@ module Pandora.Paradigm.Primary.Functor.Exactly where  import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((<--))+import Pandora.Pattern.Category ((<--), (<---)) import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))@@ -10,6 +10,7 @@ import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=)))+import Pandora.Pattern.Functor.Representable (Representable (Representation, (<#>), tabulate)) import Pandora.Pattern.Functor.Monad (Monad) import Pandora.Pattern.Functor.Comonad (Comonad) import Pandora.Pattern.Functor.Adjoint (Adjoint ((-|), (|-)))@@ -26,7 +27,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, (!))+import Pandora.Paradigm.Controlflow.Effect.Interpreted ((<~))  newtype Exactly a = Exactly a @@ -37,13 +38,13 @@ 	mult = Straight <-- Exactly . (extract <-||-) .  (extract <-|-)  instance Monoidal (-->) (-->) (:*:) (:*:) Exactly where-	unit _ = Straight <-- Exactly . (<-- One) . run+	unit _ = Straight <-- Exactly . (<~ One)  instance Semimonoidal (<--) (:*:) (:*:) Exactly where-	mult = Flip ! \(Exactly (x :*: y)) -> Exactly x :*: Exactly y+	mult = Flip <-- \(Exactly (x :*: y)) -> Exactly x :*: Exactly y  instance Monoidal (<--) (-->) (:*:) (:*:) Exactly where-	unit _ = Flip ! \(Exactly x) -> Straight (\_ -> x)+	unit _ = Flip <-- \(Exactly x) -> Straight (\_ -> x)  instance Traversable (->) (->) Exactly where 	f <<- Exactly x = Exactly <-|- f x@@ -54,18 +55,18 @@ instance Monad (->) Exactly  instance Extendable (->) Exactly where-	f <<= x = Exactly . f ! x+	f <<= x = Exactly . f <-- x  instance Comonad (->) Exactly ---instance Representable Exactly where-	--type Representation Exactly = ()-	--() <#> Exactly x = x-	--tabulate f = Exactly ! f ()+instance Representable Exactly where+	type Representation Exactly = ()+	() <#> Exactly x = x+	tabulate f = Exactly <-- f ()  instance Adjoint (->) (->) Exactly Exactly where-	f -| x = Exactly . f . Exactly ! x-	g |- x = extract . extract . (g <-|-) ! x+	f -| x = Exactly . f . Exactly <-- x+	g |- x = extract . extract <--- g <-|- x  instance Setoid a => Setoid (Exactly a) where 	Exactly x == Exactly y = x == y@@ -74,28 +75,24 @@ 	Exactly x <=> Exactly y = x <=> y  instance Semigroup a => Semigroup (Exactly a) where-	Exactly x + Exactly y = Exactly ! x + y+	Exactly x + Exactly y = Exactly <-- x + y  instance Monoid a => Monoid (Exactly a) where 	 zero = Exactly zero  instance Ringoid a => Ringoid (Exactly a) where-	Exactly x * Exactly y = Exactly ! x * y+	Exactly x * Exactly y = Exactly <--- x * y  instance Quasiring a => Quasiring (Exactly a) where 	 one = Exactly one  instance Infimum a => Infimum (Exactly a) where-	Exactly x /\ Exactly y = Exactly ! x /\ y+	Exactly x /\ Exactly y = Exactly <-- x /\ y  instance Supremum a => Supremum (Exactly a) where-	Exactly x \/ Exactly y = Exactly ! x \/ y+	Exactly x \/ Exactly y = Exactly <-- x \/ y  instance Lattice a => Lattice (Exactly a) where  instance Group a => Group (Exactly a) where-	invert (Exactly x) = Exactly ! invert x--type family Simplification (t :: * -> *) (a :: *) where-	Simplification Exactly a = a-	Simplification t a = t a+	invert (Exactly x) = Exactly <-- invert x

@@ -1,8 +1,8 @@ module Pandora.Paradigm.Primary.Functor.Maybe where -import Pandora.Core.Functor (type (:.), type (:=))+import Pandora.Core.Functor (type (:.), type (>)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category (identity)+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 ((<-|-)))@@ -19,7 +19,7 @@ import Pandora.Pattern.Object.Lattice (Lattice) import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False)) import Pandora.Paradigm.Primary.Object.Ordering (Ordering (Less, Equal, Greater))-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.UT (UT (UT), type (<.:>))@@ -33,30 +33,30 @@ data Maybe a = Nothing | Just a  instance Covariant (->) (->) Maybe where-	f <-|- Just x = Just ! f x+	f <-|- Just x = Just <-- f x 	_ <-|- Nothing = Nothing  instance Semimonoidal (-->) (:*:) (:*:) Maybe where-	mult = Straight ! \case-		Just x :*: Just y -> Just ! x :*: y+	mult = Straight <-- \case+		Just x :*: Just y -> Just <--- x :*: y 		Nothing :*: _ -> Nothing 		_ :*: Nothing -> Nothing  instance Semimonoidal (-->) (:*:) (:+:) Maybe where-	mult = Straight ! \case-		Just x :*: _ -> Just ! Option x-		Nothing :*: Just y -> Just ! Adoption y+	mult = Straight <-- \case+		Just x :*: _ -> Just <-- Option x+		Nothing :*: Just y -> Just <-- Adoption y 		Nothing :*: Nothing -> Nothing  instance Monoidal (-->) (-->) (:*:) (:*:) Maybe where-	unit _ = Straight ! Just . (! One) . run+	unit _ = Straight <-- Just . (<~ One)  instance Monoidal (-->) (-->) (:*:) (:+:) Maybe where-	unit _ = Straight ! \_ -> Nothing+	unit _ = Straight <-- \_ -> Nothing  -- TODO: Check laws instance Semimonoidal (<--) (:*:) (:*:) Maybe where-	mult = Flip ! \case+	mult = Flip <-- \case 		Just (x :*: y) -> Just x :*: Just y 		Nothing -> Nothing :*: Nothing @@ -82,7 +82,7 @@ 	Just _ <=> Nothing = Greater  instance Semigroup a => Semigroup (Maybe a) where-	Just x + Just y = Just ! x + y+	Just x + Just y = Just <-- x + y 	Nothing + x = x 	x + Nothing = x @@ -90,12 +90,12 @@ 	zero = Nothing  instance Infimum a => Infimum (Maybe a) where-	Just x /\ Just y = Just ! x /\ y+	Just x /\ Just y = Just <-- x /\ y 	_ /\ Nothing = Nothing 	Nothing /\ _ = Nothing  instance Supremum a => Supremum (Maybe a) where-	Just x \/ Just y = Just ! x \/ y+	Just x \/ Just y = Just <-- x \/ y 	x \/ Nothing = x 	Nothing \/ x = x @@ -115,7 +115,7 @@ 	reduce f r (Just x) = f x r 	reduce _ r Nothing = r -instance Monotonic a (t a) => Monotonic a (Maybe :. t := a) where+instance Monotonic a (t a) => Monotonic a (Maybe :. t > a) where 	reduce f r (Just x) = reduce f r x 	reduce _ r Nothing = r 

@@ -2,6 +2,7 @@  import Pandora.Core.Functor (type (~>), type (:=>)) import Pandora.Pattern.Semigroupoid ((.))+import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult))@@ -12,7 +13,7 @@ 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, (!)))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite))  newtype Predicate a = Predicate (a -> Boolean) @@ -22,16 +23,16 @@ 	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+	mult = Straight <-- \(Predicate f :*: Predicate g) -> Predicate <-- \(x :*: y) -> f x * g y  instance Monoidal (-->) (<--) (:*:) (:*:) Predicate where-	unit _ = Straight ! \_ -> Predicate ! \_ -> True+	unit _ = Straight <-- \_ -> Predicate <-- \_ -> True  instance Semimonoidal (-->) (:*:) (:+:) Predicate where-	mult = Straight ! \(Predicate f :*: Predicate g) -> Predicate ! \case+	mult = Straight <-- \(Predicate f :*: Predicate g) -> Predicate <-- \case 		Option x -> f x 		Adoption y -> g y @@ -39,4 +40,4 @@ equate x = Predicate (== x)  not :: Predicate ~> Predicate-not (Predicate p) = Predicate ! bool True False . p+not (Predicate p) = Predicate <-- bool True False . p

@@ -2,7 +2,7 @@  import Pandora.Core.Functor (type (:=>), type (~>)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((<--), (<---), (<----))+import Pandora.Pattern.Category ((<--), (<---)) import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))@@ -27,7 +27,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)+import Pandora.Paradigm.Controlflow.Effect.Interpreted ((<~))  newtype Tagged tag a = Tag a @@ -44,7 +44,7 @@ 	mult = Straight <-- Tag . (extract <-||-) . (extract <-|-)  instance Monoidal (-->) (-->) (:*:) (:*:) (Tagged tag) where-	unit _ = Straight <-- Tag . (<-- One) . run+	unit _ = Straight <-- Tag . (<~ One)  instance Semimonoidal (<--) (:*:) (:*:) (Tagged tag) where 	mult = Flip <-- \(Tag (x :*: y)) -> Tag x :*: Tag y@@ -75,7 +75,7 @@ 	Tag x <=> Tag y = x <=> y  instance Semigroup a => Semigroup (Tagged tag a) where-	Tag x + Tag y = Tag <---- x + y+	Tag x + Tag y = Tag <-- x + y  instance Monoid a => Monoid (Tagged tag a) where 	 zero = Tag zero

@@ -1,6 +1,6 @@ module Pandora.Paradigm.Primary.Functor.These where -import Pandora.Pattern.Category ((<--), (<-----))+import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))@@ -20,15 +20,15 @@ 	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'-	This x + That y = These <----- y <----- x-	This x + These y x' = These y <----- x + x'-	That y + This x' = These <----- y <----- x'-	That y + That y' = That <----- y + y'-	That y + These y' x = These <----- y + y' <----- x-	These y x + This x' = These <----- y <----- x + x'-	These y x + That y' = These <----- y + y' <----- x-	These y x + These y' x' = These <----- y + y' <----- x + x'+	This x + This x' = This <-- x + x'+	This x + That y = These <-- y <-- x+	This x + These y x' = These y <-- x + x'+	That y + This x' = These <-- y <-- x'+	That y + That y' = That <-- y + y'+	That y + These y' x = These <-- y + y' <-- x+	These y x + This x' = These <-- y <-- x + x'+	These y x + That y' = These <-- y + y' <-- x+	These y x + These y' x' = These <-- y + y' <-- x + x'  these :: (a -> r) -> (e -> r) -> (e -> a -> r) -> These e a -> r these f _ _ (This x) = f x

@@ -1,6 +1,7 @@ module Pandora.Paradigm.Primary.Functor.Validation where  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))@@ -17,36 +18,36 @@ 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, (!))+import Pandora.Paradigm.Controlflow.Effect.Interpreted ((<~))  data Validation e a = Flaws e | Validated a  instance Covariant (->) (->) (Validation e) where 	_ <-|- Flaws e = Flaws e-	f <-|- Validated x = Validated ! f x+	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  instance Semigroup e => Semimonoidal (-->) (:*:) (:*:) (Validation e) where-	mult = Straight ! \case-		Validated x :*: Validated y -> Validated ! x :*: y-		Flaws x :*: Flaws y -> Flaws ! x + y+	mult = Straight <-- \case+		Validated x :*: Validated y -> Validated <--- x :*: y+		Flaws x :*: Flaws y -> Flaws <-- x + y 		Validated _ :*: Flaws y -> Flaws y 		Flaws x :*: Validated _ -> Flaws x  instance Semigroup e => Monoidal (-->) (-->) (:*:) (:*:) (Validation e) where-	unit _ = Straight ! Validated . (! One) . run+	unit _ = Straight <-- Validated . (<~ One)  instance Semigroup e => Semimonoidal (-->) (:*:) (:+:) (Validation e) where-	mult = Straight ! \case+	mult = Straight <-- \case 		Flaws _ :*: y -> Adoption <-|- y 		Validated x :*: _ -> Option <-|- Validated x  instance Traversable (->) (->) (Validation e) where 	f <<- Validated x = Validated <-|- f x-	_ <<- Flaws e = point ! Flaws e+	_ <<- Flaws e = point <-- Flaws e  instance (Setoid e, Setoid a) => Setoid (Validation e a) where 	Validated x == Validated y = x == y@@ -60,8 +61,8 @@ 	Validated _ <=> Flaws _ = Greater  instance (Semigroup e, Semigroup a) => Semigroup (Validation e a) where-	Validated x + Validated y = Validated ! x + y-	Flaws x + Flaws y = Flaws ! x + y+	Validated x + Validated y = Validated <-- x + y+	Flaws x + Flaws y = Flaws <-- x + y 	Flaws _ + Validated y = Validated y 	Validated x + Flaws _ = Validated x 

@@ -1,21 +1,21 @@ module Pandora.Paradigm.Primary.Functor.Wedge where +import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Paradigm.Primary.Algebraic.Exponential () import Pandora.Paradigm.Primary.Algebraic (point)-import Pandora.Paradigm.Controlflow.Effect.Interpreted ((!))  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+	f <-|- There x = There <-- f x  instance Traversable (->) (->) (Wedge e) where 	_ <<- Nowhere = point Nowhere-	_ <<- Here x = point ! Here x+	_ <<- Here x = point <-- Here x 	f <<- There x = There <-|- f x  wedge :: (e -> r) -> (a -> r) -> r -> Wedge e a -> r

@@ -1,16 +1,15 @@ module Pandora.Paradigm.Primary.Functor.Wye where  import Pandora.Core.Functor (type (~>))-import Pandora.Pattern.Category ((<--), (<-----))+import Pandora.Pattern.Category ((<--)) 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)) import Pandora.Paradigm.Primary.Algebraic.Exponential (type (<--))-import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)))+-- import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:))) import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (reduce))-import Pandora.Paradigm.Controlflow.Effect.Interpreted ((!))  data Wye a = End | Left a | Right a | Both a a @@ -20,13 +19,13 @@ 	f <-|- Right y = Right <-- f y 	f <-|- Both x y = Both <-- f x <-- f y -instance Semimonoidal (<--) (:*:) (:*:) Wye where-	mult = Flip ! \case-		End -> End :*: End-		Left (x :*: y) -> Left x :*: Left y-		Right (x :*: y) -> Right x :*: Right y-		Both (x :*: y) (x' :*: y') -> Both x x' :*: Both y y'-	+-- instance Semimonoidal (<--) (:*:) (:*:) Wye where+-- 	mult = Flip <-- \case+-- 		End -> End :*: End+-- 		Left (x :*: y) -> Left x :*: Left y+-- 		Right (x :*: y) -> Right x :*: Right y+-- 		Both (x :*: y) (x' :*: y') -> Both x x' :*: Both y y'+ instance Monotonic a (Wye a) where 	reduce f r (Left x) = f x r 	reduce f r (Right x) = f x r@@ -36,15 +35,15 @@ instance Semigroup a => Semigroup (Wye a) where 	End + x = x 	x + End = x-	Left x + Left x' = Left <----- x + x'-	Left x + Right y = Both <----- x <----- y-	Left x + Both x' y = Both <----- x + x' <----- y-	Right y + Left x = Both <----- x <----- y-	Right y + Right y' = Right <----- y + y'-	Right y + Both x y' = Both <----- x <----- y + y'-	Both x y + Left x' = Both <----- x + x' <----- y-	Both x y + Right y' = Both <----- x <----- y + y'-	Both x y + Both x' y' = Both <----- x + x' <----- y + y'+	Left x + Left x' = Left <-- x + x'+	Left x + Right y = Both <-- x <-- y+	Left x + Both x' y = Both <-- x + x' <-- y+	Right y + Left x = Both <-- x <-- y+	Right y + Right y' = Right <-- y + y'+	Right y + Both x y' = Both <-- x <-- y + y'+	Both x y + Left x' = Both <-- x + x' <-- y+	Both x y + Right y' = Both <-- x <-- y + y'+	Both x y + Both x' y' = Both <-- x + x' <-- y + y'  instance Semigroup a => Monoid (Wye a) where 	zero = End

@@ -1,8 +1,7 @@ {-# LANGUAGE UndecidableInstances #-}- module Pandora.Paradigm.Primary.Linear.Matrix where -import Pandora.Pattern.Category ((<-----))+import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Monoid (Monoid (zero)) import Pandora.Pattern.Object.Setoid (Setoid ((==)))@@ -11,7 +10,7 @@ newtype Matrix i j a = Matrix (Vector i (Vector j a))  instance (Semigroup a, Semigroup (Vector i a), Semigroup (Vector i (Vector j a))) => Semigroup (Matrix i j a) where-	~(Matrix x) + ~(Matrix y) = Matrix <----- x + y+	~(Matrix x) + ~(Matrix y) = Matrix <-- x + y  instance (Monoid a, Monoid (Vector i a), Monoid (Vector i (Vector j a))) => Monoid (Matrix i j a) where 	zero = Matrix zero

@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Primary.Linear.Vector where -import Pandora.Pattern.Category ((<--), (<----), (<-----))+import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Ringoid (Ringoid ((*))) import Pandora.Pattern.Object.Monoid (Monoid (zero))@@ -10,23 +10,22 @@ import Pandora.Pattern.Object.Setoid (Setoid ((==))) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (reduce))-import Pandora.Paradigm.Controlflow.Effect.Interpreted ((!))  data Vector r a where 	Scalar :: a -> Vector a a 	Vector :: a -> Vector r a -> Vector (a :*: r) a  instance Semigroup a => Semigroup (Vector a a) where-	~(Scalar x) + ~(Scalar y) = Scalar <----- x + y+	~(Scalar x) + ~(Scalar y) = Scalar <-- x + y  instance (Semigroup a, Semigroup r, Semigroup (a :*: r), Semigroup (Vector r a)) => Semigroup (Vector (a :*: r) a) where-	Vector x xs + Vector y ys = Vector <----- x + y <----- xs + ys+	Vector x xs + Vector y ys = Vector <-- x + y <-- xs + ys  instance Ringoid a => Ringoid (Vector a a) where-	~(Scalar x) * ~(Scalar y) = Scalar <---- x * y+	~(Scalar x) * ~(Scalar y) = Scalar <-- x * y  instance (Ringoid a, Ringoid r, Ringoid (a :*: r), Ringoid (Vector r a)) => Ringoid (Vector (a :*: r) a) where-	Vector x xs * Vector y ys = Vector <---- x * y <---- xs * ys+	Vector x xs * Vector y ys = Vector <-- x * y <-- xs * ys  instance Monoid a => Monoid (Vector a a) where 	zero = Scalar zero@@ -41,7 +40,7 @@ 	one = Vector one one  instance Group a => Group (Vector a a) where-	invert ~(Scalar x) = Scalar ! invert x+	invert ~(Scalar x) = Scalar <-- invert x  instance (Group a, Group r, Group (a :*: r), Group (Vector r a)) => Group (Vector (a :*: r) a) where 	invert (Vector x xs) = Vector <-- invert x <-- invert xs

@@ -1,7 +1,7 @@ module Pandora.Paradigm.Primary.Transformer.Backwards where  import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((#), (<--), (<---))+import Pandora.Pattern.Category ((<--), (<---)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult))@@ -18,7 +18,7 @@ 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 Backwards t a = Backwards (t a) @@ -27,25 +27,25 @@  -- 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) . run+	unit _ = Straight <-- Backwards . point . (<~ One)  instance (Semimonoidal (<--) (:*:) (:*:) t, Covariant (->) (->) t) => Semimonoidal (<--) (:*:) (:*:) (Backwards t) where-	mult = Flip ! (Backwards <-||-) . (Backwards <-|-) . run (mult @(<--)) . run+	mult = Flip <-- (Backwards <-||-) . (Backwards <-|-) . (mult @(<--) <~) . run  instance (Covariant (->) (->) t, Monoidal (<--) (-->) (:*:) (:*:) t) => Monoidal (<--) (-->) (:*:) (:*:) (Backwards t) where-	unit _ = Flip ! \(Backwards x) -> Straight (\_ -> extract x)+	unit _ = Flip <-- \(Backwards x) -> Straight (\_ -> extract x)  instance Traversable (->) (->) t => Traversable (->) (->) (Backwards t) where 	f <<- Backwards x = Backwards <-|- f <<- x  instance Distributive (->) (->) t => Distributive (->) (->) (Backwards t) where-	f -<< x = Backwards ! run . f --<< x+	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,4 +59,4 @@ 	lower = run  instance Hoistable (->) Backwards where-	f /|\ Backwards x = Backwards ! f x+	f /|\ Backwards x = Backwards <-- f x

@@ -1,10 +1,10 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Primary.Transformer.Construction where -import Pandora.Core.Functor (type (:.), type (:=), type (:=>), type (~>))+import Pandora.Core.Functor (type (:.), type (>), type (:=>), type (~>)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((#), (<--), (<---), (<----))-import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-|-), (<-|-))+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.Functor.Traversable (Traversable ((<<-)), (<<-<<-))@@ -16,7 +16,7 @@ import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Ringoid ((*)) import Pandora.Pattern.Object.Monoid (Monoid (zero))-import Pandora.Paradigm.Primary.Algebraic ((<-*-), extract)+import Pandora.Paradigm.Primary.Algebraic ((<-*--), extract) import Pandora.Paradigm.Primary.Algebraic.Exponential (type (<--), type (-->)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Primary.Algebraic.Sum ((:+:))@@ -24,34 +24,33 @@ 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 (<::>))  infixr 7 .-+ -data Construction t a = Construct a (t :. Construction t := a)+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 = Flip <-- \(Construct (x :*: y) xys) -> (Construct x <-||-) . (Construct y <-|-)+		<---- mult @(<--) <~~~ (mult @(<--) <~) <-|- xys  instance (Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t) => Monoidal (<--) (-->) (:*:) (:*:) (Construction t) where 	unit _ = Flip <-- \(Construct x _) -> Straight (\_ -> x) ---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@@ -68,23 +67,23 @@ 	x == y = (extract x == extract y) * (deconstruct x == deconstruct y)  instance (Semigroup a, forall b . Semigroup b => Semigroup (t b), Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t) => Semigroup (Construction t a) where-	x + y = Construct <---- extract x + extract y <---- deconstruct x + deconstruct y+	x + y = Construct <-- extract x + extract y <-- deconstruct x + deconstruct y  instance (Monoid a, forall b . Semigroup b => Monoid (t b), Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t) => Monoid (Construction t a) where 	zero = Construct zero zero -instance Monotonic a (t :. Construction t := a) => Monotonic a (Construction t a) where-	reduce f r ~(Construct x xs) = f x ! reduce f r xs+instance Monotonic a (t :. Construction t > a) => Monotonic a (Construction t a) where+	reduce f r ~(Construct x xs) = f x <-- reduce f r xs -instance Monotonic a (t :. Construction t := a) => Monotonic a (t <::> Construction t := a) where+instance Monotonic a (t :. Construction t > a) => Monotonic a (t <::> Construction t > a) where 	reduce f r = reduce f r . run -deconstruct :: Construction t a -> t :. Construction t := a+deconstruct :: Construction t a -> t :. Construction t > a deconstruct ~(Construct _ xs) = xs  -- 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 xs = Construct <--- extract xs <--- section <<= xs

@@ -1,50 +1,51 @@ {-# LANGUAGE UndecidableInstances #-}- module Pandora.Paradigm.Primary.Transformer.Continuation 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.Category ((<--)) import Pandora.Pattern.Kernel (constant) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Monoidal (Monoidal) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Monad (Monad) import Pandora.Pattern.Transformer.Liftable (Liftable (lift))-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 (-->)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:)) import Pandora.Paradigm.Primary.Algebraic (point) -newtype Continuation r t a = Continuation ((->) ::|:. a :. t := r)+newtype Continuation r t a = Continuation ((->) ::|:. a :. t > r)  instance Interpreted (->) (Continuation r t) where-	type Primary (Continuation r t) a = (->) ::|:. a :. t := r+	type Primary (Continuation r t) a = (->) ::|:. a :. t > r 	run ~(Continuation x) = x 	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+	f =<< x = Continuation <-- \g -> x <~ \y -> f y <~ g ---instance Monad t => Monad (Continuation r t) where+-- TODO: Define Monoidal (-->) (-->) (:*:) (:*:) (Continuation r t) +-- instance (Monoidal (-->) (-->) (:*:) (:*:) t, Monad (->) t) => Monad (->) (Continuation r t) where+ instance (forall u . Bindable (->) u) => Liftable (->) (Continuation r) where 	lift = Continuation . (%) (=<<)  -- | Call with current continuation cwcc :: ((a -> Continuation r t b) -> Continuation r t a) -> Continuation r t a-cwcc f = Continuation ! \g -> (run % g) . f ! Continuation . constant . g+cwcc f = Continuation <-- \g -> (<~ g) . f <-- Continuation . constant . g  -- | Delimit the continuation of any 'shift' reset :: (forall u . Bindable (->) u, Monad (->) t) => Continuation r t r -> Continuation s t r-reset = lift . (run % point)+reset = lift . (<~ 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 f = Continuation ! (run % point) . f+shift f = Continuation <-- (<~ point) . f  interruptable :: Monoidal (-->) (-->) (:*:) (:*:) t => ((a -> Continuation a t a) -> Continuation a t a) -> t a-interruptable = (run % point) . cwcc+interruptable = (<~ point) . cwcc

@@ -2,7 +2,7 @@ module Pandora.Paradigm.Primary.Transformer.Day where  import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((#))+import Pandora.Pattern.Category ((<--), (<---), (<----)) import Pandora.Pattern.Kernel (constant) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=)))@@ -12,13 +12,13 @@ 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 (constant . constant # f day)+	f <<= day@(Day tb uc _) = Day tb uc <--- constant . constant <-- f day  instance Hoistable (->) (Day t) where-	g /|\ Day tb uc bca = Day tb # g uc # bca+	g /|\ Day tb uc bca = Day tb <-- g uc <-- bca  data Day_ category source target t u r = forall a b . 	Day_ (target (category (source a b) r) (target (t a) (u b)))

@@ -1,10 +1,11 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Primary.Transformer.Instruction where -import Pandora.Core.Functor (type (:.), type (:=))+import Pandora.Core.Functor (type (:.), 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.Traversable (Traversable ((<<-)), (<<-<<-))@@ -17,27 +18,27 @@ 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, (!))+import Pandora.Paradigm.Controlflow.Effect.Interpreted ((<~), (<~~~)) -data Instruction t a = Enter a | Instruct (t :. Instruction t := a)+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+	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))+		Instruct x :*: Instruct y -> Instruct <----- (mult @(-->) <~) <-|--- mult @(-->) <~~~ x :*: y  instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => Monoidal (-->) (-->) (:*:) (:*:) (Instruction t) where-	unit _ = Straight ! Enter . (! One) . run+	unit _ = Straight <-- Enter . (<~ One)  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 @@ -46,7 +47,7 @@ 	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 	lower (Enter x) = point x@@ -54,4 +55,4 @@  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

@@ -2,7 +2,7 @@ module Pandora.Paradigm.Primary.Transformer.Jack where  import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category (identity)+import Pandora.Pattern.Category ((<--), (<---), identity) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-)) import Pandora.Pattern.Functor.Monoidal (Monoidal) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))@@ -17,13 +17,12 @@ import Pandora.Paradigm.Primary.Algebraic (point) import Pandora.Paradigm.Primary.Object.Boolean (Boolean (False)) import Pandora.Paradigm.Primary.Object.Ordering (Ordering (Less, Greater))-import Pandora.Paradigm.Controlflow.Effect.Interpreted ((!))  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@@ -31,18 +30,18 @@  instance (Monoidal (-->) (-->) (:*:) (:*:) t, Bindable (->) t) => Bindable (->) (Jack t) where 	f =<< It x = f x-	f =<< Other x = Other ! jack point identity . f ==<< x+	f =<< Other x = Other <--- jack point identity . f ==<< x  instance Extendable (->) t => Extendable (->) (Jack t) where-	f <<= It x = It . f ! It x-	f <<= Other x = Other ! f . Other <<== x+	f <<= It x = It . f <-- It x+	f <<= Other x = Other <--- f . Other <<== x  instance Liftable (->) Jack where 	lift = Other  instance Hoistable (->) Jack where 	_ /|\ It x = It x-	f /|\ Other x = Other ! f x+	f /|\ Other x = Other <-- f x  instance (Setoid a, Setoid (t a)) => Setoid (Jack t a) where 	It x == It y = x == y

@@ -1,14 +1,15 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Primary.Transformer.Jet where -import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-|-), (<-|-))+import Pandora.Pattern.Category ((<----))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|--), (<-|-|-), (<-|-))) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)), (<<-<<-))-import Pandora.Paradigm.Primary.Algebraic ((<-*-))+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

@@ -1,9 +1,10 @@ module Pandora.Paradigm.Primary.Transformer.Kan where  import Pandora.Pattern.Semigroupoid ((.))+import Pandora.Pattern.Category ((<--)) 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.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite)) import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right))  data family Kan (v :: * -> k) (t :: * -> *) (u :: * -> *) b a@@ -11,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@@ -21,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

@@ -1,9 +1,8 @@ {-# LANGUAGE UndecidableInstances #-}- module Pandora.Paradigm.Primary.Transformer.Outline where  import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category (identity, (#))+import Pandora.Pattern.Category (identity, (<--), (<---), (<------)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\)))@@ -15,11 +14,11 @@  instance Covariant (->) (->) (Outline t) where 	f <-|- Line a = Line (f a)-	f <-|- Outlined x y = Outlined x # (.) f <-|- y+	f <-|- Outlined x y = Outlined x <--- (.) f <-|- y  instance Liftable (->) Outline where-	lift t = Outlined t (Line identity)+	lift t = Outlined t <-- Line identity  instance Hoistable (->) Outline where 	_ /|\ Line x = Line x-	f /|\ Outlined x y = Outlined # f x # f /|\ y+	f /|\ Outlined x y = Outlined <------ f x <------ f /|\ y

@@ -2,7 +2,7 @@ module Pandora.Paradigm.Primary.Transformer.Reverse where  import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((#), (<--), (<---))+import Pandora.Pattern.Category ((<--), (<---), (<----)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult))@@ -19,7 +19,7 @@ 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) @@ -27,13 +27,13 @@ 	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) . run+	unit _ = Straight <-- Reverse . point . (<~ One)  instance (Semimonoidal (<--) (:*:) (:*:) t, Covariant (->) (->) t) => Semimonoidal (<--) (:*:) (:*:) (Reverse t) where-	mult = Flip <-- (Reverse <-||-) . (Reverse <-|-) . (mult @(<--) !) . run+	mult = Flip <-- (Reverse <-||-) . (Reverse <-|-) . (mult @(<--) <~) . run  instance (Covariant (->) (->) t, Monoidal (<--) (-->) (:*:) (:*:) t) => Monoidal (<--) (-->) (:*:) (:*:) (Reverse t) where 	unit _ = Flip <-- \(Reverse x) -> Straight (\_ -> extract x)@@ -42,7 +42,7 @@ 	f <<- Reverse x = Reverse <-|- run (Backwards . f <<-- x)  instance Distributive (->) (->) t => Distributive (->) (->) (Reverse t) where-	f -<< x = Reverse ! run . f --<< x+	f -<< x = Reverse <--- run . f --<< x  instance Contravariant (->) (->) t => Contravariant (->) (->) (Reverse t) where 	f >-|- Reverse x = Reverse <--- f >-|- x

@@ -1,9 +1,9 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Primary.Transformer.Tap where -import Pandora.Core.Functor (type (:=))+import Pandora.Core.Functor (type (>)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((#))+import Pandora.Pattern.Category ((<--), (<---), (<----)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit))@@ -13,7 +13,7 @@ import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower)) import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Paradigm.Inventory.Some.Store (Store (Store))-import Pandora.Paradigm.Controlflow.Effect.Interpreted ((!), (-#=))+import Pandora.Paradigm.Controlflow.Effect.Interpreted ((<~~~), (-#=)) import Pandora.Paradigm.Primary.Algebraic ((<-*-), extract) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Primary.Algebraic.Exponential (type (<--), type (-->), (%))@@ -24,52 +24,51 @@ 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.Substructure-	(Substructure (Available, Substance, substructure), Segment (Root))+	(Substructure (Substance, substructure), Segment (Root))  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) -> ((-#=) @(->) @(Flip _ _) (Tap x <-|-) . (Tap y <-|-)) (mult @(<--) ! xys)+	mult = Flip <-- \(Tap (x :*: y) xys) -> ((-#=) @(->) @(Flip _ _) (Tap x <-|-) . (Tap y <-|-)) (mult @(<--) <~~~ xys)  instance Semimonoidal (<--) (:*:) (:*:) t => Monoidal (<--) (-->) (:*:) (:*:) (Tap t) where-	unit _ = Flip ! \(Tap x _) -> Straight (\_ -> x)+	unit _ = Flip <-- \(Tap x _) -> Straight (\_ -> x)  instance Traversable (->) (->) t => Traversable (->) (->) (Tap t) where 	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+	f <<= x = Tap <--- f x <--- f . Tap (extract x) <<== lower x  instance Lowerable (->) Tap where 	lower (Tap _ xs) = xs  instance Hoistable (->) Tap where-	f /|\ Tap x xs = Tap x # f xs+	f /|\ Tap x xs = Tap x <-- f xs -instance {-# OVERLAPS #-} Semimonoidal (-->) (:*:) (:*:) t => Semimonoidal (-->) (:*:) (:*:) (Tap (t <:.:> t := (:*:))) where-	mult = Straight ! \(Tap x (T_U (xls :*: xrs)) :*: Tap y (T_U (yls :*: yrs))) ->-		Tap (x :*: y) . T_U ! (mult @(-->) ! xls :*: yls) :*: (mult @(-->) ! xrs :*: yrs)+instance {-# OVERLAPS #-} Semimonoidal (-->) (:*:) (:*:) t => Semimonoidal (-->) (:*:) (:*:) (Tap (t <:.:> t > (:*:))) where+	mult = Straight <-- \(Tap x (T_U (xls :*: xrs)) :*: Tap y (T_U (yls :*: yrs))) ->+		Tap (x :*: y) . T_U <--- (mult @(-->) <~~~ xls :*: yls) :*: (mult @(-->) <~~~ xrs :*: yrs) -instance (Covariant (->) (->) t) => Substructure Root (Tap (t <:.:> t := (:*:))) where-	type Available Root (Tap (t <:.:> t := (:*:))) = Exactly-	type Substance Root (Tap (t <:.:> t := (:*:))) = Exactly-	substructure = P_Q_T ! \zipper -> case lower zipper of-		Tap x xs -> Store ! Exactly (Exactly x) :*: lift . (Tap % xs) . extract . extract+instance (Covariant (->) (->) t) => Substructure Root (Tap (t <:.:> t > (:*:))) where+	type Substance Root (Tap (t <:.:> t > (:*:))) = Exactly+	substructure = P_Q_T <-- \zipper -> case lower zipper of+		Tap x xs -> Store <--- Exactly x :*: lift . (Tap % xs) . extract -instance (Covariant (->) (->) t) => Substructure Left (Tap (t <:.:> t := (:*:))) where-	type Available Left (Tap (t <:.:> t := (:*:))) = Exactly-	type Substance Left (Tap (t <:.:> t := (:*:))) = t-	substructure = P_Q_T ! \zipper -> case lower zipper of-		Tap x (T_U (future :*: past)) -> Store ! Exactly future :*: lift . Tap x . T_U . (:*: past) . extract+instance (Covariant (->) (->) t) => Substructure Left (Tap (t <:.:> t > (:*:))) where+	type Substance Left (Tap (t <:.:> t > (:*:))) = t+	substructure = P_Q_T <-- \zipper -> case lower zipper of+		Tap x (T_U (future :*: past)) -> Store <--- future :*: lift . Tap x . T_U . (:*: past) -instance (Covariant (->) (->) t) => Substructure Right (Tap (t <:.:> t := (:*:))) where-	type Available Right (Tap (t <:.:> t := (:*:))) = Exactly-	type Substance Right (Tap (t <:.:> t := (:*:))) = t-	substructure = P_Q_T ! \zipper -> case lower zipper of-		Tap x (T_U (future :*: past)) -> Store ! Exactly past :*: lift . Tap x . T_U . (future :*:) . extract+instance (Covariant (->) (->) t) => Substructure Right (Tap (t <:.:> t > (:*:))) where+	type Substance Right (Tap (t <:.:> t > (:*:))) = t+	substructure = P_Q_T <-- \zipper -> case lower zipper of+		Tap x (T_U (future :*: past)) -> Store <--- past :*: lift . Tap x . T_U . (future :*:)

@@ -3,6 +3,7 @@ module Pandora.Paradigm.Primary.Transformer.Yoneda where  import Pandora.Pattern.Semigroupoid ((.))+import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Paradigm.Primary.Algebraic.Exponential ()@@ -11,7 +12,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)

@@ -15,32 +15,33 @@ import Pandora.Paradigm.Schemes.TT as Exports  import Pandora.Pattern.Semigroupoid ((.))+import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Functor.Covariant (Covariant) import Pandora.Pattern.Functor.Adjoint (Adjoint ((-|), (--|), (|-), (|--)))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)  instance (Covariant (->) (->) (v <:.> t), Covariant (->) (->) (u <:.> w), Adjoint (->) (->) t u, Adjoint (->) (->) v w)  	=> Adjoint (->) (->) (v <:.> t) (u <:.> w) where 		g |- TU y = (run . g |--) |- y-		f -| x = TU ! (f . TU --|) -| x+		f -| x = TU <-- (f . TU --|) -| x  instance (Covariant (->) (->) (v <:.> t), Covariant (->) (->) (w <.:> u), Adjoint (->) (->) t u, Adjoint (->) (->) v w) 	=> Adjoint (->) (->) (v <:.> t) (w <.:> u) where 		g |- TU t = (run . g |--) |- t-		f -| x = UT ! (f . TU --|) -| x+		f -| x = UT <-- (f . TU --|) -| x  instance (Covariant (->) (->) (t <.:> v), Covariant (->) (->) (w <.:> u), Adjoint (->) (->) t u, Adjoint (->) (->) v w) 	=> Adjoint (->) (->) (t <.:> v) (w <.:> u) where 		g |- UT t =  (run . g |--) |- t-		f -| x = UT ! (f . UT --|) -| x+		f -| x = UT <-- (f . UT --|) -| x  instance (Covariant (->) (->) (t <.:> v), Covariant (->) (->) (w <:.> u), Adjoint (->) (->) v u, Adjoint (->) (->) t w) 	=> Adjoint (->) (->) (t <.:> v) (w <:.> u) where 		g |- UT x = (run . g |--) |- x-		f -| x = TU ! (f . UT --|) -| x+		f -| x = TU <-- (f . UT --|) -| x  instance (Covariant (->) (->) ((t <:<.>:> u) t'),  Covariant (->) (->) ((v <:<.>:> w) v'), Adjoint (->) (->) t w, Adjoint (->) (->) t' v', Adjoint (->) (->) t v, Adjoint (->) (->) u v, Adjoint (->) (->) v' t') 	=> Adjoint (->) (->) ((t <:<.>:> u) t') ((v <:<.>:> w) v') where 		g |- TUT x = ((run . g |--) |-) |- x-		f -| x = TUT !  ((f . TUT --|) -|) -| x+		f -| x = TUT <--  ((f . TUT --|) -|) -| x

@@ -1,11 +1,12 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Schemes.TT where -import Pandora.Core.Functor (type (:.), type (:=), type (~>))+import Pandora.Core.Functor (type (:.), type (>), type (~>)) import Pandora.Pattern.Betwixt (Betwixt) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.)))-import Pandora.Pattern.Category (identity)-import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|--), (<-|-|-)))+import Pandora.Pattern.Category (identity, (<--), (<---), (<----), (<-----))+import Pandora.Pattern.Kernel (constant)+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 +16,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 ((:+:), bitraverse_sum)@@ -24,7 +25,7 @@ import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) -newtype TT ct ct' t t' a = TT (t :. t' := a)+newtype TT ct ct' t t' a = TT (t :. t' > a)  infixr 3 <::>, >::>, <::<, >::< @@ -34,7 +35,7 @@ type (>::<) = TT Contravariant Contravariant  instance Interpreted (->) (TT ct ct' t t') where-	type Primary (TT ct ct' t t') a = t :. t' := a+	type Primary (TT ct ct' t t') a = t :. t' > a 	run ~(TT x) = x 	unite = TT @@ -42,28 +43,31 @@ 	(<-|-) f = (=#-) ((<-|-|-) f)  instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:*:) t') => Semimonoidal (-->) (:*:) (:*:) (t <::> t') where-	mult = Straight ! TT . (<-|-) (mult @(-->) !) . (mult @(-->) !) . (run <-||-) . (run @(->) <-|-)+	mult = Straight <-- TT . (<-|-) (mult @(-->) <~) . (mult @(-->) <~) . (run <-||-) . (run @(->) <-|-)  instance (Covariant (->) (->) t, Covariant (->) (->) t', Semimonoidal (-->) (:*:) (:*:) t', Monoidal (-->) (-->) (:*:) (:*:) t, Monoidal (-->) (-->) (:*:) (:*:) t') => Monoidal (-->) (-->) (:*:) (:*:) (t <::> t') where-	unit _ = Straight ! TT . point . point . (! One) . run+	unit _ = Straight <-- TT . point . point . (<~ One)  instance (Covariant (->) (->) t, Covariant (->) (->) t', Semimonoidal (-->) (:*:) (:+:) t) => Semimonoidal (-->) (:*:) (:+:) (t <::> t') where-	mult = Straight ! \(TT x :*: TT y) -> TT ! bitraverse_sum identity identity <-|- (mult @(-->) @(:*:) @(:+:) ! (x :*: y))+	mult = Straight <-- \(TT x :*: TT y) -> TT+		<----- bitraverse_sum identity identity+			<-|--- mult @(-->) @(:*:) @(:+:)+				<~~~ x :*: y  instance (Covariant (->) (->) t, Covariant (->) (->) t', Semimonoidal (-->) (:*:) (:+:) t, Monoidal (-->) (-->) (:*:) (:+:) t) => Monoidal (-->) (-->) (:*:) (:+:) (t <::> t') where-	unit _ = Straight ! \_ -> TT empty+	unit _ = Straight <-- \_ -> TT empty  instance (Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t, Semimonoidal (<--) (:*:) (:*:) t') => Semimonoidal (<--) (:*:) (:*:) (t <::> t') where-	mult = Flip ! \(TT xys) -> (TT <-||-) . (TT <-|-) . (mult @(<--) !) ! (mult @(<--) !) <-|- xys+	mult = Flip <-- \(TT xys) -> (TT <-||-) . (TT <-|-) . (mult @(<--) <~) <--- (mult @(<--) <~) <-|- xys  instance (Covariant (->) (->) t, Monoidal (<--) (-->) (:*:) (:*:) t, Monoidal (<--) (-->) (:*:) (:*:) t') => Monoidal (<--) (-->) (:*:) (:*:) (t <::> t') where-	unit _ = Flip ! \(TT x) -> Straight (\_ -> extract ! extract x)+	unit _ = Flip <-- \(TT x) -> Straight <---- constant <--- extract <-- extract x  instance (Traversable (->) (->) t, Traversable (->) (->) t') => Traversable (->) (->) (t <::> t') where 	f <<- x = TT <-|-- f <<-<<- run x  instance (Bindable (->) t, Distributive (->) (->) t, Covariant (->) (->) t', Bindable (->) t') => Bindable (->) (t <::> t') where-	f =<< TT x = TT ! (\i -> (identity =<<) <-|-- run . f --<< i) =<< x+	f =<< TT x = TT <-- (\i -> (identity =<<) <-|-- run . f --<< i) =<< x  instance Monoidal (-->) (-->) (:*:) (:*:) t => Liftable (->) (TT Covariant Covariant t) where 	lift :: Covariant (->) (->) t' => t' ~> t <::> t'@@ -75,4 +79,4 @@  instance Covariant (->) (->) t => Hoistable (->) (TT Covariant Covariant t) where 	(/|\) :: t' ~> v -> (t <::> t' ~> t <::> v)-	f /|\ TT x = TT ! f <-|- x+	f /|\ TT x = TT <--- f <-|- x

@@ -1,21 +1,21 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Schemes.TU where -import Pandora.Core.Functor (type (:.), type (:=), type (~>))+import Pandora.Core.Functor (type (:.), type (>), type (~>)) import Pandora.Pattern.Betwixt (Betwixt) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.)))-import Pandora.Pattern.Category (identity)-import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|--), (<-|-|-)))+import Pandora.Pattern.Category (identity, (<--), (<---), (<-----))+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 ((<<-)), (<<-<<-))-import Pandora.Pattern.Functor.Distributive (Distributive ((-<<), (--<<)))+import Pandora.Pattern.Functor.Distributive (Distributive ((--<<))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) 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 ((:+:))@@ -24,7 +24,7 @@ import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) -newtype TU ct cu t u a = TU (t :. u := a)+newtype TU ct cu t u a = TU (t :. u > a)  infixr 3 <:.>, >:.>, <:.<, >:.< @@ -34,7 +34,7 @@ type (>:.<) = TU Contravariant Contravariant  instance Interpreted (->) (TU ct cu t u) where-	type Primary (TU ct cu t u) a = t :. u := a+	type Primary (TU ct cu t u) a = t :. u > a 	run ~(TU x) = x 	unite = TU @@ -42,28 +42,31 @@ 	(<-|-) 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) . run+	unit _ = Straight <-- TU . point . point . (<~ One)  instance (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:+:) u) => Semimonoidal (-->) (:*:) (:+:) (t <:.> u) where-	mult = Straight ! \(TU x :*: TU y) -> TU ! (mult @(-->) @(:*:) @(:+:)) <-|- (mult @(-->) @(:*:) @(:*:) ! (x :*: y))+	mult = Straight <-- \(TU x :*: TU y) -> TU+		<----- mult @(-->) @(:*:) @(:+:)+			<-|--- mult @(-->) @(:*:) @(:*:)+				<~~~ x :*: y  instance (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:+:) u, Monoidal (-->) (-->) (:*:) (:+:) t) => Monoidal (-->) (-->) (:*:) (:+:) (t <:.> u) where-	unit _ = Straight ! \_ -> TU empty+	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) -> Straight (\_ -> extract ! extract x)+	unit _ = Flip <-- \(TU x) -> Straight (\_ -> extract <-- extract x)  instance (Traversable (->) (->) t, Traversable (->) (->) u) => Traversable (->) (->) (t <:.> u) where 	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 	lift :: Covariant (->) (->) u => u ~> t <:.> u@@ -75,4 +78,4 @@  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,11 +1,11 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Schemes.TUT where -import Pandora.Core.Functor (type (:.), type (:=), type (~>))+import Pandora.Core.Functor (type (:.), type (>), type (~>)) 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.Category (identity, (<--), (<---), (<------))+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))@@ -22,9 +22,9 @@ 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)+newtype TUT ct ct' cu t t' u a = TUT (t :. u :. t' > a)  infix 3 <:<.>:>, >:<.>:>, <:<.>:<, >:<.>:<, <:>.<:>, >:>.<:>, <:>.<:<, >:>.<:< @@ -38,43 +38,47 @@ type (>:>.<:<) = TUT Contravariant Contravariant Contravariant  instance Interpreted (->) (TUT ct ct' cu t t' u) where-	type Primary (TUT ct ct' cu t t' u) a = t :. u :. t' := a+	type Primary (TUT ct ct' cu t t' u) a = t :. u :. t' > a 	run ~(TUT x) = x 	unite = TUT -instance (Semigroupoid m, Covariant m m t, 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+instance (Semigroupoid m, Covariant m m t, 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 (Adjoint (->) (->) t' t, Bindable (->) u) => Semimonoidal (-->) (:*:) (:*:) (t <:<.>:> t' := u) where-	mult = Straight ! \(TUT x :*: TUT y) -> TUT ((((\r -> (<-|-|-|-) (r :*:) y) |-) =<<) <-|- x)+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+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 -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)+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))+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 :: 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+instance (Covariant (->) (->) t, Covariant (->) (->) t', Adjoint (->) (->) t' t, Bindable (->) u) => Bindable (->) (t <:<.>:> t' > u) where+	f =<< x = TUT <--- ((run . f |--) =<<) <-|- run x -instance (Bindable (->) u, Monoidal (-->) (-->) (:*:) (:*:) u, Adjoint (->) (->) t' t) => Monoidal (-->) (-->) (:*:) (:*:) (t <:<.>:> t' := u) where-	unit _ = Straight ! unite . (point -|) . (! One) . run+instance (Bindable (->) u, Monoidal (-->) (-->) (:*:) (:*:) u, Adjoint (->) (->) t' t) => Monoidal (-->) (-->) (:*:) (:*:) (t <:<.>:> t' > u) where+	unit _ = Straight <-- unite . (point -|) . (<~ One) -instance (Adjoint (->) (->) t' t, Extendable (->) u) => Extendable (->) (t' <:<.>:> t := u) where-	f <<= x = TUT ! ((f . unite --|) <<=) <-|- run x+instance (Adjoint (->) (->) t' t, Extendable (->) u) => Extendable (->) (t' <:<.>:> t > u) where+	f <<= x = TUT <--- ((f . unite --|) <<=) <-|- run x  instance (Adjoint (->) (->) t' t, Distributive (->) (->) t) => Liftable (->) (t <:<.>:> t') where-	lift :: Covariant (->) (->) u => u ~> t <:<.>:> t' := u-	lift x = TUT ! (identity @(->) -|) -<< x+	lift :: Covariant (->) (->) u => u ~> t <:<.>:> t' > u+	lift x = TUT <--- (identity @(->) -|) -<< x  instance (Adjoint (->) (->) t t', Distributive (->) (->) t') => Lowerable (->) (t <:<.>:> t') where-	lower :: Covariant (->) (->) u => (t <:<.>:> t' := u) ~> u+	lower :: Covariant (->) (->) u => (t <:<.>:> t' > u) ~> u 	lower (TUT x) = (identity @(->) -<<) |- x

@@ -1,11 +1,11 @@ module Pandora.Paradigm.Schemes.TUVW (TUVW (..)) where -import Pandora.Core.Functor (type (:.), type (:=))+import Pandora.Core.Functor (type (:.), type (>)) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite)) -newtype TUVW ct cu cv cw t u v w a = TUVW (t :. u :. v :. w := a)+newtype TUVW ct cu cv cw t u v w a = TUVW (t :. u :. v :. w > a)  instance Interpreted (->) (TUVW ct cu cv cw t u v w) where-	type Primary (TUVW ct cu cv cw t u v w) a = t :. u :. v :. w := a+	type Primary (TUVW ct cu cv cw t u v w) a = t :. u :. v :. w > a 	run ~(TUVW x) = x 	unite = TUVW

@@ -1,7 +1,7 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Schemes.T_U where -import Pandora.Core.Functor (type (:=))+import Pandora.Core.Functor (type (>)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Morphism.Flip (Flip) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|-|-)))@@ -23,9 +23,9 @@ 	unite = T_U  -- TODO: generalize over (->)-instance (forall i . Covariant (->) (->) (p i), forall o . Covariant (->) (->) (Flip p o), Covariant (->) (->) t, Covariant (->) (->) u) => Covariant (->) (->) (t <:.:> u := p) where+instance (forall i . Covariant (->) (->) (p i), forall o . Covariant (->) (->) (Flip p o), Covariant (->) (->) t, Covariant (->) (->) u) => Covariant (->) (->) (t <:.:> u > p) where 	f <-|- x = ((-#=) @_ @(Flip _ _) ((<-|-|-) f) . ((<-|-|-) f)) =#- x  -- TODO: generalize over (->)-instance (Contravariant (->) (->) t, forall a . Covariant (->) (->) (p (t a)), Covariant (->) (->) u, forall b . Contravariant (->) (->) (Flip p (u b))) => Covariant (->) (->) (t >:.:> u := p) where+instance (Contravariant (->) (->) t, forall a . Covariant (->) (->) (p (t a)), Covariant (->) (->) u, forall b . Contravariant (->) (->) (Flip p (u b))) => Covariant (->) (->) (t >:.:> u > p) where 	(<-|-) f = (=#-) ((-#=) @_ @(Flip _ _) ((>-|-|-) f) . ((<-|-|-) f))

@@ -1,12 +1,12 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Schemes.UT where -import Pandora.Core.Functor (type (:.), type (:=), type (~>))+import Pandora.Core.Functor (type (:.), type (>), type (~>)) import Pandora.Pattern.Betwixt (Betwixt) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.)))-import Pandora.Pattern.Category (identity)+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,7 +14,7 @@ import Pandora.Pattern.Functor.Traversable (Traversable ((<<--))) 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 ((:+:))@@ -22,7 +22,7 @@ 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)+newtype UT ct cu t u a = UT (u :. t > a)  infixr 3 <.:>, >.:>, <.:<, >.:< @@ -32,7 +32,7 @@ type (>.:<) = UT Contravariant Contravariant  instance Interpreted (->) (UT ct cu t u) where-	type Primary (UT ct cu t u) a = u :. t := a+	type Primary (UT ct cu t u) a = u :. t > a 	run ~(UT x) = x 	unite = UT @@ -40,26 +40,29 @@ 	(<-|-) 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 (->) (->) u, Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) u, Semimonoidal (-->) (:*:) (:+:) t) => Semimonoidal (-->) (:*:) (:+:) (t <.:> u) where-	mult = Straight ! \(UT x :*: UT y) -> UT ! (mult @(-->) @(:*:) @(:+:)) <-|- (mult @(-->) @(:*:) @(:*:) ! (x :*: y))+	mult = Straight <-- \(UT x :*: UT y) -> UT+		<----- mult @(-->) @(:*:) @(:+:)+			<-|--- mult @(-->) @(:*:) @(:*:)+				<~~~ x :*: y  instance (Covariant (->) (->) t, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) u, Monoidal (-->) (-->) (:*:) (:*:) t, Monoidal (-->) (-->) (:*:) (:*:) u) => Monoidal (-->) (-->) (:*:) (:*:) (t <.:> u) where-	unit _ = Straight ! UT . point . point . (! One) . run+	unit _ = Straight <-- UT . point . point . (<~ One)  instance (Traversable (->) (->) t, Bindable (->) t, Semimonoidal (-->) (:*:) (:*:) u, Monoidal (-->) (-->) (:*:) (:*:) u, Bindable (->) u) => Bindable (->) (t <.:> u) where-	f =<< UT x = UT ! ((identity =<<) <-|-) . (run . f <<--) ==<< x+	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) -> Straight (\_ -> extract ! extract x)+	unit _ = Flip <-- \(UT x) -> Straight (\_ -> extract <-- extract x)  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 	lower :: Covariant (->) (->) u => t <.:> u ~> u

@@ -1,11 +1,11 @@ module Pandora.Paradigm.Schemes.UTU where -import Pandora.Core.Functor (type (:.), type (:=))+import Pandora.Core.Functor (type (:.), type (>)) import Pandora.Pattern.Functor.Covariant (Covariant) import Pandora.Pattern.Functor.Contravariant (Contravariant) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite)) -newtype UTU ct cu t u u' a = UTU (u :. t :. u' := a)+newtype UTU ct cu t u u' a = UTU (u :. t :. u' > a)  type (<.<:>.>) = UTU Covariant Covariant Covariant type (>.<:>.>) = UTU Contravariant Covariant Covariant@@ -17,6 +17,6 @@ type (>.>:<.<) = UTU Contravariant Contravariant Contravariant  instance Interpreted (->) (UTU ct cu t u u') where-	type Primary (UTU ct cu t u u') a = u :. t :. u' := a+	type Primary (UTU ct cu t u u') a = u :. t :. u' > a 	run ~(UTU x) = x 	unite = UTU

@@ -1,6 +1,5 @@ {-# LANGUAGE UndecidableInstances #-} {-# OPTIONS_GHC -fno-warn-orphans #-}- module Pandora.Paradigm.Structure (module Exports) where  import Pandora.Paradigm.Structure.Ability as Exports@@ -8,14 +7,14 @@ import Pandora.Paradigm.Structure.Modification as Exports import Pandora.Paradigm.Structure.Some as Exports -import Pandora.Core.Functor (type (:=))+import Pandora.Core.Functor (type (>)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((#), identity)+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.Some.Optics () import Pandora.Paradigm.Inventory.Some.Store (Store (Store)) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), attached)@@ -36,21 +35,20 @@ import Pandora.Paradigm.Schemes.P_Q_T (P_Q_T (P_Q_T))  instance Monotonic s a => Monotonic s (s :*: a) where-	reduce f r x = reduce f # f (attached x) r # extract x+	reduce f r x = reduce f <-- f (attached x) r <-- extract x  instance (Covariant (->) (->) t) => Substructure Tail (Tap t) where-	type Available Tail (Tap t) = Exactly 	type Substance Tail (Tap t) = t-	substructure = P_Q_T ! \tap -> case extract # run tap of-		Tap x xs -> Store ! Exactly xs :*: lift . Tap x . extract+	substructure = P_Q_T <-- \tap -> case extract <-- run tap of+		Tap x xs -> Store <--- xs :*: lift . Tap x  instance Morphable (Into (Preorder (Construction Maybe))) (Construction Wye) where 	type Morphing (Into (Preorder (Construction Maybe))) (Construction Wye) = Construction Maybe 	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+		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@@ -68,80 +66,66 @@ 		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+-- instance Morphable (Into (o ds)) (Construction Wye) => Morphable (Into (o ds)) Binary where+	-- type Morphing (Into (o ds)) Binary = Maybe <:.> Morphing (Into (o ds)) (Construction Wye)+	-- morphing (premorph -> xs) = (into @(o ds) <-|-) =#- xs  instance Substructure Left (Flip (:*:) a) where-	type Available Left (Flip (:*:) a) = Exactly 	type Substance Left (Flip (:*:) a) = Exactly-	substructure = P_Q_T ! \product -> case run # lower product of-		s :*: x -> Store ! Exactly (Exactly s) :*: lift . Flip . (:*: x) . extract . extract+	substructure = P_Q_T <-- \product -> case run <-- lower product of+		s :*: x -> Store <--- Exactly s :*: lift . Flip . (:*: x) . extract  instance Substructure Right ((:*:) s) where-	type Available Right ((:*:) s) = Exactly 	type Substance Right ((:*:) s) = Exactly-	substructure = P_Q_T ! \product -> case lower product of-		s :*: x -> Store ! Exactly (Exactly x) :*: lift . (s :*:) . extract . extract+	substructure = P_Q_T <-- \product -> case lower product of+		s :*: x -> Store <--- Exactly x :*: lift . (s :*:) . extract  instance Accessible s (s :*: a) where-	access = P_Q_T ! \(s :*: x) -> Store ! Exactly s :*: (:*: x) . extract+	access = P_Q_T <-- \(s :*: x) -> Store <--- Exactly s :*: (:*: x) . extract  instance Accessible a (s :*: a) where-	access = P_Q_T ! \(s :*: x) -> Store ! Exactly x :*: (s :*:) . extract+	access = P_Q_T <-- \(s :*: x) -> Store <--- Exactly x :*: (s :*:) . extract  instance {-# OVERLAPS #-} Accessible b a => Accessible b (s :*: a) where 	access = access @b . access @a  -- TODO: Causes overlapping instances error when target is (a :*: b), it's better to use some wrapper instead -- instance {-# OVERLAPS #-} (Accessible a s, Accessible b s) => Accessible (a :*: b) s where-	-- access = mult @(-->) @(:*:) @(:*:) ! (access @a :*: access @b)+	-- access = mult @(-->) @(:*:) @(:*:) <~ (access @a :*: access @b)  instance Accessible a (Exactly a) where-	access = P_Q_T ! \(Exactly x) -> Store ! Exactly x :*: identity+	access = P_Q_T <-- \(Exactly x) -> Store <--- Exactly x :*: identity  instance Possible a (Maybe a) where-	perhaps = P_Q_T ! \x -> Store ! x :*: identity+	perhaps = P_Q_T <-- \x -> Store <--- x :*: identity  instance {-# OVERLAPS #-} Possible a (o :+: a) where-	perhaps = P_Q_T ! \case-		Option s -> Store ! Nothing :*: resolve @a @(Maybe a) Adoption (Option s)-		Adoption x -> Store ! Just x :*: resolve @a @(Maybe a) Adoption (Adoption x)+	perhaps = P_Q_T <-- \case+		Option s -> Store <--- Nothing :*: (resolve @a @(Maybe a) <-- Adoption <-- Option s)+		Adoption x -> Store <--- Just x :*: (resolve @a @(Maybe a) <-- Adoption <-- Adoption x)  instance {-# OVERLAPS #-} Possible o (o :+: a) where-	perhaps = P_Q_T ! \case-		Option s -> Store ! Just s :*: resolve @o @(Maybe o) Option (Option s)-		Adoption x -> Store ! Nothing :*: resolve @o @(Maybe o) Option (Adoption x)+	perhaps = P_Q_T <-- \case+		Option s -> Store <--- Just s :*: (resolve @o @(Maybe o) <-- Option <-- Option s)+		Adoption x -> Store <--- Nothing :*: (resolve @o @(Maybe o) <-- Option <-- Adoption x)  instance Accessible target source => Possible target (Maybe source) where-	perhaps = let lst = access @target @source in P_Q_T ! \case-		Just source -> let (Exactly target :*: its) = run (lst ! source) in-			Store ! Just target :*: (its . Exactly <-|-)-		Nothing -> Store ! Nothing :*: \_ -> Nothing+	perhaps = let lst = access @target @source in P_Q_T <-- \case+		Just source -> let (Exactly target :*: its) = run (lst <~ source) in+			Store <--- Just target :*: (its . Exactly <-|-)+		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 . Exactly--instance (Covariant (->) (->) t) => Substructure Left (t <:.:> t := (:*:)) where-	type Available Left (t <:.:> t := (:*:)) = Exactly-	type Substance Left (t <:.:> t := (:*:)) = t-	substructure = P_Q_T ! \x -> case run # lower x of-		ls :*: rs -> Store ! Exactly ls :*: lift . (twosome % rs) . extract--instance (Covariant (->) (->) t) => Substructure Right (t <:.:> t := (:*:)) where-	type Available Right (t <:.:> t := (:*:)) = Exactly-	type Substance Right (t <:.:> t := (:*:)) = t-	substructure = P_Q_T ! \x -> case run # lower x of-		ls :*: rs -> Store ! Exactly rs :*: lift . (twosome ls) . extract+	perhaps = let lst = access @(Maybe target) @source in P_Q_T <-- \source ->+		let target :*: imts = run (lst <~ source) in+			Store <--- extract target :*: imts . Exactly  instance Morphable (Into List) (Vector r) where 	type Morphing (Into List) (Vector r) = List-	morphing (premorph -> Scalar x) = TT . Just ! Construct x Nothing-	morphing (premorph -> Vector x xs) = item @Push x ! into @List xs+	morphing (premorph -> Scalar x) = TT . Just <-- Construct x Nothing+	morphing (premorph -> Vector x xs) = item @Push x <-- into @List xs  instance Morphable (Into (Construction Maybe)) (Vector r) where 	type Morphing (Into (Construction Maybe)) (Vector r) = Construction Maybe 	morphing (premorph -> Scalar x) = Construct x Nothing-	morphing (premorph -> Vector x xs) = item @Push x ! into @(Nonempty List) xs+	morphing (premorph -> Vector x xs) = item @Push x <-- into @(Nonempty List) xs

@@ -1,6 +1,6 @@ module Pandora.Paradigm.Structure.Ability.Monotonic where -import Pandora.Pattern.Category ((#))+import Pandora.Pattern.Category ((<----)) import Pandora.Pattern.Kernel (constant) import Pandora.Paradigm.Primary.Algebraic.Exponential ((.:..)) @@ -10,7 +10,7 @@  	-- | Version of `reduce` which ignores accumulator 	resolve :: (a -> r) -> r -> e -> r-	resolve g = reduce # g .:.. constant+	resolve g = reduce <---- g .:.. constant  instance Monotonic a a where 	reduce f r x = f x r

@@ -1,9 +1,9 @@ {-# LANGUAGE AllowAmbiguousTypes #-} module Pandora.Paradigm.Structure.Ability.Morphable 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.Category ((<--)) import Pandora.Pattern.Object.Chain (Chain ((<=>))) import Pandora.Pattern.Object.Setoid (Setoid) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)))@@ -38,32 +38,34 @@  data Vertical a = Up a | Down a +data Horizontal a = Leftward a | Rightward a+ rotate :: forall mod struct . Morphable (Rotate mod) struct => struct ~> Morphing (Rotate mod) struct rotate = morphing . TT . Tag @(Rotate mod)  into :: forall mod struct . Morphable (Into mod) struct => struct ~> Morphing (Into mod) struct into = morphing . TT . Tag @(Into mod) -insert :: forall mod struct a . Morphed (Insert mod) struct (Exactly <:.:> struct := (->)) => a :=:=> struct-insert new xs = run # morph @(Insert mod) xs # Exactly new+insert :: forall mod struct a . Morphed (Insert mod) struct (Exactly <:.:> struct > (->)) => a :=:=> struct+insert new xs = run <-- morph @(Insert mod) xs <-- Exactly new -item :: forall mod struct a . Morphed mod struct (Exactly <:.:> struct := (->)) => a :=:=> struct-item new xs = run # morph @mod xs # Exactly new+item :: forall mod struct a . Morphed mod struct (Exactly <:.:> struct > (->)) => a :=:=> struct+item new xs = run <-- morph @mod xs <-- Exactly new -collate :: forall mod struct a . (Chain a, Morphed mod struct ((Exactly <:.:> Comparison := (:*:)) <:.:> struct := (->))) => a :=:=> struct-collate new xs = run # morph @mod xs # T_U (Exactly new :*: Convergence (<=>))+collate :: forall mod struct a . (Chain a, Morphed mod struct ((Exactly <:.:> Comparison > (:*:)) <:.:> struct > (->))) => a :=:=> struct+collate new xs = run <-- morph @mod xs <-- T_U (Exactly new :*: Convergence (<=>)) -delete :: forall mod struct a . (Setoid a, Morphed (Delete mod) struct (Predicate <:.:> struct := (->))) => a :=:=> struct-delete x xs = run # morph @(Delete mod) xs # equate x+delete :: forall mod struct a . (Setoid a, Morphed (Delete mod) struct (Predicate <:.:> struct > (->))) => a :=:=> struct+delete x xs = run <-- morph @(Delete mod) xs <-- equate x -filter :: forall mod struct a . (Morphed (Delete mod) struct (Predicate <:.:> struct := (->))) => Predicate a -> struct a -> struct a-filter p xs = run # morph @(Delete mod) xs # p+filter :: forall mod struct a . (Morphed (Delete mod) struct (Predicate <:.:> struct > (->))) => Predicate a -> struct a -> struct a+filter p xs = run <-- morph @(Delete mod) xs <-- p -find :: forall mod struct result a . (Morphed (Find mod) struct (Predicate <:.:> result := (->))) => Predicate a -> struct a -> result a-find p xs = run # morph @(Find mod) xs # p+find :: forall mod struct result a . (Morphed (Find mod) struct (Predicate <:.:> result > (->))) => Predicate a -> struct a -> result a+find p xs = run <-- morph @(Find mod) xs <-- p  lookup :: forall mod key struct a . (Morphed (Lookup mod) struct ((->) key <::> Maybe)) => key -> struct a -> Maybe a-lookup key struct = run # morph @(Lookup mod) struct # key+lookup key struct = run <-- morph @(Lookup mod) struct <-- key -vary :: forall mod key value struct . (Morphed (Vary mod) struct (((:*:) key <::> Exactly) <:.:> struct := (->))) => key -> value -> struct value -> struct value-vary key value xs = run # morph @(Vary mod) @struct xs # TT (key :*: Exactly value)+vary :: forall mod key value struct . (Morphed (Vary mod) struct (((:*:) key <::> Exactly) <:.:> struct > (->))) => key -> value -> struct value -> struct value+vary key value xs = run <-- morph @(Vary mod) @struct xs <-- TT (key :*: Exactly value)

@@ -2,42 +2,51 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Structure.Ability.Substructure where -import Pandora.Core.Functor (type (:=))+import Pandora.Core.Functor (type (>)) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.)))-import Pandora.Pattern.Category (identity)+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.Paradigm.Controlflow.Effect.Interpreted ((=#-))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (=#-)) import Pandora.Paradigm.Inventory.Some.Store (Store (Store))-import Pandora.Paradigm.Inventory.Some.Optics (Lens, Convex, type (#=@))-import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)))+import Pandora.Paradigm.Inventory.Some.Optics (Lens, Convex, type (#=@), type (@>>>))+import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), type (<:*:>)) import Pandora.Paradigm.Primary.Algebraic ((>-|-<-|-)) import Pandora.Paradigm.Primary.Functor.Exactly (Exactly) import Pandora.Paradigm.Primary.Functor.Tagged (Tagged)+import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right)) import Pandora.Paradigm.Schemes.TU (type (<:.>))+import Pandora.Paradigm.Schemes.T_U (T_U (T_U)) import Pandora.Paradigm.Schemes.P_Q_T (P_Q_T (P_Q_T))-import Pandora.Paradigm.Controlflow.Effect.Interpreted ((!))  data Segment a = Root a | Tail a -type Substructured segment source available target = (Substructure segment source,-	Substance segment source ~ target, Available segment source ~ available)+type Substructured segment source target = (Substructure segment source, Substance segment source ~ target)  class Substructure segment (structure :: * -> *) where-	type Available segment structure :: * -> * 	type Substance segment structure :: * -> *-	substructure :: (Tagged segment <:.> structure) #=@ Substance segment structure := Available segment structure+	substructure :: (Tagged segment <:.> structure) @>>> Substance segment structure -	sub :: (Covariant (->) (->) structure) => structure #=@ Substance segment structure := Available segment structure+	sub :: (Covariant (->) (->) structure) => structure @>>> Substance 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 Exactly 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 Exactly Exactly) => Convex Lens (structure element) element-only = inner . ((sub @segment) :: Convex Lens (structure element) (Exactly element)) where+--only :: forall segment structure element . (Covariant (->) (->) structure, Substructured segment structure Exactly Exactly) => Convex Lens (structure element) element+--only = inner . ((sub @segment) :: Convex Lens (structure element) (Exactly element)) where -	inner :: Convex Lens (Exactly element) element-	inner = P_Q_T ! \x -> Store ! x :*: identity+--	inner :: Convex Lens (Exactly element) element+--	inner = P_Q_T <-- \x -> Store <--- x :*: identity++instance (Covariant (->) (->) t, Covariant (->) (->) u) => Substructure Left (t <:*:> u) where+	type Substance Left (t <:*:> u) = t+	substructure = P_Q_T <-- \x -> case run <-- lower x of+		ls :*: rs -> Store <--- ls :*: lift . (T_U . (:*: rs))++instance (Covariant (->) (->) t, Covariant (->) (->) u) => Substructure Right (t <:*:> u) where+	type Substance Right (t <:*:> u) = u+	substructure = P_Q_T <-- \x -> case run <-- lower x of+		ls :*: rs -> Store <--- rs :*: lift . (T_U . (ls :*:))

@@ -1,111 +1,107 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE TypeSynonymInstances #-}- module Pandora.Paradigm.Structure.Ability.Zipper where -import Pandora.Core.Functor (type (:=), type (:::))+import Pandora.Core.Functor (type (>), type (<), type (:.), type (:::)) import Pandora.Core.Impliable (Impliable (Arguments, imply)) 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.Category ((<--), (<---), (<----))+import Pandora.Pattern.Kernel (constant)+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 ((:*:) ((:*:)))-import Pandora.Paradigm.Primary.Algebraic ((<-*-))+import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), type (<:*:>))+import Pandora.Paradigm.Primary.Algebraic ((<-*-), (<-*--), point) import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly)) import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right))+import Pandora.Paradigm.Primary.Functor.Tagged (Tagged) import Pandora.Paradigm.Primary.Transformer.Reverse (Reverse (Reverse)) import Pandora.Paradigm.Primary (twosome) import Pandora.Paradigm.Schemes.TT (TT (TT), type (<::>))+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.Structure.Ability.Morphable (Morphable, Morph (Rotate), Vertical (Up, Down), Occurrence (All))+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substance, substructure), Segment (Root), sub)+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (<~), (=#-)) import Pandora.Paradigm.Inventory.Ability.Gettable (get) import Pandora.Paradigm.Inventory.Ability.Settable (set) import Pandora.Paradigm.Inventory.Some.Store (Store (Store))-import Pandora.Paradigm.Inventory.Some.Optics (Lens, Convex)+import Pandora.Paradigm.Inventory.Some.Optics (Lens, Convex, view, replace, mutate)  class Zippable (structure :: * -> *) where 	type Breadcrumbs structure :: * -> * -type Zipper (structure :: * -> *) = Exactly <:.:> Breadcrumbs structure := (:*:)+type Zipper (structure :: * -> *) = Tagged Zippable <:.> (Exactly <:*:> Breadcrumbs structure)  type Breadcrumbed structure t = (Zippable structure, Breadcrumbs structure ~ t) -instance {-# OVERLAPS #-} Semimonoidal (<--) (:*:) (:*:) t => Semimonoidal (<--) (:*:) (:*:) (Exactly <:.:> t := (:*:)) where-	mult = Flip ! \(T_U (Exactly (x :*: y) :*: xys)) ->-		let xs :*: ys = mult @(<--) ! xys in+instance {-# OVERLAPS #-} Semimonoidal (<--) (:*:) (:*:) t+	=> Semimonoidal (<--) (:*:) (:*:) (Exactly <:.:> t > (:*:)) where+	mult = Flip <-- \(T_U (Exactly (x :*: y) :*: xys)) ->+		let xs :*: ys = mult @(<--) <~ xys in 			T_U (Exactly x :*: xs) :*: T_U (Exactly y :*: ys) -instance {-# OVERLAPS #-} Semimonoidal (<--) (:*:) (:*:) t => Monoidal (<--) (-->) (:*:) (:*:) (Exactly <:.:> t := (:*:)) where-	unit _ = Flip ! \(T_U (Exactly x :*: _)) -> Straight (\_ -> x)+instance {-# OVERLAPS #-} Semimonoidal (<--) (:*:) (:*:) t => Monoidal (<--) (-->) (:*:) (:*:) (Exactly <:.:> t > (:*:)) where+	unit _ = Flip <-- \(T_U (Exactly 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+	Fastenable structure (r ::: rs) = (Morphable < Rotate r < structure, Fastenable structure rs)+	Fastenable structure r = Morphable < Rotate r < structure -type Tape t = Exactly <:.:> (Reverse t <:.:> t := (:*:)) := (:*:)+type Tape t = Tagged Zippable <:.> (Exactly <:*:> (Reverse t <:*:> t)) -instance Impliable (Tape t a) where+instance Covariant (->) (->) t => Impliable (Tape t a) where 	type Arguments (Tape t a) = a -> t a -> t a -> Tape t a-	imply focused left right = twosome # Exactly focused ! twosome # Reverse left # right+	imply focused left right = lift+		<---- twosome <-- Exactly focused +			<--- twosome <-- Reverse left <-- right --- TODO: It's too fragile to define such an instance without any hints about zippers?--- Should we wrap Zipper in Tagged Zippable?+-- TODO: Isn't too fragile to define such an instance without any hints about zippers? instance Covariant (->) (->) t => Substructure Root (Tape t) where-	type Available Root (Tape t) = Exactly 	type Substance Root (Tape t) = Exactly-	substructure = P_Q_T ! \zipper -> case run # lower zipper of-		 Exactly x :*: xs -> Store ! Exactly (Exactly x) :*: lift . T_U . (:*: xs) . extract+	substructure = P_Q_T <-- \zipper -> case run . lower <-- lower zipper of+		 Exactly x :*: xs -> Store <--- Exactly x :*: lift . lift . T_U . (:*: xs)  instance Covariant (->) (->) t => Substructure Left (Tape t) where-	type Available Left (Tape t) = Exactly 	type Substance Left (Tape t) = Reverse t-	substructure = P_Q_T ! \zipper -> case run # lower zipper of-		Exactly x :*: T_U (ls :*: rs) -> Store ! Exactly ls :*: lift . (imply @(Tape t _) x % rs) . run . extract-		-- Exactly x :*: T_U (ls :*: rs) -> Store ! Exactly ls :*: lift . T_U . (Exactly x :*:) . T_U . (:*: rs) . extract+	substructure = P_Q_T <-- \zipper -> case run . lower <-- lower zipper of+		Exactly x :*: T_U (ls :*: rs) -> Store <--- ls :*: lift . (imply @(Tape t _) x % rs) . run  instance Covariant (->) (->) t => Substructure Right (Tape t) where-	type Available Right (Tape t) = Exactly 	type Substance Right (Tape t) = t-	substructure = P_Q_T ! \zipper -> case run # lower zipper of-		Exactly x :*: T_U (Reverse ls :*: rs) -> Store ! Exactly rs :*: lift . imply @(Tape t _) x ls . extract+	substructure = P_Q_T <-- \zipper -> case run . lower <-- lower zipper of+		Exactly x :*: T_U (Reverse ls :*: rs) -> Store <--- rs :*: lift . imply @(Tape t _) x ls  instance Covariant (->) (->) t => Substructure Up (Tape t <::> Tape t) where-	type Available Up (Tape t <::> Tape t) = Exactly 	type Substance Up (Tape t <::> Tape t) = t <::> Tape t-	substructure = P_Q_T ! \x -> case run . run . extract . run # x of+	substructure = P_Q_T <-- \x -> case run . lower . run . lower <-- x of 		Exactly focused :*: T_U (Reverse d :*: u) ->-			Store ! Exactly (TT u) :*: lift . TT . imply @(Tape t _) focused d . run . extract+			Store <--- TT u :*: lift . TT . imply @(Tape t _) focused d . run  instance Covariant (->) (->) t => Substructure Down (Tape t <::> Tape t) where-	type Available Down (Tape t <::> Tape t) = Exactly 	type Substance Down (Tape t <::> Tape t) = Reverse t <::> Tape t-	substructure = P_Q_T ! \ii -> case run . run . extract . run # ii of+	substructure = P_Q_T <-- \ii -> case run . lower . run . lower <-- ii of 		Exactly focused :*: T_U (d :*: u) ->-			Store ! Exactly (TT d) :*: lift . TT . (imply @(Tape t _) focused % u) . run . run . extract+			Store <--- TT d :*: lift . TT . (imply @(Tape t _) focused % u) . run . run -instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => Substructure Left (Tape t <::> Tape t) where-	type Available Left (Tape t <::> Tape t) = Exactly-	type Substance Left (Tape t <::> Tape t) = Tape t <::> Reverse t-	substructure = P_Q_T ! \ii ->-		let target = (get @(Convex Lens) (sub @Left) <-|-) =#- (lower ii) in-		let updated new = (set @(Convex Lens) % sub @Left) <-|- new <-*- run (lower ii) in-		Store ! Exactly target :*: lift . (updated =#-) . extract+instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => Substructure (All Left) (Tape t <::> Tape t) where+	type Substance (All Left) (Tape t <::> Tape t) = Tape t <::> Reverse t+	substructure = P_Q_T <-- \source ->+		let target = (view (sub @Left) <-|-) =#- lower source in+		let updated new = replace % sub @Left <-|-- new <-*-- run <-- lower source in+		Store <--- target :*: lift . (updated =#-) -instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => Substructure Right (Tape t <::> Tape t) where-	type Available Right (Tape t <::> Tape t) = Exactly-	type Substance Right (Tape t <::> Tape t) = Tape t <::> t-	substructure = P_Q_T ! \ii ->-		let target = (get @(Convex Lens) (sub @Right) <-|-) =#- lower ii in-		let updated new = (set @(Convex Lens) % sub @Right) <-|- new <-*- run (lower ii) in-		Store ! Exactly target :*: lift . (updated =#-) . extract+instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t) => Substructure (All Right) (Tape t <::> Tape t) where+	type Substance (All Right) (Tape t <::> Tape t) = Tape t <::> t+	substructure = P_Q_T <-- \source ->+		let target = (view (sub @Right) <-|-) =#- lower source in+		let updated new = replace % sub @Right <-|-- new <-*-- run <-- lower source in+			Store <--- target :*: lift . (updated =#-)

@@ -1,10 +1,11 @@ {-# LANGUAGE AllowAmbiguousTypes #-} module Pandora.Paradigm.Structure.Interface.Set where -import Pandora.Core.Functor (type (:=))+import Pandora.Core.Functor (type (>)) import Pandora.Pattern.Semigroupoid ((.))+import Pandora.Pattern.Category ((<--), (<---)) import Pandora.Pattern.Kernel (constant)-import Pandora.Pattern.Functor.Traversable (Traversable ((<<--)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<<-), (<<--))) import Pandora.Pattern.Object.Setoid (Setoid ((!=))) import Pandora.Pattern.Object.Semigroup ((+)) import Pandora.Pattern.Object.Quasiring (one)@@ -20,12 +21,12 @@ import Pandora.Paradigm.Inventory.Ability.Modifiable (modify) import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing), Morph (Find), find) import Pandora.Paradigm.Inventory.Some.State (State)-import Pandora.Paradigm.Controlflow.Effect (run, (!))+import Pandora.Paradigm.Controlflow.Effect ((<~~))  type Set t f a = (Traversable (->) (->) t, Setoid a, Setoid (t a), Morphable (Find f) t) -subset :: forall t f a . (Set t f a, Morphing (Find f) t ~ (Predicate <:.:> Maybe := (->))) => Convergence Boolean := t a-subset = Convergence ! \s ss -> Nothing != (find @f @t @Maybe % s) . equate <<-- ss+subset :: forall t f a . (Set t f a, Morphing (Find f) t ~ (Predicate <:.:> Maybe > (->))) => Convergence Boolean > t a+subset = Convergence <-- \s ss -> Nothing != (find @f @t @Maybe % s) . equate <<-- ss  cardinality :: Traversable (->) (->) t => t a -> Numerator-cardinality s = attached . run @(->) @(State _) % Zero ! constant (modify @State (+ one)) <<-- s+cardinality s = attached <--- constant (modify @State (+ one)) <<- s <~~ Zero

@@ -2,21 +2,22 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Structure.Modification.Comprehension where -import Pandora.Core.Functor (type (:=))+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.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))-import Pandora.Pattern.Functor.Bindable (Bindable ((=<<)))+import Pandora.Pattern.Functor.Bindable (Bindable ((=<<), (===<<))) import Pandora.Pattern.Transformer.Liftable (lift) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Monoid (Monoid (zero)) import Pandora.Pattern.Object.Setoid (Setoid ((==))) import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly)) 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.TT (TT (TT), type (<::>)) import Pandora.Paradigm.Schemes.T_U (T_U (T_U), type (<:.:>)) import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Push), premorph)@@ -25,37 +26,37 @@ import Pandora.Paradigm.Primary.Algebraic.Sum ((:+:)) import Pandora.Paradigm.Primary.Algebraic (empty, (<-|-<-|-)) -newtype Comprehension t a = Comprehension (t <::> Construction t := a)+newtype Comprehension t a = Comprehension (t <::> Construction t > a)  instance Interpreted (->) (Comprehension t) where-	type Primary (Comprehension t) a = t <::> Construction t := a+	type Primary (Comprehension t) a = t <::> Construction t > a 	run ~(Comprehension x) = x 	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  instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) right t, Semimonoidal (-->) (:*:) right (t <::> Construction t)) => Semimonoidal (-->) (:*:) right (Comprehension t) where-	mult = Straight ! Comprehension . (mult @(-->) @(:*:) @right !) . ((run :*: run) <-|-<-|-)+	mult = Straight <-- Comprehension . (mult @(-->) @(:*:) @right <~) . ((run :*: run) <-|-<-|-)  instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:*:) (Construction t), Semimonoidal (-->) (:*:) (:+:) t, Semimonoidal (-->) (:*:) (:+:) (Construction t), Monoidal (-->) (-->) (:*:) (:+:) t) => Monoidal (-->) (-->) (:*:) (:+:) (Comprehension t) where-	unit _ = Straight ! \_ -> Comprehension empty+	unit _ = Straight <-- \_ -> Comprehension empty -instance (forall a . Semigroup (t <::> Construction t := a), Bindable (->) t) => Bindable (->) (Comprehension t) where-	f =<< Comprehension (TT t) = Comprehension . TT ! (\(Construct x xs) -> run . run @(->) ! f x + (f =<< Comprehension (TT xs))) =<< t+instance (forall a . Semigroup (t <::> Construction t > a), Bindable (->) t) => Bindable (->) (Comprehension t) where+	f =<< Comprehension (TT t) = Comprehension . TT <-- (\(Construct x xs) -> run . run @(->) <---- f x + (f ===<< Comprehension <-- TT xs)) =<< t -instance Setoid (t <::> Construction t := a) => Setoid (Comprehension t a) where+instance Setoid (t <::> Construction t > a) => Setoid (Comprehension t a) where 	Comprehension ls == Comprehension rs = ls == rs -instance Semigroup (t <::> Construction t := a) => Semigroup (Comprehension t a) where-	Comprehension x + Comprehension y = Comprehension ! x + y+instance Semigroup (t <::> Construction t > a) => Semigroup (Comprehension t a) where+	Comprehension x + Comprehension y = Comprehension <---- x + y -instance Monoid (t <::> Construction t := a) => Monoid (Comprehension t a) where+instance Monoid (t <::> Construction t > a) => Monoid (Comprehension t a) where 	zero = Comprehension zero  instance (Covariant (->) (->) t, Monoidal (-->) (-->) (:*:) (:*:) t) => Morphable Push (Comprehension t) where-	type Morphing Push (Comprehension t) = Exactly <:.:> Comprehension t := (->)-	morphing (run . premorph -> xs) = T_U ! \(Exactly x) -> Comprehension . lift . Construct x . run ! xs+	type Morphing Push (Comprehension t) = Exactly <:.:> Comprehension t > (->)+	morphing (run . premorph -> xs) = T_U <-- \(Exactly x) -> Comprehension . lift . Construct x . run <-- xs

@@ -1,9 +1,8 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE UndecidableInstances #-}- module Pandora.Paradigm.Structure.Modification.Prefixed where -import Pandora.Core.Functor (type (:.), type (:=))+import Pandora.Core.Functor (type (:.), type (>)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|--), (<-|-|-))) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)), (<<-<<-))@@ -13,10 +12,10 @@ import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Into), premorph) import Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty) -newtype Prefixed t k a = Prefixed (t :. (:*:) k := a)+newtype Prefixed t k a = Prefixed (t :. (:*:) k > a)  instance Interpreted (->) (Prefixed t k) where-	type Primary (Prefixed t k) a = t :. (:*:) k := a+	type Primary (Prefixed t k) a = t :. (:*:) k > a 	run ~(Prefixed x) = x 	unite = Prefixed 

@@ -6,7 +6,7 @@ import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Primary.Algebraic ((>-|-<-|-)) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite, (=#-)))-import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Available, Substance, substructure))+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substance, substructure))  newtype Turnover t a = Turnover (t a) @@ -19,6 +19,5 @@ 	unite = Turnover  instance (Covariant (->) (->) structure, Substructure segment structure) => Substructure segment (Turnover structure) where-	type Available segment (Turnover structure) = Available segment structure 	type Substance segment (Turnover structure) = Substance segment structure 	substructure = (((run /|\) :*: ((unite /|\) <-|-)) >-|-<-|-) =#- substructure @segment @structure

@@ -1,137 +1,141 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Structure.Some.Binary where -import Pandora.Core.Functor (type (~>), type (:=), type (:=>))+import Pandora.Core.Functor (type (~>), type (>), type (<), type (:=>)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((<--), (<---), (<----), (-->), (--->))+import Pandora.Pattern.Category ((<--), (<---), (<----), (<-----), (-->), (--->))+import Pandora.Pattern.Kernel (constant) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|--), (<-|-|-))) import Pandora.Pattern.Functor.Traversable (Traversable ((<<-))) import Pandora.Pattern.Functor.Bindable (Bindable ((===<<))) import Pandora.Pattern.Transformer.Liftable (lift) import Pandora.Pattern.Transformer.Lowerable (lower) import Pandora.Pattern.Object.Chain (Chain ((<=>)))-import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), type (:*:), attached)-import Pandora.Paradigm.Primary.Algebraic.Exponential ((%), (&))-import Pandora.Paradigm.Primary.Algebraic ((<-*-), (<-*-*-), extract, point)-import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False))+import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), type (:*:), type (<:*:>), attached)+import Pandora.Paradigm.Primary.Algebraic.Exponential ((%), (&), (.:..))+import Pandora.Paradigm.Primary.Algebraic ((<-*-), (<-*--), (<-*-*-), extract, point, empty) import Pandora.Paradigm.Primary.Object.Ordering (order) import Pandora.Paradigm.Primary.Functor (Comparison) import Pandora.Paradigm.Primary.Functor.Convergence (Convergence (Convergence)) import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly)) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing))-import Pandora.Paradigm.Primary.Functor.Predicate (Predicate (Predicate))-import Pandora.Paradigm.Primary.Functor.Wye (Wye (End, Left, Right, Both))+import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct)) import Pandora.Paradigm.Primary (twosome) import Pandora.Paradigm.Schemes (TT (TT), T_U (T_U), P_Q_T (P_Q_T), type (<::>), type (<:.:>))-import Pandora.Paradigm.Controlflow.Effect.Conditional ((?))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (<~)) import Pandora.Paradigm.Inventory.Ability.Gettable (get) import Pandora.Paradigm.Inventory.Ability.Settable (set) import Pandora.Paradigm.Inventory.Ability.Modifiable (modify) import Pandora.Paradigm.Inventory.Some.Store (Store (Store))-import Pandora.Paradigm.Inventory.Some.Optics (Lens, Obscure)+import Pandora.Paradigm.Inventory.Some.Optics (Lens, Obscure, view, replace, mutate) import Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty) import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (resolve)) import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), morph, premorph-	, Morph (Rotate, Into, Insert, Lookup, Key), Vertical (Up, Down), lookup)-import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Available, Substance, substructure), Segment (Root), sub)+	, Morph (Rotate, Into, Insert, Lookup, Key), Vertical (Up, Down), Horizontal (Leftward, Rightward), lookup)+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substance, substructure), Segment (Root), sub) import Pandora.Paradigm.Structure.Ability.Zipper (Zippable (Breadcrumbs)) import Pandora.Paradigm.Structure.Modification.Prefixed (Prefixed (Prefixed)) -type Binary = Maybe <::> Construction Wye+type Binary = Maybe <::> Construction (Maybe <:*:> Maybe) -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+-- 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 ---rebalance :: Chain a => (Wye :. Construction Wye := a) -> Nonempty Binary a+-- instance {-# OVERLAPS #-} Traversable (->) (->) (Construction (Maybe <:*:> Maybe)) where+	-- f <<- Construct x branches = Construct <-|- f x <-*- (f <<- branches :: _)++	-- 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 (Nothing <:*:> Nothing) = Construct % (Nothing <:*:> Nothing) <-|- f x++--rebalance :: Chain a => (Wye :. Construction Wye > a) -> Nonempty Binary a --rebalance (Both x y) = extract x <=> extract y & order --	# Construct (extract x) (Both # rebalance (deconstruct x) # rebalance (deconstruct y)) --	# Construct (extract y) (Both # x # rebalance (deconstruct y)) --	# Construct (extract x) (Both # rebalance (deconstruct x) # y) -instance Morphable Insert Binary where-	type Morphing Insert Binary = (Exactly <:.:> Comparison := (:*:)) <:.:> Binary := (->)-	morphing struct = case run ---> premorph struct of-		Nothing -> T_U <-- \(T_U (Exactly x :*: _)) -> lift <-- leaf x-		Just binary -> T_U <-- \(T_U (Exactly x :*: Convergence f)) ->-			let continue xs = run <-- morph @Insert @(Nonempty Binary) xs ! twosome <-- Exactly x <-- Convergence f in-			let step = (?) <-|-|- get @(Obscure Lens) <-*-*- modify @(Obscure Lens) continue <-*-*- set @(Obscure Lens) <-- leaf x in-			lift <---- order binary-				<--- step <-- sub @Left <-- binary-				<--- step <-- sub @Right <-- binary-				<--- f x <-- extract binary+-- instance Morphable Insert Binary where+	-- type Morphing Insert Binary = (Exactly <:.:> Comparison > (:*:)) <:.:> Binary > (->)+	-- morphing struct = case run ---> premorph struct of+		-- Nothing -> T_U <-- \(T_U (Exactly x :*: _)) -> lift <-- leaf x+		-- Just binary -> T_U <-- \(T_U (Exactly x :*: Convergence f)) ->+			-- let continue xs = run <-- morph @Insert @(Nonempty Binary) xs <--- twosome <-- Exactly x <-- Convergence f in+			-- let step = iff @Just <-|-|- get @(Obscure Lens) <-*-*- modify @(Obscure Lens) continue <-*-*- set @(Obscure Lens) <-- leaf x in+			-- lift <---- order binary+				-- <--- step <-- sub @Left <-- binary+				-- <--- step <-- sub @Right <-- binary+				-- <--- f x <-- extract binary  instance Substructure Left Binary where-	type Available Left Binary = Maybe-	type Substance Left Binary = Construction Wye-	substructure = P_Q_T ! \struct -> case run . lower ---> struct of-		Nothing -> Store ! Nothing :*: lift . TT-		Just tree -> lift . lift @(->) <-|- run (sub @Left) tree+	type Substance Left Binary = Binary+	substructure = P_Q_T <-- \struct -> case run <-- lower struct of+		Nothing -> Store <--- empty :*: lift . constant empty+		Just tree -> lift . lift @(->) <-|- sub @Left <~ tree  instance Substructure Right Binary where-	type Available Right Binary = Maybe-	type Substance Right Binary = Construction Wye-	substructure = P_Q_T ! \struct -> case run . extract . run ---> struct of-		Nothing -> Store ! Nothing :*: lift . TT-		Just tree -> lift . lift @(->) <-|-- run <-- sub @Right <-- tree+	type Substance Right Binary = Binary+	substructure = P_Q_T <-- \struct -> case run . extract . run ---> struct of+		Nothing -> Store <--- empty :*: lift . constant empty+		Just tree -> lift . lift @(->) <-|- sub @Right <~ tree  -------------------------------------- Non-empty binary tree --------------------------------------- -type instance Nonempty Binary = Construction Wye+type instance Nonempty Binary = Construction (Maybe <:*:> Maybe) -instance Morphable (Into Binary) (Construction Wye) where-	type Morphing (Into Binary) (Construction Wye) = Binary+instance Morphable (Into Binary) (Construction (Maybe <:*:> Maybe)) where+	type Morphing (Into Binary) (Construction (Maybe <:*:> Maybe)) = Binary 	morphing = lift . premorph -instance Morphable Insert (Construction Wye) where-	type Morphing Insert (Construction Wye) = (Exactly <:.:> Comparison := (:*:)) <:.:> Construction Wye := (->)-	morphing (premorph -> struct) = T_U <-- \(T_U (Exactly x :*: Convergence f)) ->-		let continue xs = run <--- morph @Insert @(Nonempty Binary) xs ! twosome <--- Exactly x <--- Convergence f in-		let step = (?) <-|-|- get @(Obscure Lens) <-*-*- modify @(Obscure Lens) continue <-*-*- set @(Obscure Lens) (leaf x) in-		order struct ! step <--- sub @Left <--- struct ! step <--- sub @Right <--- struct ! f x <--- extract struct+-- instance Morphable Insert (Construction Wye) where+	-- type Morphing Insert (Construction Wye) = (Exactly <:.:> Comparison > (:*:)) <:.:> Construction Wye > (->)+	-- morphing (premorph -> struct) = T_U <-- \(T_U (Exactly x :*: Convergence f)) ->+		-- let continue xs = run <--- morph @Insert @(Nonempty Binary) xs <---- twosome <--- Exactly x <--- Convergence f in+		-- let step = iff @Just <-|-|- (run .:.. view) <-*-*- mutate continue <-*-*- replace (leaf x) in+		-- order struct+			-- <---- step <--- sub @Left <--- struct+			-- <---- step <--- sub @Right <--- struct+			-- <---- f x <--- extract struct -instance Substructure Root (Construction Wye) where-	type Available Root (Construction Wye) = Exactly-	type Substance Root (Construction Wye) = Exactly-	substructure = P_Q_T ! \struct -> case lower struct of-		Construct x xs -> Store ! Exactly (Exactly x) :*: lift . (Construct % xs) . extract . extract+instance Substructure Root (Construction (Maybe <:*:> Maybe)) where+	type Substance Root (Construction (Maybe <:*:> Maybe)) = Exactly+	substructure = P_Q_T <-- \struct -> case lower struct of+		Construct x xs -> Store <--- Exactly x :*: lift . (Construct % xs) . extract -instance Substructure Left (Construction Wye) where-	type Available Left (Construction Wye) = Maybe-	type Substance Left (Construction Wye) = Construction Wye-	substructure = P_Q_T ! \struct -> case extract ---> run struct of-		Construct x End -> Store ! Nothing :*: lift . resolve (Construct x . Left) (leaf x)-		Construct x (Left lst) -> Store ! Just lst :*: lift . Construct x . resolve Left End-		Construct x (Right rst) -> Store ! Nothing :*: lift . Construct x . resolve (Both % rst) (Right rst)-		Construct x (Both lst rst) -> Store ! Just lst :*: lift . Construct x . resolve (Both % rst) (Right rst)+instance Substructure Left (Construction (Maybe <:*:> Maybe)) where+	type Substance Left (Construction (Maybe <:*:> Maybe)) = Binary+	substructure = P_Q_T <-- \struct -> case extract ---> run struct of+		Construct x (T_U (Nothing :*: Nothing)) -> Store <--- TT Nothing :*: lift . resolve (Construct x . left) (leaf x) . run+		Construct x (T_U (Just lst :*: Nothing)) -> Store <--- TT (Just lst) :*: lift . Construct x . resolve left end . run+		Construct x (T_U (Nothing :*: Just rst)) -> Store <--- TT Nothing :*: lift . Construct x . resolve (both % rst) (right rst) . run+		Construct x (T_U (Just lst :*: Just rst)) -> Store <--- TT (Just lst) :*: lift . Construct x . resolve (both % rst) (right rst) . run -instance Substructure Right (Construction Wye) where-	type Available Right (Construction Wye) = Maybe-	type Substance Right (Construction Wye) = Construction Wye-	substructure = P_Q_T ! \struct -> case extract ---> run struct of-		Construct x End -> Store ! Nothing :*: lift . resolve (Construct x . Right) (leaf x)-		Construct x (Left lst) -> Store ! Nothing :*: lift . Construct x . resolve (Both lst) (Left lst)-		Construct x (Right rst) -> Store ! Just rst :*: lift . Construct x . resolve Right End-		Construct x (Both lst rst) -> Store ! Just rst :*: lift . Construct x . resolve (Both lst) (Left lst)+instance Substructure Right (Construction (Maybe <:*:> Maybe)) where+	type Substance Right (Construction (Maybe <:*:> Maybe)) = Binary+	substructure = P_Q_T <-- \struct -> case extract <-- run struct of+		Construct x (T_U (Nothing :*: Nothing)) -> Store <--- TT Nothing :*: lift . resolve (Construct x . right) (leaf x) . run+		Construct x (T_U (Just lst :*: Nothing)) -> Store <--- TT Nothing :*: lift . Construct x . resolve (both lst) (left lst) . run+		Construct x (T_U (Nothing :*: Just rst)) -> Store <--- TT (Just rst) :*: lift . Construct x . resolve right end . run+		Construct x (T_U (Just lst :*: Just rst)) -> Store <--- TT (Just rst) :*: lift . Construct x . resolve (both lst) (left lst) . run  -------------------------------------- Prefixed binary tree ----------------------------------------  instance Chain k => Morphable (Lookup Key) (Prefixed Binary k) where 	type Morphing (Lookup Key) (Prefixed Binary k) = (->) k <::> Maybe 	morphing struct = case run . run . premorph <-- struct of-		Nothing -> TT ! \_ -> Nothing-		Just tree -> TT ! \key ->+		Nothing -> TT <-- \_ -> Nothing+		Just tree -> TT <-- \key -> 			key <=> attached <-- extract tree & order 				<---- Just --> extract --> extract tree-				<---- lookup @Key key . Prefixed ===<< get @(Obscure Lens) <-- sub @Left <-- tree-				<---- lookup @Key key . Prefixed ===<< get @(Obscure Lens) <-- sub @Right <-- tree+				<---- lookup @Key key . Prefixed ===<< run (view <-- sub @Left <-- tree)+				<---- lookup @Key key . Prefixed ===<< run (view <-- sub @Right <-- tree)  -- instance Chain k => Morphable (Vary Element) (Prefixed Binary k) where-	-- type Morphing (Vary Element) (Prefixed Binary k) = ((:*:) k <::> Exactly) <:.:> Prefixed Binary k := (->)+	-- type Morphing (Vary Element) (Prefixed Binary k) = ((:*:) k <::> Exactly) <:.:> Prefixed Binary k > (->) 	-- morphing struct = case run . run . premorph ! struct of 		-- Nothing -> T_U ! \(TT (key :*: Exactly value)) -> Prefixed . lift . leaf ! key :*: value 		-- Just tree -> T_U ! \(TT (key :*: Exactly value)) ->@@ -143,80 +147,90 @@  ---------------------------------- Prefixed non-empty binary tree ---------------------------------- -instance Chain key => Morphable (Lookup Key) (Prefixed (Construction Wye) key) where-	type Morphing (Lookup Key) (Prefixed (Construction Wye) key) = (->) key <::> Maybe+instance Chain key => Morphable (Lookup Key) (Prefixed < Construction (Maybe <:*:> Maybe) < key) where+	type Morphing (Lookup Key) (Prefixed < Construction (Maybe <:*:> Maybe) < key) = (->) key <::> Maybe 	morphing (run . premorph -> Construct x xs) = TT <-- \key ->-		key <=> attached x & order +		key <=> attached x & order 			<---- Just <-- extract x-			<---- lookup @Key key . Prefixed . extract ===<< get @(Obscure Lens) <-- sub @Left <-- xs-			<---- lookup @Key key . Prefixed . extract ===<< get @(Obscure Lens) <-- sub @Left <-- xs+			<---- lookup @Key key . Prefixed ===<< get @(Obscure Lens) <-- sub @Left <-- xs+			<---- lookup @Key key . Prefixed ===<< get @(Obscure Lens) <-- sub @Left <-- xs  -------------------------------------- Zipper of binary tree -----------------------------------------data Biforked a = Top | Leftward a | Rightward a+	{-+data Biforked a = Top | Horizontal (Horizontal a)  instance Covariant (->) (->) Biforked where 	_ <-|- Top = Top-	f <-|- Leftward l = Leftward ! f l-	f <-|- Rightward r = Rightward ! f r+	f <-|- Horizontal (Leftward l) = Horizontal . Leftward <-- f l+	f <-|- Horizontal (Rightward r) = Horizontal . Rightward <-- f r  instance Traversable (->) (->) Biforked where 	_ <<- Top = point Top-	f <<- Leftward l = Leftward <-|- f l-	f <<- Rightward r = Rightward <-|- f r+	f <<- Horizontal (Leftward l) = Horizontal . Leftward <-|- f l+	f <<- Horizontal (Rightward r) = Horizontal . Rightward <-|- f r  type Bifurcation = Biforked <::> Construction Biforked -type Bicursor = Exactly <:.:> Binary := (:*:)+type Bicursor = Exactly <:.:> Binary > (:*:)  instance Zippable (Construction Wye) where-	type Breadcrumbs (Construction Wye) = (Wye <::> Construction Wye) <:.:> (Bifurcation <::> Bicursor) := (:*:)+	type Breadcrumbs (Construction Wye) = (Wye <::> Construction Wye) <:.:> (Bifurcation <::> Bicursor) > (:*:) -_focused_part_to_nonempty_binary_tree :: (Exactly <:.:> Wye <::> Construction Wye := (:*:)) ~> Construction Wye+_focused_part_to_nonempty_binary_tree :: (Exactly <:.:> Wye <::> Construction Wye > (:*:)) ~> Construction Wye _focused_part_to_nonempty_binary_tree (T_U (Exactly x :*: xs)) = Construct x <-- run xs -instance Morphable (Rotate Up) ((Exactly <:.:> Wye <::> Construction Wye := (:*:)) <:.:> (Bifurcation <::> Bicursor) := (:*:)) where-	type Morphing (Rotate Up) ((Exactly <:.:> Wye <::> Construction Wye := (:*:)) <:.:> (Bifurcation <::> Bicursor) := (:*:))-		= Maybe <::> ((Exactly <:.:> Wye <::> Construction Wye := (:*:)) <:.:> Bifurcation <::> Bicursor := (:*:))+instance Morphable (Rotate Up) ((Exactly <:.:> Wye <::> Construction Wye > (:*:)) <:.:> (Bifurcation <::> Bicursor) > (:*:)) where+	type Morphing (Rotate Up) ((Exactly <:.:> Wye <::> Construction Wye > (:*:)) <:.:> (Bifurcation <::> Bicursor) > (:*:))+		= Maybe <::> ((Exactly <:.:> Wye <::> Construction Wye > (:*:)) <:.:> Bifurcation <::> Bicursor > (:*:)) 	morphing struct = case run ---> premorph struct of-		focused :*: TT (TT (Rightward (Construct (T_U (Exactly parent :*: rest)) next))) ->-			lift . (twosome % TT (TT next)) . twosome (Exactly parent) . TT ! resolve-				<--- Both (_focused_part_to_nonempty_binary_tree focused)-				<--- Left (_focused_part_to_nonempty_binary_tree focused)+		focused :*: TT (TT (Horizontal (Rightward (Construct (T_U (Exactly parent :*: rest)) next)))) ->+			lift . (twosome % TT (TT next)) . twosome (Exactly parent) . TT <---- resolve+				<--- Both <-- _focused_part_to_nonempty_binary_tree focused+				<--- Left <-- _focused_part_to_nonempty_binary_tree focused 				<--- run rest-		focused :*: TT (TT (Leftward (Construct (T_U (Exactly parent :*: rest)) next))) ->-			lift . (twosome % TT (TT next)) . twosome (Exactly parent) . TT ! resolve+		focused :*: TT (TT (Horizontal (Leftward (Construct (T_U (Exactly parent :*: rest)) next)))) ->+			lift . (twosome % TT (TT next)) . twosome (Exactly parent) . TT <---- resolve 				<--- Both % _focused_part_to_nonempty_binary_tree focused-				<--- Right (_focused_part_to_nonempty_binary_tree focused)+				<--- Right <-- _focused_part_to_nonempty_binary_tree focused 				<--- run rest 		_ -> TT Nothing -_nonempty_binary_tree_to_focused_part :: Construction Wye ~> Exactly <:.:> Wye <::> Construction Wye := (:*:)+_nonempty_binary_tree_to_focused_part :: Construction Wye ~> Exactly <:.:> Wye <::> Construction Wye > (:*:) _nonempty_binary_tree_to_focused_part (Construct x xs) = twosome <--- Exactly x <--- TT xs -instance Morphable (Rotate (Down Left)) ((Exactly <:.:> Wye <::> Construction Wye := (:*:)) <:.:> (Bifurcation <::> Bicursor) := (:*:)) where-	type Morphing (Rotate (Down Left)) ((Exactly <:.:> Wye <::> Construction Wye := (:*:)) <:.:> (Bifurcation <::> Bicursor) := (:*:))-		= Maybe <::> ((Exactly <:.:> Wye <::> Construction Wye := (:*:)) <:.:> Bifurcation <::> Bicursor := (:*:))+instance Morphable (Rotate > Down Left) ((Exactly <:.:> Wye <::> Construction Wye > (:*:)) <:.:> (Bifurcation <::> Bicursor) > (:*:)) where+	type Morphing (Rotate > Down Left) ((Exactly <:.:> Wye <::> Construction Wye > (:*:)) <:.:> (Bifurcation <::> Bicursor) > (:*:))+		= Maybe <::> ((Exactly <:.:> Wye <::> Construction Wye > (:*:)) <:.:> Bifurcation <::> Bicursor > (:*:)) 	morphing struct = case run ---> premorph struct of 		T_U (Exactly x :*: TT (Left lst)) :*: TT (TT next) -> 			lift . twosome (_nonempty_binary_tree_to_focused_part lst)-				. TT . TT . Leftward ! Construct <--- twosome (Exactly x) (TT Nothing) <--- next+				. TT . TT . Horizontal . Leftward <---- Construct +					<--- twosome <-- Exactly x <-- TT Nothing +					<--- next 		T_U (Exactly x :*: TT (Both lst rst)) :*: TT (TT next) -> 			lift . twosome (_nonempty_binary_tree_to_focused_part lst)-				. TT . TT . Leftward ! Construct <--- twosome <-- Exactly x <-- lift rst <--- next+				. TT . TT . Horizontal . Leftward <---- Construct+					<--- twosome <-- Exactly x <-- lift rst +					<--- next 		_ -> TT Nothing -instance Morphable (Rotate (Down Right)) ((Exactly <:.:> Wye <::> Construction Wye := (:*:)) <:.:> (Bifurcation <::> Bicursor) := (:*:)) where-	type Morphing (Rotate (Down Right)) ((Exactly <:.:> Wye <::> Construction Wye := (:*:)) <:.:> (Bifurcation <::> Bicursor) := (:*:))-		= Maybe <::> ((Exactly <:.:> Wye <::> Construction Wye := (:*:)) <:.:> Bifurcation <::> Bicursor := (:*:))+instance Morphable (Rotate > Down Right) ((Exactly <:.:> Wye <::> Construction Wye > (:*:)) <:.:> (Bifurcation <::> Bicursor) > (:*:)) where+	type Morphing (Rotate > Down Right) ((Exactly <:.:> Wye <::> Construction Wye > (:*:)) <:.:> (Bifurcation <::> Bicursor) > (:*:))+		= Maybe <::> ((Exactly <:.:> Wye <::> Construction Wye > (:*:)) <:.:> Bifurcation <::> Bicursor > (:*:)) 	morphing struct = case run ---> premorph struct of 		T_U (Exactly x :*: TT (Right rst)) :*: TT (TT next) -> 			lift . twosome (_nonempty_binary_tree_to_focused_part rst)-				. TT . TT . Rightward ! Construct (twosome <--- Exactly x <--- TT Nothing) next+				. TT . TT . Horizontal . Rightward <---- Construct (twosome <--- Exactly x <--- TT Nothing) next 		T_U (Exactly x :*: TT (Both lst rst)) :*: TT (TT next) -> 			lift . twosome (_nonempty_binary_tree_to_focused_part rst)-				. TT . TT . Rightward ! Construct (twosome <--- Exactly x <--- lift lst) next+				. TT . TT . Horizontal . Rightward <---- Construct (twosome <--- Exactly x <--- lift lst) next 		_ -> TT Nothing+-}  leaf :: a :=> Nonempty Binary-leaf x = Construct x End+leaf x = Construct x end++left x = T_U <--- Just x :*: Nothing+right x = T_U <--- Nothing :*: Just x+both x y = T_U <--- Just x :*: Just y+end = T_U <--- Nothing :*: Nothing

@@ -1,7 +1,7 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Structure.Some.List where -import Pandora.Core.Functor (type (:.), type (:=))+import Pandora.Core.Functor (type (:.), type (<), type (>)) import Pandora.Core.Impliable (imply) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category ((<--), (<---), (<----), (<-----), (-->), (--->), (---->), identity)@@ -9,21 +9,22 @@ 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 ((=<<), (==<<), (===<<)))+import Pandora.Pattern.Functor.Bindable (Bindable ((=<<), (==<<), (===<<), (====<<))) import Pandora.Pattern.Functor.Adjoint (Adjoint ((|-))) import Pandora.Pattern.Transformer.Liftable (lift) import Pandora.Pattern.Transformer.Lowerable (lower)-import Pandora.Pattern.Object.Setoid (Setoid ((==)))+import Pandora.Pattern.Object.Setoid (Setoid ((==), (?==))) 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.Algebraic ((<-*-), (<-*--), (.-*-), (.-+-), (.:..), extract, point, empty, void) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), attached) import Pandora.Paradigm.Primary.Algebraic.Exponential ((%)) import Pandora.Paradigm.Primary.Algebraic ((<-|-<-|-))+import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True)) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing)) import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly)) import Pandora.Paradigm.Primary.Functor.Predicate (Predicate (Predicate))+import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag)) import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct, (.-+)) import Pandora.Paradigm.Primary.Transformer.Reverse (Reverse (Reverse))@@ -34,9 +35,9 @@ import Pandora.Paradigm.Inventory.Some.State (State, fold) import Pandora.Paradigm.Inventory.Some.Store (Store (Store)) import Pandora.Paradigm.Inventory.Some.Optics (Convex, Obscure, Lens)-import Pandora.Paradigm.Controlflow.Effect.Conditional (Conditional ((?)))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!), (=#-))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (<~), (=#-)) import Pandora.Paradigm.Schemes.TT (TT (TT), type (<::>))+import Pandora.Paradigm.Schemes.TU (TU (TU)) 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.Nonempty (Nonempty)@@ -45,7 +46,7 @@ import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing) 	, Morph (Rotate, Into, Push, Pop, Delete, Find, Lookup, Element, Key) 	, Occurrence (All, First), premorph, rotate, item, filter, find, lookup, into)-import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Available, Substance, substructure, sub), Segment (Root, Tail))+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substance, substructure, sub), Segment (Root, Tail)) import Pandora.Paradigm.Structure.Interface.Stack (Stack (Popping, Pushing, Topping, push, pop, top)) import Pandora.Paradigm.Structure.Modification.Combinative (Combinative) import Pandora.Paradigm.Structure.Modification.Comprehension (Comprehension (Comprehension))@@ -61,83 +62,83 @@ instance Semigroup (List a) where 	TT Nothing + TT ys = TT ys 	TT (Just (Construct x xs)) + TT ys = lift . Construct x . run-		<---- TT @Covariant @Covariant xs + TT @Covariant @Covariant ys+		<-- TT @Covariant @Covariant xs + TT @Covariant @Covariant ys  instance Monoid (List a) where 	zero = empty  instance Morphable Push List where-	type Morphing Push List = Exactly <:.:> List := (->)-	morphing (premorph -> xs) = T_U ! lift . (Construct % run xs) . extract+	type Morphing Push List = Exactly <:.:> List > (->)+	morphing (premorph -> xs) = T_U <-- lift . (Construct % run xs) . extract  instance Morphable Pop List where 	type Morphing Pop List = List 	morphing (premorph -> xs) = resolve deconstruct Nothing =#- xs  instance Morphable (Find Element) List where-	type Morphing (Find Element) List = Predicate <:.:> Maybe := (->)+	type Morphing (Find Element) List = Predicate <:.:> Maybe > (->) 	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 <-- TT xs+		Nothing -> T_U <-- \_ -> Nothing+		Just (Construct x xs) -> T_U <-- \p ->+			p <~ x ?== True <----- Just x+				<----- find @Element @List @Maybe <-- p <-- TT xs  instance Morphable (Delete First) List where-	type Morphing (Delete First) List = Predicate <:.:> List := (->)+	type Morphing (Delete First) List = Predicate <:.:> List > (->) 	morphing list = case run --> premorph list of-		Nothing -> T_U ! \_ -> empty-		Just (Construct x xs) -> T_U ! \p ->-			run p x ? TT xs ! lift . Construct x . run . filter @First @List p <--- TT xs+		Nothing -> T_U <-- constant empty+		Just (Construct x xs) -> T_U <-- \p -> +			p <~ x ?== True <----- TT xs+				<----- lift . Construct x . run . filter @First @List p <-- TT xs  instance Morphable (Delete All) List where-	type Morphing (Delete All) List = Predicate <:.:> List := (->)+	type Morphing (Delete All) List = Predicate <:.:> List > (->) 	morphing list = case run <--- premorph list of-		Nothing -> T_U ! \_ -> empty-		Just (Construct x xs) -> T_U ! \p ->-			run p x ? filter @All @List p <-- TT xs-				! lift . Construct x . run . filter @All @List p <--- TT xs+		Nothing -> T_U <-- constant empty+		Just (Construct x xs) -> T_U <-- \p -> p <~ x ?== True+				<----- filter @All @List p <-- TT xs+				<----- lift . Construct x . run . filter @All @List p <-- TT xs  instance Stack List where 	type Topping List = Maybe 	type Popping List = List 	type Pushing List = List-	top = P_Q_T ! \list -> case list of-		TT Nothing -> Store ! Nothing :*: constant empty-		TT (Just xs) -> Store ! Just (extract xs) :*: \new -> case new of-			Nothing -> TT ! deconstruct xs-			Just x -> TT ! Construct x . Just <-|- deconstruct xs+	top = P_Q_T <-- \list -> case list of+		TT Nothing -> Store <--- Nothing :*: constant empty+		TT (Just xs) -> Store <--- Just (extract xs) :*: \new -> case new of+			Nothing -> TT <-- deconstruct xs+			Just x -> TT <--- Construct x . Just <-|- deconstruct xs 	pop = resolve @(Nonempty List _) (\(Construct x xs) -> constant (Just x) <-|- set @State (TT xs)) (point Nothing) . run ==<< get @State 	push x = point x .-*- modify @State (item @Push x)  instance Substructure Root List where-	type Available Root List = Maybe-	type Substance Root List = Exactly-	substructure = P_Q_T ! \zipper -> case run --> lower zipper of-		Just (Construct x xs) -> Store ! Just <-- Exactly x :*: lift . resolve (lift . (Construct % xs) . extract @Exactly) zero-		Nothing -> Store ! Nothing :*: lift . resolve (lift . point . extract @Exactly) zero+	type Substance Root List = Maybe+	substructure = P_Q_T <-- \zipper -> case run --> lower zipper of+		Just (Construct x xs) -> Store <--- Just x :*: lift . resolve (lift . (Construct % xs)) zero+		Nothing -> Store <--- Nothing :*: lift . resolve (lift . point) zero  instance Substructure Tail List where-	type Available Tail List = Exactly 	type Substance Tail List = List-	substructure = P_Q_T ! \x -> case run . extract . run ! x of+	substructure = P_Q_T <-- \source -> case run . lower <-- source of 		Just ns -> lift . lift @(->) <-|- run (sub @Tail) ns-		Nothing -> Store ! Exactly zero :*: lift . identity . extract+		Nothing -> Store <--- zero :*: lift . identity  -- | Transform any traversable structure into a list linearize :: forall t a . Traversable (->) (->) t => t a -> List a-linearize = TT . extract . (run @(->) @(State (Maybe :. Nonempty List := a)) % Nothing) . fold (Just .:.. Construct)+linearize = TT . extract . (run @(->) @(State (Maybe :. Nonempty List > a)) % Nothing) . fold (Just .:.. Construct)  ----------------------------------------- Non-empty list -------------------------------------------  type instance Nonempty List = Construction Maybe  instance {-# OVERLAPS #-} Semigroup (Construction Maybe a) where-	Construct x Nothing + ys = Construct x ! Just ys-	Construct x (Just xs) + ys = Construct x . Just ! xs + ys+	Construct x Nothing + ys = Construct x <-- Just ys+	Construct x (Just xs) + ys = Construct x . Just <-- xs + ys  instance Morphable (Find Element) (Construction Maybe) where-	type Morphing (Find Element) (Construction Maybe) = Predicate <:.:> Maybe := (->)-	morphing (premorph -> Construct x xs) = T_U ! \p ->-		run p x ? Just x ! find @Element @(Nonempty List) @Maybe <-- p ===<< xs+	type Morphing (Find Element) (Construction Maybe) = Predicate <:.:> Maybe > (->)+	morphing (premorph -> Construct x xs) = T_U <-- \p -> p <~ x ?== True <----- Just x+		<----- find @Element @(Nonempty List) @Maybe <-- p ===<< xs  instance Morphable (Into List) (Construction Maybe) where 	type Morphing (Into List) (Construction Maybe) = List@@ -152,27 +153,24 @@ 		Construct Nothing Nothing -> empty  instance Morphable Push (Construction Maybe) where-	type Morphing Push (Construction Maybe) = Exactly <:.:> Construction Maybe := (->)-	morphing (premorph -> xs) = T_U ! \(Exactly x) -> Construct x ! Just xs+	type Morphing Push (Construction Maybe) = Exactly <:.:> Construction Maybe > (->)+	morphing (premorph -> xs) = T_U <-- \(Exactly x) -> Construct x <-- Just xs  instance Substructure Root (Construction Maybe) where-	type Available Root (Construction Maybe) = Exactly 	type Substance Root (Construction Maybe) = Exactly-	substructure = imply @(Convex Lens _ _) (Exactly . extract . lower)-		(\source target -> lift ----> Construct <--- extract target <--- deconstruct --> lower source)+	substructure = P_Q_T <-- \source -> case lower source of+		Construct x xs -> Store <--- Exactly x :*: lift . (Construct % xs) . extract  instance Substructure Tail (Construction Maybe) where-	type Available Tail (Construction Maybe) = Exactly 	type Substance Tail (Construction Maybe) = List-	substructure = imply @(Convex Lens _ _)-		<----- TT . deconstruct . lower-		<----- (\source target -> lift ----> Construct <--- extract (lower source) <--- run target)+	substructure = P_Q_T <-- \source -> case lower source of+		Construct x xs -> Store <--- TT xs :*: lift . Construct x . run  instance Stack (Construction Maybe) where 	type Topping (Construction Maybe) = Exactly 	type Popping (Construction Maybe) = Construction Maybe 	type Pushing (Construction Maybe) = Construction Maybe-	top = P_Q_T ! \xs -> Store ! Exactly (extract xs) :*: \(Exactly new) -> Construct new <--- deconstruct xs+	top = P_Q_T <-- \xs -> Store <--- Exactly (extract xs) :*: \(Exactly new) -> Construct new <--- deconstruct xs 	-- It will never return you the last element 	pop = (\(Construct x xs) -> constant x <-|-|- set @State <<- xs) =<< get @State 	push x = point x .-*- (modify @State <-- Construct x . Just)@@ -184,141 +182,130 @@ ----------------------------------------- Zipper of list -------------------------------------------  instance Zippable List where-	type Breadcrumbs List = Reverse List <:.:> List := (:*:)+	type Breadcrumbs List = Reverse List <:.:> List > (:*:)  instance {-# OVERLAPS #-} Traversable (->) (->) (Tape List) where-	f <<- T_U (Exactly x :*: T_U (left :*: right)) = (\past' x' left' -> twosome (Exactly x') ! twosome <--- left' <--- run past')-		<-|- f <<- Reverse right <-*- f x <-*- f <<- left--instance {-# OVERLAPS #-} Extendable (->) (Tape List) where-	f <<= z = let move rtt = TT . deconstruct <----- run . rtt .-+ z in-		imply @(Tape List _)-			<---- f z-			<---- f <-|-- move <-- rotate @Left-			<---- f <-|-- move <-- rotate @Right--instance Morphable (Rotate Left) (Tape List) where-	type Morphing (Rotate Left) (Tape List) = Maybe <::> Tape List-	morphing (premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) =-		let subtree = twosome <--- Reverse (get @(Convex Lens) <--- sub @Tail <--- left) <--- item @Push x right in-		TT ! (twosome % subtree) <-|-- get @(Obscure Lens) <-- sub @Root <-- left+	f <<- TU (Tag (T_U (Exactly x :*: T_U (left :*: right)))) = +		(\past' x' left' -> lift <---- twosome <-- Exactly x' <--- twosome <-- left' <-- run past')+			<-|- f <<- Reverse right <-*- f x <-*- f <<- left --- TODO: refactor it so that we dissect right list once-instance Morphable (Rotate Right) (Tape List) where-	type Morphing (Rotate Right) (Tape List) = Maybe <::> Tape List-	morphing (premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) =-		let subtree = twosome ! Reverse (item @Push x left) ! attached (pop @List ! right) in-		TT ! (twosome % subtree) <-|-- get @(Obscure Lens) <-- sub @Root <-- right+-- instance {-# OVERLAPS #-} Extendable (->) (Tape List) where+	-- f <<= z = let move rtt = TT . deconstruct <----- run . rtt .-+ z in+		-- imply @(Tape List _)+			-- <---- f z+			-- <---- f <-|-- move <-- rotate @Left+			-- <---- f <-|-- move <-- rotate @Right -instance Morphable (Rotate Left) (Turnover (Tape List)) where-	type Morphing (Rotate Left) (Turnover (Tape List)) = Turnover (Tape List)-	morphing s@(premorph -> Turnover (T_U (Exactly x :*: T_U (Reverse left :*: right)))) =-		resolve @(Tape List _) <--- Turnover <--- premorph s !+instance Morphable (Rotate Left) (Turnover < Tape List) where+	type Morphing (Rotate Left) (Turnover < Tape List) = Turnover < Tape List+	morphing s@(lower . run . premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) =+		resolve @(Tape List _) <--- Turnover <--- premorph s <---- 			(rotate_over x <-|- run right) .-+- (rotate_left x right <-|- run left) where  		rotate_left :: a -> List a -> Nonempty List a -> Tape List a 		rotate_left focused rs (Construct lx lxs) = imply @(Tape List _) <-- lx <-- TT lxs <-- item @Push focused rs  		rotate_over :: a -> Nonempty List a -> Tape List a-		rotate_over focused rs = let new_left = attached (put_over <<- rs ! point focused) in+		rotate_over focused rs = let new_left = attached <--- run <-- put_over <<- rs <-- point focused in 			imply @(Tape List _) <--- extract new_left <--- TT <-- deconstruct new_left <--- empty  		put_over :: a -> State (Nonempty List a) () 		put_over = void . modify @State . item @Push -instance Morphable (Rotate Right) (Turnover (Tape List)) where-	type Morphing (Rotate Right) (Turnover (Tape List)) = Turnover (Tape List)-	morphing s@(premorph -> Turnover (T_U (Exactly x :*: T_U (Reverse left :*: right)))) =+instance Morphable (Rotate Right) (Turnover < Tape List) where+	type Morphing (Rotate Right) (Turnover < Tape List) = Turnover < Tape List+	morphing s@(lower . run . premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) = 		resolve @(Tape List _) <--- Turnover <--- premorph s-			! (rotate_over x <-|- run left) .-+- (rotate_right x left <-|- run right) where+			<---- (rotate_over x <-|- run left) .-+- (rotate_right x left <-|- run right) where  		rotate_right :: a -> List a -> Nonempty List a -> Tape List a-		rotate_right focused ls (Construct rx rxs) = imply @(Tape List _) ! rx ! item @Push focused ls ! TT rxs+		rotate_right focused ls (Construct rx rxs) = imply @(Tape List _) <-- rx <-- item @Push focused ls <-- TT rxs  		rotate_over :: a -> Nonempty List a -> Tape List a-		rotate_over focused ls = let new_right = attached (put_over <<- ls ! point focused) in+		rotate_over focused ls = let new_right = attached (run <-- put_over <<- ls <-- point focused) in 			imply @(Tape List _) <--- extract new_right <--- empty <--- TT <-- deconstruct new_right  		put_over :: a -> State (Nonempty List a) () 		put_over = void . modify @State . item @Push -instance Morphable (Into (Tape List)) List where-	type Morphing (Into (Tape List)) List = Maybe <::> Tape List+instance Morphable (Into > Tape List) List where+	type Morphing (Into > Tape List) List = Maybe <::> Tape List 	morphing (premorph -> list) = (into @(Zipper List) <-|-) =#- list  instance Morphable (Into List) (Tape List) where 	type Morphing (Into List) (Tape List) = List-	morphing (premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) = attached ! run @(->) @(State _)+	morphing (lower . premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) = attached <---- run @(->) @(State _) 		<--- modify @State . item @Push @List <<-- right 		<--- item @Push x left -instance Morphable (Into (Comprehension Maybe)) (Tape List) where-	type Morphing (Into (Comprehension Maybe)) (Tape List) = Comprehension Maybe-	morphing (premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) = attached ! run @(->) @(State _)+instance Morphable (Into > Comprehension Maybe) (Tape List) where+	type Morphing (Into > Comprehension Maybe) (Tape List) = Comprehension Maybe+	morphing (lower . premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) = attached <---- run @(->) @(State _) 		<--- modify @State . item @Push @(Comprehension Maybe) <<-- right 		<--- item @Push x <-- Comprehension left  ------------------------------------- Zipper of non-empty list -------------------------------------  instance Zippable (Construction Maybe) where-	type Breadcrumbs (Construction Maybe) = Reverse (Construction Maybe) <:.:> Construction Maybe := (:*:)+	type Breadcrumbs (Construction Maybe) = Reverse > Construction Maybe <:.:> Construction Maybe > (:*:) -instance Morphable (Rotate Left) (Tape (Construction Maybe)) where-	type Morphing (Rotate Left) (Tape (Construction Maybe)) = Maybe <::> (Tape (Construction Maybe))-	morphing (premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) =+instance Morphable (Rotate Left) (Tape > Construction Maybe) where+	type Morphing (Rotate Left) (Tape > Construction Maybe) = Maybe <::> (Tape > Construction Maybe)+	morphing (lower . premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) = 		TT <----- imply @(Tape (Nonempty List) _) 			<-|-- point <-- extract left 			<-*-- deconstruct left 			<-*-- point <-- item @Push x right -instance Morphable (Rotate Right) (Tape (Construction Maybe)) where-	type Morphing (Rotate Right) (Tape (Construction Maybe)) = Maybe <::> Tape (Construction Maybe)-	morphing (premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) =+instance Morphable (Rotate Right) (Tape > Construction Maybe) where+	type Morphing (Rotate Right) (Tape > Construction Maybe) = Maybe <::> Tape (Construction Maybe)+	morphing (lower . premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) = 		TT <----- imply @(Tape (Nonempty List) _) 			<-|-- point <-- extract right 			<-*-- point <-- item @Push x left 			<-*-- deconstruct right -instance Morphable (Into (Tape List)) (Construction Maybe) where-	type Morphing (Into (Tape List)) (Construction Maybe) = Tape List+instance Morphable (Into > Tape List) (Construction Maybe) where+	type Morphing (Into > Tape List) (Construction Maybe) = Tape List 	morphing (premorph -> ne) = imply @(Tape List _) <--- extract ne <--- empty <--- TT <-- deconstruct ne -instance Morphable (Into (Tape List)) (Tape (Construction Maybe)) where-	type Morphing (Into (Tape List)) (Tape (Construction Maybe)) = Tape List-	morphing (premorph -> zipper) = (((((lift =#-) :*: lift) <-|-<-|-) =#-) <-|-) =#- zipper+--instance Morphable (Into > Tape List) (Tape > Construction Maybe) where+	--type Morphing (Into > Tape List) (Tape > Construction Maybe) = Tape List+	--morphing (premorph -> zipper) = (((((((lift =#-) :*: lift) <-|-<-|-) =#-) <-|-) =#-) =#-) zipper -instance Morphable (Into (Tape (Construction Maybe))) (Tape List) where-	type Morphing (Into (Tape (Construction Maybe))) (Tape List) =-		Maybe <::> Tape (Construction Maybe)-	morphing (premorph -> zipper) = let spread x y = (\x' y' -> Reverse x' :*: y') <-|- x <-*- y in-		TT ! T_U . (Exactly (extract zipper) :*:) . T_U <-|- ((spread |-) . ((run . run :*: run) <-|-<-|-) . run . extract ! run zipper)+--instance Morphable (Into > Tape > Construction Maybe) (Tape List) where+	--type Morphing (Into > Tape > Construction Maybe) (Tape List) =+		--Maybe <::> Tape (Construction Maybe)+	--morphing (lower . premorph -> zipper) = let spread x y = (\x' y' -> Reverse x' :*: y') <-|- x <-*- y in+		--lift . TT <--- T_U . (Exactly <-- extract zipper :*:) . T_U <-|- ((spread |-) . ((run . run :*: run) <-|-<-|-) . run . extract <-- run zipper) -instance Morphable (Into (Construction Maybe)) (Tape (Construction Maybe)) where-	type Morphing (Into (Construction Maybe)) (Tape (Construction Maybe)) = Construction Maybe-	morphing (premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) = attached ! run @(->) @(State _)+instance Morphable (Into > Construction Maybe) (Tape > Construction Maybe) where+	type Morphing (Into > Construction Maybe) (Tape > Construction Maybe) = Construction Maybe+	morphing (lower . premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) = attached <---- run @(->) @(State _) 		<--- modify @State . item @Push @(Nonempty List) <<-- right 		<--- item @Push x left -instance Morphable (Into List) (Tape (Construction Maybe)) where-	type Morphing (Into List) (Tape (Construction Maybe)) = List-	morphing (premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) = attached ! run @(->) @(State _)+instance Morphable (Into List) (Tape > Construction Maybe) where+	type Morphing (Into List) (Tape > Construction Maybe) = List+	morphing (lower . premorph -> T_U (Exactly x :*: T_U (Reverse left :*: right))) = attached <---- run @(->) @(State _) 		<--- modify @State . item @Push @List <<-- right 		<--- item @Push x <-- lift left  ------------------------------------ Zipper of combinative list ------------------------------------  instance Zippable (Comprehension Maybe) where-	type Breadcrumbs (Comprehension Maybe) = Comprehension Maybe <:.:> Comprehension Maybe := (:*:)+	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) = TT ! \key -> lookup @Key key ===<< Prefixed <-|- run list+	morphing (run . premorph -> list) = TT <-- \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) = TT ! \key -> extract <-|- search key where-		search key = key == attached x ? Just x ! find @Element <-- Predicate ((key ==) . attached) ===<< xs+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) = TT <-- \key -> extract <-|- search key where+		search key = key ?== attached x <----- Just x +			<----- find @Element <--- Predicate <-- (key ==) . attached ====<< xs

@@ -1,29 +1,33 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Structure.Some.Rose where -import Pandora.Core.Functor (type (:.), type (:=))+import Pandora.Core.Functor (type (:.), type (>)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((#))-import Pandora.Pattern.Functor.Contravariant ((>-|-))+import Pandora.Pattern.Category ((<--), (<---), (<----), (<-----))+import Pandora.Pattern.Kernel (constant)+import Pandora.Pattern.Functor.Contravariant ((>-|--)) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Transformer.Liftable (lift) import Pandora.Pattern.Transformer.Lowerable (lower)-import Pandora.Pattern.Object.Setoid (Setoid ((==), (!=)))+import Pandora.Pattern.Object.Setoid (Setoid ((==), (!=), (?==))) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), attached) import Pandora.Paradigm.Primary.Algebraic.Exponential ((%)) import Pandora.Paradigm.Primary.Algebraic (extract)+import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True))+import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:)), attached)+import Pandora.Paradigm.Primary.Algebraic.Exponential ((%))+import Pandora.Paradigm.Primary.Algebraic (extract)+import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True)) import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly)) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing)) import Pandora.Paradigm.Primary.Functor.Predicate (equate) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct) import Pandora.Paradigm.Schemes (TU (TU), P_Q_T (P_Q_T), type (<:.>))-import Pandora.Paradigm.Controlflow.Effect.Conditional (Conditional ((?)))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run) import Pandora.Paradigm.Inventory.Some.Store (Store (Store))-import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing)-	, Morph (Lookup, Element, Key), premorph, find)+import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Lookup, Element, Key), premorph, find) import Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty)-import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Available, Substance, substructure), Segment (Root, Tail))+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substance, substructure), Segment (Root, Tail)) import Pandora.Paradigm.Structure.Modification.Prefixed (Prefixed) import Pandora.Paradigm.Structure.Some.List (List) @@ -33,45 +37,43 @@ --instance Substructure Root Rose where --	type Available Root Rose = Maybe --	type Substance Root Rose = Exactly---	substructure = P_Q_T ! \rose -> case run # lower rose of---		Nothing -> Store ! Nothing :*: TU . Tag . TU . ((Construct % empty) . extract <-|-)---		Just nonempty_rose -> Store ! Just (Exactly # extract nonempty_rose) :*: \case---			Just (Exactly new) -> lift . TU . Just . Construct new ! deconstruct nonempty_rose+--	substructure = P_Q_T <-- \rose -> case run # lower rose of+--		Nothing -> Store <--- Nothing :*: TU . Tag . TU . ((Construct % empty) . extract <-|-)+--		Just nonempty_rose -> Store <--- Just (Exactly # extract nonempty_rose) :*: \case+--			Just (Exactly new) -> lift . TU . Just . Construct new <-- deconstruct nonempty_rose --			Nothing -> lift empty  --instance Substructure Just Rose where --	type Available Just Rose = Exactly --	type Substance Just Rose = List <:.> Construction List---	substructure = P_Q_T ! \rose -> case run . extract . run # rose of---		Nothing -> Store ! Exactly empty :*: constant (lift empty)---		Just (Construct x xs) -> Store ! Exactly (TU xs) :*: lift . lift . Construct x . run . extract+--	substructure = P_Q_T <-- \rose -> case run . extract . run # rose of+--		Nothing -> Store <--- Exactly empty :*: constant (lift empty)+--		Just (Construct x xs) -> Store <--- Exactly (TU xs) :*: lift . lift . Construct x . run . extract  --------------------------------------- Non-empty rose tree ----------------------------------------  type instance Nonempty Rose = Construction List  instance Substructure Root (Construction List) where-	type Available Root (Construction List) = Exactly 	type Substance Root (Construction List) = Exactly-	substructure = P_Q_T ! \rose -> Store ! Exactly (Exactly # extract (lower rose)) :*: lift . (Construct % deconstruct (lower rose)) . extract . extract+	--substructure = P_Q_T <-- \rose -> Store <--- Exactly (Exactly <-- extract (lower rose)) :*: lift . (Construct % deconstruct (lower rose)) . extract . extract  instance Substructure Tail (Construction List) where-	type Available Tail (Construction List) = Exactly 	type Substance Tail (Construction List) = List <:.> Construction List-	substructure = P_Q_T ! \rose -> case extract # run rose of-		Construct x xs -> Store ! Exactly (TU xs) :*: lift . Construct x . run . extract+	--substructure = P_Q_T <-- \rose -> case extract <-- run rose of+	--	Construct x xs -> Store <--- Exactly (TU xs) :*: lift . Construct x . run . extract  --------------------------------------- Prefixed rose tree -----------------------------------------  instance Setoid k => Morphable (Lookup Key) (Prefixed Rose k) where 	type Morphing (Lookup Key) (Prefixed Rose k) = (->) (Nonempty List k) <:.> Maybe-	morphing prefixed_rose_tree = case run # premorph prefixed_rose_tree of-		TU Nothing -> TU ! \_ -> Nothing-		TU (Just tree) -> TU ! find_rose_sub_tree % tree+	morphing prefixed_rose_tree = case run <-- premorph prefixed_rose_tree of+		TU Nothing -> TU <-- constant 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---	type Morphing (Vary Element) (Prefixed Rose k) = ((:*:) (Nonempty List k) <:.> Exactly) <:.:> Prefixed Rose k := (->)+--	type Morphing (Vary Element) (Prefixed Rose k) = ((:*:) (Nonempty List k) <:.> Exactly) <:.:> Prefixed Rose k > (->) --	morphing (run . run . premorph -> Nothing) = T_U ! \(TU (Construct key _ :*: Exactly value)) -> Prefixed . lift ! Construct (key :*: value) empty --	morphing (run . run . premorph -> Just (Construct focused subtree)) = T_U ! \(TU (breadcrumbs :*: Exactly value)) -> case breadcrumbs of --		Construct key Nothing -> Prefixed . lift ! attached focused == key ? Construct (key :*: value) subtree ! Construct focused subtree@@ -83,7 +85,7 @@ -- 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 (Construction List) k) where --	type Morphing (Vary Element) (Prefixed (Construction List) k) =---		((:*:) (Nonempty List k) <:.> Exactly) <:.:> Prefixed (Construction List) k := (->)+--		((:*:) (Nonempty List k) <:.> Exactly) <:.:> Prefixed (Construction List) k > (->) --	morphing (run . premorph -> Construct x (TU Nothing)) = T_U ! \(TU (breadcrumbs :*: Exactly value)) -> case breadcrumbs of --		Construct key Nothing -> Prefixed ! attached x == key ? Construct (key :*: value) empty ! Construct x empty --		Construct _ (Just _) -> Prefixed ! Construct x (TU Nothing)@@ -93,9 +95,9 @@ --		Construct key (Just keys) -> Prefixed ! attached x != key ? Construct x # lift subtree --			! Construct (key :*: value) . lift ! vary @Element @_ @_ @(Nonempty (Prefixed Rose k)) keys value -#=!> subtree -find_rose_sub_tree :: forall k a . Setoid k => Nonempty List k -> Nonempty Rose := k :*: a -> Maybe a-find_rose_sub_tree (Construct k Nothing) tree = k == attached (extract tree) ? Just (extract ! extract tree) ! Nothing-find_rose_sub_tree (Construct k (Just ks)) tree = k != attached (extract tree) ? Nothing ! find_rose_sub_tree ks =<< subtree where+find_rose_sub_tree :: forall k a . Setoid k => Nonempty List k -> Nonempty Rose > k :*: a -> Maybe a+find_rose_sub_tree (Construct k Nothing) tree = k ?== attached <-- extract tree <----- Just <--- extract <-- extract tree <----- Nothing+find_rose_sub_tree (Construct k (Just ks)) tree = k ?== attached <-- extract tree <----- find_rose_sub_tree ks =<< subtree <----- Nothing where  -	subtree :: Maybe :. Nonempty Rose := k :*: a-	subtree = find @Element # attached . extract >-|- equate (extract ks) # deconstruct tree+	subtree :: Maybe :. Nonempty Rose > k :*: a+	subtree = find @Element <---- attached . extract >-|-- equate <-- extract ks <---- deconstruct tree

@@ -2,23 +2,24 @@ {-# LANGUAGE AllowAmbiguousTypes #-} module Pandora.Paradigm.Structure.Some.Splay where -import Pandora.Core.Functor (type (~>), type (:.), type (:=))+import Pandora.Core.Functor (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.Bindable (Bindable ((==<<), (===<<)))+import Pandora.Pattern.Transformer.Hoistable ((/|\)) import Pandora.Paradigm.Primary ()-import Pandora.Paradigm.Primary.Algebraic ((.:..), (<-*-), extract)+import Pandora.Paradigm.Primary.Algebraic ((<-*-), extract)+import Pandora.Paradigm.Primary.Algebraic.Product (type (<:*:>)) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just)) import Pandora.Paradigm.Primary.Functor.Tagged (type (:#)) import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct) import Pandora.Paradigm.Primary (twosome) import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)-import Pandora.Paradigm.Inventory.Ability.Modifiable (modify)-import Pandora.Paradigm.Inventory.Some.Optics (Lens, Obscure)+import Pandora.Paradigm.Inventory.Some.Optics (view, mutate) import Pandora.Paradigm.Schemes (TT (TT), type (<::>))-import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morphed, Morph (Rotate, Into), premorph, rotate, into)+import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morphed, Morph (Rotate), premorph, rotate) import Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty) import Pandora.Paradigm.Structure.Ability.Substructure (sub) import Pandora.Paradigm.Structure.Ability.Monotonic (resolve)@@ -26,86 +27,85 @@  data Splay a = Zig a | Zag a -instance Morphable (Rotate (Left Zig)) Binary where-	type Morphing (Rotate (Left Zig)) Binary = Binary+instance Morphable (Rotate > Left Zig) Binary where+	type Morphing (Rotate > Left Zig) Binary = Binary 	morphing (premorph -> binary) = TT <--- run . rotate @(Left Zig) ==<< run binary -instance Morphable (Rotate (Right Zig)) Binary where-	type Morphing (Rotate (Right Zig)) Binary = Binary+instance Morphable (Rotate > Right Zig) Binary where+	type Morphing (Rotate > Right Zig) Binary = Binary 	morphing (premorph -> binary) = TT <--- run . rotate @(Right Zig) ==<< run binary -instance Morphable (Rotate (Left (Zig Zig))) Binary where-	type Morphing (Rotate (Left (Zig Zig))) Binary = Binary-	morphing (premorph -> binary) = TT <--- run . rotate @(Left (Zig Zig)) ==<< run binary+instance Morphable (Rotate > Left > Zig Zig) Binary where+	type Morphing (Rotate > Left > Zig Zig) Binary = Binary+	morphing (premorph -> binary) = TT <--- run . rotate @(Left > Zig Zig) ==<< run binary -instance Morphable (Rotate (Right (Zig Zig))) Binary where-	type Morphing (Rotate (Right (Zig Zig))) Binary = Binary-	morphing (premorph -> binary) = TT <--- run . rotate @(Right (Zig Zig)) ==<< run binary+instance Morphable (Rotate > Right > Zig Zig) Binary where+	type Morphing (Rotate > Right > Zig Zig) Binary = Binary+	morphing (premorph -> binary) = TT <--- run . rotate @(Right > Zig Zig) ==<< run binary -instance Morphable (Rotate (Left (Zig Zag))) Binary where-	type Morphing (Rotate (Left (Zig Zag))) Binary = Binary-	morphing (premorph -> binary) = TT <--- run . rotate @(Left (Zig Zag)) ==<< run binary+instance Morphable (Rotate > Left > Zig Zag) Binary where+	type Morphing (Rotate > Left > Zig Zag) Binary = Binary+	morphing (premorph -> binary) = TT <--- run . rotate @(Left > Zig Zag) ==<< run binary -instance Morphable (Rotate (Right (Zig Zag))) Binary where-	type Morphing (Rotate (Right (Zig Zag))) Binary = Binary-	morphing (premorph -> binary) = TT <--- run . rotate @(Right (Zig Zag)) ==<< run binary+instance Morphable (Rotate > Right > Zig Zag) Binary where+	type Morphing (Rotate > Right > Zig Zag) Binary = Binary+	morphing (premorph -> binary) = TT <--- run . rotate @(Right > Zig Zag) ==<< run binary  -------------------------------------- Non-empty Splay tree ---------------------------------------- -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+-- TODO: refactor so that there is only one expression+instance Morphable (Rotate > Left Zig) (Construction (Maybe <:*:> Maybe)) where+	type Morphing (Rotate > Left Zig) (Construction (Maybe <:*:> Maybe)) = Binary+	morphing :: forall a . (:#) (Rotate > Left Zig) <::> Construction (Maybe <:*:> Maybe) > a -> Binary a 	morphing (premorph -> Construct x xs) = TT <--- Construct <-|- parent <-*- Just nodes where -		nodes :: Wye :. Nonempty Binary := a-		nodes = into @Wye .:.. twosome-			<------ branch @Left xs-			<------ Just . Construct x . into @Wye+		nodes :: (Maybe <:*:> Maybe) :. Nonempty Binary > a+		nodes = twosome+			<------ view <-- sub @Left <-- xs+			<------ Just . Construct x 				<----- twosome-					<---- branch @Left ===<< deconstruct <-|- branch @Right xs-					<---- branch @Right ===<< deconstruct <-|- branch @Right xs+					<---- view (sub @Left) ===<< deconstruct <-|- view (sub @Right) xs+					<---- view (sub @Right) ===<< deconstruct <-|- view (sub @Right) xs  		parent :: Maybe a-		parent = extract <-|- branch @Right xs+		parent = extract <-|-- view <-- sub @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+instance Morphable (Rotate > Right Zig) (Construction (Maybe <:*:> Maybe)) where+	type Morphing (Rotate > Right Zig) (Construction (Maybe <:*:> Maybe)) = Binary+	morphing :: forall a . (:#) (Rotate > Right Zig) <::> Construction (Maybe <:*:> Maybe) > a -> Binary a 	morphing (premorph -> Construct x xs) = TT <--- 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+		nodes :: (Maybe <:*:> Maybe) :. Nonempty Binary > a+		nodes = twosome+			<------ view (sub @Left) ===<< deconstruct <-|- view (sub @Left) xs+			<------ Just . Construct x 				<----- twosome-					<---- branch @Right ===<< deconstruct <-|- branch @Left xs-					<---- branch @Right xs+					<---- view (sub @Right) ===<< deconstruct <-|- view (sub @Left) xs+					<---- view (sub @Right) xs  		parent :: Maybe a-		parent = extract <-|- branch @Left xs+		parent = extract <-|-- view <-- sub @Left <-- xs  -- TODO: Morphing ... = Conclussion Error <::> Nonempty Binary-instance Morphable (Rotate (Left (Zig Zig))) (Construction Wye) where-	type Morphing (Rotate (Left (Zig Zig))) (Construction Wye) = Maybe <::> Construction Wye+instance Morphable (Rotate > Left > Zig Zig) (Construction (Maybe <:*:> Maybe)) where+	type Morphing (Rotate > Left > Zig Zig) (Construction (Maybe <:*:> Maybe)) = Maybe <::> Construction (Maybe <:*:> Maybe) 	morphing (premorph -> tree) = TT <---- run . rotate @(Left Zig) ===<< run <-- rotate @(Left Zig) tree  -- TODO: Morphing ... = Conclussion Error <::> Nonempty Binary-instance Morphable (Rotate (Right (Zig Zig))) (Construction Wye) where-	type Morphing (Rotate (Right (Zig Zig))) (Construction Wye) = Maybe <::> Construction Wye+instance Morphable (Rotate > Right > Zig Zig) (Construction (Maybe <:*:> Maybe)) where+	type Morphing (Rotate > Right > Zig Zig) (Construction (Maybe <:*:> Maybe)) = Maybe <::> Construction (Maybe <:*:> Maybe) 	morphing (premorph -> tree) = TT <---- run . rotate @(Right Zig) ===<< run <-- rotate @(Right Zig) tree  -- TODO: Morphing ... = Conclussion Error <::> Nonempty Binary-instance Morphable (Rotate (Left (Zig Zag))) (Construction Wye) where-	type Morphing (Rotate (Left (Zig Zag))) (Construction Wye) = Maybe <::> Construction Wye-	morphing (premorph -> struct) = rotate @(Left Zig) <--- modify @(Obscure Lens) <-- try_to_rotate @(Right Zig) <-- sub @Left <-- struct+instance Morphable (Rotate > Left > Zig Zag) (Construction (Maybe <:*:> Maybe)) where+	type Morphing (Rotate > Left > Zig Zag) (Construction (Maybe <:*:> Maybe)) = Maybe <::> Construction (Maybe <:*:> Maybe)+	morphing (premorph -> struct) = rotate @(Left Zig) <--- mutate <-- (try_to_rotate @(Right Zig) /|\) <-- sub @Left <-- struct  -- TODO: Morphing ... = Conclussion Error <::> Nonempty Binary-instance Morphable (Rotate (Right (Zig Zag))) (Construction Wye) where-	type Morphing (Rotate (Right (Zig Zag))) (Construction Wye) = Maybe <::> Construction Wye-	morphing (premorph -> struct) = rotate @(Right Zig) <--- modify @(Obscure Lens) <-- try_to_rotate @(Left Zig) <-- sub @Right <-- struct--branch :: forall b . Morphable (Into (b Maybe)) Wye => Wye ~> Morphing (Into (b Maybe)) Wye-branch = into @(b Maybe)+instance Morphable (Rotate > Right > Zig Zag) (Construction (Maybe <:*:> Maybe)) where+	type Morphing (Rotate > Right > Zig Zag) (Construction (Maybe <:*:> Maybe)) = Maybe <::> Construction (Maybe <:*:> Maybe)+	morphing (premorph -> struct) = rotate @(Right Zig) <--- mutate <-- (try_to_rotate @(Left Zig) /|\) <-- sub @Right <-- struct +-- TODO: Include error instead of returning empty tree try_to_rotate :: forall direction . Morphed (Rotate direction) (Nonempty Binary) Binary => Nonempty Binary ~> Nonempty Binary try_to_rotate tree = resolve @(Nonempty Binary _) identity tree <--- run <-- rotate @direction tree

@@ -2,11 +2,12 @@ module Pandora.Paradigm.Structure.Some.Stream where  import Pandora.Core.Impliable (imply)-import Pandora.Core.Functor (type (:=), type (:=>))+import Pandora.Core.Functor (type (>), type (:=>)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((<--), (<---), (-->))+import Pandora.Pattern.Category ((<--), (<---), (<----), (-->)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|--))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=)))+import Pandora.Pattern.Transformer.Lowerable (lower) import Pandora.Paradigm.Primary.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Primary.Algebraic (extract) import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly))@@ -17,26 +18,26 @@ import Pandora.Paradigm.Structure.Ability.Zipper (Zippable (Breadcrumbs), Tape) import Pandora.Paradigm.Schemes.T_U (T_U (T_U), type (<:.:>)) import Pandora.Paradigm.Primary.Algebraic (point)-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (!))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)  type Stream = Construction Exactly  instance Zippable (Construction Exactly) where-	type Breadcrumbs (Construction Exactly) = Reverse Stream <:.:> Stream := (:*:)+	type Breadcrumbs (Construction Exactly) = Reverse Stream <:.:> Stream > (:*:)  instance Morphable (Rotate Left) (Tape Stream) where 	type Morphing (Rotate Left) (Tape Stream) = Tape Stream-	morphing (run . premorph -> Exactly x :*: T_U (Reverse ls :*: rs)) =+	morphing (run . lower . premorph -> Exactly x :*: T_U (Reverse ls :*: rs)) = 		imply @(Tape Stream _) <--- extract ls <--- extract (deconstruct ls) <--- Construct x --> point rs  instance Morphable (Rotate Right) (Tape Stream) where 	type Morphing (Rotate Right) (Tape Stream) = Tape Stream-	morphing (run . premorph -> Exactly x :*: T_U (Reverse ls :*: rs)) =+	morphing (run . lower . premorph -> Exactly x :*: T_U (Reverse ls :*: rs)) = 		imply @(Tape Stream _) <--- extract rs <--- Construct x (point ls) <--- extract (deconstruct rs)  instance {-# OVERLAPS #-} Extendable (->) (Tape Stream) where-	f <<= z = let move rtt = extract . deconstruct ! point . rtt .-+ z in+	f <<= z = let move rtt = extract . deconstruct <---- point . rtt .-+ z in 		f <-|-- imply @(Tape Stream _) <-- z <-- move (rotate @Left) <-- move (rotate @Right)  repeat :: a :=> Stream-repeat x = Construct x . Exactly ! repeat x+repeat x = Construct x . Exactly <-- repeat x

@@ -3,7 +3,7 @@ import Pandora.Pattern.Semigroupoid (Semigroupoid ((.)))  infixl 1 <----------infixl 2 <--------, #+infixl 2 <-------- infixl 3 <------- infixl 4 <------ infixl 5 <-----@@ -28,9 +28,6 @@  class Semigroupoid m => Category m where 	identity :: m a a--	(#) :: m (m a b) (m a b)-	(#) = identity . identity  	(<---------), (<--------), (<-------), (<------), (<-----), (<----), (<---), (<--) :: m (m a b) (m a b) 	(<---------) = identity . identity

@@ -4,12 +4,12 @@ import Pandora.Pattern.Betwixt (Betwixt) import Pandora.Pattern.Semigroupoid (Semigroupoid) -infixl 1 <-|---------infixl 2 <-|--------infixl 3 <-|------, <$$>-infixl 4 <-|-----, <$$$>-infixl 5 <-|-----infixl 6 <-|---, <-|-|-|-+infixl 1 <-|--------, <-|-|-------+infixl 2 <-|-------, <-|-|------+infixl 3 <-|------, <-|-|-----, <$$>+infixl 4 <-|-----, <-|-|----, <$$$>+infixl 5 <-|----, <-|-|---+infixl 6 <-|---, <-|-|--, <-|-|-|- infixl 7 <-|--, <-|-|- infixl 8 <-|- @@ -32,8 +32,14 @@ 	(<-|-------) = (<-|-) 	(<-|--------) = (<-|-) -	(<-|-|-) :: (Covariant source (Betwixt source target) u, Covariant (Betwixt source target) target t)+	(<-|-|-), (<-|-|--), (<-|-|---), (<-|-|----), (<-|-|-----), (<-|-|------), (<-|-|-------) :: (Covariant source (Betwixt source target) u, Covariant (Betwixt source target) target t) 		=> source a b -> target (t (u a)) (t (u b))+	(<-|-|-------) s = ((<-|-) ((<-|-) @source @(Betwixt source target) @_ s))+	(<-|-|------) s = ((<-|-) ((<-|-) @source @(Betwixt source target) @_ s))+	(<-|-|-----) s = ((<-|-) ((<-|-) @source @(Betwixt source target) @_ s))+	(<-|-|----) s = ((<-|-) ((<-|-) @source @(Betwixt source target) @_ s))+	(<-|-|---) s = ((<-|-) ((<-|-) @source @(Betwixt source target) @_ s))+	(<-|-|--) s = ((<-|-) ((<-|-) @source @(Betwixt source target) @_ s)) 	(<-|-|-) s = ((<-|-) ((<-|-) @source @(Betwixt source target) @_ s))  	(<-|-|-|-) :: (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)

@@ -3,7 +3,7 @@ import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Monoid (Monoid) -infixl 7 -+infixl 9 -  {- | > When providing a new instance, you should ensure it satisfies:

@@ -2,7 +2,7 @@  import Pandora.Pattern.Object.Semigroup (Semigroup) -infixl 8 *+infixl 9 *  {- | > When providing a new instance, you should ensure it satisfies:

@@ -1,6 +1,6 @@ module Pandora.Pattern.Object.Semigroup (Semigroup (..)) where -infixl 7 ++infixl 9 +  {- | > When providing a new instance, you should ensure it satisfies:

@@ -2,7 +2,7 @@  import Pandora.Paradigm.Primary.Object.Boolean (Boolean (False, True)) -infix 4 ==, !=+infix 6 ==, !=, ?==  {- | > When providing a new instance, you should ensure it satisfies:@@ -20,3 +20,8 @@ 	(!=) x y = case x == y of 		True -> False 		False -> True++	(?==) :: a -> a -> r -> r -> r+	(?==) x y xc yc = case x == y of+		True -> xc+		False -> yc

@@ -1,5 +1,5 @@ name:                pandora-version:             0.5.1+version:             0.5.2 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@@ -29,6 +29,7 @@     Pandora.Paradigm.Primary     Pandora.Paradigm.Primary.Object     Pandora.Paradigm.Primary.Algebraic+    Pandora.Paradigm.Primary.Algebraic.Functor     Pandora.Paradigm.Primary.Algebraic.Exponential     Pandora.Paradigm.Primary.Algebraic.Product     Pandora.Paradigm.Primary.Algebraic.Sum