pandora 0.4.0 → 0.4.1

raw patch · 46 files changed

+539/−296 lines, 46 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +25/−0
• Pandora/Paradigm/Controlflow/Effect/Interpreted.hs +36/−1
• Pandora/Paradigm/Controlflow/Effect/Transformer/Comonadic.hs +2/−2
• Pandora/Paradigm/Controlflow/Effect/Transformer/Monadic.hs +2/−2
• Pandora/Paradigm/Inventory.hs +1/−1
• Pandora/Paradigm/Inventory/Imprint.hs +1/−1
• Pandora/Paradigm/Inventory/Optics.hs +14/−11
• Pandora/Paradigm/Inventory/Store.hs +2/−3
• Pandora/Paradigm/Primary.hs +23/−3
• Pandora/Paradigm/Primary/Functor/Endo.hs +8/−1
• Pandora/Paradigm/Primary/Linear/Vector.hs +6/−6
• Pandora/Paradigm/Primary/Transformer/Backwards.hs +2/−2
• Pandora/Paradigm/Primary/Transformer/Construction.hs +14/−3
• Pandora/Paradigm/Primary/Transformer/Day.hs +4/−5
• Pandora/Paradigm/Primary/Transformer/Flip.hs +5/−2
• Pandora/Paradigm/Primary/Transformer/Instruction.hs +3/−3
• Pandora/Paradigm/Primary/Transformer/Jack.hs +3/−3
• Pandora/Paradigm/Primary/Transformer/Outline.hs +3/−3
• Pandora/Paradigm/Primary/Transformer/Reverse.hs +2/−2
• Pandora/Paradigm/Primary/Transformer/Tap.hs +2/−2
• Pandora/Paradigm/Schemes.hs +1/−0
• Pandora/Paradigm/Schemes/PQ_.hs +10/−0
• Pandora/Paradigm/Schemes/TU.hs +3/−3
• Pandora/Paradigm/Schemes/T_U.hs +5/−5
• Pandora/Paradigm/Structure.hs +17/−18
• Pandora/Paradigm/Structure/Ability.hs +0/−1
• Pandora/Paradigm/Structure/Ability/Focusable.hs +0/−18
• Pandora/Paradigm/Structure/Ability/Monotonic.hs +2/−2
• Pandora/Paradigm/Structure/Ability/Morphable.hs +32/−23
• Pandora/Paradigm/Structure/Ability/Substructure.hs +5/−13
• Pandora/Paradigm/Structure/Interface/Dictionary.hs +1/−13
• Pandora/Paradigm/Structure/Modification.hs +1/−0
• Pandora/Paradigm/Structure/Modification/Combinative.hs +3/−0
• Pandora/Paradigm/Structure/Modification/Prefixed.hs +18/−0
• Pandora/Paradigm/Structure/Some/Binary.hs +61/−48
• Pandora/Paradigm/Structure/Some/List.hs +108/−39
• Pandora/Paradigm/Structure/Some/Rose.hs +54/−27
• Pandora/Pattern.hs +1/−17
• Pandora/Pattern/Category.hs +4/−7
• Pandora/Pattern/Functor/Bivariant.hs +6/−3
• Pandora/Pattern/Functor/Covariant.hs +33/−0
• Pandora/Pattern/Functor/Divariant.hs +3/−1
• Pandora/Pattern/Functor/Invariant.hs +2/−0
• Pandora/Pattern/Functor/Representable.hs +2/−0
• Pandora/Pattern/Transformer/Hoistable.hs +6/−0
• pandora.cabal +3/−2

@@ -415,3 +415,28 @@ * Define `Matrix` datatype as combination of `Vector`'s * Define `|>` datatype to use it for combining `Substructure` instances * Define `Substructured` type synonymous as constraint kind++# 0.4.1+* Generalize `$` and `#` `Category`'s infix operators+* Add `Covariant` constraint in `Bivariant` and `Divariant` typeclasses definition+* Add infix version of `hoist` method in `Hoistable` typeclass - `/|\`+* Define `PQ_` joint schema exclusively for `Lens` type+* Change `Lens` representation - wrap it in `PQ_` joint schema+* Remove `|>` lens composition operator in favor of `.` `Category` method+* Rename `.|..`, `.|...`, `.|....` to `.#..`, `.#...`, `.#....` and move them to `Covariant` typeclass+* Change precedence for `||=` and `=||` infix operators+* Define precedence for `>-<` infix operator+* Move `|>` existential polymorphic type to `Core.Functor` module+* Remove `|>` existential polymorphic type and its Substructure instance+* Remove `lookup` and `discover` methods from `Dictionary` interface+* Define `lookup` method in `Morphable` ability module+* Remove `binary` expression from `Binary` module+* Define `Morphed` type synonymous as constraint kind+* Define `Combinative` type family+* Remove `Location` datatype in `Focusable` module+* Remove `Focusable` ability if favor of `Structure` typeclass+* Define `<$$`, `<$$$`, `<$$$$`, `$$>`, `$$$>`, `$$$$>` infix operators in `Covariant` typeclass+* Define `<$||=`, `<$$||=`, `<$$$||=`, `<$$$$||=` infix operators in `Interpreted` typeclass+* Define `=||$>`, =||$$>`, `=||$$$>`, `=||$$$$>` infix operators in `Interpreted` typeclass++# 0.4.2

@@ -1,10 +1,13 @@ module Pandora.Paradigm.Controlflow.Effect.Interpreted where +import Pandora.Core.Functor (type (:.), type (:=)) import Pandora.Pattern.Category ((.))-import Pandora.Pattern.Functor.Covariant (Covariant)+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>), (<$$$>), (<$$$$>))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Paradigm.Primary.Functor.Function () +infixr 2 ||=, =||+ type family Schematic (c :: (* -> *) -> k) (t :: * -> *) = (r :: (* -> *) -> * -> *) | r -> t  class Interpreted t where@@ -18,6 +21,38 @@  	(=||) :: Interpreted u => (t a -> u b) -> Primary t a -> Primary u b 	(=||) f = run . f . unite++	(<$||=) :: (Covariant j, Interpreted u)+		=> (Primary t a -> Primary u b) -> j := t a -> j := u b+	f <$||= x = (f ||=) <$> x++	(<$$||=) :: (Covariant j, Covariant k, Interpreted u)+		=> (Primary t a -> Primary u b) -> j :. k := t a -> j :. k := u b+	f <$$||= x = (f ||=) <$$> x++	(<$$$||=) :: (Covariant j, Covariant k, Covariant l, Interpreted u)+		=> (Primary t a -> Primary u b) -> j :. k :. l := t a -> j :. k :. l := u b+	f <$$$||= x = (f ||=) <$$$> x++	(<$$$$||=) :: (Covariant j, Covariant k, Covariant l, Covariant m, Interpreted u)+		=> (Primary t a -> Primary u b) -> j :. k :. l :. m := t a -> j :. k :. l :. m := u b+	f <$$$$||= x = (f ||=) <$$$$> x++	(=||$>) :: (Covariant j, Interpreted u)+		=> (t a -> u b) -> j := Primary t a -> j := Primary u b+	f =||$> x = (f =||) <$> x++	(=||$$>) :: (Covariant j, Covariant k, Interpreted u)+		=> (t a -> u b) -> j :. k := Primary t a -> j :. k := Primary u b+	f =||$$> x = (f =||) <$$> x++	(=||$$$>) :: (Covariant j, Covariant k, Covariant l, Interpreted u)+		=> (t a -> u b) -> j :. k :. l := Primary t a -> j :. k :. l := Primary u b+	f =||$$$> x = (f =||) <$$$> x++	(=||$$$$>) :: (Covariant j, Covariant k, Covariant l, Covariant m, Interpreted u)+		=> (t a -> u b) -> j :. k :. l :. m := Primary t a -> j :. k :. l :. m := Primary u b+	f =||$$$$> x = (f =||) <$$$$> x  (-=:) :: (Liftable t, Interpreted (t u), Interpreted (t v), Covariant u) 	=> (t u a -> t v b) -> u a -> Primary (t v) b

@@ -15,7 +15,7 @@ import Pandora.Pattern.Functor.Extendable (Extendable ((=>>))) import Pandora.Pattern.Functor.Comonad (Comonad) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))-import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))+import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite))  class Interpreted t => Comonadic t where@@ -58,7 +58,7 @@ 	lower (TC x) = lower x  instance Hoistable (Schematic Comonad t) => Hoistable ((:<) t) where-	hoist f (TC x) = TC $ hoist f x+	f /|\ TC x = TC $ f /|\ x  instance (Interpreted (Schematic Comonad t u)) => Interpreted (t :< u) where 	type Primary (t :< u) a = Primary (Schematic Comonad t u) a

@@ -16,7 +16,7 @@ import Pandora.Pattern.Functor.Extendable (Extendable ((=>>))) import Pandora.Pattern.Functor.Monad (Monad) import Pandora.Pattern.Transformer.Liftable (Liftable (lift))-import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))+import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite))  class Interpreted t => Monadic t where@@ -62,7 +62,7 @@ 	lift = TM . lift  instance Hoistable (Schematic Monad t) => Hoistable ((:>) t) where-	hoist f (TM x) = TM $ hoist f x+	f /|\ TM x = TM $ f /|\ x  instance (Interpreted (Schematic Monad t u)) => Interpreted (t :> u) where 	type Primary (t :> u) a = Primary (Schematic Monad t u) a

@@ -38,7 +38,7 @@  zoom :: Stateful bg t => Lens bg ls -> State ls ~> t zoom lens less = let restruct f v = f <-> identity $ run less v-	in adapt . State $ (|- restruct) . run . lens+	in adapt . State $ (|- restruct) . run . run lens  (=<>) :: Stateful src t => src :-. tgt -> tgt -> t src lens =<> new = modify $ set lens new

@@ -29,7 +29,7 @@ 	extract (Imprint x) = x zero  instance Divariant Imprint where-	(>->) ab cd bc = (ab >-> cd) ||= bc+	(>->) ab cd bc = ab >-> cd ||= bc  instance Semigroup e => Extendable (Imprint e) where 	Imprint x =>> f = Imprint $ \e -> f $ Imprint $ x . (e +)

@@ -1,14 +1,17 @@+{-# OPTIONS_GHC -fno-warn-orphans #-}+ module Pandora.Paradigm.Inventory.Optics where -import Pandora.Core.Functor (type (:=>))-import Pandora.Pattern.Category ((.), ($))+import Pandora.Pattern.Category (Category (identity, (.), ($))) import Pandora.Pattern.Functor.Covariant ((<$)) import Pandora.Pattern.Functor.Extractable (Extractable (extract)) import Pandora.Pattern.Functor.Representable (Representable (Representation, (<#>), tabulate)) import Pandora.Pattern.Object.Setoid (Setoid ((==)))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run) import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:))) import Pandora.Paradigm.Primary.Object.Boolean ((?)) import Pandora.Paradigm.Inventory.Store (Store (Store), position, look, retrofit)+import Pandora.Paradigm.Schemes.PQ_ (PQ_ (PQ_))  infixr 0 :-. infixr 0 :~.@@ -16,27 +19,27 @@ type (:-.) src tgt = Lens src tgt  -- Reference to taret within some source-type Lens src tgt = src :=> Store tgt+type Lens = PQ_ (->) Store +instance Category Lens where+	identity = PQ_ $ \src -> Store $ src :*: identity+	PQ_ to . PQ_ from = PQ_ $ \src -> src <$ (to . position $ from src)+ -- Lens as natural transformation type (:~.) src tgt = forall a . Lens (src a) (tgt a) --- | Lens composition infix operator-(|>) :: Lens src tgt -> Lens tgt new -> Lens src new-(|>) from to src = src <$ (to . position $ from src)- -- | Get the target of a lens view :: Lens src tgt -> src -> tgt-view lens = position . lens+view lens = position . run lens  -- | Replace the target of a lens set :: Lens src tgt -> tgt -> src -> src-set lens new = look new . lens+set lens new = look new . run lens  -- | Modify the target of a lens over :: Lens src tgt -> (tgt -> tgt) -> src -> src-over lens f = extract . retrofit f . lens+over lens f = extract . retrofit f . run lens  -- | Representable based lens represent :: (Representable t, Setoid (Representation t)) => Representation t -> t a :-. a-represent r x = Store $ (r <#> x) :*: \new -> tabulate (\r' -> r' == r ? new $ r' <#> x)+represent r = PQ_ $ \x -> Store $ r <#> x :*: \new -> tabulate (\r' -> r' == r ? new $ r' <#> x)

@@ -3,9 +3,8 @@ module Pandora.Paradigm.Inventory.Store where  import Pandora.Core (type (:.), type (:=), type (<:=), type (~>))-import Pandora.Pattern ((.|..)) import Pandora.Pattern.Category (identity, (.), ($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>), (.#..))) import Pandora.Pattern.Functor.Extractable (Extractable (extract)) import Pandora.Pattern.Functor.Extendable (Extendable ((=>>))) import Pandora.Pattern.Functor.Comonad (Comonad)@@ -28,7 +27,7 @@ 	extract = (|- ($)) . run  instance Extendable (Store s) where-	Store x =>> f = Store $ f <$$> (Store .|.. (-| identity)) <$> x+	Store x =>> f = Store $ f <$$> Store .#.. (-| identity) <$> x  instance Comonad (Store s) where 

@@ -8,14 +8,18 @@ import Pandora.Paradigm.Primary.Object as Exports  import Pandora.Core.Functor (type (:=))-import Pandora.Pattern.Category (Category ((.), ($), identity))+import Pandora.Pattern.Category (Category ((.), ($), (#), identity)) import Pandora.Pattern.Functor.Covariant (Covariant ((<$>))) import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<))) import Pandora.Pattern.Functor.Extractable (Extractable (extract))+import Pandora.Pattern.Transformer.Liftable (lift)+import Pandora.Pattern.Transformer.Lowerable (lower) import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (||=))-import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>))-import Pandora.Paradigm.Schemes.T_U (type (<:.:>))+import Pandora.Paradigm.Inventory.Store (Store (Store))+import Pandora.Paradigm.Schemes (TU (TU), PQ_ (PQ_), type (<:.>), type (<:.:>))+import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (resolve)) import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Into), premorph)+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substructural, substructure))  instance Category (Flip (->)) where 	identity = Flip identity@@ -88,3 +92,19 @@ 	morphing (run . premorph -> Nothing :*: Just y) = Right y 	morphing (run . premorph -> Just x :*: Nothing) = Left x 	morphing (run . premorph -> Nothing :*: Nothing) = End++instance Substructure Left Wye where+	type Substructural Left Wye = Maybe+	substructure = PQ_ $ \new -> case lower new of+		End -> Store $ Nothing :*: lift . resolve Left End+		Left x -> Store $ Just x :*: lift . resolve Left End+		Right y -> Store $ Nothing :*: (lift # Right y !)+		Both x y -> Store $ Just x :*: lift . resolve (Both % y) (Right y)++instance Substructure Right Wye where+	type Substructural Right Wye = Maybe+	substructure = PQ_ $ \new -> case lower new of+		End -> Store $ Nothing :*: lift . resolve Right End+		Left x -> Store $ Nothing :*: (lift # Left x !)+		Right y -> Store $ Just y :*: lift . resolve Right End+		Both x y -> Store $ Just y :*: lift . resolve (Both x) (Left x)

@@ -2,14 +2,21 @@  import Pandora.Pattern.Category (identity, (.), (#)) import Pandora.Pattern.Functor.Invariant (Invariant ((>-<)))+import Pandora.Pattern.Functor.Divariant ((>->)) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Monoid (Monoid (zero))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite, (||=))) import Pandora.Paradigm.Primary.Functor.Function ()  newtype Endo a = Endo { endo :: a -> a } +instance Interpreted Endo where+	type Primary Endo a = a -> a+	run ~(Endo x) = x+	unite = Endo+ instance Invariant Endo where-	f >-< g = \(Endo x) -> Endo (f . x . g)+	f >-< g = (g >-> f ||=)  instance Semigroup (Endo a) where 	Endo f + Endo g = Endo # g . f

@@ -3,13 +3,13 @@ module Pandora.Paradigm.Primary.Linear.Vector where  import Pandora.Pattern.Category (($), (#))+import Pandora.Pattern.Functor.Pointable (point) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Ringoid (Ringoid ((*))) import Pandora.Pattern.Object.Monoid (Monoid (zero)) import Pandora.Pattern.Object.Quasiring (Quasiring (one)) import Pandora.Pattern.Object.Group (Group (invert)) import Pandora.Pattern.Object.Setoid (Setoid ((==)))-import Pandora.Pattern.Functor.Pointable (point) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe) import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)), type (:*:)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction)@@ -23,13 +23,13 @@ 	Vector :: a -> Vector r a -> Vector (a :*: r) a  instance Semigroup a => Semigroup (Vector a a) where-	Scalar x + Scalar y = Scalar $ x + y+	~(Scalar x) + ~(Scalar y) = Scalar $ x + y  instance (Semigroup a, Semigroup r, Semigroup (a :*: r), Semigroup (Vector r a)) => Semigroup (Vector (a :*: r) a) where 	Vector x xs + Vector y ys = Vector # x + y # xs + ys  instance Ringoid a => Ringoid (Vector a a) where-	Scalar x * Scalar y = Scalar $ x * y+	~(Scalar x) * ~(Scalar y) = Scalar $ x * y  instance (Ringoid a, Ringoid r, Ringoid (a :*: r), Ringoid (Vector r a)) => Ringoid (Vector (a :*: r) a) where 	Vector x xs * Vector y ys = Vector # x * y # xs * ys@@ -47,19 +47,19 @@ 	one = Vector one one  instance Group a => Group (Vector a a) where-	invert (Scalar x) = Scalar $ invert x+	invert ~(Scalar x) = Scalar $ invert x  instance (Group a, Group r, Group (a :*: r), Group (Vector r a)) => Group (Vector (a :*: r) a) where 	invert (Vector x xs) = Vector # invert x # invert xs  instance Setoid a => Setoid (Vector a a) where-	Scalar x == Scalar y = x == y+	~(Scalar x) == ~(Scalar y) = x == y  instance (Setoid a, Setoid (Vector r a)) => Setoid (Vector (a :*: r) a) where 	Vector x xs == Vector y ys = (x == y) * (xs == ys)  instance Monotonic a (Vector a a) where-	reduce f r (Scalar x) = f x r+	reduce f r ~(Scalar x) = f x r  instance Monotonic a (Vector r a) => Monotonic a (Vector (a :*: r) a) where 	reduce f r (Vector x xs) = reduce f # f x r # xs

@@ -10,7 +10,7 @@ import Pandora.Pattern.Functor.Distributive (Distributive ((>>-))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))-import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))+import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Paradigm.Primary.Functor.Function ((&)) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite)) @@ -49,4 +49,4 @@ 	lower = run  instance Hoistable Backwards where-	hoist f (Backwards x) = Backwards $ f x+	f /|\ Backwards x = Backwards $ f x

@@ -1,7 +1,9 @@+{-# LANGUAGE UndecidableInstances #-}+ module Pandora.Paradigm.Primary.Transformer.Construction where  import Pandora.Core.Functor (type (:.), type (:=), type (:=>), type (~>))-import Pandora.Pattern.Category (($), (#))+import Pandora.Pattern.Category ((.), ($), (#)) import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>))) import Pandora.Pattern.Functor.Avoidable (Avoidable (empty)) import Pandora.Pattern.Functor.Pointable (Pointable (point))@@ -14,12 +16,15 @@ import Pandora.Pattern.Functor.Monad (Monad) import Pandora.Pattern.Functor.Comonad (Comonad) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))-import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))+import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\), hoist)) import Pandora.Pattern.Object.Setoid (Setoid ((==))) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Ringoid ((*)) import Pandora.Pattern.Object.Monoid (Monoid (zero)) import Pandora.Paradigm.Primary.Functor.Function ()+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)+import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (reduce))+import Pandora.Paradigm.Schemes (type (<:.>))  infixr 7 .-+ @@ -54,7 +59,7 @@ 	lower x = extract <$> deconstruct x  instance Hoistable Construction where-	hoist f x = Construct # extract x $ f # hoist f <$> deconstruct x+	f /|\ x = Construct # extract x $ f # hoist f <$> deconstruct x  instance (Setoid a, forall b . Setoid b => Setoid (t b), Covariant t) => Setoid (Construction t a) where 	x == y = (extract x == extract y) * (deconstruct x == deconstruct y)@@ -64,6 +69,12 @@  instance (Monoid a, forall b . Semigroup b => Monoid (t b), Covariant t) => Monoid (Construction t a) where 	zero = Construct zero zero++instance Monotonic a (t :. Construction t := a) => Monotonic a (Construction t a) where+	reduce f r ~(Construct x xs) = f x $ reduce f r xs++instance Monotonic a (t :. Construction t := a) => Monotonic a (t <:.> Construction t := a) where+	reduce f r = reduce f r . run  deconstruct :: Construction t a -> t :. Construction t := a deconstruct ~(Construct _ xs) = xs

@@ -1,21 +1,20 @@ module Pandora.Paradigm.Primary.Transformer.Day where -import Pandora.Pattern ((.|..)) import Pandora.Pattern.Category (($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (.#..))) import Pandora.Pattern.Functor.Pointable (Pointable (point)) import Pandora.Pattern.Functor.Extractable (Extractable (extract)) import Pandora.Pattern.Functor.Applicative (Applicative ((<*>))) import Pandora.Pattern.Functor.Extendable (Extendable ((=>>))) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))-import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))+import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Paradigm.Primary.Functor.Function ((!!)) import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)))  data Day t u a = forall b c . Day (t b) (u c) (b -> c -> a)  instance Covariant (Day t u) where-	f <$> Day tb uc g = Day tb uc # f .|.. g+	f <$> Day tb uc g = Day tb uc # f .#.. g  instance (Pointable t, Pointable u) => Pointable (Day t u) where 	point x = Day # point () # point () # (x !!)@@ -34,4 +33,4 @@ 	lower (Day tb uc bca) = bca (extract tb) <$> uc  instance Hoistable (Day t) where-	hoist g (Day tb uc bca) = Day tb # g uc # bca+	g /|\ Day tb uc bca = Day tb # g uc # bca

@@ -1,5 +1,8 @@+{-# LANGUAGE UndecidableInstances #-}+ module Pandora.Paradigm.Primary.Transformer.Flip where +import Pandora.Pattern.Functor.Covariant (Covariant) import Pandora.Pattern.Functor.Bivariant (Bivariant ((<->))) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite, (||=))) @@ -10,5 +13,5 @@ 	run ~(Flip x) = x 	unite = Flip -instance Bivariant v => Bivariant (Flip v) where-	f <-> g = \x -> (g <-> f) ||= x+instance (forall i . Covariant (Flip v i), Bivariant v) => Bivariant (Flip v) where+	f <-> g = (g <-> f ||=)

@@ -14,7 +14,7 @@ import Pandora.Pattern.Functor.Monad (Monad) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))-import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))+import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\), hoist)) import Pandora.Paradigm.Primary.Functor.Function ()  data Instruction t a = Enter a | Instruct (t :. Instruction t := a)@@ -55,5 +55,5 @@ 	lower (Instruct xs) = xs >>= lower  instance (forall v . Covariant v) => Hoistable Instruction where-	hoist _ (Enter x) = Enter x-	hoist f (Instruct xs) = Instruct $ hoist f <$> f xs+	_ /|\ Enter x = Enter x+	f /|\ Instruct xs = Instruct $ hoist f <$> f xs

@@ -12,7 +12,7 @@ import Pandora.Pattern.Functor.Bindable (Bindable ((>>=))) import Pandora.Pattern.Functor.Extendable (Extendable ((=>>))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift))-import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))+import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Pattern.Object.Setoid (Setoid ((==))) import Pandora.Pattern.Object.Chain (Chain ((<=>))) import Pandora.Paradigm.Primary.Functor.Function ()@@ -65,8 +65,8 @@ 	lift = Other  instance Hoistable Jack where-	hoist _ (It x) = It x-	hoist f (Other x) = Other $ f x+	_ /|\ It x = It x+	f /|\ Other x = Other $ f x  instance (Setoid a, Setoid (t a)) => Setoid (Jack t a) where 	It x == It y = x == y

@@ -6,7 +6,7 @@ import Pandora.Pattern.Functor.Extractable (Extractable (extract)) import Pandora.Pattern.Functor.Applicative (Applicative ((<*>))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift))-import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))+import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite)) import Pandora.Paradigm.Primary.Functor.Function ((%)) @@ -33,8 +33,8 @@ 	lift t = Outlined t (Line identity)  instance Hoistable Outline where-	hoist _ (Line x) = Line x-	hoist f (Outlined x y) = Outlined # f x # hoist f y+	_ /|\ Line x = Line x+	f /|\ Outlined x y = Outlined # f x # f /|\ y  instance (Extractable t, Pointable t, Applicative t) => Interpreted (Outline t) where 	type Primary (Outline t) a = t a

@@ -10,7 +10,7 @@ import Pandora.Pattern.Functor.Distributive (Distributive ((>>-))) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))-import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))+import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Paradigm.Primary.Transformer.Backwards (Backwards (Backwards)) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite)) @@ -49,4 +49,4 @@ 	lower = run  instance Hoistable Reverse where-	hoist f (Reverse x) = Reverse # f x+	f /|\ Reverse x = Reverse # f x

@@ -11,7 +11,7 @@ import Pandora.Pattern.Functor.Extendable (Extendable ((=>>))) import Pandora.Pattern.Functor.Bindable (Bindable ((>>=))) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))-import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))+import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Paradigm.Primary.Functor.Function ((%))  data Tap t a = Tap a (t a)@@ -41,4 +41,4 @@ 	lower (Tap _ xs) = xs  instance Hoistable Tap where-	hoist f (Tap x xs) = Tap x # f xs+	f /|\ Tap x xs = Tap x # f xs

@@ -2,6 +2,7 @@  module Pandora.Paradigm.Schemes (module Exports) where +import Pandora.Paradigm.Schemes.PQ_ as Exports import Pandora.Paradigm.Schemes.U_T as Exports import Pandora.Paradigm.Schemes.T_U as Exports import Pandora.Paradigm.Schemes.UTU as Exports

@@ -0,0 +1,10 @@+module Pandora.Paradigm.Schemes.PQ_ where++import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite))++newtype PQ_ p q a b = PQ_ (p a (q b a))++instance Interpreted (PQ_ p q a) where+	type Primary (PQ_ p q a) b = p a (q b a)+	run ~(PQ_ x) = x+	unite = PQ_

@@ -14,7 +14,7 @@ import Pandora.Pattern.Functor.Bindable (Bindable ((>>=), join)) import Pandora.Pattern.Transformer.Liftable (Liftable (lift)) import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))-import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))+import Pandora.Pattern.Transformer.Hoistable (Hoistable ((/|\))) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite))  newtype TU ct cu t u a = TU (t :. u := a)@@ -64,5 +64,5 @@ 	lower (TU x) = extract x  instance Covariant t => Hoistable (TU Covariant Covariant t) where-	hoist :: u ~> v -> (t <:.> u ~> t <:.> v)-	hoist f (TU x) = TU $ f <$> x+	(/|\) :: u ~> v -> (t <:.> u ~> t <:.> v)+	f /|\ TU x = TU $ f <$> x

@@ -21,11 +21,11 @@ 	run ~(T_U x) = x 	unite = T_U -instance (Bivariant p, Covariant t, Covariant u) => Covariant (t <:.:> u := p) where-	f <$> x = ((f <$>) <-> (f <$>)) ||= x+instance (forall i . Covariant (p i), Bivariant p, Covariant t, Covariant u) => Covariant (t <:.:> u := p) where+	f <$> x = (f <$>) <-> (f <$>) ||= x  instance (Divariant p, Contravariant t, Covariant u) => Covariant (t >:.:> u := p) where-	f <$> x = ((f >$<) >-> (f <$>)) ||= x+	f <$> x = (f >$<) >-> (f <$>) ||= x -instance (Bivariant p, Contravariant t, Contravariant u) => Contravariant (t >:.:< u := p) where-	f >$< x = ((f >$<) <-> (f >$<)) ||= x+instance (forall i . Covariant (p i), Bivariant p, Contravariant t, Contravariant u) => Contravariant (t >:.:< u := p) where+	f >$< x = (f >$<) <-> (f >$<) ||= x

@@ -12,20 +12,22 @@ import Pandora.Pattern.Functor.Extractable (extract) import Pandora.Pattern.Functor.Pointable (point) import Pandora.Pattern.Transformer.Liftable (lift)+import Pandora.Pattern.Transformer.Lowerable (lower) import Pandora.Pattern.Object.Semigroup ((+)) import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (||=))-import Pandora.Paradigm.Inventory.Optics ((|>))+import Pandora.Paradigm.Inventory.Optics () import Pandora.Paradigm.Inventory.Store (Store (Store)) import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False)) import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity)) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing))-import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag)) import Pandora.Paradigm.Primary.Functor.Predicate (Predicate (Predicate)) import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)), type (:*:), attached) import Pandora.Paradigm.Primary.Functor.Wye (Wye (Both, Left, Right, End)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct))+import Pandora.Paradigm.Primary.Transformer.Flip (Flip (Flip)) import Pandora.Paradigm.Primary.Transformer.Tap (Tap (Tap)) import Pandora.Paradigm.Schemes.TU (type (<:.>))+import Pandora.Paradigm.Schemes.PQ_ (PQ_ (PQ_))  instance Monotonic s a => Monotonic s (s :*: a) where 	reduce f r x = reduce f # f (attached x) r # extract x@@ -33,15 +35,10 @@ instance Nullable Maybe where 	null = Predicate $ \case { Just _ -> True ; _ -> False } -instance Substructure Right (Product s) where-	type Substructural Right (Product s) = Identity-	substructure (extract . run -> s :*: x) =-		Store $ Identity x :*: lift . (s :*:) . extract- instance Covariant t => Substructure Tail (Tap t) where 	type Substructural Tail (Tap t) = t-	substructure (extract . run -> Tap x xs) =-		Store $ xs :*: lift . Tap x+	substructure = PQ_ $ \tap -> case extract # run tap of+		Tap x xs -> Store $ xs :*: lift . Tap x  instance Morphable (Into (Preorder (Construction Maybe))) (Construction Wye) where 	type Morphing (Into (Preorder (Construction Maybe))) (Construction Wye) = Construction Maybe@@ -68,19 +65,21 @@ 	type Morphing (Into (o ds)) Binary = Maybe <:.> Morphing (Into (o ds)) (Construction Wye) 	morphing (premorph -> xs) = comap (into @(o ds)) ||= xs -instance Focusable Left (Product s) where-	type Focusing Left (Product s) a = s-	focusing (extract -> s :*: x) = Store $ s :*: Tag . (:*: x)+instance Substructure Left (Flip Product a) where+	type Substructural Left (Flip Product a) = Identity+	substructure = PQ_ $ \product -> case run # lower product of+		s :*: x -> Store $ Identity s :*: lift . Flip . (:*: x) . extract -instance Focusable Right (Product s) where-	type Focusing Right (Product s) a = a-	focusing (extract -> s :*: x) = Store $ x :*: Tag . (s :*:)+instance Substructure Right (Product s) where+	type Substructural Right (Product s) = Identity+	substructure = PQ_ $ \product -> case lower product of+		s :*: x -> Store $ Identity x :*: lift . (s :*:) . extract  instance Accessible s (s :*: a) where-	access ~(s :*: x) = Store $ s :*: (:*: x)+	access = PQ_ $ \(s :*: x) -> Store $ s :*: (:*: x)  instance Accessible a (s :*: a) where-	access ~(s :*: x) = Store $ x :*: (s :*:)+	access = PQ_ $ \(s :*: x) -> Store $ x :*: (s :*:)  instance {-# OVERLAPS #-} Accessible b a => Accessible b (s :*: a) where-	access = access @a |> access @b+	access = access @b . access @a

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

@@ -1,18 +0,0 @@-{-# LANGUAGE AllowAmbiguousTypes #-}--module Pandora.Paradigm.Structure.Ability.Focusable where--import Pandora.Pattern.Category ((.))-import Pandora.Pattern.Functor.Covariant (comap)-import Pandora.Pattern.Functor.Extractable (extract)-import Pandora.Paradigm.Inventory.Optics (type (:-.))-import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag))--class Focusable f t where-	type Focusing (f :: * -> k) (t :: * -> *) a-	focusing :: Tagged f (t a) :-. Focusing f t a--focus :: forall f t a . Focusable f t => t a :-. Focusing f t a-focus = comap extract . focusing . Tag @f--data Location a = Root a | Head a

@@ -1,7 +1,7 @@ module Pandora.Paradigm.Structure.Ability.Monotonic where -import Pandora.Pattern ((.|..)) import Pandora.Pattern.Category ((#))+import Pandora.Pattern.Functor.Covariant ((.#..)) import Pandora.Paradigm.Primary.Functor.Function ((!))  class Monotonic a e where@@ -10,7 +10,7 @@  	-- | Version of `reduce` which ignores accumulator 	resolve :: (a -> r) -> r -> e -> r-	resolve g = reduce # g .|.. (!)+	resolve g = reduce # g .#.. (!)  instance Monotonic a a where 	reduce f r x = f x r

@@ -10,6 +10,7 @@ import Pandora.Paradigm.Primary.Functor (Comparison) import Pandora.Paradigm.Primary.Functor.Convergence (Convergence (Convergence)) import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity))+import Pandora.Paradigm.Primary.Functor.Maybe (Maybe) import Pandora.Paradigm.Primary.Functor.Predicate (Predicate, equate) import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)), type (:*:)) import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag))@@ -17,44 +18,52 @@ import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>)) import Pandora.Paradigm.Schemes.T_U (T_U (T_U), type (<:.:>)) -class Morphable f t | f t -> t where-	type Morphing (f :: k) (t :: * -> *) :: * -> *-	morphing :: Tagged f <:.> t ~> Morphing f t+class Morphable mod struct | mod struct -> struct where+	type Morphing (mod :: k) (struct :: * -> *) :: * -> *+	morphing :: Tagged mod <:.> struct ~> Morphing mod struct -morph :: forall f t . Morphable f t => t ~> Morphing f t-morph = morphing . TU . Tag @f+type Morphed mod struct result = (Morphable mod struct, Morphing mod struct ~ result) -premorph :: Morphable f t => Tagged f <:.> t ~> t+morph :: forall mod struct . Morphable mod struct => struct ~> Morphing mod struct+morph = morphing . TU . Tag @mod++premorph :: Morphable mod struct => Tagged mod <:.> struct ~> struct premorph = extract . run  data Walk a = Preorder a | Inorder a | Postorder a | Levelorder a -data Morph a = Rotate a | Into a | Insert a | Push a | Pop a | Delete a | Find a | Lookup a | Element a+data Morph a = Rotate a | Into a | Insert a | Push a | Pop a | Delete a | Find a | Lookup a | Vary a | Key a | Element a  data Occurrence a = All a | First a  data Vertical a = Up a | Down a -rotate :: forall f t . Morphable (Rotate f) t => t ~> Morphing (Rotate f) t-rotate = morphing . TU . Tag @(Rotate f)+rotate :: forall mod struct . Morphable (Rotate mod) struct => struct ~> Morphing (Rotate mod) struct+rotate = morphing . TU . Tag @(Rotate mod) -into :: forall f t . Morphable (Into f) t => t ~> Morphing (Into f) t-into = morphing . TU . Tag @(Into f)+into :: forall mod struct . Morphable (Into mod) struct => struct ~> Morphing (Into mod) struct+into = morphing . TU . Tag @(Into mod) -insert :: forall f t a . (Morphable (Insert f) t, Morphing (Insert f) t ~ (Identity <:.:> t := (->))) => a :=:=> t-insert new xs = run # morph @(Insert f) xs # Identity new+insert :: forall mod struct a . Morphed (Insert mod) struct (Identity <:.:> struct := (->)) => a :=:=> struct+insert new xs = run # morph @(Insert mod) xs # Identity new -item :: forall f t a . (Morphable f t, Morphing f t ~ (Identity <:.:> t := (->))) => a :=:=> t-item new xs = run # morph @f xs # Identity new+item :: forall mod struct a . Morphed mod struct (Identity <:.:> struct := (->)) => a :=:=> struct+item new xs = run # morph @mod xs # Identity new -collate :: forall f t a . (Chain a, Morphable f t, Morphing f t ~ ((Identity <:.:> Comparison := (:*:)) <:.:> t := (->))) => a :=:=> t-collate new xs = run # morph @f xs # T_U (Identity new :*: Convergence (<=>))+collate :: forall mod struct a . (Chain a, Morphed mod struct ((Identity <:.:> Comparison := (:*:)) <:.:> struct := (->))) => a :=:=> struct+collate new xs = run # morph @mod xs # T_U (Identity new :*: Convergence (<=>)) -delete :: forall f t a . (Setoid a, Morphable (Delete f) t, Morphing (Delete f) t ~ (Predicate <:.:> t := (->))) => a :=:=> t-delete x xs = run # morph @(Delete f) xs # equate x+delete :: forall mod struct a . (Setoid a, Morphed (Delete mod) struct (Predicate <:.:> struct := (->))) => a :=:=> struct+delete x xs = run # morph @(Delete mod) xs # equate x -filter :: forall f t a . (Morphable (Delete f) t, Morphing (Delete f) t ~ (Predicate <:.:> t := (->))) => Predicate a -> t a -> t a-filter p xs = run # morph @(Delete f) xs # p+filter :: forall mod struct a . (Morphed (Delete mod) struct (Predicate <:.:> struct := (->))) => Predicate a -> struct a -> struct a+filter p xs = run # morph @(Delete mod) xs # p -find :: forall f t u a . (Morphable (Find f) t, Morphing (Find f) t ~ (Predicate <:.:> u := (->))) => Predicate a -> t a -> u a-find p xs = run # morph @(Find f) xs # p+find :: forall mod struct result a . (Morphed (Find mod) struct (Predicate <:.:> result := (->))) => Predicate a -> struct a -> result a+find p xs = run # morph @(Find mod) xs # p++lookup :: forall mod key struct a . (Morphed (Lookup mod) struct ((->) key <:.> Maybe)) => key -> struct a -> Maybe a+lookup key struct = run # morph @(Lookup mod) struct # key++vary :: forall mod key value struct . (Morphed (Vary mod) struct ((Product key <:.> Identity) <:.:> struct := (->))) => key -> value -> struct value -> struct value+vary key value xs = run # morph @(Vary mod) @struct xs # TU (key :*: Identity value)

@@ -3,14 +3,12 @@  module Pandora.Paradigm.Structure.Ability.Substructure where -import Pandora.Pattern.Category ((.), ($)) import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))-import Pandora.Pattern.Functor.Extractable (extract)-import Pandora.Pattern.Functor.Pointable (point) import Pandora.Pattern.Functor.Divariant ((>->)) import Pandora.Pattern.Transformer.Liftable (lift)-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, unite)-import Pandora.Paradigm.Inventory.Optics (type (:~.), (|>))+import Pandora.Pattern.Transformer.Lowerable (lower)+import Pandora.Paradigm.Controlflow.Effect.Interpreted ((||=))+import Pandora.Paradigm.Inventory.Optics (type (:~.)) import Pandora.Paradigm.Primary.Functor.Tagged (Tagged) import Pandora.Paradigm.Schemes.TU (type (<:.>)) @@ -19,14 +17,8 @@ 	substructure :: Tagged f <:.> t :~. Substructural f t  	sub :: Covariant t => t :~. Substructural f t-	sub x = extract . run <$> substructure @f (lift x)--data Segment a = Tail a--data (|>) (i :: * -> k) (j :: * -> k') a+	sub = lift >-> (lower <$>) ||= substructure @f @t -instance (Covariant t, Covariant (Substructural i t), Substructure i t, Substructure j (Substructural i t)) => Substructure (i |> j) t where-	type Substructural (i |> j) t = Substructural j (Substructural i t)-	substructure = extract . run >-> (unite . point <$>) $ sub @i |> sub @j+data Segment a = Root a | Tail a  type Substructured i source target = (Substructure i source, Substructural i source ~ target)

@@ -1,17 +1,5 @@-{-# LANGUAGE AllowAmbiguousTypes #-}- module Pandora.Paradigm.Structure.Interface.Dictionary where -import Pandora.Pattern.Category ((#))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)-import Pandora.Paradigm.Schemes.TU (type (<:.>))--import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing), Morph (Lookup), morph)+import Pandora.Paradigm.Structure.Ability.Morphable (Morphable, Morph (Lookup))  type Dictionary f t = Morphable (Lookup f) t--lookup :: forall f k t u a . (Dictionary f t, Morphing (Lookup f) t ~ ((->) k <:.> u)) => k -> t a -> u a-lookup key xs = run # morph @(Lookup f) xs # key--discover :: forall f k v t u a . (Dictionary f t, Morphing (Lookup f) t ~ ((->) (v k) <:.> u)) => v k -> t a -> u a-discover keys xs = run # morph @(Lookup f) xs # keys

@@ -2,3 +2,4 @@  import Pandora.Paradigm.Structure.Modification.Prefixed as Exports import Pandora.Paradigm.Structure.Modification.Comprehension as Exports+import Pandora.Paradigm.Structure.Modification.Combinative as Exports

@@ -0,0 +1,3 @@+module Pandora.Paradigm.Structure.Modification.Combinative where++type family Combinative (s :: * -> *) = (r :: * -> *) | r -> s

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE UndecidableInstances #-}  module Pandora.Paradigm.Structure.Modification.Prefixed where@@ -7,9 +8,14 @@ import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>))) import Pandora.Pattern.Functor.Pointable (Pointable (point)) import Pandora.Pattern.Functor.Traversable (Traversable ((->>), (->>>)))+import Pandora.Pattern.Functor.Extractable (extract)+import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))+import Pandora.Pattern.Functor.Avoidable (Avoidable (empty)) import Pandora.Pattern.Object.Monoid (Monoid (zero)) import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:))) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite))+import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Into), premorph)+import Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty)  newtype Prefixed t k a = Prefixed (t :. Product k := a) @@ -26,3 +32,15 @@  instance (Monoid k, Pointable t) => Pointable (Prefixed t k) where 	point = Prefixed . point . (:*:) zero++instance Alternative t => Alternative (Prefixed t k) where+	x <+> y = Prefixed $ run x <+> run y++instance Avoidable t => Avoidable (Prefixed t k) where+	empty = Prefixed empty++instance Covariant t => Morphable (Into t) (Prefixed t k) where+	type Morphing (Into t) (Prefixed t k) = t+	morphing (run . premorph -> prefixed) = extract <$> prefixed++type instance Nonempty (Prefixed t k) = Prefixed (Nonempty t) k

@@ -4,13 +4,15 @@  import Pandora.Core.Functor (type (:.), type (:=), type (:=>)) import Pandora.Pattern.Category (identity, (.), ($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), comap))-import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), ($$>))) import Pandora.Pattern.Functor.Extractable (extract) import Pandora.Pattern.Functor.Avoidable (empty)+import Pandora.Pattern.Functor.Bindable ((>>=)) import Pandora.Pattern.Transformer.Liftable (lift)+import Pandora.Pattern.Transformer.Lowerable (lower) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Pattern.Object.Chain (Chain ((<=>)))+import Pandora.Paradigm.Primary () import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False)) import Pandora.Paradigm.Primary.Object.Ordering (order) import Pandora.Paradigm.Primary.Object.Numerator (Numerator (Numerator, Zero))@@ -23,21 +25,20 @@ import Pandora.Paradigm.Primary.Functor.Predicate (Predicate (Predicate)) import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)), type (:*:), attached, twosome) import Pandora.Paradigm.Primary.Functor.Wye (Wye (End, Left, Right, Both))-import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct)-import Pandora.Paradigm.Schemes (TU (TU), T_U (T_U), type (<:.>), type (<:.:>))+import Pandora.Paradigm.Schemes (TU (TU), T_U (T_U), PQ_ (PQ_), type (<:.>), type (<:.:>)) import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)-import Pandora.Paradigm.Inventory.State (State, modify) import Pandora.Paradigm.Inventory.Store (Store (Store))-import Pandora.Paradigm.Inventory.Optics (over)+import Pandora.Paradigm.Inventory.Optics (over, view) import Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty) import Pandora.Paradigm.Structure.Ability.Nullable (Nullable (null))-import Pandora.Paradigm.Structure.Ability.Focusable (Focusable (Focusing, focusing), Location (Root)) import Pandora.Paradigm.Structure.Ability.Measurable (Measurable (Measural, measurement), Scale (Heighth), measure) import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (resolve))-import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Rotate, Into, Insert), Vertical (Up, Down), morph, premorph)-import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substructural, substructure), sub)+import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing)+	, Morph (Rotate, Into, Insert, Lookup, Vary, Key, Element), Vertical (Up, Down), morph, premorph, lookup)+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substructural, substructure), Segment (Root), sub) import Pandora.Paradigm.Structure.Ability.Zipper (Zipper)+import Pandora.Paradigm.Structure.Modification.Prefixed (Prefixed (Prefixed))  type Binary = Maybe <:.> Construction Wye @@ -54,12 +55,6 @@ 		let continue xs = run # morph @Insert xs $ twosome # Identity x # Convergence f 		in lift $ f x # extract ne & order # ne # over (sub @Left) continue ne # over (sub @Right) continue ne -instance (forall a . Chain a) => Focusable Root Binary where-	type Focusing Root Binary a = Maybe a-	focusing (run . extract -> Nothing) = Store $ Nothing :*: Tag . TU . comap leaf-	focusing (run . extract -> Just x) = Store $ Just # extract x :*: Tag . lift-		. resolve (Construct % deconstruct x) (rebalance $ deconstruct x)- instance Measurable Heighth Binary where 	type Measural Heighth Binary a = Numerator 	measurement (run . extract -> Just bt) = Numerator $ measure @Heighth bt@@ -70,23 +65,17 @@  instance Substructure Left Binary where 	type Substructural Left Binary = Binary-	substructure (run . extract . run -> Nothing) = Store $ empty :*: lift . identity-	substructure (run . extract . run -> Just tree) = lift . lift <$> sub @Left tree+	substructure = PQ_ $ \bintree -> case run . extract . run # bintree of+		Nothing -> Store $ empty :*: lift . identity+		Just tree -> lift . lift <$> run (sub @Left) tree  instance Substructure Right Binary where 	type Substructural Right Binary = Binary-	substructure (run . extract . run -> Nothing) = Store $ empty :*: lift . identity-	substructure (run . extract . run -> Just tree) = lift . lift <$> sub @Right tree--binary :: forall t a . (Traversable t, Chain a) => t a -> Binary a-binary struct = attached $ run @(State (Binary a)) % empty $ struct ->> modify @(Binary a) . insert' where+	substructure = PQ_ $ \bintree -> case run . extract . run # bintree of+		Nothing -> Store $ empty :*: lift . identity+		Just tree -> lift . lift <$> run (sub @Right) tree -	insert' :: a -> Binary a -> Binary a-	insert' x (run -> Nothing) = lift $ leaf x-	insert' x tree@(run -> Just nonempty) = order # tree-		# (over # sub @Left # insert' x # tree)-		# (over # sub @Right # insert' x # tree)-		# x <=> extract nonempty+-------------------------------------- Non-empty binary tree ---------------------------------------  type instance Nonempty Binary = Construction Wye @@ -104,10 +93,6 @@ 			# over (sub @Right) change nonempty_list 			# f x (extract nonempty_list) -instance Focusable Root (Construction Wye) where-	type Focusing Root (Construction Wye) a = a-	focusing (extract -> Construct x xs) = Store $ x :*: Tag . Construct % xs- instance Measurable Heighth (Construction Wye) where 	type Measural Heighth (Construction Wye) a = Denumerator 	measurement (deconstruct . extract -> End) = One@@ -117,27 +102,55 @@ 		let (lm :*: rm) = measure @Heighth lst :*: measure @Heighth rst 		in lm <=> rm & order lm rm lm +instance Substructure Root (Construction Wye) where+	type Substructural Root (Construction Wye) = Identity+	substructure = PQ_ $ \bintree -> case lower bintree of+		Construct x xs -> Store $ Identity x :*: lift . (Construct % xs) . extract+ instance Substructure Left (Construction Wye) where 	type Substructural Left (Construction Wye) = Binary-	substructure (extract . run -> Construct x End) =-		Store $ empty :*: lift . resolve (Construct x . Left) (leaf x) . run-	substructure (extract . run -> Construct x (Left lst)) =-		Store $ lift lst :*: lift . Construct x . resolve Left End . run-	substructure (extract . run -> Construct x (Right rst)) =-		Store $ empty :*: lift . Construct x . resolve (Both % rst) (Right rst) . run-	substructure (extract . run -> Construct x (Both lst rst)) =-		Store $ lift lst :*: lift . Construct x . resolve (Both % rst) (Right rst) . run+	substructure = PQ_ $ \bintree -> case extract # run bintree of+		Construct x End -> Store $ empty :*: lift . resolve (Construct x . Left) (leaf x) . run+		Construct x (Left lst) -> Store $ lift lst :*: lift . Construct x . resolve Left End . run+		Construct x (Right rst) -> Store $ empty :*: lift . Construct x . resolve (Both % rst) (Right rst) . run+		Construct x (Both lst rst) -> Store $ lift lst :*: lift . Construct x . resolve (Both % rst) (Right rst) . run  instance Substructure Right (Construction Wye) where 	type Substructural Right (Construction Wye) = Binary-	substructure (extract . run -> Construct x End) =-		Store $ empty :*: lift . resolve (Construct x . Right) (leaf x) . run-	substructure (extract . run -> Construct x (Left lst)) =-		Store $ empty :*: lift . Construct x . resolve (Both lst) (Left lst) . run-	substructure (extract . run -> Construct x (Right rst)) =-		Store $ lift rst :*: lift . Construct x . resolve Right End . run-	substructure (extract . run -> Construct x (Both lst rst)) =-		 Store $ lift rst :*: lift . Construct x . resolve (Both lst) (Left lst) . run+	substructure = PQ_ $ \bintree -> case extract # run bintree of+		Construct x End -> Store $ empty :*: lift . resolve (Construct x . Right) (leaf x) . run+		Construct x (Left lst) -> Store $ empty :*: lift . Construct x . resolve (Both lst) (Left lst) . run+		Construct x (Right rst) -> Store $ lift rst :*: lift . Construct x . resolve Right End . run+		Construct x (Both lst rst) -> Store $ lift rst :*: lift . Construct x . resolve (Both lst) (Left lst) . run++-------------------------------------- Prefixed binary tree ----------------------------------------++instance Chain k => Morphable (Lookup Key) (Prefixed Binary k) where+	type Morphing (Lookup Key) (Prefixed Binary k) = (->) k <:.> Maybe+	morphing (run . run . premorph -> Nothing) = lift Nothing+	morphing (run . run . premorph -> Just tree) = TU $ \key ->+		let root = extract tree in key <=> attached root & order # Just (extract root)+			# lookup @Key key (Prefixed $ view # sub @Left # tree)+			# lookup @Key key (Prefixed $ view # sub @Right # tree)++instance Chain k => Morphable (Vary Element) (Prefixed Binary k) where+	type Morphing (Vary Element) (Prefixed Binary k) = (Product k <:.> Identity) <:.:> Prefixed Binary k := (->)+	morphing (run . run . premorph -> Nothing) = T_U $ \(TU (key :*: Identity value)) -> Prefixed . lift . leaf $ key :*: value+	morphing (run . run . premorph -> Just tree) = T_U $ \(TU (key :*: Identity value)) ->+		let continue xs = run $ run # morph @(Vary Element) (Prefixed xs) # TU (key :*: Identity value)+		in let root = extract tree in Prefixed . lift $ key <=> attached root & order+			# over (sub @Root) ($$> value) tree # over (sub @Left) continue tree # over (sub @Right) continue tree++---------------------------------- Prefixed non-empty binary tree ----------------------------------++instance Chain key => Morphable (Lookup Key) (Prefixed (Construction Wye) key) where+	type Morphing (Lookup Key) (Prefixed (Construction Wye) key) = (->) key <:.> Maybe+	morphing (run . premorph -> Construct x xs) = TU $ \key ->+		key <=> attached x & order (Just # extract x)+			(view # sub @Left # xs >>= lookup @Key key . Prefixed)+			(view # sub @Right # xs >>= lookup @Key key . Prefixed)++-------------------------------------- Zipper of binary tree ---------------------------------------  data Biforked a = Top | Leftward a | Rightward a 

@@ -3,14 +3,14 @@ module Pandora.Paradigm.Structure.Some.List where  import Pandora.Core.Functor (type (:.), type (:=))-import Pandora.Pattern ((.|..)) import Pandora.Pattern.Category ((.), ($), (#), identity)-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (.#..))) import Pandora.Pattern.Functor.Applicative (Applicative ((<*>))) import Pandora.Pattern.Functor.Extractable (extract) import Pandora.Pattern.Functor.Avoidable (empty) import Pandora.Pattern.Functor.Traversable (Traversable ((->>))) import Pandora.Pattern.Functor.Extendable (Extendable ((=>>)))+import Pandora.Pattern.Functor.Bindable ((>>=)) import Pandora.Pattern.Functor.Bivariant ((<->)) import Pandora.Pattern.Functor.Adjoint ((|-)) import Pandora.Pattern.Functor ()@@ -22,12 +22,11 @@ import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False), (?)) import Pandora.Paradigm.Primary.Object.Numerator (Numerator (Numerator)) import Pandora.Paradigm.Primary.Object.Denumerator (Denumerator (One))-import Pandora.Paradigm.Primary.Functor.Function ((%), (&))+import Pandora.Paradigm.Primary.Functor.Function ((%)) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing)) import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity)) import Pandora.Paradigm.Primary.Functor.Predicate (Predicate (Predicate)) import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)), type (:*:), attached, twosome)-import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag)) import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct, (.-+)) import Pandora.Paradigm.Primary.Transformer.Tap (Tap (Tap))@@ -38,16 +37,21 @@ import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (||=)) import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>)) import Pandora.Paradigm.Schemes.T_U (T_U (T_U), type (<:.:>))+import Pandora.Paradigm.Schemes.PQ_ (PQ_ (PQ_)) import Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty) import Pandora.Paradigm.Structure.Ability.Nullable (Nullable (null)) import Pandora.Paradigm.Structure.Ability.Zipper (Zipper)-import Pandora.Paradigm.Structure.Ability.Focusable (Focusable (Focusing, focusing), Location (Head), focus)+-- import Pandora.Paradigm.Structure.Ability.Focusable () import Pandora.Paradigm.Structure.Ability.Measurable (Measurable (Measural, measurement), Scale (Length), measure)-import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (reduce, resolve))-import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Rotate, Into, Push, Pop, Delete, Find, Element)-	, Occurrence (All, First), premorph, rotate, item, filter, find, into)-import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substructural, substructure, sub), Segment (Tail))+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.Substructure (Substructure (Substructural, substructure, sub), Segment (Root, Tail)) import Pandora.Paradigm.Structure.Interface.Stack (Stack)+import Pandora.Paradigm.Structure.Modification.Combinative (Combinative)+import Pandora.Paradigm.Structure.Modification.Comprehension (Comprehension (Comprehension))+import Pandora.Paradigm.Structure.Modification.Prefixed (Prefixed (Prefixed))  -- | Linear data structure that serves as a collection of elements type List = Maybe <:.> Construction Maybe@@ -91,12 +95,6 @@  instance Stack List where -instance Focusable Head List where-	type Focusing Head List a = Maybe a-	focusing (extract -> stack) = Store $ extract <$> run stack :*: \case-		Just x -> stack & view (sub @Tail) & item @Push x & Tag-		Nothing -> stack & view (sub @Tail) & Tag- instance Measurable Length List where 	type Measural Length List a = Numerator 	measurement (run . extract -> Nothing) = zero@@ -105,29 +103,39 @@ instance Nullable List where 	null = Predicate $ \case { TU Nothing -> True ; _ -> False } +instance Substructure Root List where+	type Substructural Root List = Maybe+	substructure = PQ_ $ \zipper -> case run # lower zipper of+		Just (Construct x xs) -> Store $ Just x :*: lift . resolve (lift . (Construct % xs)) empty+		Nothing -> Store $ Nothing :*: lift . resolve (lift . (Construct % empty)) empty+ instance Substructure Tail List where 	type Substructural Tail List = List-	substructure (run . extract . run -> Just ns) = lift . lift <$> sub @Tail ns-	substructure (run . extract . run -> Nothing) = Store $ empty :*: lift . identity+	substructure = PQ_ $ \x -> case run . extract . run $ x of+		Just ns -> lift . lift <$> run (sub @Tail) ns+		Nothing -> Store $ empty :*: lift . identity  -- | Transform any traversable structure into a stack linearize :: forall t a . Traversable t => t a -> List a-linearize = TU . extract . (run @(State (Maybe :. Nonempty List := a)) % Nothing) . fold (Just .|.. Construct)+linearize = TU . 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 +instance Morphable (Find Element) (Construction Maybe) where+	type Morphing (Find Element) (Construction Maybe) = Predicate <:.:> Maybe := (->)+	morphing (premorph -> Construct x xs) = T_U $ \p ->+		run p x ? Just x $ xs >>= find @Element @(Nonempty List) @Maybe # p+ instance Morphable (Into List) (Construction Maybe) where 	type Morphing (Into List) (Construction Maybe) = List 	morphing = lift . premorph -instance Focusable Head (Construction Maybe) where-	type Focusing Head (Construction Maybe) a = a-	focusing (extract -> stack) = Store $ extract stack :*: Tag . Construct % deconstruct stack- instance Morphable Push (Construction Maybe) where 	type Morphing Push (Construction Maybe) = Identity <:.:> Construction Maybe := (->) 	morphing (premorph -> xs) = T_U $ \(Identity x) -> Construct x $ Just xs@@ -137,16 +145,27 @@ 	measurement (deconstruct . extract -> Nothing) = One 	measurement (deconstruct . extract -> Just xs) = One + measure @Length xs -instance Monotonic a (Construction Maybe a) where-	reduce f r ~(Construct x xs) = f x $ reduce f r xs+instance Substructure Root (Construction Maybe) where+	type Substructural Root (Construction Maybe) = Identity+	substructure = PQ_ $ \zipper -> case lower zipper of+		Construct x xs -> Store $ Identity x :*: lift . (Construct % xs) . extract  instance Substructure Tail (Construction Maybe) where 	type Substructural Tail (Construction Maybe) = List-	substructure (extract . run -> Construct x xs) =-		Store $ TU xs :*: lift . Construct x . run+	substructure = PQ_ $ \stack -> case extract $ run stack of+		Construct x xs -> Store $ TU xs :*: lift . Construct x . run +---------------------------------------- Combinative list ------------------------------------------++type instance Combinative List = Comprehension Maybe++----------------------------------------- Zipper of list -------------------------------------------+ type instance Zipper List = Tap (List <:.:> List := (:*:)) +instance {-# OVERLAPS #-} Applicative (Tap (List <:.:> List := (:*:))) where+	Tap f (T_U (lfs :*: rfs)) <*> Tap x (T_U (ls :*: rs)) = Tap # f x # T_U (lfs <*> ls :*: rfs <*> rs)+ instance {-# OVERLAPS #-} Traversable (Tap (List <:.:> List := (:*:))) where 	Tap x (T_U (future :*: past)) ->> f = (\past' x' future' -> Tap x' $ twosome # future' # run past') 		<$> Reverse past ->> f <*> f x <*> future ->> f@@ -155,19 +174,15 @@ 	z =>> f = let move rtt = TU . deconstruct $ run . rtt .-+ z in 		Tap # f z $ twosome # f <$> move (rotate @Left) # f <$> move (rotate @Right) -instance Focusable Head (Tap (List <:.:> List := (:*:))) where-	type Focusing Head (Tap (List <:.:> List := (:*:))) a = a-	focusing (extract -> zipper) = Store $ extract zipper :*: Tag . Tap % lower zipper- instance Morphable (Rotate Left) (Tap (List <:.:> List := (:*:))) where 	type Morphing (Rotate Left) (Tap (List <:.:> List := (:*:))) = Maybe <:.> Zipper List 	morphing (premorph -> Tap x (T_U (future :*: past))) = TU-		$ Tap % twosome (view (sub @Tail) future) (item @Push x past) <$> view (focus @Head) future+		$ Tap % twosome (view (sub @Tail) future) (item @Push x past) <$> view (sub @Root) future  instance Morphable (Rotate Right) (Tap (List <:.:> List := (:*:))) where 	type Morphing (Rotate Right) (Tap (List <:.:> List := (:*:))) = Maybe <:.> Zipper List 	morphing (premorph -> Tap x (T_U (future :*: past))) = TU-		$ Tap % twosome (item @Push x future) (view (sub @Tail) past) <$> view (focus @Head) past+		$ Tap % twosome (item @Push x future) (view (sub @Tail) past) <$> view (sub @Root) past  instance Morphable (Into (Tap (List <:.:> List := (:*:)))) List where 	type Morphing (Into (Tap (List <:.:> List := (:*:)))) List = Maybe <:.> Zipper List@@ -179,16 +194,38 @@ 		# past ->> modify . item @Push @List 		# item @Push x future +instance Morphable (Into (Comprehension Maybe)) (Tap (List <:.:> List := (:*:))) where+	type Morphing (Into (Comprehension Maybe)) (Tap (List <:.:> List := (:*:))) = Comprehension Maybe+	morphing (premorph -> Tap x (T_U (future :*: past))) = attached $ run @(State _)+		# past ->> modify . item @Push @(Comprehension Maybe)+		# item @Push x (Comprehension future)++instance Substructure Root (Tap (List<:.:> List:= (:*:))) where+	type Substructural Root (Tap (List<:.:> List:= (:*:))) = Identity+	substructure = PQ_ $ \zipper -> case lower zipper of+		Tap x xs -> Store $ Identity x :*: lift . (Tap % xs) . extract++instance Substructure Left (Tap (List <:.:> List := (:*:))) where+	type Substructural Left (Tap (List <:.:> List := (:*:))) = List+	substructure = PQ_ $ \zipper -> case lower zipper of+		Tap x (T_U (future :*: past)) -> Store $ future :*: lift . Tap x . T_U . (:*: past)++instance Substructure Right (Tap (List <:.:> List := (:*:))) where+	type Substructural Right (Tap (List <:.:> List := (:*:))) = List+	substructure = PQ_ $ \zipper -> case lower zipper of+		Tap x (T_U (future :*: past)) -> Store $ past :*: lift . Tap x . T_U . (future :*:)++------------------------------------- Zipper of non-empty list -------------------------------------+ type instance Zipper (Construction Maybe) = Tap (Construction Maybe <:.:> Construction Maybe := (:*:)) +instance {-# OVERLAPS #-} Applicative (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where+	Tap f (T_U (lfs :*: rfs)) <*> Tap x (T_U (ls :*: rs)) = Tap # f x # T_U (lfs <*> ls :*: rfs <*> rs)+ instance {-# OVERLAPS #-} Traversable (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where 	Tap x (T_U (future :*: past)) ->> f = (\past' x' future' -> Tap x' $ twosome # future' # run past') 		<$> Reverse past ->> f <*> f x <*> future ->> f -instance Focusable Head (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where-	type Focusing Head (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) a = a-	focusing (extract -> zipper) = Store $ extract zipper :*: Tag . Tap % lower zipper- instance Morphable (Rotate Left) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where 	type Morphing (Rotate Left) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) = Maybe <:.> Zipper (Construction Maybe) 	morphing (premorph -> Tap x (T_U (future :*: past))) = TU $ Tap (extract future) . twosome % item @Push x past <$> deconstruct future@@ -203,7 +240,7 @@  instance Morphable (Into (Tap (List <:.:> List := (:*:)))) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where 	type Morphing (Into (Tap (List <:.:> List := (:*:)))) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) = Zipper List-	morphing (premorph -> zipper) = Tap # extract zipper $ (lift <-> lift) ||= lower zipper+	morphing (premorph -> zipper) = Tap # extract zipper $ lift <-> lift ||= lower zipper  instance Morphable (Into (Tap (Construction Maybe <:.:> Construction Maybe := (:*:)))) (Tap (List <:.:> List := (:*:))) where 	type Morphing (Into (Tap (Construction Maybe <:.:> Construction Maybe := (:*:)))) (Tap (List <:.:> List := (:*:))) = Maybe <:.> Zipper (Construction Maybe)@@ -222,5 +259,37 @@ 		# past ->> modify . item @Push @List 		# item @Push x (lift future) -instance Monotonic a (Maybe <:.> Construction Maybe := a) where-	reduce f r = reduce f r . run+instance Substructure Root (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where+	type Substructural Root (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) = Identity+	substructure = PQ_ $ \zipper -> case lower zipper of+		Tap x xs -> Store $ Identity x :*: lift . (Tap % xs) . extract++instance Substructure Left (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where+	type Substructural Left (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) = Construction Maybe+	substructure = PQ_ $ \zipper -> case lower zipper of+		Tap x (T_U (future :*: past)) -> Store $ future :*: lift . Tap x . T_U . (:*: past)++instance Substructure Right (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where+	type Substructural Right (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) = Construction Maybe+	substructure = PQ_ $ \zipper -> case lower zipper of+		Tap x (T_U (future :*: past)) -> Store $ past :*: lift . Tap x . T_U . (future :*:)++------------------------------------ Zipper of combinative list ------------------------------------++type instance Zipper (Comprehension Maybe) = Tap (Comprehension Maybe <:.:> Comprehension Maybe := (:*:))++instance {-# OVERLAPS #-} Applicative (Tap (Comprehension Maybe <:.:> Comprehension Maybe := (:*:))) where+	Tap f (T_U (lfs :*: rfs)) <*> Tap x (T_U (ls :*: rs)) = Tap # f x # T_U (lfs <*> ls :*: rfs <*> rs)++----------------------------------------- Prefixed list --------------------------------------------++instance Setoid key => Morphable (Lookup Key) (Prefixed List key) where+	type Morphing (Lookup Key) (Prefixed List key) = (->) key <:.> Maybe+	morphing (run . premorph -> list) = TU $ \key -> Prefixed <$> run list >>= lookup @Key key++------------------------------------ Prefixed non-empty list ---------------------------------------++instance Setoid key => Morphable (Lookup Key) (Prefixed (Construction Maybe) key) where+	type Morphing (Lookup Key) (Prefixed (Construction Maybe) key) = (->) key <:.> Maybe+	morphing (run . premorph -> Construct x xs) = TU $ \key -> extract <$> search key where+		search key = key == attached x ? Just x $ xs >>= find @Element # Predicate ((key ==) . attached)

@@ -4,64 +4,91 @@  import Pandora.Core.Functor (type (:.), type (:=)) import Pandora.Pattern.Category ((.), ($), (#))-import Pandora.Pattern.Functor.Covariant (Covariant (comap))+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>))) import Pandora.Pattern.Functor.Contravariant ((>$<)) import Pandora.Pattern.Functor.Extractable (extract) import Pandora.Pattern.Functor.Avoidable (Avoidable (empty)) 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.Paradigm.Primary.Object.Boolean (Boolean (True, False), (?)) import Pandora.Paradigm.Primary.Functor.Function ((!), (%))+import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity)) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing)) import Pandora.Paradigm.Primary.Functor.Predicate (Predicate (Predicate), equate) import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)), type (:*:), attached)-import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct)-import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)+import Pandora.Paradigm.Schemes (TU (TU), T_U (T_U), PQ_ (PQ_), type (<:.>), type (<:.:>))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (=||$>)) import Pandora.Paradigm.Inventory.Store (Store (Store))-import Pandora.Paradigm.Structure.Ability.Focusable (Focusable (Focusing, focusing), Location (Root))-import Pandora.Paradigm.Structure.Ability.Monotonic (resolve)-import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Lookup, Element), premorph, find)+import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing)+	, Morph (Lookup, Vary, Element, Key), premorph, find, vary) import Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty) import Pandora.Paradigm.Structure.Ability.Nullable (Nullable (null))-import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substructural, substructure))-import Pandora.Paradigm.Structure.Modification.Prefixed (Prefixed)+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substructural, substructure), Segment (Root, Tail))+import Pandora.Paradigm.Structure.Modification.Prefixed (Prefixed (Prefixed)) import Pandora.Paradigm.Structure.Some.List (List)  type Rose = Maybe <:.> Construction List -instance Focusable Root Rose where-	type Focusing Root Rose a = Maybe a-	focusing (run . extract -> Nothing) = Store $ Nothing :*: Tag . TU . comap (Construct % empty)-	focusing (run . extract -> Just rose) = Store $ Just (extract rose)-		:*: Tag . resolve (lift . Construct % deconstruct rose) empty- instance Nullable Rose where 	null = Predicate $ \case { TU Nothing -> True ; _ -> False } +instance Substructure Root Rose where+	type Substructural Root Rose = Maybe+	substructure = PQ_ $ \rose -> case run # lower rose of+		Nothing -> Store $ Nothing :*: lift . TU . (Construct % empty <$>)+ instance Substructure Just Rose where 	type Substructural Just Rose = List <:.> Construction List-	substructure (run . extract . run -> Nothing) =-		Store $ empty :*: (lift empty !)-	substructure (run . extract . run -> Just (Construct x xs)) =-		Store $ TU xs :*: lift . lift . Construct x . run+	substructure = PQ_ $ \rose -> case run . extract . run # rose of+		Nothing -> Store $ empty :*: (lift empty !)+		Just (Construct x xs) -> Store $ TU xs :*: lift . lift . Construct x . run +--------------------------------------- Non-empty rose tree ----------------------------------------+ type instance Nonempty Rose = Construction List -instance Focusable Root (Construction List) where-	type Focusing Root (Construction List) a = a-	focusing (Tag rose) = Store $ extract rose :*: Tag . Construct % deconstruct rose+instance Substructure Root (Construction List) where+	type Substructural Root (Construction List) = Identity+	substructure = PQ_ $ \rose -> Store $ Identity # extract (lower rose) :*: lift . (Construct % deconstruct (lower rose)) . extract -instance Substructure Just (Construction List) where-	type Substructural Just (Construction List) = List <:.> Construction List-	substructure (extract . run -> Construct x xs) = Store $ TU xs :*: lift . Construct x . run+instance Substructure Tail (Construction List) where+	type Substructural Tail (Construction List) = List <:.> Construction List+	substructure = PQ_ $ \rose -> case extract # run rose of+		Construct x xs -> Store $ TU xs :*: lift . Construct x . run -instance Setoid k => Morphable (Lookup Element) (Prefixed Rose k) where-	type Morphing (Lookup Element) (Prefixed Rose k) = (->) (Nonempty List k) <:.> Maybe+--------------------------------------- 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 (run . premorph -> TU Nothing) = TU $ \_ -> Nothing 	morphing (run . premorph -> TU (Just tree)) = TU $ find_rose_sub_tree % tree++-- TODO: Ineffiecient - we iterate over all branches in subtree, but we need to short-circuit on the first matching part of+instance Setoid k => Morphable (Vary Element) (Prefixed Rose k) where+	type Morphing (Vary Element) (Prefixed Rose k) = (Product (Nonempty List k) <:.> Identity) <:.:> Prefixed Rose k := (->)+	morphing (run . run . premorph -> Nothing) = T_U $ \(TU (Construct key _ :*: Identity value)) -> Prefixed . lift $ Construct (key :*: value) empty+	morphing (run . run . premorph -> Just (Construct focused subtree)) = T_U $ \(TU (breadcrumbs :*: Identity value)) -> case breadcrumbs of+		Construct key Nothing -> Prefixed . lift $ attached focused == key ? Construct (key :*: value) subtree $ Construct focused subtree+		Construct key (Just keys) -> Prefixed . lift $ attached focused != key ? Construct focused subtree+			$ Construct focused $ vary @Element @_ @_ @(Nonempty (Prefixed Rose k)) keys value =||$> subtree++---------------------------------- Non-empty prefixed rose 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 (Construction List) k) where+	type Morphing (Vary Element) (Prefixed (Construction List) k) =+		(Product (Nonempty List k) <:.> Identity) <:.:> Prefixed (Construction List) k := (->)+	morphing (run . premorph -> Construct x (TU Nothing)) = T_U $ \(TU (breadcrumbs :*: Identity value)) -> case breadcrumbs of+		Construct key Nothing -> Prefixed $ attached x == key ? Construct (key :*: value) empty $ Construct x empty+		Construct _ (Just _) -> Prefixed $ Construct x (TU Nothing)+	morphing (run . premorph -> Construct x (TU (Just subtree))) = T_U $ \(TU (breadcrumbs :*: Identity value)) -> case breadcrumbs of+		Construct key Nothing -> Prefixed $ attached x != key ? Construct x # lift subtree+			$ Construct (key :*: value) (lift subtree)+		Construct key (Just keys) -> Prefixed $ attached x != key ? Construct x # lift subtree+			$ Construct (key :*: value) . lift $ vary @Element @_ @_ @(Nonempty (Prefixed Rose k)) keys value =||$> subtree  find_rose_sub_tree :: forall k a . Setoid k => Nonempty List k -> Nonempty Rose := k :*: a -> Maybe a find_rose_sub_tree (Construct k Nothing) tree = k == attached (extract tree) ? Just (extract $ extract tree) $ Nothing

@@ -1,22 +1,6 @@-module Pandora.Pattern (module Exports, (.|..), (.|...), (.|....)) where+module Pandora.Pattern (module Exports) where  import Pandora.Pattern.Object as Exports import Pandora.Pattern.Transformer as Exports import Pandora.Pattern.Functor as Exports import Pandora.Pattern.Category as Exports--import Pandora.Core.Functor (type (:.), type (:=))--infixr 7 .|.., .|..., .|....--(.|..) :: (Category v, Covariant (v a))-	=> v c d -> v a :. v b := c -> v a :. v b := d-f .|.. g = (f .) <$> g--(.|...) :: (Category v, Covariant (v a), Covariant (v b))-	=> v d e -> v a :. v b :. v c := d -> v a :. v b :. v c := e-f .|... g = (f .) <$$> g--(.|....) :: (Category v, Covariant (v a), Covariant (v b), Covariant (v c))-	=> v e f -> v a :. v b :. v c :. v d := e -> v a :. v b :. v c :. v d := f-f .|.... g = (f .) <$$$> g

@@ -1,8 +1,5 @@ module Pandora.Pattern.Category (Category (..)) where -import Pandora.Core.Functor (type (~~>))---- infixl 1 # infixl 2 # infixr 0 $ infixr 9 .@@ -11,8 +8,8 @@ 	identity :: m a a 	(.) :: m b c -> m a b -> m a c -	($) :: m ~~> m-	($) f = identity . f+	($) :: m (m a b) (m a b)+	($) = identity . identity -	(#) :: m ~~> m-	(#) f = identity . f+	(#) :: m (m a b) (m a b)+	(#) = identity . identity

@@ -1,5 +1,7 @@ module Pandora.Pattern.Functor.Bivariant where +import Pandora.Pattern.Functor.Covariant (Covariant)+ infixl 4 <->  {- |@@ -8,9 +10,10 @@ > * Parametricity: bimap  (f . g) (h . i) ≡ bimap f h . bimap g i -} -class Bivariant (v :: * -> * -> *) where+class (forall i . Covariant (v i)) => Bivariant (v :: * -> * -> *) where 	{-# MINIMAL (<->) #-}-	(<->) :: (a -> b) -> (c -> d) -> v a c -> v b d+	(<->) :: (forall i . Covariant (v i)) => (a -> b) -> (c -> d) -> v a c -> v b d+ 	-- | Prefix version of '<->'-	bimap :: (a -> b) -> (c -> d) -> v a c -> v b d+	bimap :: (forall i . Covariant (v i)) => (a -> b) -> (c -> d) -> v a c -> v b d 	bimap f g x = (f <-> g) x

@@ -1,6 +1,7 @@ module Pandora.Pattern.Functor.Covariant where  import Pandora.Core.Functor (type (:.), type (:=), type (<:=))+import Pandora.Pattern.Category (Category ((.)))  infixl 4 <$>, <$, $> infixl 3 <$$>@@ -12,6 +13,8 @@ infixl 3 <&&&> infixl 4 <&&&&> +infixr 7 .#.., .#..., .#....+ {- | > When providing a new instance, you should ensure it satisfies: > * Identity morphism: comap identity ≡ identity@@ -61,3 +64,33 @@ 	(<&&&&>) :: (Covariant u, Covariant v, Covariant w) 		=> t :. u :. v :. w := a -> (a -> b) -> t :. u :. v :. w := b 	x <&&&&> f = f <$$$$> x++	(.#..) :: (t ~ v a, Category v)+		=> v c d -> v a :. v b := c -> v a :. v b := d+	f .#.. g = (f .) <$> g++	(.#...) :: (t ~ v a, t ~ v b, Category v, Covariant (v a), Covariant (v b))+		=> v d e -> v a :. v b :. v c := d -> v a :. v b :. v c := e+	f .#... g = (f .) <$$> g++	(.#....) :: (t ~ v a, t ~ v b, t ~ v c, Category v, Covariant (v a), Covariant (v b), Covariant (v c))+		=> v e f -> v a :. v b :. v c :. v d := e -> v a :. v b :. v c :. v d := f+	f .#.... g = (f .) <$$$> g++	(<$$) :: Covariant u => b -> t :. u := a -> t :. u := b+	x <$$ s = (\_-> x) <$$> s++	(<$$$) :: (Covariant u, Covariant v) => b -> t :. u :. v := a -> t :. u :. v := b+	x <$$$ s = (\_-> x) <$$$> s++	(<$$$$) :: (Covariant u, Covariant v, Covariant w) => b -> t :. u :. v :. w := a -> t :. u :. v :. w := b+	x <$$$$ s = (\_-> x) <$$$$> s++	($$>) :: Covariant u => t :. u := a -> b -> t :. u := b+	s $$> x = (\_-> x) <$$> s++	($$$>) :: (Covariant u, Covariant v) => t :. u :. v := a -> b -> t :. u :. v := b+	s $$$> x = (\_-> x) <$$$> s++	($$$$>) :: (Covariant u, Covariant v, Covariant w) => t :. u :. v :. w := a -> b -> t :. u :. v :. w := b+	s $$$$> x = (\_-> x) <$$$$> s

@@ -1,5 +1,7 @@ module Pandora.Pattern.Functor.Divariant where +import Pandora.Pattern.Functor.Covariant (Covariant)+ infixl 4 >->  {- |@@ -8,7 +10,7 @@ > * Interpreted: dimap (f . g) (h . i) ≡ dimap g h . dimap f i -} -class Divariant (v :: * -> * -> *) where+class (forall i . Covariant (v i)) => Divariant (v :: * -> * -> *) where 	{-# MINIMAL (>->) #-} 	(>->) :: (a -> b) -> (c -> d) -> v b c -> v a d 	-- | Prefix version of '>->'

@@ -6,6 +6,8 @@ > Interpreted of morphisms: invmap g j . invmap f h = invmap (g . f) (h . j) -} +infixl 4 >-<+ class Invariant (t :: * -> *) where 	{-# MINIMAL (>-<) #-} 	(>-<) :: (a -> b) -> (b -> a) -> t a -> t b

@@ -11,6 +11,8 @@ > * Interchange tabulation: comap f . tabulate ≡ tabulate . comap f -} +infixr 6 <#>+ class Pointable t => Representable t where 	{-# MINIMAL (<#>), tabulate #-} 	type Representation t :: *

@@ -9,5 +9,11 @@ > * Interpreted of morphisms: hoist (f . g) ≡ hoist f . hoist g -} +infixr 5 /|\+ class Hoistable t where+	{-# MINIMAL (/|\) #-}+	(/|\) :: Covariant u => u ~> v -> t u ~> t v+ 	hoist :: Covariant u => u ~> v -> t u ~> t v+	hoist = (/|\)

@@ -1,5 +1,5 @@ name:                pandora-version:             0.4.0+version:             0.4.1 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@@ -72,6 +72,7 @@     Pandora.Paradigm.Schemes.UTU     Pandora.Paradigm.Schemes.T_U     Pandora.Paradigm.Schemes.U_T+    Pandora.Paradigm.Schemes.PQ_     -- Control flow primitives     Pandora.Paradigm.Controlflow     -- Typeclassess about functor junctions@@ -97,7 +98,6 @@     Pandora.Paradigm.Structure.Ability     Pandora.Paradigm.Structure.Ability.Morphable     Pandora.Paradigm.Structure.Ability.Accessible-    Pandora.Paradigm.Structure.Ability.Focusable     Pandora.Paradigm.Structure.Ability.Measurable     Pandora.Paradigm.Structure.Ability.Substructure     Pandora.Paradigm.Structure.Ability.Nonempty@@ -105,6 +105,7 @@     Pandora.Paradigm.Structure.Ability.Zipper     Pandora.Paradigm.Structure.Ability.Monotonic     Pandora.Paradigm.Structure.Modification+    Pandora.Paradigm.Structure.Modification.Combinative     Pandora.Paradigm.Structure.Modification.Comprehension     Pandora.Paradigm.Structure.Modification.Prefixed     Pandora.Paradigm.Structure.Interface