pandora 0.5.4 → 0.5.5

raw patch · 52 files changed

+659/−432 lines, 52 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +31/−0
• Pandora/Core/Interpreted.hs +10/−4
• Pandora/Paradigm/Algebraic.hs +11/−8
• Pandora/Paradigm/Algebraic/Functor.hs +65/−25
• Pandora/Paradigm/Algebraic/Product.hs +3/−2
• Pandora/Paradigm/Controlflow/Effect/Transformer/Comonadic.hs +3/−3
• Pandora/Paradigm/Controlflow/Effect/Transformer/Monadic.hs +3/−3
• Pandora/Paradigm/Inventory.hs +14/−7
• Pandora/Paradigm/Inventory/Some/Equipment.hs +2/−2
• Pandora/Paradigm/Inventory/Some/Optics.hs +11/−6
• Pandora/Paradigm/Inventory/Some/State.hs +4/−4
• Pandora/Paradigm/Primary.hs +7/−0
• Pandora/Paradigm/Primary/Auxiliary.hs +12/−0
• Pandora/Paradigm/Primary/Functor/Conclusion.hs +12/−4
• Pandora/Paradigm/Primary/Functor/Edges.hs +5/−5
• Pandora/Paradigm/Primary/Functor/Exactly.hs +2/−2
• Pandora/Paradigm/Primary/Functor/Maybe.hs +4/−3
• Pandora/Paradigm/Primary/Functor/Tagged.hs +2/−2
• Pandora/Paradigm/Primary/Functor/These.hs +4/−4
• Pandora/Paradigm/Primary/Functor/Validation.hs +3/−3
• Pandora/Paradigm/Primary/Functor/Wedge.hs +4/−4
• Pandora/Paradigm/Primary/Transformer/Backwards.hs +3/−3
• Pandora/Paradigm/Primary/Transformer/Construction.hs +15/−8
• Pandora/Paradigm/Primary/Transformer/Instruction.hs +3/−3
• Pandora/Paradigm/Primary/Transformer/Jack.hs +4/−4
• Pandora/Paradigm/Primary/Transformer/Jet.hs +2/−2
• Pandora/Paradigm/Primary/Transformer/Reverse.hs +2/−2
• Pandora/Paradigm/Primary/Transformer/Tap.hs +4/−4
• Pandora/Paradigm/Schemes/TT.hs +2/−2
• Pandora/Paradigm/Schemes/TU.hs +2/−2
• Pandora/Paradigm/Schemes/TUT.hs +1/−1
• Pandora/Paradigm/Schemes/UT.hs +2/−2
• Pandora/Paradigm/Structure/Ability/Monotonic.hs +9/−0
• Pandora/Paradigm/Structure/Ability/Substructure.hs +15/−6
• Pandora/Paradigm/Structure/Interface/Set.hs +5/−5
• Pandora/Paradigm/Structure/Interface/Zipper.hs +7/−7
• Pandora/Paradigm/Structure/Modification/Comprehension.hs +3/−3
• Pandora/Paradigm/Structure/Modification/Nonempty.hs +7/−2
• Pandora/Paradigm/Structure/Modification/Tape.hs +10/−10
• Pandora/Paradigm/Structure/Some/Binary.hs +87/−110
• Pandora/Paradigm/Structure/Some/List.hs +40/−47
• Pandora/Paradigm/Structure/Some/Rose.hs +156/−62
• Pandora/Paradigm/Structure/Some/Splay.hs +16/−10
• Pandora/Paradigm/Structure/Some/Stream.hs +15/−19
• Pandora/Pattern/Functor/Covariant.hs +2/−0
• Pandora/Pattern/Functor/Distributive.hs +1/−0
• Pandora/Pattern/Functor/Monad.hs +3/−3
• Pandora/Pattern/Functor/Traversable.hs +19/−22
• Pandora/Pattern/Morphism.hs +1/−0
• Pandora/Pattern/Morphism/Flip.hs +1/−1
• Pandora/Pattern/Morphism/Trip.hs +8/−0
• pandora.cabal +2/−1

@@ -758,3 +758,34 @@ * Move `Nonempty` from `Ability` to `Modification` module  # 0.5.5+* Change `Nonempty` type family: close it+* Change `Zipper` of `Binary` tree definition+* Define `reconstruct` method of `Construction` for schemes+* Define `Trip` datatype as `Flip` extension+* Define `<-|||-` length encoding operators in `Algebraic` module+* Rename `<<-` method of `Traversable` to `<-/-`+* Define experimental `<<-/-` method+* Define `primary` lens for `Interpreted` values+* Rename `.-*-` length encoding operators to `-*-`+* Define `Location` datatype+* Remove `Fastenable` type family+* Define `fasten` method in `Zippable` typeclass+* Change `Zipper` of `Rose` tree definition+* Define precedence and fixity for `@>>>` operator+* Define `unfasten` method in `Zippable` typeclass+* Define `probably` method of `State` effect+* Rename `<-/-<-/-` `Traversable` method to `<-/-/-`+* Decrease precedence for `:*:` infix operator+* Rename `-*-` length encoding operators to `--*`+* Change definitions of `--*` length encoding operators: arguments order+* Define another `-*` length encoding operator+* Change definition of `-*-*-` operator: arguments order+* Change definition of `-+-` operator: arguments order+* Rename `-+-` operator to `-+`+* Define  `-+` length encoding operators+* Remove `reconstruct` method of `Construction`+* Define `Cardinality` type family+* Define `:+*+:` type operator+* Define `:*+*:` type operator++# 0.5.6

@@ -3,6 +3,7 @@ import Pandora.Core.Functor (type (<), type (>)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Morphism.Flip (Flip (Flip))+import Pandora.Pattern.Morphism.Trip (Trip (Trip)) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.))) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift))@@ -68,12 +69,17 @@ 	=> m < t u a < t v b -> m < u a < Primary (t v) b (-=:) f = run . f . lift +instance Interpreted (->) (Straight v e) where+	type Primary (Straight v e) a = v e a+	run ~(Straight x) = x+	unite = Straight+ instance Interpreted (->) (Flip v a) where 	type Primary (Flip v a) e = v e a 	run ~(Flip x) = x 	unite = Flip -instance Interpreted (->) (Straight v e) where-	type Primary (Straight v e) a = v e a-	run ~(Straight x) = x-	unite = Straight+instance Interpreted (->) (Trip v a b) where+	type Primary (Trip v a b) e = v e b a+	run ~(Trip x) = x+	unite = Trip

@@ -1,5 +1,5 @@ {-# OPTIONS_GHC -fno-warn-orphans #-}-module Pandora.Paradigm.Algebraic (module Exports) where+module Pandora.Paradigm.Algebraic (module Exports, type (:+*+:), type (:*+*:)) where  import Pandora.Paradigm.Algebraic.Functor as Exports import Pandora.Paradigm.Algebraic.Exponential as Exports@@ -8,19 +8,18 @@ import Pandora.Paradigm.Algebraic.Zero as Exports import Pandora.Paradigm.Algebraic.One as Exports -import Pandora.Core.Functor (type (>)) import Pandora.Core.Interpreted (Interpreted ((<~))) import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((<--), (<---), (<----), identity)+import Pandora.Pattern.Category ((<--), (<---)) import Pandora.Pattern.Kernel (constant)-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.Comonad (Comonad)-import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))-import Pandora.Paradigm.Schemes.T_U (T_U (T_U), type (<:.:>))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-)))+import Pandora.Paradigm.Schemes.T_U (T_U (T_U))  instance (Semimonoidal (<--) (:*:) (:*:) t, Semimonoidal (<--) (:*:) (:*:) u) => Semimonoidal (<--) (:*:) (:*:) (t <:*:> u) where 	mult = Flip <-- \(T_U lrxys) ->@@ -40,10 +39,10 @@ 		unit _ = Straight <-- \_ -> empty <:*:> empty  instance (Traversable (->) (->) t, Traversable (->) (->) u) => Traversable (->) (->) (t <:*:> u) where-	f <<- T_U (xs :*: ys) = T_U <-|-- (:*:) <-|- f <<- xs <-*- f <<- ys+	f <-/- T_U (xs :*: ys) = T_U <-|--- (:*:) <-|-- f <-/- xs <-*-- f <-/- ys  instance Traversable (->) (->) ((:*:) s) where-	f <<- x = (attached x :*:) <-|- f (extract x)+	f <-/- x = (attached x :*:) <-|- f (extract x)  instance Semimonoidal (-->) (:*:) (:*:) ((->) e) where 	mult :: ((e -> a) :*: (e -> b)) --> (e -> (a :*: b))@@ -85,3 +84,7 @@  instance Monoidal (<--) (-->) (:*:) (:*:) (Flip (:*:) a) where 	unit _ = Flip <-- \(Flip (s :*: _)) -> Straight (\_ -> s)++type (:+*+:) l r = (l :+: r) :*: (r :+: l)++type (:*+*:) l r = (l :*: r) :+: (r :*: l)

@@ -1,16 +1,18 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Algebraic.Functor where -import Pandora.Core.Interpreted (Interpreted ((<~), (<~~~), (-#=)))+import Pandora.Core.Interpreted (Interpreted ((<~), (<~~~), (-#=), run)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Kernel (constant)-import Pandora.Pattern.Morphism.Flip (Flip)+import Pandora.Pattern.Morphism.Flip (Flip (Flip))+import Pandora.Pattern.Morphism.Trip (Trip) 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), Unit)+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Functor.Adjoint (Adjoint ((-|), (|-))) import Pandora.Paradigm.Algebraic.Exponential (type (-->), type (<--), (&)) import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)))@@ -19,14 +21,22 @@ import Pandora.Paradigm.Algebraic.One (One (One)) import Pandora.Paradigm.Primary.Functor.Proxy (Proxy (Proxy)) -infixl 1 <-*------, .-*------, <-||-----, >-||------infixl 2 <-*-----, .-*-----, <-||----, >-||-----infixl 3 <-*----, .-*----, <-||---, >-||----infixl 4 <-*---, .-*---, <-*-*-, <-||--, >-||---infixl 5 <-*--, .-*--, .-*-*-, <-||-, >-||--infixl 6 <-*-, .-*-, <-+--infixl 7 -+-+infixl 1 <-*------, <-||-----, >-||-----+infixl 2 <-*-----, <-||----, >-||----+infixl 3 <-*----, <-||---, >-||---+infixl 4 <-*---, <-*-*-, <-||--, >-||--+infixl 5 <-*--, <-||-, >-||-+infixl 6 <-*-, <-+- +infixr 1 --------*+infixr 2 -------*+infixr 3 ------*+infixr 4 -----*+infixr 5 ----*, -*-*-+infixr 6 ---*+infixr 7 --*+infixr 8 -*, -++ infixl 6 <-|-<-|-, <-|->-|-, >-|-<-|-, >-|->-|-  type instance Unit (:*:) = One@@ -53,30 +63,39 @@ 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, Semimonoidal (-->) (:*:) (:*:) t) => t a -> t b -> t b+x --------* y = (\_ y' -> y') <-|- x <-*- y+x -------* y = (\_ y' -> y') <-|- x <-*- y+x ------* y = (\_ y' -> y') <-|- x <-*- y+x -----* y = (\_ y' -> y') <-|- x <-*- y+x ----* y = (\_ y' -> y') <-|- x <-*- y+x ---* y = (\_ y' -> y') <-|- x <-*- y+x --* y = (\_ y' -> y') <-|- x <-*- y+x -* y = (\_ 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, Covariant (->) (->) u, Semimonoidal (-->) (:*:) (:*:) t, Semimonoidal (-->) (:*:) (:*:) u) => t (u a) -> t (u b) -> t (u b)+x -*-*- y = (\_ y' -> y') <-|-|- x <-*-*- y  (<-+-) :: (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:+:) t) => t b -> t a -> (a :+: b -> r) -> t r-y <-+- x = \f -> f <-|--- mult @(-->) <~~~ x :*: y+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+(--------+), (-------+), (------+), (-----+), (----+), (---+), (--+), (-+)+	:: (Covariant (->) (->) t, Semimonoidal (-->) (:*:) (:+:) t) => t a -> t a -> t a+x --------+ y = (\r -> case r of Option rx -> rx; Adoption ry -> ry) <-|--- mult @(-->) <~~~ x :*: y+x -------+ y = (\r -> case r of Option rx -> rx; Adoption ry -> ry) <-|--- mult @(-->) <~~~ x :*: y+x ------+ y = (\r -> case r of Option rx -> rx; Adoption ry -> ry) <-|--- mult @(-->) <~~~ x :*: y+x -----+ y = (\r -> case r of Option rx -> rx; Adoption ry -> ry) <-|--- mult @(-->) <~~~ x :*: y+x ----+ y = (\r -> case r of Option rx -> rx; Adoption ry -> ry) <-|--- mult @(-->) <~~~ x :*: y+x ---+ y = (\r -> case r of Option rx -> rx; Adoption ry -> ry) <-|--- mult @(-->) <~~~ x :*: y+x --+ y = (\r -> case r of Option rx -> rx; Adoption ry -> ry) <-|--- mult @(-->) <~~~ x :*: y+x -+ y = (\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+loop x = let r = x -* r in r  type Extractable t = Monoidal (<--) (-->) (:*:) (:*:) t type Pointable t = Monoidal (-->) (-->) (:*:) (:*:) t@@ -94,6 +113,7 @@ empty :: Emptiable t => t a empty = unit @(-->) Proxy <~ Straight absurd +-- TODO: Rename <-||- to <<-|- (<-||-), (<-||--), (<-||---), (<-||----), (<-||-----), (<-||------), (<-||-------), (<-||--------) 	:: 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)@@ -106,6 +126,19 @@ (<-||--) f = (-#=) @m @(Flip p c) ((<-|-) f) (<-||-) f = (-#=) @m @(Flip p c) ((<-|-) f) +-- TODO: Rename <-|||- to <<<-|-+(<-|||-), (<-|||--), (<-|||---), (<-|||----), (<-|||-----), (<-|||------), (<-|||-------), (<-|||--------)+	:: forall (m :: * -> * -> *) (v :: * -> * -> * -> *) a b c d .+	(Covariant m m (Trip v d c), Interpreted m (Trip v d c)) => m a b -> m (v a c d) (v b c d)+(<-|||--------) f = (-#=) @m @(Trip v d c) ((<-|-) f)+(<-|||-------) f = (-#=) @m @(Trip v d c) ((<-|-) f)+(<-|||------) f = (-#=) @m @(Trip v d c) ((<-|-) f)+(<-|||-----) f = (-#=) @m @(Trip v d c) ((<-|-) f)+(<-|||----) f = (-#=) @m @(Trip v d c) ((<-|-) f)+(<-|||---) f = (-#=) @m @(Trip v d c) ((<-|-) f)+(<-|||--) f = (-#=) @m @(Trip v d c) ((<-|-) f)+(<-|||-) f = (-#=) @m @(Trip v d 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)@@ -140,3 +173,10 @@  void :: Covariant (->) (->) t => t a -> t () void x = constant () <-|- x++-- TODO: generalize (->), it's hard to do since we don't have such a method: run <-|-- f <-/- unite x+(<<-/-) :: forall v u a b c .+	( Covariant (->) (->) u, Monoidal (Straight (->)) (Straight (->)) (:*:) (:*:) u+	, Interpreted (->) (Flip v c), Traversable (->) (->) (Flip v c))+	=> (a -> u b) -> v a c -> u (v b c)+(<<-/-) f = (<-|--) (run @(->)) . (<-/-) @(->) @(->) @(Flip v c) f . Flip

@@ -15,9 +15,10 @@ import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Paradigm.Schemes.T_U (T_U (T_U), type (<:.:>), type (>:.:>), type (<:.:<), type (>:.:<)) --- TODO: Change precedence to 7-infixr 8 :*:+infixr 7 :*: infixr 5 <:*:>++-- TODO Define :*:*:, :*:*:*:, ...  data (:*:) s a = s :*: a 

@@ -6,11 +6,11 @@ import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category ((<--), (<---), (<----)) import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|--))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<), (--<<)))-import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<), (==<<))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=), (<<==))) import Pandora.Pattern.Functor.Comonad (Comonad)@@ -41,7 +41,7 @@ 	unit _ = Straight <-- TC . point . (<-- One) . run  instance Traversable (->) (->) (Schematic Comonad t u) => Traversable (->) (->) (t :< u) where-	f <<- TC x = TC <-|- f <<- x+	f <-/- TC x = TC <-|-- f <-/- x  instance Distributive (->) (->) (Schematic Comonad t u) => Distributive (->) (->) (t :< u) where 	f -<< x = TC <--- tc . f -<< x

@@ -6,11 +6,11 @@ import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category ((<--), (<---), (<----))-import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|--))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<)))-import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=))) import Pandora.Pattern.Functor.Monad (Monad)@@ -47,7 +47,7 @@ 			<~~~ f :*: x  instance Traversable (->) (->) (Schematic Monad t u) => Traversable (->) (->) (t :> u) where-	f <<- TM x = TM <-|- f <<- x+	f <-/- TM x = TM <-|-- f <-/- x  instance Distributive (->) (->) (Schematic Monad t u) => Distributive (->) (->) (t :> u) where 	f -<< x = TM <--- tm . f -<< x

@@ -1,26 +1,26 @@ {-# LANGUAGE AllowAmbiguousTypes #-} {-# OPTIONS_GHC -fno-warn-orphans #-}-module Pandora.Paradigm.Inventory (module Exports, zoom, overlook, (=<>), (~<>)) where+module Pandora.Paradigm.Inventory (module Exports, zoom, overlook, probably, (=<>), (~<>)) where  import Pandora.Paradigm.Inventory.Ability as Exports import Pandora.Paradigm.Inventory.Some as Exports -import Pandora.Core.Functor (type (~>))+import Pandora.Core.Functor (type (>>>)) import Pandora.Core.Interpreted (run, (<~)) import Pandora.Pattern.Semigroupoid ((.)) 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.Covariant (Covariant ((<-|-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Adjoint (Adjoint ((-|), (--|), (|-), (|--)))-import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly))-import Pandora.Paradigm.Primary.Functor.Maybe (Maybe)+import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing)) import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:))) import Pandora.Paradigm.Algebraic.Exponential ((%), type (<--)) import Pandora.Paradigm.Algebraic (Pointable, extract)-import Pandora.Paradigm.Primary (Simplification)+import Pandora.Paradigm.Controlflow.Effect.Transformer ((:>) (TM)) import Pandora.Paradigm.Controlflow.Effect.Adaptable (Adaptable (adapt))+import Pandora.Paradigm.Schemes.TUT (TUT (TUT))  instance Adjoint (->) (->) (Store s) (State s) where 	(-|) :: (Store s a -> b) -> a -> State s b@@ -40,10 +40,17 @@ zoom lens less = State <-- \source -> restruct |- run (lens <~ source) where  	restruct :: (u ls -> bg) -> u ls -> bg :*: result-	restruct to target = run @(->) <---- to <-|- Flip (less <~ target)+	restruct to target = run @(->) <---- to <-|- Flip <-- less <~ target  overlook :: (Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t) => State s result -> State (t s) (t result) overlook (State state) = State <-- \ts -> mult @(<--) @(:*:) @(:*:) <~ (state <-|- ts)++-- TODO: it's better to rename it to `perhaps` but this name is already taken+-- `Perhaps` and `Accessibe` typeclasses should be generalized to only one+probably :: State s :> Maybe >>> result -> State s (Maybe result)+probably (TM (TUT state)) = State <-- \old -> case state old of+	Just (new :*: r) -> new :*: Just r+	Nothing -> old :*: Nothing  (=<>) :: (Pointable available, Stateful src t) 	=> Lens available src tgt -> tgt -> t src

@@ -5,7 +5,7 @@ import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category ((<---), (<----)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|--)))-import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=))) import Pandora.Pattern.Functor.Comonad (Comonad) import Pandora.Paradigm.Algebraic ()@@ -20,7 +20,7 @@ 	f <-|- Equipment x = Equipment <---- f <-|- x  instance Traversable (->) (->) (Equipment e) where-	f <<- Equipment x = Equipment <-|-- f <<- x+	f <-/- Equipment x = Equipment <-|-- f <-/- x  instance Extendable (->) (Equipment e) where 	f <<= Equipment (e :*: x) = Equipment . (:*:) e . f . Equipment <---- e :*: x

@@ -4,10 +4,10 @@  import Pandora.Core.Functor (type (<)) import Pandora.Core.Impliable (Impliable (Arguments, imply))-import Pandora.Core.Interpreted (Interpreted (run, (<~)))+import Pandora.Core.Interpreted (Interpreted (Primary, run, unite, (<~))) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.))) import Pandora.Pattern.Category (Category (identity, (<--), (<---), (<----), (<-----), (<-------)))-import Pandora.Pattern.Kernel (Kernel (constant))+import Pandora.Pattern.Kernel (constant) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|-|-))) import Pandora.Pattern.Functor.Invariant (Invariant ((<!<))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult))@@ -29,7 +29,8 @@ import Pandora.Paradigm.Schemes.P_Q_T (P_Q_T (P_Q_T)) import Pandora.Paradigm.Structure.Ability.Monotonic (resolve) -infixl 2 #=@+infixr 6 @>>>+infixl 7 #=@  type Lens = P_Q_T (->) Store @@ -60,7 +61,7 @@ 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@@ -70,12 +71,13 @@ 		(source -> Maybe target) -> (source -> Maybe target -> source) -> Lens Maybe source target 	imply getter setter = P_Q_T <-- \source -> Store <--- getter source :*: setter source +-- This type of lens leave whole structure untouched if we set target = Nothing 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 :*: constant source 		Just between :*: mbs -> case run <-- to between of-			Nothing :*: _ -> Store <--- Nothing :*: \_ -> source+			Nothing :*: _ -> Store <--- Nothing :*: constant source 			Just target :*: mtb -> Store <--- Just target :*: mbs . Just . mtb  instance Category (Lens Maybe) where@@ -140,3 +142,6 @@  transwrap :: (Covariant (->) (->) u, Liftable (->) t, Lowerable (->) t) => Lens u < t u e < e transwrap = P_Q_T <-- \origin -> Store <--- lower origin :*: lift++primary :: Interpreted (->) t => Lens Exactly < t a < Primary t a+primary = P_Q_T <-- \origin -> Store <--- Exactly (run origin) :*: unite . extract

@@ -11,7 +11,7 @@ import Pandora.Pattern.Functor.Invariant (Invariant ((<!<))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit))-import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<), (==<<))) import Pandora.Pattern.Functor.Monad (Monad) import Pandora.Pattern.Functor.Adjoint ((-|), (|-))@@ -21,7 +21,7 @@ import Pandora.Paradigm.Inventory.Ability.Settable (Settable (Setting, set)) import Pandora.Paradigm.Inventory.Ability.Modifiable (Modifiable (Modification, modify)) import Pandora.Paradigm.Algebraic.Exponential (type (-->))-import Pandora.Paradigm.Algebraic ((:*:) ((:*:)), (.-*-), delta)+import Pandora.Paradigm.Algebraic ((:*:) ((:*:)), delta) import Pandora.Paradigm.Algebraic.One (One (One)) import Pandora.Paradigm.Algebraic (Pointable, point, (<-||-), (>-||-)) import Pandora.Paradigm.Schemes (Schematic, TUT (TUT), type (<:<.>:>))@@ -73,8 +73,8 @@  type Memorable s t = (Covariant (->) (->) t, Pointable t, Stateful s t) -fold :: (Traversable (->) (->) t, Memorable s u) => (a -> s -> s) -> t a -> u s-fold op struct = adapt <-- get @State .-*- (adapt . modify @State . op <<- struct)+-- fold :: (Traversable (->) (->) t, Memorable s u) => (a -> s -> s) -> t a -> u s+-- fold op struct = adapt <-- get @State -*- (adapt . modify @State . op <-/- struct)  instance Gettable State where 	type Getting State state ouput = State state state

@@ -13,6 +13,9 @@ import Pandora.Pattern.Category ((<---)) import Pandora.Pattern.Functor.Adjoint (Adjoint ((|-), (-|))) import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)))+import Pandora.Paradigm.Algebraic.Sum ((:+:))+import Pandora.Paradigm.Algebraic.One (One)+import Pandora.Paradigm.Algebraic.Zero (Zero) import Pandora.Paradigm.Schemes (TU, T_U, UT, TUT)  instance Adjoint (->) (->) (Flip (:*:) s) ((->) s) where@@ -26,3 +29,7 @@ 	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++type family Cardinality (t :: * -> *) where+	Cardinality Exactly = One+	Cardinality Maybe = Zero :+: One

@@ -1,5 +1,17 @@ module Pandora.Paradigm.Primary.Auxiliary where +import Pandora.Pattern.Category ((<--))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Paradigm.Algebraic.Exponential ()+ data Vertical a = Up a | Down a +instance Covariant (->) (->) Vertical where+	f <-|- Up x = Up <-- f x+	f <-|- Down x = Down <-- f x+ data Horizontal a = Left a | Right a++instance Covariant (->) (->) Horizontal where+	f <-|- Left x = Left <-- f x+	f <-|- Right x = Right <-- f x

@@ -8,7 +8,7 @@ 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.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Monad (Monad) import Pandora.Pattern.Object.Setoid (Setoid ((==)))@@ -26,6 +26,8 @@ import Pandora.Paradigm.Algebraic (point) import Pandora.Paradigm.Schemes (Schematic, UT (UT), type (<.:>)) +-- TODO: rename it to Progress = Stop e | Continue a+-- it would be a more generalized and semantic-based name data Conclusion e a = Failure e | Success a  instance Covariant (->) (->) (Conclusion e) where@@ -47,10 +49,10 @@ 		Success x :*: _ -> Option <-|- Success x  instance Traversable (->) (->) (Conclusion e) where-	(<<-) :: (Covariant (->) (->) u, Monoidal (-->) (-->) (:*:) (:*:) u, Semimonoidal (-->) (:*:) (:*:) u)+	(<-/-) :: (Covariant (->) (->) u, Monoidal (-->) (-->) (:*:) (:*:) u, Semimonoidal (-->) (:*:) (:*:) u) 		 => (a -> u b) -> Conclusion e a -> u (Conclusion e b)-	_ <<- Failure y = point <-- Failure y-	f <<- Success x = Success <-|- f x+	_ <-/- Failure y = point <-- Failure y+	f <-/- Success x = Success <-|- f x  instance Bindable (->) (Conclusion e) where 	f =<< Success x = f x@@ -121,3 +123,9 @@  instance Monoidal (-->) (-->) (:*:) (:*:) (Flip Conclusion a) where 	unit _ = Straight <--- Flip . Failure . (<~ One)++instance Traversable (->) (->) (Flip Conclusion a) where+	(<-/-) :: (Covariant (->) (->) u, Monoidal (-->) (-->) (:*:) (:*:) u, Semimonoidal (-->) (:*:) (:*:) u)+		 => (e -> u e') -> Flip Conclusion a e -> u (Flip Conclusion a e')+	_ <-/- Flip (Success y) = point <--- Flip <-- Success y+	f <-/- Flip (Failure x) = Flip . Failure <-|- f x

@@ -2,7 +2,7 @@  import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))-import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-))) import Pandora.Paradigm.Algebraic.Exponential () import Pandora.Paradigm.Algebraic (point) @@ -15,10 +15,10 @@ 	f <-|- Leap x = Leap <-- f x  instance Traversable (->) (->) Edges where-	_ <<- Empty = point Empty-	f <<- Connect x = Connect <-|- f x-	f <<- Overlay x = Overlay <-|- f x-	f <<- Leap x = Leap <-|- f x+	_ <-/- Empty = point Empty+	f <-/- Connect x = Connect <-|- f x+	f <-/- Overlay x = Overlay <-|- f x+	f <-/- Leap x = Leap <-|- f x  edges :: r -> (a -> r) -> (a -> r) -> (a -> r) -> Edges a -> r edges r _ _ _ Empty = r

@@ -6,7 +6,7 @@ import Pandora.Pattern.Morphism.Flip (Flip (Flip)) import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))-import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<)))@@ -47,7 +47,7 @@ 	unit _ = Flip <-- \(Exactly x) -> Straight (\_ -> x)  instance Traversable (->) (->) Exactly where-	f <<- Exactly x = Exactly <-|- f x+	f <-/- Exactly x = Exactly <-|- f x  instance Bindable (->) Exactly where 	f =<< Exactly x = f x

@@ -9,7 +9,7 @@ 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.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Monad (Monad) import Pandora.Pattern.Object.Setoid (Setoid ((==)))@@ -30,6 +30,7 @@ import Pandora.Paradigm.Algebraic (point) import Pandora.Paradigm.Schemes (Schematic, UT (UT), type (<.:>)) +-- TODO: better to rename it to Option a = Some a | None? data Maybe a = Nothing | Just a  instance Covariant (->) (->) Maybe where@@ -61,8 +62,8 @@ 		Nothing -> Nothing :*: Nothing  instance Traversable (->) (->) Maybe where-	_ <<- Nothing = point Nothing-	f <<- Just x = Just <-|- f x+	_ <-/- Nothing = point Nothing+	f <-/- Just x = Just <-|- f x  instance Bindable (->) Maybe where 	f =<< Just x = f x

@@ -9,7 +9,7 @@ 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.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=)))@@ -53,7 +53,7 @@ 	unit _ = Flip <-- \(Tag x) -> Straight (\_ -> x)  instance Traversable (->) (->) (Tagged tag) where-	f <<- Tag x = Tag <-|- f x+	f <-/- Tag x = Tag <-|- f x  instance Distributive (->) (->) (Tagged tag) where 	f -<< x = Tag <---- extract . f <-|- x

@@ -2,7 +2,7 @@  import Pandora.Pattern.Category ((<--)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))-import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Paradigm.Algebraic.Exponential () import Pandora.Paradigm.Algebraic (point)@@ -15,9 +15,9 @@ 	f <-|- These y x = These y <-- f x  instance Traversable (->) (->) (These e) where-	f <<- This x = This <-|- f x-	_ <<- That y = point <-- That y-	f <<- These y x = These y <-|- f x+	f <-/- This x = This <-|- f x+	_ <-/- That y = point <-- That y+	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'

@@ -6,7 +6,7 @@ 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.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Object.Setoid (Setoid ((==))) import Pandora.Pattern.Object.Chain (Chain ((<=>))) import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))@@ -46,8 +46,8 @@ 		Validated x :*: _ -> Option <-|- Validated x  instance Traversable (->) (->) (Validation e) where-	f <<- Validated x = Validated <-|- f x-	_ <<- Flaws e = point <-- Flaws e+	f <-/- Validated x = Validated <-|- f x+	_ <-/- Flaws e = point <-- Flaws e  instance (Setoid e, Setoid a) => Setoid (Validation e a) where 	Validated x == Validated y = x == y

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

@@ -2,11 +2,11 @@  import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category ((<--), (<---), (<----))-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))-import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<), (--<<))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))@@ -39,7 +39,7 @@ 	unit _ = Flip <-- \(Backwards x) -> Straight (\_ -> extract x)  instance Traversable (->) (->) t => Traversable (->) (->) (Backwards t) where-	f <<- Backwards x = Backwards <-|- f <<- x+	f <-/- Backwards x = Backwards <-|-- f <-/- x  instance Distributive (->) (->) t => Distributive (->) (->) (Backwards t) where 	f -<< x = Backwards <--- run . f -<< x

@@ -2,12 +2,15 @@ module Pandora.Paradigm.Primary.Transformer.Construction where  import Pandora.Core.Functor (type (:.), type (>>>), type (:=>), type (~>))+import Pandora.Core.Interpreted (Interpreted (Primary, run, unite, (<~), (<~~~), (<~~~~)))+import Pandora.Pattern.Morphism.Flip (Flip (Flip))+import Pandora.Pattern.Morphism.Straight (Straight (Straight)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category ((<--), (<---), (<----), (<-----), (<------))-import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|--), (<-|----), (<-|-|-)))+import Pandora.Pattern.Functor.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.Traversable (Traversable ((<-/-)), (<-/-/-)) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=))) import Pandora.Pattern.Functor.Comonad (Comonad) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))@@ -16,15 +19,14 @@ import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Ringoid ((*)) import Pandora.Pattern.Object.Monoid (Monoid (zero))-import Pandora.Paradigm.Algebraic ((<-*----), extract)+import Pandora.Paradigm.Algebraic ((<-*------), extract) import Pandora.Paradigm.Algebraic.Exponential (type (<--), type (-->))-import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)))+import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)), type (<:*:>), (<:*:>)) import Pandora.Paradigm.Algebraic.Sum ((:+:)) import Pandora.Paradigm.Algebraic.One (One (One)) import Pandora.Paradigm.Algebraic (empty, (<-||-))-import Pandora.Pattern.Morphism.Flip (Flip (Flip))-import Pandora.Pattern.Morphism.Straight (Straight (Straight))-import Pandora.Core.Interpreted (run, (<~), (<~~~), (<~~~~))+import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly))+import Pandora.Paradigm.Schemes (TT (TT), T_U (T_U), type (<::>))  data Construction t a = Construct a (t :. Construction t >>> a) @@ -46,7 +48,7 @@ 	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@@ -67,6 +69,11 @@  instance (Monoid a, forall b . Semigroup b => Monoid (t b), Covariant (->) (->) t, Semimonoidal (<--) (:*:) (:*:) t) => Monoid (Construction t a) where 	zero = Construct zero zero++instance Interpreted (->) (Construction t) where+	type Primary (Construction t) a = (Exactly <:*:> t <::> Construction t) a+	run (Construct x xs) = Exactly x <:*:> unite xs+	unite (T_U (Exactly x :*: TT xs)) = Construct x 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

@@ -8,7 +8,7 @@ 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.Traversable (Traversable ((<-/-)), (<-/-/-)) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Functor.Monad (Monad) import Pandora.Pattern.Transformer.Liftable (Liftable (lift))@@ -43,8 +43,8 @@ instance Monad (->) t => Monad (->) (Instruction t) where  instance Traversable (->) (->) t => Traversable (->) (->) (Instruction t) where-	f <<- Enter x = Enter <-|- f x-	f <<- Instruct xs = Instruct <-|- (f <<-<<- xs)+	f <-/- Enter x = Enter <-|- f x+	f <-/- Instruct xs = Instruct <-|- (f <-/-/- xs)  instance Liftable (->) Instruction where 	lift x = Instruct <---- Enter <-|- x

@@ -3,9 +3,9 @@  import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category ((<--), (<---), (<----), identity)-import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|-))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)), (<-|--)) import Pandora.Pattern.Functor.Monoidal (Monoidal)-import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<), (==<<))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=), (<<==))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift))@@ -25,8 +25,8 @@ 	f <-|- Other y = Other <---- f <-|- y  instance Traversable (->) (->) t => Traversable (->) (->) (Jack t) where-	f <<- It x = It <-|- f x-	f <<- Other y = Other <-|- f <<- y+	f <-/- It x = It <-|- f x+	f <-/- Other y = Other <-|-- f <-/- y  instance (Monoidal (-->) (-->) (:*:) (:*:) t, Bindable (->) t) => Bindable (->) (Jack t) where 	f =<< It x = f x

@@ -3,7 +3,7 @@  import Pandora.Pattern.Category ((<------)) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|--), (<-|-|-), (<-|-)))-import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)), (<<-<<-))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-)), (<-/-/-)) import Pandora.Paradigm.Algebraic ((<-*--))  data Jet t a = Jet a (Jet t (t a))@@ -14,4 +14,4 @@ 		<------ 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)

@@ -7,7 +7,7 @@ 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.Traversable (Traversable ((<-/-), (<-/--))) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<), (--<<))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))@@ -46,7 +46,7 @@ 	unit _ = Straight <-- \_ -> Reverse empty  instance Traversable (->) (->) t => Traversable (->) (->) (Reverse t) where-	f <<- Reverse x = Reverse <-|- run (Backwards . f <<-- x)+	f <-/- Reverse x = Reverse <-|- run (Backwards . f <-/-- x)  instance Distributive (->) (->) t => Distributive (->) (->) (Reverse t) where 	f -<< x = Reverse <--- run . f -<< x

@@ -4,15 +4,15 @@ import Pandora.Core.Functor (type (>>>>>>)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Category ((<--), (<---), (<----), (<------))-import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|-)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|--))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit))-import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=), (<<==))) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower)) import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Core.Interpreted ((<~), (<~~~))-import Pandora.Paradigm.Algebraic ((<-*-), (<-||--), extract)+import Pandora.Paradigm.Algebraic ((<-*--), (<-||--), extract) import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)), (<:*:>)) import Pandora.Paradigm.Algebraic.Exponential (type (<--), type (-->)) import Pandora.Pattern.Morphism.Flip (Flip (Flip))@@ -34,7 +34,7 @@ 	unit _ = Flip <-- \(Tap x _) -> Straight (\_ -> x)  instance Traversable (->) (->) t => Traversable (->) (->) (Tap t) where-	f <<- Tap x xs = Tap <-|- f x <-*- f <<- xs+	f <-/- Tap x xs = Tap <-|-- f x <-*-- f <-/- xs  instance (Semimonoidal (<--) (:*:) (:*:) t, Extendable (->) t, Covariant (->) (->) t) => Extendable (->) (Tap t) where 	f <<= x = Tap <--- f x <--- f . Tap (extract x) <<= lower x

@@ -11,7 +11,7 @@ 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.Traversable (Traversable ((<-/-)), (<-/-/-)) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift))@@ -64,7 +64,7 @@ 	unit _ = Flip <-- \(TT x) -> Straight <---- constant <--- extract <-- extract x  instance (Traversable (->) (->) t, Traversable (->) (->) t') => Traversable (->) (->) (t <::> t') where-	f <<- x = TT <-|-- (f <<-<<- run x)+	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

@@ -10,7 +10,7 @@ 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.Traversable (Traversable ((<-/-)), (<-/-/-)) import Pandora.Pattern.Functor.Distributive (Distributive ((-<<))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift))@@ -63,7 +63,7 @@ 	unit _ = Flip <-- \(TU x) -> Straight (\_ -> extract <-- extract x)  instance (Traversable (->) (->) t, Traversable (->) (->) u) => Traversable (->) (->) (t <:.> u) where-	f <<- x = TU <-|-- (f <<-<<- run x)+	f <-/- x = TU <-|-- (f <-/-/- run x)  instance (Bindable (->) t, Distributive (->) (->) t, Covariant (->) (->) u, Bindable (->) u) => Bindable (->) (t <:.> u) where 	f =<< TU x = TU <--- (\i -> (identity =<<) <-|- run . f -<< i) =<< x

@@ -62,7 +62,7 @@ 			<-|-- 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 

@@ -12,7 +12,7 @@ import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal (unit)) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<), (==<<)))-import Pandora.Pattern.Functor.Traversable (Traversable ((<<--)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/--))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower)) import Pandora.Paradigm.Algebraic.Exponential (type (<--), type (-->))@@ -52,7 +52,7 @@ 	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

@@ -3,6 +3,7 @@ import Pandora.Pattern.Category ((<----)) import Pandora.Pattern.Kernel (constant) import Pandora.Paradigm.Algebraic.Exponential ((.:..))+import Pandora.Paradigm.Algebraic.Sum ((:+:) (Option, Adoption))  class Monotonic a e where 	{-# MINIMAL reduce #-}@@ -14,3 +15,11 @@  instance Monotonic a a where 	reduce f r x = f x r++instance Monotonic a (o :+: a) where+	reduce fun def (Adoption x) = fun x def+	reduce _ def (Option x) = def++instance Monotonic o (o :+: a) where+	reduce fun def (Option x) = fun x def+	reduce _ def (Adoption x) = def

@@ -2,19 +2,21 @@ {-# LANGUAGE UndecidableInstances #-} module Pandora.Paradigm.Structure.Ability.Substructure where -import Pandora.Core.Interpreted (run, unite, (=#-))+import Pandora.Core.Interpreted (run, unite, (<~), (=#-)) import Pandora.Pattern.Semigroupoid (Semigroupoid ((.))) import Pandora.Pattern.Category ((<--), (<---), (<----))-import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-|-)))+import Pandora.Pattern.Kernel (constant)+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|-|-))) import Pandora.Pattern.Transformer.Liftable (lift) import Pandora.Pattern.Transformer.Lowerable (lower) import Pandora.Paradigm.Inventory.Some.Store (Store (Store)) import Pandora.Paradigm.Inventory.Some.Optics (type (@>>>), view, replace) import Pandora.Paradigm.Algebraic.Exponential ((%)) import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)), type (<:*:>), (<:*:>))-import Pandora.Paradigm.Algebraic ((>-||-), extract)+import Pandora.Paradigm.Algebraic.Functor ((>-||-), extract, empty) import Pandora.Paradigm.Primary.Auxiliary (Horizontal (Left, Right)) import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly))+import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing)) import Pandora.Paradigm.Primary.Functor.Tagged (Tagged) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct)) import Pandora.Paradigm.Schemes.TU (type (<:.>))@@ -31,8 +33,7 @@ 	sub = (lift >-||-) . (lower @(->) <-|-|-) =#- substructure @segment @structure  tagstruct :: Covariant (->) (->) structure => (Tagged segment <:.> structure) @>>> structure-tagstruct = P_Q_T <-- \ts -> case lower ts of-	struct -> Store <--- struct :*: lift+tagstruct = P_Q_T <-- Store . (:*: lift) . lower  instance (Covariant (->) (->) t, Covariant (->) (->) u) => Substructure Left (t <:*:> u) where 	type Substance Left (t <:*:> u) = t@@ -44,8 +45,10 @@ 	substructure = P_Q_T <-- \x -> case run <-- lower x of 		ls :*: rs -> Store <--- rs :*: lift . (ls <:*:>) -data Segment a = Root a | Rest a | Branch a | Ancestors a | Forest a+data Segment a = Tree a | Root a | Rest a | Branch a | Ancestors a | Children a | Siblings a | Forest a | Medium a +data Location a = Focused a+ instance Covariant (->) (->) t => Substructure Root (Exactly <:*:> t) where 	type Substance Root (Exactly <:*:> t) = Exactly 	substructure = (lower >-||-) . (lift @(->) <-|-|-) =#- sub @Left@@ -69,3 +72,9 @@ 	substructure = P_Q_T <-- \source -> case lower source of 		Construct x xs -> Store <--- unite (view <-- sub @i <-- xs) :*: \target -> 			lift <---- Construct x <--- replace <-- run target <-- sub @i <-- xs++instance (Covariant (->) (->) t, Substructured i t Maybe) => Substructure (i Branch) (Maybe <::> Construction t) where+	type Substance (i Branch) (Maybe <::> Construction t) = Maybe <::> Construction t+	substructure = P_Q_T <-- \struct -> case run . extract . run <-- struct of+		Nothing -> Store <--- empty :*: lift . constant empty+		Just tree -> lift . lift @(->) <-|- sub @(i Branch) <~ tree

@@ -2,11 +2,11 @@ module Pandora.Paradigm.Structure.Interface.Set where  import Pandora.Core.Functor (type (>), type (>>>>>>))-import Pandora.Core.Interpreted ((<~~))+import Pandora.Core.Interpreted ((<~~~)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((<--), (<---))+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)@@ -26,7 +26,7 @@ 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 = Convergence <-- \s ss -> Nothing != ((find @f @t @Maybe % s) . equate <-/- ss)  cardinality :: Traversable (->) (->) t => t a -> Numerator-cardinality s = attached <--- constant (modify @State (+ one)) <<- s <~~ Zero+cardinality s = attached <---- constant (modify @State (+ one)) <-/- s <~~~ Zero

@@ -1,6 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE UndecidableInstances #-}-{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE AllowAmbiguousTypes #-} module Pandora.Paradigm.Structure.Interface.Zipper where  import Pandora.Core.Functor (type (>), type (<), type (:.), type (:::))@@ -12,26 +12,30 @@ 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.Traversable (Traversable ((<-/-), (<-/---))) 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.Algebraic.Exponential (type (<--), type (-->), (%)) import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)), type (<:*:>), (<:*:>))-import Pandora.Paradigm.Algebraic ((<-*-), (<-*--), (<-*---), (.-*-), extract, point)+import Pandora.Paradigm.Algebraic ((<-*-), (<-*--), (<-*---), extract, point) import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly))+import Pandora.Paradigm.Primary.Functor.Maybe (Maybe) import Pandora.Paradigm.Primary.Functor.Tagged (Tagged) 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.Inventory.Some.Store (Store (Store)) import Pandora.Paradigm.Structure.Ability.Morphable (Morphable, Morph (Rotate))+import Pandora.Paradigm.Structure.Modification.Nonempty (Nonempty) import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substance, substructure, sub), Segment (Root, Rest))  -- TODO: Use Slidable superclass with Slides associated type family class Zippable (structure :: * -> *) where 	type Breadcrumbs structure :: * -> *+	fasten :: structure e -> Maybe > Zipper structure e+	unfasten :: Zipper structure e -> Nonempty structure e  type Zipper (structure :: * -> *) = Exactly <:*:> Breadcrumbs structure @@ -43,7 +47,3 @@  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

@@ -7,10 +7,10 @@ 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 ((<<-)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Functor.Bindable (Bindable ((=<<), (==<<))) import Pandora.Pattern.Transformer.Liftable (lift) import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))@@ -37,7 +37,7 @@ 	f <-|- Comprehension x = Comprehension <---- f <-|- x  instance Traversable (->) (->) (t <::> Construction t) => Traversable (->) (->) (Comprehension t) where-	f <<- Comprehension x = Comprehension <-|- f <<- x+	f <-/- Comprehension x = Comprehension <-|-- f <-/- x  instance (Covariant (->) (->) t, Semimonoidal (-->) (:*:) right t, Semimonoidal (-->) (:*:) right (t <::> Construction t)) => Semimonoidal (-->) (:*:) right (Comprehension t) where 	mult = Straight <-- Comprehension . (mult @(-->) @(:*:) @right <~) . ((run :*: run) <-|-<-|-)

@@ -1,4 +1,9 @@ module Pandora.Paradigm.Structure.Modification.Nonempty where --- | Type synonymous for at least one element data structure-type family Nonempty (s :: * -> *) = (r :: * -> *) | r -> s+import Pandora.Paradigm.Schemes (type (<::>))+import Pandora.Paradigm.Primary.Functor.Maybe (Maybe)+import Pandora.Paradigm.Primary.Transformer.Construction (Construction)++-- | At least one element data structure+type family Nonempty (structure :: * -> *) where+	Nonempty (Maybe <::> Construction t) = Construction t

@@ -9,7 +9,7 @@ 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.Traversable (Traversable ((<-/-), (<-/---))) import Pandora.Pattern.Functor.Bindable (Bindable ((====<<))) import Pandora.Pattern.Functor.Semimonoidal (Semimonoidal (mult)) import Pandora.Pattern.Functor.Monoidal (Monoidal)@@ -27,7 +27,7 @@ import Pandora.Paradigm.Controlflow.Effect.Adaptable (adapt) import Pandora.Paradigm.Controlflow.Effect.Transformer ((:>), wrap) import Pandora.Paradigm.Structure.Ability.Morphable (Occurrence (All))-import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substance, substructure), Segment (Root, Rest), sub)+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substance, substructure), Segment (Root, Branch, Rest), sub) import Pandora.Paradigm.Structure.Ability.Slidable (Slidable (Sliding, slide)) import Pandora.Paradigm.Structure.Interface.Stack (Stack (Topping, push, pop)) import Pandora.Paradigm.Inventory.Some.State (State, change)@@ -39,10 +39,10 @@  -- TODO: No overlapping, let's use wrappers instead -- instance {-# OVERLAPS #-} Traversable (->) (->) t => Traversable (->) (->) (Tape t) where--- 	f <<- z = (\ls x rs -> lift <------ x <:*:> ls <:*:> rs)--- 		<-|--- f <<--- view <-- sub @Left <-- z--- 		<-*--- f <<--- view <-- sub @Root <-- z--- 		<-*--- f <<--- view <-- sub @Right <-- z+-- 	f <-/- z = (\ls x rs -> lift <------ x <:*:> ls <:*:> rs)+-- 		<-|--- f <-/--- view <-- sub @Left <-- z+-- 		<-*--- f <-/--- view <-- sub @Root <-- z+-- 		<-*--- f <-/--- view <-- sub @Right <-- z  instance Covariant (->) (->) t => Impliable (Tape t a) where 	type Arguments (Tape t a) = a -> t a -> t a -> Tape t a@@ -74,8 +74,8 @@ 		let updated new = (\trg src -> mutate (replace <-- trg <-- sub @Right) <-- sub @Rest <-- src) <-|-- new <-*-- run <-- lower source in 		Store <--- target :*: lift . (updated =#-) -instance (Covariant (->) (->) structure, Bindable (->) (Topping structure), Monoidal (-->) (-->) (:*:) (:*:) (Topping structure), Stack structure) => Slidable Left (Tape structure) where-	type Sliding Left (Tape structure) = Topping structure+instance (Covariant (->) (->) structure, Bindable (->) (Topping structure), Monoidal (-->) (-->) (:*:) (:*:) (Topping structure), Stack structure) => Slidable Right (Tape structure) where+	type Sliding Right (Tape structure) = Topping structure 	slide :: forall e . State > Tape structure e :> Topping structure >>> () 	slide = void . wrap . zoom @(Tape structure e) (sub @Rest) 		. zoom (sub @Left) . zoom transwrap . push @structure . extract@@ -83,8 +83,8 @@ 				====<< lift ====<< wrap <---- zoom @(Tape structure e) <--- sub @Rest 					<--- zoom <-- sub @Right <-- pop @structure -instance (Covariant (->) (->) structure, Stack structure, Bindable (->) (Topping structure), Monoidal (-->) (-->) (:*:) (:*:) (Topping structure)) => Slidable Right (Tape structure) where-	type Sliding Right (Tape structure) = Topping structure+instance (Covariant (->) (->) structure, Stack structure, Bindable (->) (Topping structure), Monoidal (-->) (-->) (:*:) (:*:) (Topping structure)) => Slidable Left (Tape structure) where+	type Sliding Left (Tape structure) = Topping structure 	slide :: forall e . State > Tape structure e :> Topping structure >>> () 	slide = void . wrap . zoom @(Tape structure e) (sub @Rest) 		. zoom (sub @Right) . push . extract

@@ -1,41 +1,40 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Structure.Some.Binary where -import Pandora.Core.Functor (type (~>), type (>), type (>>>>>>), type (<), type (:=>))-import Pandora.Core.Interpreted (run, (<~))+import Pandora.Core.Functor (type (>), type (>>>), type (>>>>>), type (<))+import Pandora.Core.Interpreted (run, unite, (<~)) 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.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.Algebraic.Product ((:*:) ((:*:)), type (<:*:>), (<:*:>), attached)-import Pandora.Paradigm.Algebraic.Exponential ((%), (&), (.:..))-import Pandora.Paradigm.Algebraic ((<-*-), (<-*--), (<-*-*-), extract, point, empty)+import Pandora.Paradigm.Algebraic.Exponential ((&), (.:..))+import Pandora.Paradigm.Algebraic.Functor ((<-*---), (-------*), extract, empty, void) import Pandora.Paradigm.Primary.Auxiliary (Vertical (Up, Down), Horizontal (Left, Right)) import Pandora.Paradigm.Primary.Object.Ordering (order)-import Pandora.Paradigm.Primary.Auxiliary (Horizontal (Left, Right))-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.Transformer.Construction (Construction (Construct))-import Pandora.Paradigm.Schemes (TT (TT), T_U (T_U), P_Q_T (P_Q_T), type (<::>), type (<:.:>))+import Pandora.Paradigm.Controlflow.Effect.Transformer ((:>), wrap) 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.State (State, change, current) import Pandora.Paradigm.Inventory.Some.Store (Store (Store))-import Pandora.Paradigm.Inventory.Some.Optics (Lens, Obscure, view, replace, mutate)+import Pandora.Paradigm.Inventory.Some.Optics (Lens, Obscure, view, primary)+import Pandora.Paradigm.Inventory (zoom, overlook) import Pandora.Paradigm.Structure.Modification.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), lookup)-import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substance, substructure), Segment (Root, Branch), sub)-import Pandora.Paradigm.Structure.Interface.Zipper (Zippable (Breadcrumbs))+import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), premorph, Morph (Into, Lookup, Key), lookup)+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substance, substructure), Segment (Tree, Root, Branch, Ancestors, Children), Location (Focused), sub)+import Pandora.Paradigm.Structure.Ability.Slidable (Slidable (Sliding, slide))+import Pandora.Paradigm.Structure.Interface.Stack (push, pop)+import Pandora.Paradigm.Structure.Interface.Zipper (Zipper, Zippable (Breadcrumbs, fasten, unfasten)) import Pandora.Paradigm.Structure.Modification.Prefixed (Prefixed)+import Pandora.Paradigm.Structure.Some.List (List)+import Pandora.Paradigm.Schemes (TT (TT), T_U (T_U), P_Q_T (P_Q_T), type (<::>))  type Binary = Maybe <::> Construction (Maybe <:*:> Maybe) @@ -57,22 +56,8 @@ 				-- <--- step <-- sub @Right <-- binary 				-- <--- f x <-- extract binary -instance Substructure (Left Branch) Binary where-	type Substance (Left Branch) Binary = Binary-	substructure = P_Q_T <-- \struct -> case run <-- lower struct of-		Nothing -> Store <--- empty :*: lift . constant empty-		Just tree -> lift . lift @(->) <-|- sub @(Left Branch) <~ tree--instance Substructure (Right Branch) Binary where-	type Substance (Right Branch) 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 Branch) <~ tree- -------------------------------------- Non-empty binary tree --------------------------------------- -type instance Nonempty Binary = Construction (Maybe <:*:> Maybe)- instance Morphable (Into Binary) (Construction (Maybe <:*:> Maybe)) where 	type Morphing (Into Binary) (Construction (Maybe <:*:> Maybe)) = Binary 	morphing = lift . premorph@@ -87,22 +72,6 @@ 			-- <---- step <--- sub @Right <--- struct 			-- <---- f x <--- extract struct --- 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) (point 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 (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) (point 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@@ -137,73 +106,81 @@ 			<---- lookup @Key key . TT @Covariant @Covariant ==<< get @(Obscure Lens) <-- sub @Left <-- xs  -------------------------------------- Zipper of binary tree ----------------------------------------	{--data Biforked a = Top | Horizontal (Horizontal a) -instance Covariant (->) (->) Biforked where-	_ <-|- Top = Top-	f <-|- Horizontal (Left l) = Horizontal . Left <-- f l-	f <-|- Horizontal (Right r) = Horizontal . Right <-- f r+instance Zippable Binary where+	type Breadcrumbs Binary = (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe)+		<:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)+	fasten (TT (Just (Construct x xs))) = Just <----- Exactly x <:*:> TT xs <:*:> TT empty+	fasten (TT Nothing) = Nothing+	unfasten :: forall e . Zipper Binary e -> Nonempty Binary e+	unfasten (T_U (Exactly focus :*: T_U (TT children :*: TT ancestors))) =+		attached <-- (cover <-/- ancestors) <~ Construct focus children where -instance Traversable (->) (->) Biforked where-	_ <<- Top = point Top-	f <<- Horizontal (Left l) = Horizontal . Left <-|- f l-	f <<- Horizontal (Right r) = Horizontal . Right <-|- f r+		cover :: (Horizontal <::> (Exactly <:*:> Binary)) e -> State (Nonempty Binary e) ()+		cover (TT (Left (T_U (Exactly x :*: TT right)))) = void <-- change @(Nonempty Binary e) (\nbt -> Construct x <----- Just nbt <:*:> right)+		cover (TT (Right (T_U (Exactly x :*: TT left)))) = void <-- change @(Nonempty Binary e) (\nbt -> Construct x <----- left <:*:> Just nbt) -type Bifurcation = Biforked <::> Construction Biforked+instance Substructure Children (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) where+	type Substance Children (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) = (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe)+	substructure = P_Q_T <-- \source -> case run @(->) <-|- run <-- lower source of+		focus :*: children :*: ancestors -> Store <--- children :*: lift . (focus <:*:>) . (<:*:> ancestors) -type Bicursor = Exactly <:.:> Binary > (:*:)+instance Substructure (Left Tree) (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) where+	type Substance (Left Tree) (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) = Maybe <::> Construction (Maybe <:*:> Maybe)+	substructure = P_Q_T <-- \source -> case run @(->) <-|- run <-- lower source of+		focus :*: TT (T_U (left :*: right)) :*: ancestors ->+			Store <--- unite left :*: lift . (focus <:*:>) . (<:*:> ancestors) . TT . (<:*:> right) . run -instance Zippable (Construction Wye) where-	type Breadcrumbs (Construction Wye) = (Wye <::> Construction Wye) <:.:> (Bifurcation <::> Bicursor) > (:*:)+instance Substructure (Right Tree) (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) where+	type Substance (Right Tree) (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) = Maybe <::> Construction (Maybe <:*:> Maybe)+	substructure = P_Q_T <-- \source -> case run @(->) <-|- run <-- lower source of+		focus :*: TT (T_U (left :*: right)) :*: ancestors ->+			Store <--- unite right :*: lift . (focus <:*:>) . (<:*:> ancestors) . TT . (left <:*:>) . run -_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 Substructure Ancestors (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) where+	type Substance Ancestors (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) = List <::> Horizontal <::> (Exactly <:*:> Binary)+	substructure = P_Q_T <-- \source -> case run @(->) <-|- run <-- lower source of+		focus :*: children :*: ancestors -> Store <--- ancestors :*: lift . (focus <:*:>) . (children <:*:>) -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 (Horizontal (Right (Construct (T_U (Exactly parent :*: rest)) next)))) ->-			lift . ((<:*:>) % TT (TT next)) . (<:*:>) (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 (Horizontal (Left (Construct (T_U (Exactly parent :*: rest)) next)))) ->-			lift . ((<:*:>) % TT (TT next)) . (<:*:>) (Exactly parent) . TT <---- resolve-				<--- Both % _focused_part_to_nonempty_binary_tree focused-				<--- Right <-- _focused_part_to_nonempty_binary_tree focused-				<--- run rest-		_ -> TT Nothing+instance Substructure (Focused Tree) (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) where+	type Substance (Focused Tree) (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) = Construction (Maybe <:*:> Maybe)+	substructure = P_Q_T <-- \source -> case run @(->) <-|- run <-- lower source of+		focus :*: children :*: ancestors -> Store+			<--- (Construct <-- extract focus <-- run children)+				:*: lift . T_U . ((<:*:> ancestors) <-|-) . run . run -_nonempty_binary_tree_to_focused_part :: Construction Wye ~> Exactly <:.:> Wye <::> Construction Wye > (:*:)-_nonempty_binary_tree_to_focused_part (Construct x xs) = Exactly x <:*:> TT xs+instance Slidable (Down Left) (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) where+	type Sliding (Down Left) (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) = Maybe+	slide :: forall e . State > Zipper Binary e :> Maybe >>> ()+	slide = wrap . zoom (sub @Ancestors) . zoom primary . overlook . push @List+			-- TODO: Try to use Semimonoidal instance for lenses+			=====<< TT . Right .:.. (<:*:>)+				<-|--- wrap <--- zoom <-- sub @Root <-- current+				<-*--- wrap <--- zoom <-- sub @(Right Tree) <-- current+		-------* void . wrap . zoom @(Zipper Binary e) (sub @(Focused Tree)) . change . constant+			=====<< lift . run =====<< wrap <--- zoom <-- sub @(Left Tree) <-- current @(Binary e) -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 . (<:*:>) (_nonempty_binary_tree_to_focused_part lst)-				. TT . TT . Horizontal . Left <------- Construct-					<------ Exactly x <:*:> TT Nothing-					<------ next-		T_U (Exactly x :*: TT (Both lst rst)) :*: TT (TT next) ->-			lift . (<:*:>) (_nonempty_binary_tree_to_focused_part lst)-				. TT . TT . Horizontal . Left <------- Construct-					<------ Exactly x <:*:> lift rst-					<------ next-		_ -> TT Nothing+instance Slidable (Down Right) (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) where+	type Sliding (Down Right) (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) = Maybe+	slide :: forall e . State > Zipper Binary e :> Maybe >>> ()+	slide = wrap . zoom (sub @Ancestors) . zoom primary . overlook . push @List+			-- TODO: Try to use Semimonoidal instance for lenses+			=====<< TT . Left .:.. (<:*:>)+				<-|--- wrap <--- zoom <-- sub @Root <-- current+				<-*--- wrap <--- zoom <-- sub @(Left Tree) <-- current+		-------* void . wrap . zoom @(Zipper Binary e) (sub @(Focused Tree)) . change . constant+			=====<< lift . run =====<< wrap <--- zoom <-- sub @(Right Tree) <-- current @(Binary e) -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 . (<:*:>) (_nonempty_binary_tree_to_focused_part rst)-				. TT . TT . Horizontal . Right <---- Construct (Exactly x <:*:> TT Nothing) next-		T_U (Exactly x :*: TT (Both lst rst)) :*: TT (TT next) ->-			lift . (<:*:>) (_nonempty_binary_tree_to_focused_part rst)-				. TT . TT . Horizontal . Right <---- Construct (Exactly x <:*:> lift lst) next-		_ -> TT Nothing--}+instance Slidable Up (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) where+	type Sliding Up (Exactly <:*:> (Maybe <:*:> Maybe) <::> Construction (Maybe <:*:> Maybe) <:*:> List <::> Horizontal <::> (Exactly <:*:> Binary)) = Maybe+	slide :: forall e . State > Zipper Binary e :> Maybe >>> ()+	slide = void . wrap . zoom @(Zipper Binary e) (sub @(Focused Tree)) . change . branching+		=====<< lift . extract =====<< wrap <----- zoom @(Zipper Binary e) <---- sub @Ancestors+			<---- zoom <--- primary <--- overlook <-- pop @List where++		branching :: Horizontal <::> (Exactly <:*:> Binary) >>>>> e+			-> Nonempty Binary e -> Nonempty Binary e+		branching (TT (Left (T_U (Exactly root :*: left)))) right =+			Construct <----- root <----- run left <:*:> Just right+		branching (TT (Right (T_U (Exactly root :*: right)))) left =+			Construct <----- root <----- Just left <:*:> run right

@@ -3,55 +3,45 @@  import Pandora.Core.Functor (type (:.), type (<), type (>), type (>>>), type (>>>>>>)) import Pandora.Core.Impliable (imply)-import Pandora.Core.Interpreted (run, unite, (<~), (<~~~), (=#-))+import Pandora.Core.Interpreted (run, (<~), (<~~~), (=#-)) 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, Covariant ((<-|-), (<-|--), (<-|-|-)))-import Pandora.Pattern.Functor.Traversable (Traversable ((<<-)))-import Pandora.Pattern.Functor.Extendable (Extendable ((<<=)))-import Pandora.Pattern.Functor.Bindable (Bindable ((=<<), (==<<), (===<<), (====<<)))-import Pandora.Pattern.Functor.Adjoint (Adjoint ((|-)))+import Pandora.Pattern.Functor.Covariant (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.Setoid (Setoid ((==), (?=))) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Monoid (Monoid (zero))-import Pandora.Paradigm.Algebraic ((<-*-), (<-*--), (.-*-), (-+-), (.:..), extract, point, empty, void)+import Pandora.Paradigm.Algebraic ((<-*--), (-*), (-+), (.:..), extract, point, empty, void) import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)), type (<:*:>), (<:*:>), attached) import Pandora.Paradigm.Algebraic.Exponential ((%))-import Pandora.Paradigm.Algebraic ((<-|-<-|-)) import Pandora.Paradigm.Primary.Auxiliary (Horizontal (Left, Right)) 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.Transformer.Construction (Construction (Construct), deconstruct) import Pandora.Paradigm.Primary.Transformer.Reverse (Reverse (Reverse)) import Pandora.Paradigm.Primary ()-import Pandora.Paradigm.Controlflow.Effect.Adaptable (adapt)-import Pandora.Paradigm.Controlflow.Effect.Transformer ((:>)) 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.Inventory.Ability.Gettable (get) import Pandora.Paradigm.Inventory.Ability.Settable (set) import Pandora.Paradigm.Inventory.Ability.Modifiable (modify)-import Pandora.Paradigm.Inventory.Some.State (State, fold, current, change)+import Pandora.Paradigm.Inventory.Some.State (State, current, change) import Pandora.Paradigm.Inventory.Some.Store (Store (Store))-import Pandora.Paradigm.Inventory.Some.Optics (Convex, Obscure, Lens, transwrap)-import Pandora.Paradigm.Inventory (zoom, overlook) import Pandora.Paradigm.Structure.Modification.Nonempty (Nonempty) import Pandora.Paradigm.Structure.Ability.Monotonic (resolve) import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing) 	, Morph (Rotate, Into, Push, Pop, Delete, Find, Lookup, Element, Key)-	, Occurrence (All, First), premorph, rotate, item, filter, find, lookup, into)-import Pandora.Paradigm.Structure.Ability.Slidable (Slidable (Sliding, slide))+	, Occurrence (All, First), premorph, item, filter, find, lookup, into) import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substance, substructure, sub), Segment (Root, Rest)) import Pandora.Paradigm.Structure.Interface.Stack (Stack (Topping, push, pop, top))-import Pandora.Paradigm.Structure.Interface.Zipper (Zippable (Breadcrumbs), Zipper)+import Pandora.Paradigm.Structure.Interface.Zipper (Zippable (Breadcrumbs, fasten, unfasten), Zipper) import Pandora.Paradigm.Structure.Modification.Combinative (Combinative) import Pandora.Paradigm.Structure.Modification.Comprehension (Comprehension (Comprehension)) import Pandora.Paradigm.Structure.Modification.Prefixed (Prefixed)@@ -112,7 +102,7 @@ 			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)+	push x = modify @State (item @Push x) -* point x  instance Substructure Root List where 	type Substance Root List = Maybe@@ -127,13 +117,11 @@ 		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 :: forall t a . Traversable (->) (->) t => t a -> List a+-- 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@@ -163,8 +151,8 @@ 	type Topping (Construction Maybe) = Exactly 	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 <-- Exactly x <-|- change @(Nonempty List _) . constant <<- xs) =<< current @(Nonempty List _)-	push x = point x .-*- (modify @State <-- Construct x . Just)+	pop = (\(Construct x xs) -> constant <-- Exactly x <-|-- change @(Nonempty List _) . constant <-/- xs) =<< current @(Nonempty List _)+	push x = (modify @State <-- Construct x . Just) -* point x  ---------------------------------------- Combinative list ------------------------------------------ @@ -174,12 +162,17 @@  instance Zippable List where 	type Breadcrumbs List = Reverse List <:*:> List+	fasten (TT (Just (Construct x xs))) = Just <----- Exactly x <:*:> Reverse <-- TT empty <:*:> TT xs+	fasten (TT Nothing) = Nothing+	unfasten :: forall e . Zipper List e -> Nonempty List e+	unfasten (T_U (Exactly focus :*: T_U (Reverse left :*: right))) =+		attached <-- (push @(Nonempty List) <-/- left) <~ Construct focus (run right) where  -- TODO: No overlapping, let's use wrappers instead instance {-# OVERLAPS #-} Traversable (->) (->) (Tape List) where-	f <<- T_U (Exactly x :*: T_U (left :*: right)) =+	f <-/- T_U (Exactly x :*: T_U (left :*: right)) = 		(\past' x' left' -> Exactly x' <:*:> left' <:*:> run past')-			<-|- f <<- Reverse right <-*- f x <-*- f <<- left+			<-|-- f <-/- Reverse right <-*-- f x <-*-- f <-/- left  -- TODO: Try to generalize to Extendable (Tape structure) -- instance {-# OVERLAPS #-} Extendable (->) (Tape List) where@@ -189,33 +182,35 @@ -- 			<---- f <-|-- move <-- rotate @Left -- 			<---- f <-|-- move <-- rotate @Right +-- TODO: Define Stack structure => Slidable Left (Turnover < Tape structure) instance Morphable (Rotate Left) (Turnover < Tape List) where 	type Morphing (Rotate Left) (Turnover < Tape List) = Turnover < Tape List 	morphing s@(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 x right <-|- run left) -+ (rotate_over x <-|- run right) 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 <--- (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 +-- TODO: Define Stack structure => Slidable Right (Turnover < Tape structure) instance Morphable (Rotate Right) (Turnover < Tape List) where 	type Morphing (Rotate Right) (Turnover < Tape List) = Turnover < Tape List 	morphing s@(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_right x left <-|- run right) -+ (rotate_over x <-|- run left) 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_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 (put_over <-/- ls <~~~ point focused) in 			imply @(Tape List _) <--- extract new_right <--- empty <--- TT <-- deconstruct new_right  		put_over :: a -> State (Nonempty List a) ()@@ -227,21 +222,18 @@  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 _)-		<--- modify @State . item @Push @List <<- right-		<--- item @Push x left+	morphing (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 _)-		<--- modify @State . item @Push @(Comprehension Maybe) <<- right-		<--- item @Push x <-- Comprehension left+	morphing (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- 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))) =@@ -274,18 +266,19 @@  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 _)-		<--- modify @State . item @Push @(Nonempty List) <<- right-		<--- item @Push x left+	morphing (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 _)-		<--- modify @State . item @Push @List <<- right-		<--- item @Push x <-- lift left+	morphing (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 ------------------------------------ +-- TODO: add `fasten` and `unfasten` implementations instance Zippable (Comprehension Maybe) where 	type Breadcrumbs (Comprehension Maybe) = Comprehension Maybe <:*:> Comprehension Maybe 

@@ -1,53 +1,55 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} module Pandora.Paradigm.Structure.Some.Rose where -import Pandora.Core.Functor (type (:.), type (>>>))+import Pandora.Core.Functor (type (:.), type (>), type (<<), type (>>>)) import Pandora.Core.Interpreted (run, unite, (<~)) import Pandora.Pattern.Semigroupoid ((.))-import Pandora.Pattern.Category ((<--), (<---), (<----), (<-----), identity)+import Pandora.Pattern.Category ((<--), (<---), (<----), (<-----), (<------), (<-------)) import Pandora.Pattern.Kernel (constant)-import Pandora.Pattern.Functor.Covariant ((<-|-))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|----))) import Pandora.Pattern.Functor.Contravariant ((>-|-))-import Pandora.Pattern.Functor.Traversable ((<<-))-import Pandora.Pattern.Functor.Bindable (Bindable ((=<<)))+import Pandora.Pattern.Functor.Traversable ((<-/-))+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.Semigroup ((+))-import Pandora.Paradigm.Algebraic.Exponential ((%))+import Pandora.Paradigm.Algebraic.Exponential ((%), (.:..)) import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)), type (<:*:>), (<:*:>), attached)-import Pandora.Paradigm.Algebraic.Functor (extract, point, empty)+import Pandora.Paradigm.Algebraic.Functor ((<-*-), (<-*----), extract, point, empty, void) import Pandora.Paradigm.Primary.Auxiliary (Vertical (Up, Down), Horizontal (Left, Right)) 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.Functor.Tagged (Tagged) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct)-import Pandora.Paradigm.Primary.Transformer.Reverse (Reverse)+import Pandora.Paradigm.Primary.Transformer.Reverse (Reverse (Reverse)) import Pandora.Paradigm.Schemes (TU (TU), TT (TT), T_U (T_U), P_Q_T (P_Q_T),  type (<::>), type (<:.>))+import Pandora.Paradigm.Controlflow.Effect.Transformer ((:>), wrap)+import Pandora.Paradigm.Inventory.Some.State (State, change, current) import Pandora.Paradigm.Inventory.Some.Store (Store (Store))-import Pandora.Paradigm.Inventory.Some.Optics (view)-import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Into, Rotate, Lookup, Element, Key), premorph, find)+import Pandora.Paradigm.Inventory.Some.Optics (Lens, view, mutate, replace, primary)+import Pandora.Paradigm.Inventory (zoom, overlook, probably)+import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Lookup, Element, Key), premorph, find) import Pandora.Paradigm.Structure.Modification.Nonempty (Nonempty)-import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substance, substructure), Segment (Root, Rest, Forest), sub)-import Pandora.Paradigm.Structure.Interface.Zipper (Zippable (Breadcrumbs))-import Pandora.Paradigm.Structure.Interface.Stack (Stack (pop))+import Pandora.Paradigm.Structure.Ability.Slidable (Slidable (Sliding, slide))+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substance, substructure)+	, Segment (Rest, Ancestors, Siblings, Children, Tree, Forest), Location (Focused), sub)+import Pandora.Paradigm.Structure.Interface.Zipper (Zipper, Zippable (Breadcrumbs, fasten, unfasten))+import Pandora.Paradigm.Structure.Interface.Stack (Stack (pop, push, top)) import Pandora.Paradigm.Structure.Modification.Prefixed (Prefixed) import Pandora.Paradigm.Structure.Modification.Tape (Tape) import Pandora.Paradigm.Structure.Some.List (List) -type Rose = Maybe <:.> Construction List----------------------------------------- Non-empty rose tree ------------------------------------------type instance Nonempty Rose = Construction List+type Rose = Maybe <::> Construction List  --------------------------------------- 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 <-- constant Nothing-		TU (Just tree) -> TU <-- find_rose_sub_tree % tree+		TT Nothing -> TU <-- constant Nothing+		TT (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@@ -90,56 +92,148 @@  type Roses = List <::> Construction List -instance Zippable (Construction List) where-	type Breadcrumbs (Construction List) = Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses)+instance Zippable Rose where+	type Breadcrumbs Rose = Roses <:*:> List <::> Tape Roses+	fasten (TT (Just (Construct x xs))) = Just <----- Exactly x <:*:> TT xs <:*:> TT empty+	fasten (TT Nothing) = Nothing+	unfasten :: forall e . Zipper Rose e -> Nonempty Rose e+	unfasten (T_U (Exactly focus :*: T_U (TT children :*: TT ancestors))) =+		attached <-- (cover <-/- ancestors) <~ Construct focus children where +		cover :: Tape Roses e -> State << Nonempty Rose e << ()+		cover (T_U (Exactly x :*: T_U (Reverse (TT lf) :*: TT rf))) =++			void <--- change @(Nonempty Rose e) <-- \nrt ->+				Construct <------- x <------- lift <------ unfasten @List+					<----- Exactly nrt <:*:> Reverse lf <:*:> rf+ -- TODO: Try to use substructure @Right . substructure @Right . substructure @Right . substructure @Right here-instance Substructure (Up Forest) (Exactly <:*:> Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses)) where-	type Substance (Up Forest) (Exactly <:*:> Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses)) = List <::> Tape Roses-	substructure = P_Q_T <-- \zipper -> case run <-- lower zipper of-		Exactly x :*: T_U (down :*: T_U (left :*: T_U (right :*: up))) ->-			Store <--- up :*: lift . (Exactly x <:*:>) . (down <:*:>) . (left <:*:>) . (right <:*:>)+instance Substructure Ancestors (Exactly <:*:> Roses <:*:> List <::> Tape Roses) where+	type Substance Ancestors (Exactly <:*:> Roses <:*:> List <::> Tape Roses) = List <::> Tape Roses+	substructure = P_Q_T <-- \zipper -> case run @(->) <-|- run <-- lower zipper of+		Exactly x :*: down :*: up -> Store <--- up :*: lift . (Exactly x <:*:>) . (down <:*:>)  -- TODO: Try to use substructure @Left . substructure @Right here-instance Substructure (Down Forest) (Exactly <:*:> Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses)) where-	type Substance (Down Forest) (Exactly <:*:> Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses)) = Roses-	substructure = P_Q_T <-- \zipper -> case run <-- lower zipper of-		Exactly x :*: T_U (down :*: rest) ->-			Store <--- down :*: lift . (Exactly x <:*:>) . (<:*:> rest)+instance Substructure Children (Exactly <:*:> Roses <:*:> List <::> Tape Roses) where+	type Substance Children (Exactly <:*:> Roses <:*:> List <::> Tape Roses) = Roses+	substructure = P_Q_T <-- \zipper -> case run @(->) <-|- run <-- lower zipper of+		Exactly x :*: down :*: up -> Store <--- down :*: lift . (Exactly x <:*:>) . (<:*:> up) +-- Think about lens methods/operators that could make this code easier+instance Substructure Siblings (Exactly <:*:> Roses <:*:> List <::> Tape Roses) where+	type Substance Siblings (Exactly <:*:> Roses <:*:> List <::> Tape Roses) = Maybe <::> (Reverse Roses <:*:> Roses)+	substructure = P_Q_T <-- \zipper -> case run @(->) <-|- run <-- lower zipper of+		Exactly x :*: down :*: up -> Store+			<--- (TT <---- view <-- sub @Rest <-|- view <-- top @List <-- run up)+				:*: \siblings -> lift <----- Exactly x <:*:> down+					<:*:> TT <--- mutate (replace <-|- run siblings <-*- Just <-- sub @Rest <-*-)+						<-- top @List <-- run up++instance Substructure (Focused Tree) (Exactly <:*:> Roses <:*:> List <::> Tape Roses) where+	type Substance (Focused Tree) (Exactly <:*:> Roses <:*:> List <::> Tape Roses) = Construction List+	substructure = P_Q_T <-- \zipper -> case run @(->) <-|- run <-- lower zipper of+		Exactly x :*: children :*: up -> Store <--- Construct x (run children) :*: lift . T_U . ((<:*:> up) <-|-) . run . run++-- TODO: Refactor this instance, looks too complicated+-- TODO: it seem like this instance is wrong, when I try to update the focus, I lost andestors+instance Substructure (Focused Forest) (Exactly <:*:> Roses <:*:> List <::> Tape Roses) where+	type Substance (Focused Forest) (Exactly <:*:> Roses <:*:> List <::> Tape Roses) = Tape List <::> Nonempty Rose+	substructure :: forall e . Lens (Tape List <::> Nonempty Rose)+		((Tagged (Focused Forest) <:.> (Exactly <:*:> Roses <:*:> List <::> Tape Roses)) > e) e+	substructure = P_Q_T <-- \zipper -> case run @(->) <-|- run @(->) <-- lower zipper of+		Exactly root :*: down :*: up -> Store <--- TT focused :*: lift . updated where++			focused :: Tape List > Nonempty Rose e+			focused = case run <--- view <-- top @List <-- run up of+				Nothing -> Exactly tree <:*:> Reverse empty <:*:> empty+				Just (T_U (Exactly _ :*: T_U (Reverse left :*: right)))+					-> Exactly tree <:*:> Reverse (run left) <:*:> run right++			tree :: Nonempty Rose e+			tree = Construct root <-- run down++			updated :: (Tape List <::> Nonempty Rose) e -> (Exactly <:*:> Roses <:*:> List <::> Tape Roses) e+			updated (TT (T_U (Exactly (Construct new_root new_down) :*: T_U (Reverse left_ :*: right_)))) =+				Exactly new_root <:*:> unite new_down <:*:> TT+					<--- mutate <-- (update_sides (Reverse (TT left_) <:*:> TT right_) <-|-) <-- top @List <-- run up++			update_sides :: (Reverse Roses <:*:> Roses) e -> Tape Roses e -> Tape Roses e+			update_sides sides tape = replace <-- sides <-- sub @Rest <-- tape+ -- TODO: Try to use substructure @Left . substructure @Right . substructure @Right here-instance Substructure (Left Forest) (Exactly <:*:> Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses)) where-	type Substance (Left Forest) (Exactly <:*:> Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses)) = Reverse Roses-	substructure = P_Q_T <-- \zipper -> case run <-- lower zipper of-		Exactly x :*: T_U (down :*: T_U (left :*: rest)) ->-			Store <--- left :*: lift . (Exactly x <:*:>) . (down <:*:>) . (<:*:> rest)+-- instance Substructure (Left Siblings) (Exactly <:*:> Roses <:*:> List <::> Tape Roses) where+-- 	type Substance (Left Siblings) (Exactly <:*:> Roses <:*:> List <::> Tape Roses) = Reverse Roses+-- 	substructure = P_Q_T <-- \zipper -> case run @(->) <-|- run <-- lower zipper of+-- 		Exactly x :*: down :*: up -> Store+-- 			<--- (view (sub @Left) . view (sub @Rest) <-- up)+-- 				:*: \left' -> lift (Exactly x <:*:> down <:*:> mutate (mutate (constant left') (sub @Left)) (sub @Rest) up)  -- TODO: Try to use substructure  @Left . substructure @Right . substructure @Right . substructure @Right here-instance Substructure (Right Forest) (Exactly <:*:> Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses)) where-	type Substance (Right Forest) (Exactly <:*:> Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses)) = Roses-	substructure = P_Q_T <-- \zipper -> case run <-- lower zipper of-		Exactly x :*: T_U (down :*: T_U (left :*: T_U (right :*: rest))) ->-			Store <--- right :*: lift . (Exactly x <:*:>) . (down <:*:>) . (left <:*:>) . (<:*:> rest)+-- instance Substructure (Right Siblings) (Exactly <:*:> Roses <:*:> List <::> Tape Roses) where+-- 	type Substance (Right Siblings) (Exactly <:*:> Roses <:*:> List <::> Tape Roses) = Roses+	--substructure = P_Q_T <-- \zipper -> case run @(->) <-|-|-|- run @(->) <-|-|- run @(->) <-|- run <-- lower zipper of+	--	Exactly x :*: down :*: left :*: right :*: rest -> Store <--- right :*: lift . (Exactly x <:*:>) . (down <:*:>) . (left <:*:>) . (<:*:> rest) -instance Morphable (Into (Exactly <:*:> Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses))) (Construction List) where-	type Morphing (Into (Exactly <:*:> Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses))) (Construction List) =-		Exactly <:*:> Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses)-	morphing nonempty_rose_tree = case premorph nonempty_rose_tree of-		Construct x xs -> Exactly x <:*:> unite xs <:*:> empty <:*:> empty <:*:> empty+--instance Morphable (Into (Exactly <:*:> Roses <:*:> List <::> Tape Roses)) (Construction List) where+	--type Morphing (Into (Exactly <:*:> Roses <:*:> List <::> Tape Roses)) (Construction List) = Exactly <:*:> Roses <:*:> List <::> Tape Roses+	--morphing nonempty_rose_tree = case premorph nonempty_rose_tree of+		--Construct x xs -> Exactly x <:*:> unite xs <:*:> empty <:*:> empty <:*:> empty -instance Morphable (Rotate Up) (Exactly <:*:> Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses)) where-	type Morphing (Rotate Up) (Exactly <:*:> Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses)) =-		Maybe <::> (Exactly <:*:> Roses <:*:> Reverse Roses <:*:> Roses <:*:> (List <::> Tape Roses))-	morphing (premorph -> z) = TT <---- restruct <-|- identity @(->) <<- pop @List <~ run (view <-- sub @(Up Forest) <-- z) where+--instance Morphable (Rotate Up) (Exactly <:*:> Roses <:*:> List <::> Tape Roses) where+	--type Morphing (Rotate Up) (Exactly <:*:> Roses <:*:> List <::> Tape Roses) =+		--Maybe <::> (Exactly <:*:> Roses <:*:> List <::> Tape Roses)+	--morphing (premorph -> z) = TT <----- restruct <-|-- identity @(->) <-/- pop @List <~ run (view <-- sub @Ancestors <-- z) where+--+		---- TODO: Add type declaration+		--restruct (parents :*: parent) =+			--let child_node = extract <--- view <-- sub @Root <-- z in+			--let central_children = run <--- view <-- sub @Children <-- z in+			----let left_children = run @(->) <---- run <--- view <-- sub @(Left Siblings) <-- z in+			--let right_children = run <--- view <-- sub @(Right Siblings) <-- z in+			--view <-- sub @Root <-- parent+				-- <:*:> unite <-- left_children + point (Construct child_node central_children) + right_children+				-- <:*:> view <--- sub @(Left Branch) <--- view <-- sub @Rest <-- parent+				-- <:*:> view <--- sub @(Right Branch) <--- view <-- sub @Rest <-- parent+				-- <:*:> unite parents -		-- TODO: Add type declaration-		restruct (parents :*: parent) =-			let child_node = extract <--- view <-- sub @Root <-- z in-			let central_children = run <--- view <-- sub @(Down Forest) <-- z in-			let left_children = run @(->) <---- run <--- view <-- sub @(Left Forest) <-- z in-			let right_children = run <--- view <-- sub @(Right Forest) <-- z in-			view <-- sub @Root <-- parent-				<:*:> unite <-- left_children + point (Construct child_node central_children) + right_children-				<:*:> view <--- sub @Left <--- view <-- sub @Rest <-- parent-				<:*:> view <--- sub @Right <--- view <-- sub @Rest <-- parent-				<:*:> unite parents+instance Slidable Up (Exactly <:*:> Roses <:*:> List <::> Tape Roses) where+	type Sliding Up (Exactly <:*:> Roses <:*:> List <::> Tape Roses) = Maybe+	slide :: forall e . State > Zipper Rose e :> Maybe >>> ()+	slide = void . wrap . zoom @(Zipper Rose e) (sub @(Focused Tree)) . change . constant ======<< merging+		<-|---- wrap <--- zoom @(Zipper Rose e) <-- sub @(Focused Tree) <-- current+		<-*---- lift . extract ====<< wrap .:.. zoom @(Zipper Rose e) <--- sub @Ancestors+			<--- zoom <-- primary <-- overlook (pop @List) where++		merging :: Nonempty Rose e -> Tape (List <::> Nonempty Rose) e -> Nonempty Rose e+		merging x (T_U (Exactly p :*: T_U (Reverse ls :*: rs))) =+			-- TODO: This is wrong, we should add left part in reverse order+			Construct p <-- run ls + point x + run rs++instance Slidable Left (Exactly <:*:> Roses <:*:> List <::> Tape Roses) where+	type Sliding Left (Exactly <:*:> Roses <:*:> List <::> Tape Roses) = Maybe+	slide :: forall e . State > Zipper Rose e :> Maybe >>> ()+	slide = void <------- lift . extract+		=====<< wrap .:.. zoom @(Zipper Rose e)+			<----- sub @(Focused Forest)+			<----- zoom <---- primary <---- overlook+				<--- probably <-- slide @Left++instance Slidable Right (Exactly <:*:> Roses <:*:> List <::> Tape Roses) where+	type Sliding Right (Exactly <:*:> Roses <:*:> List <::> Tape Roses) = Maybe+	slide :: forall e . State > Zipper Rose e :> Maybe >>> ()+	slide = void <------- lift . extract+		=====<< wrap .:.. zoom @(Zipper Rose e)+			<----- sub @(Focused Forest)+			<----- zoom <---- primary <---- overlook+				<--- probably <-- slide @Right++instance Slidable Down (Exactly <:*:> Roses <:*:> List <::> Tape Roses) where+	type Sliding Down (Exactly <:*:> Roses <:*:> List <::> Tape Roses) = Maybe+	slide :: forall e . State > Zipper Rose e :> Maybe >>> ()+	slide = void . wrap . zoom @(Zipper Rose e) (sub @Ancestors) . zoom primary . overlook . push @List . ancestor+		====<< wrap . zoom @(Zipper Rose e) (sub @(Focused Tree)) . change . constant+		====<< lift . extract ====<< wrap .:.. zoom @(Zipper Rose e) <---- sub @(Focused Tree)+			<---- zoom <--- sub @Rest <--- zoom <-- primary <-- overlook (pop @List) where++		ancestor :: Construction List e -> Tape Roses e+		ancestor (Construct x xs) = Exactly x <:*:> Reverse <-- unite empty <:*:> unite xs

@@ -2,25 +2,25 @@ {-# LANGUAGE AllowAmbiguousTypes #-} module Pandora.Paradigm.Structure.Some.Splay where -import Pandora.Core.Functor (type (~>), type (>), type (>>>), type (>>>>>>))-import Pandora.Core.Interpreted (run)+import Pandora.Core.Functor (type (~>), type (>), type (>>>))+import Pandora.Core.Interpreted (run, (<~)) import Pandora.Pattern.Semigroupoid ((.)) import Pandora.Pattern.Kernel (constant)-import Pandora.Pattern.Category ((<--), (<---), (<----), (<-----), identity)+import Pandora.Pattern.Category ((<--), (<---), (<----), identity) import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-), (<-|---)))-import Pandora.Pattern.Functor.Bindable (Bindable ((=<<), (==<<), (===<<), (====<<)))+import Pandora.Pattern.Functor.Bindable (Bindable ((=<<), (==<<), (===<<))) import Pandora.Pattern.Transformer.Liftable (lift) import Pandora.Pattern.Transformer.Hoistable ((/|\)) import Pandora.Paradigm.Algebraic.Functor ((<-*-), extract, point, void)-import Pandora.Paradigm.Algebraic.Product (type (<:*:>), (<:*:>))+import Pandora.Paradigm.Algebraic.Product (type (<:*:>), (<:*:>), attached) import Pandora.Paradigm.Primary.Auxiliary (Horizontal (Left, Right)) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct)) import Pandora.Paradigm.Controlflow.Effect.Adaptable (adapt)-import Pandora.Paradigm.Controlflow.Effect.Transformer ((:>), wrap)+import Pandora.Paradigm.Controlflow.Effect.Transformer ((:>)) import Pandora.Paradigm.Inventory.Some.Optics (view, mutate) import Pandora.Paradigm.Inventory.Some.State (State, change, current)-import Pandora.Paradigm.Inventory (zoom, overlook)+import Pandora.Paradigm.Inventory (zoom) import Pandora.Paradigm.Schemes (TT (TT), type (<::>)) import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morphed, Morph (Rotate), premorph, rotate) import Pandora.Paradigm.Structure.Modification.Nonempty (Nonempty)@@ -83,13 +83,12 @@ 				) 			) --- TODO: Slidable (Left Zig) (Construction (Maybe <:*:> Maybe))+-- TODO: Slidable (Left > Zig) (Construction (Maybe <:*:> Maybe)) -- TODO: Slidable (Left > Zig Zig) (Construction (Maybe <:*:> Maybe)) -- TODO: Slidable (Right > Zig Zig) (Construction (Maybe <:*:> Maybe)) -- TODO: Slidable (Left > Zig Zag) (Construction (Maybe <:*:> Maybe)) -- TODO: Slidable (Right > Zig Zag) (Construction (Maybe <:*:> Maybe))--- TODO: Slidable (Left Zig) Binary--- TODO: Slidable (Right Zig) Binary+-- TODO: Slidable (Left > Zig) Binary -- TODO: Slidable (Left > Zig Zig) Binary -- TODO: Slidable (Right > Zig Zig) Binary -- TODO: Slidable (Left > Zig Zag) Binary@@ -107,6 +106,13 @@ 		===<< adapt <--- zoom @(Nonempty Binary element) 			<-- sub @(Left Branch) 			<-- current @(Binary element)++instance Slidable (Right > Zig) Binary where+	type Sliding (Right Zig) Binary = Maybe+	slide :: forall element . State > Binary element :> Maybe >>> ()+	slide = void . change @(Binary element) . constant . lift . attached+		=<< adapt . (slide @(Right > Zig) @(Nonempty Binary) <~)+		=<< adapt . run =<< current @(Binary element)  -- TODO: Morphing ... = Conclussion Error <::> Nonempty Binary instance Morphable (Rotate > Left > Zig Zig) (Construction (Maybe <:*:> Maybe)) where

@@ -2,35 +2,29 @@ module Pandora.Paradigm.Structure.Some.Stream where  import Pandora.Core.Impliable (imply)-import Pandora.Core.Functor (type (>), type (>>>), type (:=>)) import Pandora.Core.Interpreted (run) 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.Covariant (Covariant ((<-|-), (<-|--)))+import Pandora.Pattern.Functor.Traversable (Traversable ((<-/-))) import Pandora.Pattern.Functor.Extendable (Extendable ((<<=)))-import Pandora.Pattern.Functor.Bindable (Bindable ((=<<), (====<<)))-import Pandora.Pattern.Transformer.Lowerable (lower)-import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)), type (<:*:>))-import Pandora.Paradigm.Algebraic.Functor (extract, void, (.-*-))+import Pandora.Pattern.Functor.Bindable (Bindable ((=<<)))+import Pandora.Paradigm.Algebraic.Product ((:*:) ((:*:)), type (<:*:>), (<:*:>))+import Pandora.Paradigm.Algebraic.Functor (extract, empty, (-*)) import Pandora.Paradigm.Primary.Auxiliary (Horizontal (Left, Right)) import Pandora.Paradigm.Primary.Functor.Exactly (Exactly (Exactly))+import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct, constitute) import Pandora.Paradigm.Primary.Transformer.Reverse (Reverse (Reverse))-import Pandora.Paradigm.Controlflow.Effect.Adaptable (adapt)-import Pandora.Paradigm.Controlflow.Effect.Transformer ((:>)) import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Rotate), premorph, rotate)-import Pandora.Paradigm.Structure.Ability.Substructure (sub, Segment (Root, Rest))-import Pandora.Paradigm.Structure.Ability.Slidable (Slidable (Sliding, slide))-import Pandora.Paradigm.Structure.Interface.Zipper (Zippable (Breadcrumbs))+import Pandora.Paradigm.Structure.Interface.Zipper (Zippable (Breadcrumbs, fasten)) import Pandora.Paradigm.Structure.Interface.Stack (Stack (Topping, push, pop, top)) import Pandora.Paradigm.Structure.Modification.Tape (Tape)-import Pandora.Paradigm.Inventory.Some.State (State, change, current)+import Pandora.Paradigm.Inventory.Some.State (change, current) import Pandora.Paradigm.Inventory.Some.Store (Store (Store))-import Pandora.Paradigm.Inventory.Some.Optics (transwrap)-import Pandora.Paradigm.Inventory (zoom, overlook) import Pandora.Paradigm.Schemes.P_Q_T (P_Q_T (P_Q_T))+import Pandora.Paradigm.Schemes.TT (TT (TT)) import Pandora.Paradigm.Schemes.T_U (T_U (T_U)) import Pandora.Paradigm.Algebraic (point) @@ -38,6 +32,8 @@  instance Zippable (Construction Exactly) where 	type Breadcrumbs (Construction Exactly) = Reverse Stream <:*:> Stream+	-- TODO: It should not return Maybe since Stream is not empty, try to use Simplification (Fastenable structure) here+	fasten (Construct x xs) = Just <----- Exactly x <:*:> Reverse <-- extract xs <:*:> extract xs  -- TODO: Try to generalize to Extendable (Tape structure) instance {-# OVERLAPS #-} Extendable (->) (Tape Stream) where@@ -47,8 +43,8 @@ instance Stack (Construction Exactly) where 	type Topping (Construction Exactly) = Exactly 	top = P_Q_T <-- \xs -> Store <--- Exactly (extract xs) :*: \(Exactly new) -> Construct new <--- deconstruct xs-	pop = (\(Construct x xs) -> constant <-- Exactly x <-|- change @(Stream _) . constant <<- xs) =<< current-	push x = point x .-*- (change <-- Construct x . Exactly)+	pop = (\(Construct x xs) -> constant <-- Exactly x <-|-- change @(Stream _) . constant <-/- xs) =<< current+	push x = (change <-- Construct x . Exactly) -* point x  instance Morphable (Rotate Left) (Tape Stream) where 	type Morphing (Rotate Left) (Tape Stream) = Tape Stream@@ -60,5 +56,5 @@ 	morphing (run . premorph -> Exactly x :*: T_U (Reverse ls :*: rs)) = 		imply @(Tape Stream _) <--- extract rs <--- Construct x (point ls) <--- extract (deconstruct rs) -repeat :: a :=> Stream+repeat :: a -> Stream a repeat x = Construct x . Exactly <-- repeat x

@@ -44,6 +44,8 @@ 		=> source a b -> target (t (u (v a))) (t (u (v b))) 	(<-|-|-|-) s = ((<-|-) @(Betwixt (Betwixt source target) target) @target ((<-|-) @(Betwixt source (Betwixt source target)) @(Betwixt (Betwixt source target) target) @_ ((<-|-) @source @(Betwixt source (Betwixt source target)) @_ s))) +	-- TODO: create <-|-|-|-|-+ (<$>) :: Covariant source target t => source a b -> target (t a) (t b) (<$>) = (<-|-) 

@@ -19,6 +19,7 @@ infixl 7 -<<  class Covariant source target t => Distributive source target t where+	-- TODO: rename to <-\- 	(-<<) :: Covariant source target u => source a (t b) -> target (u a) (t (u b))  	(--<<), (---<<), (----<<), (-----<<), (------<<), (-------<<) :: Covariant source target u => source a (t b) -> target (u a) (t (u b))

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

@@ -10,36 +10,33 @@ > Let p :: (Monoidal u category category (:*:) (:*:), Monoidal u category category (:*:) (:*:)) => t a -> u a  > When providing a new instance, you should ensure it satisfies:-> * Numeratority of traversing: g . (f <<--) ≡ (g . f <<--)-> * Numeratority of sequencing: f . (identity <<--)= (identity <<--) . (f <-|-)+> * Numeratority of traversing: g . (f <-/--) ≡ (g . f <-/--)+> * Numeratority of sequencing: f . (identity <-/--)= (identity <-/--) . (f <-|-) > * Preserving point: p (point x) ≡ point x-> * Preserving apply: f (x <.-*- y) ≡ f x <.-*- f y+> * Preserving apply: f (x <-*- y) ≡ f x <-*- f y -} -infixl 4 <<-<<---infixl 1 <<--------infixl 2 <<-------infixl 3 <<------infixl 4 <<-----infixl 5 <<----infixl 6 <<---infixl 7 <<-+infixl 1 <-/------+infixl 2 <-/-----+infixl 3 <-/----+infixl 4 <-/---, <-/-/-+infixl 5 <-/--+infixl 6 <-/-  class Covariant source target t => Traversable source target t where-	(<<-) :: (Covariant source target u, Monoidal (Straight source) (Straight target) (:*:) (:*:) u) => source a (u b) -> target (t a) (u (t b))+	(<-/-) :: (Covariant source target u, Monoidal (Straight source) (Straight target) (:*:) (:*:) u) => source a (u b) -> target (t a) (u (t b)) -	(<<-------), (<<------), (<<-----), (<<----), (<<---), (<<--)+	(<-/-------), (<-/------), (<-/-----), (<-/----), (<-/---), (<-/--) 		:: (Covariant source target u, Monoidal (Straight source) (Straight target) (:*:) (:*:) u) 		=> source a (u b) -> target (t a) (u (t b))-	(<<-------) = (<<-)-	(<<------) = (<<-)-	(<<-----) = (<<-)-	(<<----) = (<<-)-	(<<---) = (<<-)-	(<<--) = (<<-)+	(<-/-------) = (<-/-)+	(<-/------) = (<-/-)+	(<-/-----) = (<-/-)+	(<-/----) = (<-/-)+	(<-/---) = (<-/-)+	(<-/--) = (<-/-) -(<<-<<-) :: forall t u v category a b .+(<-/-/-) :: forall t u v category a b . 	(Traversable category category t, Covariant category category u, Monoidal (Straight category) (Straight category) (:*:) (:*:) u, Traversable category category v) 	=> category a (u b) -> category (v (t a)) (u (v (t b)))-(<<-<<-) f = ((<<-) ((<<-) @category @category @t f))+(<-/-/-) f = ((<-/-) ((<-/-) @category @category @t f))

@@ -1,5 +1,6 @@ module Pandora.Pattern.Morphism (module Exports, Opposite) where +import Pandora.Pattern.Morphism.Trip as Exports import Pandora.Pattern.Morphism.Flip as Exports import Pandora.Pattern.Morphism.Straight as Exports 

@@ -19,5 +19,5 @@ instance (Category m, Covariant m m t) => Contravariant m (Flip m) t where 	(>-|-) f = Flip ((<-|-) f) -instance (Category m, Covariant m m t) => Covariant  (Flip m) (Flip m) t where+instance (Category m, Covariant m m t) => Covariant (Flip m) (Flip m) t where 	(<-|-) (Flip f) = Flip ((<-|-) f)

@@ -0,0 +1,8 @@+module Pandora.Pattern.Morphism.Trip where++import Pandora.Pattern.Semigroupoid (Semigroupoid ((.)))+import Pandora.Pattern.Category (Category (identity))+import Pandora.Pattern.Functor.Covariant (Covariant ((<-|-)))+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>-|-)))++newtype Trip (v :: * -> * -> * -> *) a b c = Trip (v c b a)

@@ -1,5 +1,5 @@ name:                pandora-version:             0.5.4+version:             0.5.5 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@@ -143,6 +143,7 @@     Pandora.Pattern     Pandora.Pattern.Betwixt     -- Different morphisms+    Pandora.Pattern.Morphism.Trip     Pandora.Pattern.Morphism.Flip     Pandora.Pattern.Morphism.Straight     -- Algebra typeclasses