pandora 0.3.8 → 0.3.9

raw patch · 55 files changed

+354/−175 lines, 55 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +18/−0
• Pandora/Paradigm/Controlflow/Effect/Interpreted.hs +2/−2
• Pandora/Paradigm/Inventory/Imprint.hs +2/−2
• Pandora/Paradigm/Inventory/State.hs +3/−0
• Pandora/Paradigm/Primary.hs +5/−0
• Pandora/Paradigm/Primary/Functor.hs +7/−3
• Pandora/Paradigm/Primary/Functor/Convergence.hs +16/−0
• Pandora/Paradigm/Primary/Functor/Equivalence.hs +0/−17
• Pandora/Paradigm/Primary/Functor/Wye.hs +18/−0
• Pandora/Paradigm/Primary/Transformer/Flip.hs +2/−3
• Pandora/Paradigm/Structure.hs +2/−2
• Pandora/Paradigm/Structure/Ability.hs +0/−1
• Pandora/Paradigm/Structure/Ability/Deletable.hs +0/−9
• Pandora/Paradigm/Structure/Ability/Monotonic.hs +0/−7
• Pandora/Paradigm/Structure/Ability/Morphable.hs +21/−6
• Pandora/Paradigm/Structure/Ability/Substructure.hs +1/−3
• Pandora/Paradigm/Structure/Interface/Dictionary.hs +14/−3
• Pandora/Paradigm/Structure/Interface/Set.hs +12/−8
• Pandora/Paradigm/Structure/Interface/Stack.hs +1/−1
• Pandora/Paradigm/Structure/Modification/Comprehension.hs +36/−1
• Pandora/Paradigm/Structure/Modification/Prefixed.hs +9/−24
• Pandora/Paradigm/Structure/Some/Binary.hs +23/−18
• Pandora/Paradigm/Structure/Some/List.hs +85/−25
• Pandora/Paradigm/Structure/Some/Rose.hs +22/−4
• Pandora/Pattern/Functor/Adjoint.hs +1/−1
• Pandora/Pattern/Functor/Alternative.hs +1/−1
• Pandora/Pattern/Functor/Applicative.hs +4/−3
• Pandora/Pattern/Functor/Avoidable.hs +1/−1
• Pandora/Pattern/Functor/Bindable.hs +1/−1
• Pandora/Pattern/Functor/Bivariant.hs +1/−1
• Pandora/Pattern/Functor/Comonad.hs +1/−1
• Pandora/Pattern/Functor/Contravariant.hs +1/−1
• Pandora/Pattern/Functor/Covariant.hs +1/−1
• Pandora/Pattern/Functor/Distributive.hs +1/−1
• Pandora/Pattern/Functor/Divariant.hs +1/−1
• Pandora/Pattern/Functor/Extendable.hs +1/−1
• Pandora/Pattern/Functor/Invariant.hs +1/−1
• Pandora/Pattern/Functor/Monad.hs +1/−1
• Pandora/Pattern/Functor/Pointable.hs +3/−0
• Pandora/Pattern/Functor/Representable.hs +1/−1
• Pandora/Pattern/Functor/Traversable.hs +1/−1
• Pandora/Pattern/Object.hs +1/−0
• Pandora/Pattern/Object/Chain.hs +1/−1
• Pandora/Pattern/Object/Cycle.hs +14/−0
• Pandora/Pattern/Object/Group.hs +1/−1
• Pandora/Pattern/Object/Lattice.hs +1/−1
• Pandora/Pattern/Object/Monoid.hs +1/−1
• Pandora/Pattern/Object/Quasiring.hs +1/−1
• Pandora/Pattern/Object/Ring.hs +1/−1
• Pandora/Pattern/Object/Ringoid.hs +1/−1
• Pandora/Pattern/Object/Semigroup.hs +1/−1
• Pandora/Pattern/Object/Semilattice.hs +2/−2
• Pandora/Pattern/Object/Semiring.hs +1/−1
• Pandora/Pattern/Object/Setoid.hs +1/−1
• pandora.cabal +6/−6

@@ -378,3 +378,21 @@ * Define `Stack` typeclass with no methods but with `Push` and `Pop` constraints  # 0.3.9+* Remove `Deletable` ability for datastructures in favor of `Morphable Delete First` instance+* Generalize `filter` and move it from `List` to `Morphable` module+* Define `Set` interface as constraint+* Generalize `Equivalence` and rename it to `Convergence`+* Define `Equivalence` and `Comparison` as type synonyms for `Convergence`+* Define version of `<*>` with flipped arguments - `<%>`+* Generalize `||=` and `=||` methods of `Interpreted` on another `Interpeted` functor+* Define `pass` method in `Pointable` typeclass+* Define experimental `reconcile` method in `State` module+* Remove `Maybe` from `Prefixed` type synonymous+* Define `discover` for `Morphable Find` instances with composite keys+* Change `subset` method of `Set` interface: returns `Convergence Boolean`+* Remove `Dictonary` typeclass+* Define `Lookup` verb for finding elements in datastructures by key+* Define `Cycle` typeclass with `Chain` superclass+* Move `lookup` and `discover` exressions to `Dictionary` module++# 0.4.0

@@ -13,10 +13,10 @@ 	run :: t a -> Primary t a 	unite :: Primary t a -> t a -	(||=) :: (Primary t a -> Primary t b) -> t a -> t b+	(||=) :: Interpreted u => (Primary t a -> Primary u b) -> t a -> u b 	(||=) f = unite . f . run -	(=||) :: (t a -> t b) -> Primary t a -> Primary t b+	(=||) :: Interpreted u => (t a -> u b) -> Primary t a -> Primary u b 	(=||) f = run . f . unite  (-=:) :: (Liftable t, Interpreted (t u), Interpreted (t v), Covariant u)

@@ -12,7 +12,7 @@ import Pandora.Pattern.Object.Monoid (Monoid (zero)) import Pandora.Pattern.Object.Semigroup (Semigroup ((+))) import Pandora.Paradigm.Primary.Functor.Function ()-import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run, unite, (||=))) import Pandora.Paradigm.Controlflow.Effect.Transformer.Comonadic (Comonadic (bring), (:<) (TC)) import Pandora.Paradigm.Controlflow.Effect.Adaptable (Adaptable) import Pandora.Paradigm.Schemes.UT (UT (UT), type (<.:>))@@ -29,7 +29,7 @@ 	extract (Imprint x) = x zero  instance Divariant Imprint where-	(>->) ab cd bc = Imprint $ ab >-> cd $ run bc+	(>->) ab cd bc = (ab >-> cd) ||= bc  instance Semigroup e => Extendable (Imprint e) where 	Imprint x =>> f = Imprint $ \e -> f $ Imprint $ x . (e +)

@@ -59,6 +59,9 @@ replace :: Stateful s t => s -> t s replace s = adapt . State $ \_ -> s :*: s +reconcile :: (Bindable t, Stateful s t, Adaptable u t) => (s -> u s) -> t s+reconcile f = current >>= adapt . f >>= replace+ type Memorable s t = (Pointable t, Applicative t, Stateful s t)  fold :: (Traversable t, Memorable s u) => (a -> s -> s) -> t a -> u s

@@ -31,6 +31,11 @@ 	morphing (premorph -> Just x) = TU $ \_ -> Success x 	morphing (premorph -> Nothing) = TU $ \e -> Failure e +instance Morphable (Into (Flip Conclusion e)) Maybe where+	type Morphing (Into (Flip Conclusion e)) Maybe = (->) e <:.> Flip Conclusion e+	morphing (run . premorph -> Just x) = TU $ \_ -> Flip $ Failure x+	morphing (run . premorph -> Nothing) = TU $ Flip . Success+ instance Morphable (Into (Left Maybe)) Wye where 	type Morphing (Into (Left Maybe)) Wye = Maybe 	morphing (premorph -> Both ls _) = Just ls

@@ -1,9 +1,9 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} -module Pandora.Paradigm.Primary.Functor (module Exports, match) where+module Pandora.Paradigm.Primary.Functor (module Exports, Equivalence, Comparison, match) where  import Pandora.Paradigm.Primary.Functor.Fix as Exports-import Pandora.Paradigm.Primary.Functor.Equivalence as Exports+import Pandora.Paradigm.Primary.Functor.Convergence as Exports import Pandora.Paradigm.Primary.Functor.Predicate as Exports import Pandora.Paradigm.Primary.Functor.These as Exports import Pandora.Paradigm.Primary.Functor.Validation as Exports@@ -22,7 +22,11 @@  import Pandora.Pattern.Category (($)) import Pandora.Pattern.Functor.Adjoint (Adjoint ((-|), (|-)))-import Pandora.Paradigm.Primary.Object.Boolean ((?))+import Pandora.Paradigm.Primary.Object.Boolean (Boolean, (?))+import Pandora.Paradigm.Primary.Object.Ordering (Ordering)++type Equivalence = Convergence Boolean+type Comparison = Convergence Ordering  instance Adjoint (Product s) ((->) s) where 	(-|) :: a -> ((s :*: a) -> b) -> (s -> b)

@@ -0,0 +1,16 @@+module Pandora.Paradigm.Primary.Functor.Convergence where++import Pandora.Pattern.Category (($), (/))+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))+import Pandora.Pattern.Functor.Divisible (Divisible ((>*<)))+import Pandora.Pattern.Object.Ringoid (Ringoid ((*)))+import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)))++data Convergence r a = Convergence (a -> a -> r)++instance Contravariant (Convergence r) where+	f >$< Convergence g = Convergence $ \x y -> g / f x / f y++instance Ringoid r => Divisible (Convergence r) where+	Convergence g >*< Convergence h = Convergence $+		\(x :*: x') (y :*: y') -> g x y * h x' y'

@@ -1,17 +0,0 @@-module Pandora.Paradigm.Primary.Functor.Equivalence where--import Pandora.Pattern.Category (($), (/))-import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))-import Pandora.Pattern.Functor.Divisible (Divisible ((>*<)))-import Pandora.Pattern.Object.Ringoid (Ringoid ((*)))-import Pandora.Paradigm.Primary.Object.Boolean (Boolean)-import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)))--data Equivalence a = Equivalence (a -> a -> Boolean)--instance Contravariant Equivalence where-	f >$< Equivalence g = Equivalence $ \x y -> g / f x / f y--instance Divisible Equivalence where-	Equivalence g >*< Equivalence h = Equivalence $-		\(x :*: x') (y :*: y') -> g x y * h x' y'

@@ -6,6 +6,8 @@ import Pandora.Pattern.Functor.Pointable (Pointable (point)) import Pandora.Pattern.Functor.Applicative (Applicative ((<*>))) import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))+import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))+import Pandora.Pattern.Object.Monoid (Monoid (zero)) import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (reduce))  data Wye a = End | Left a | Right a | Both a a@@ -27,6 +29,22 @@ 	reduce f r (Right x) = f x r 	reduce f r (Both x y) = f y (f x r) 	reduce _ r End = r++instance Semigroup a => Semigroup (Wye a) where+	End + x = x+	x + End = x+	Left x + Left x' = Left / x + x'+	Left x + Right y = Both x y+	Left x + Both x' y = Both / x + x' / y+	Right y + Left x = Both x y+	Right y + Right y' = Right / y + y'+	Right y + Both x y' = Both x / y + y'+	Both x y + Left x' = Both / x + x' / y+	Both x y + Right y' = Both / x / y + y'+	Both x y + Both x' y' = Both / x + x' / y + y'++instance Semigroup a => Monoid (Wye a) where+	zero = End  wye :: r -> (a -> r) -> (a -> r) -> (a -> a -> r) -> Wye a -> r wye r _ _ _ End = r

@@ -1,8 +1,7 @@ module Pandora.Paradigm.Primary.Transformer.Flip where -import Pandora.Pattern.Category (($)) import Pandora.Pattern.Functor.Bivariant (Bivariant ((<->)))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite, (||=)))  newtype Flip (v :: * -> * -> *) a e = Flip (v e a) @@ -12,4 +11,4 @@ 	unite = Flip  instance Bivariant v => Bivariant (Flip v) where-	f <-> g = \x -> unite $ g <-> f $ run x+	f <-> g = \x -> (g <-> f) ||= x

@@ -13,7 +13,7 @@ import Pandora.Pattern.Functor.Pointable (point) import Pandora.Pattern.Transformer.Liftable (lift) import Pandora.Pattern.Object.Semigroup ((+))-import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, unite)+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (||=)) import Pandora.Paradigm.Inventory.Optics ((|>)) import Pandora.Paradigm.Inventory.Store (Store (Store)) import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False))@@ -66,7 +66,7 @@  instance Morphable (Into (o ds)) (Construction Wye) => Morphable (Into (o ds)) Binary where 	type Morphing (Into (o ds)) Binary = Maybe <:.> Morphing (Into (o ds)) (Construction Wye)-	morphing = unite . comap (into @(o ds)) . run . premorph+	morphing (premorph -> xs) = comap (into @(o ds)) ||= xs  instance Focusable Left (Product s) where 	type Focusing Left (Product s) a = s

@@ -5,7 +5,6 @@ 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.Deletable 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,9 +0,0 @@-module Pandora.Paradigm.Structure.Ability.Deletable where--import Pandora.Core.Functor (type (:=:=>))-import Pandora.Pattern.Object.Setoid (Setoid)--infixr 3 -=--class Deletable t where-	(-=) :: Setoid a => a :=:=> t

@@ -2,11 +2,7 @@  import Pandora.Pattern ((.|..)) import Pandora.Pattern.Category ((/))-import Pandora.Pattern.Functor ((<+>))-import Pandora.Pattern.Functor.Pointable (Pointable)-import Pandora.Pattern.Functor.Avoidable (Avoidable (empty)) import Pandora.Paradigm.Primary.Functor.Function ((!))-import Pandora.Paradigm.Primary.Functor.Predicate (Predicate, satisfy)  class Monotonic a e where 	{-# MINIMAL reduce #-}@@ -18,6 +14,3 @@  instance Monotonic a a where 	reduce f r x = f x r--find :: (Monotonic a e, Pointable t, Avoidable t) => Predicate a -> e -> t a-find p struct = reduce (\x r -> r <+> satisfy p x) empty struct

@@ -5,12 +5,17 @@ import Pandora.Core.Functor (type (:=), type (~>), type (:=:=>)) import Pandora.Pattern.Category ((.), (/)) import Pandora.Pattern.Functor.Extractable (extract)-import Pandora.Pattern.Object.Chain (Chain)+import Pandora.Pattern.Object.Chain (Chain ((<=>)))+import Pandora.Pattern.Object.Setoid (Setoid)+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.Predicate (Predicate, equate)+import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)), type (:*:)) import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag)) 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.Schemes.T_U (T_U (T_U), type (<:.:>))  class Morphable f t | f t -> t where 	type Morphing (f :: k) (t :: * -> *) :: * -> *@@ -24,8 +29,10 @@  data Walk a = Preorder a | Inorder a | Postorder a | Levelorder a -data Morph a = Rotate a | Into a | Insert a | Push a | Pop a+data Morph a = Rotate a | Into a | Insert a | Push a | Pop a | Delete a | Find a | Lookup a | Element a +data Occurrence a = All a | First a+ rotate :: forall f t . Morphable (Rotate f) t => t ~> Morphing (Rotate f) t rotate = morphing . TU . Tag @(Rotate f) @@ -38,6 +45,14 @@ item :: forall f t a . (Morphable f t, Morphing f t ~ (Identity <:.:> t := (->))) => a :=:=> t item new xs = run / morph @f xs / Identity new --- FIXME: doesn't work right now, quantified constraints in instances for Binary have ambigous variables-collate :: forall f t a . (Chain a, Morphable f t, Morphing f t ~ (Identity <:.:> t := (->))) => a :=:=> t-collate new xs = run / morph @f 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 (<=>))++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++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++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

@@ -27,6 +27,4 @@ 	subplace :: (Substructural f t) a -> t a -> t a 	subplace = set (sub @f) -data Command a = Delete a--data Segment a = All a | First a | Tail a+data Segment a = Tail a

@@ -1,6 +1,17 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+ module Pandora.Paradigm.Structure.Interface.Dictionary where -import Pandora.Paradigm.Primary.Functor.Maybe (Maybe)+import Pandora.Pattern.Category ((/))+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)+import Pandora.Paradigm.Schemes.TU (type (<:.>)) -class Dictionary a k t where-	(?=) :: k -> t a -> Maybe a+import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing), Morph (Lookup), morph)++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

@@ -1,25 +1,29 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+ module Pandora.Paradigm.Structure.Interface.Set where +import Pandora.Core.Functor (type (:=)) import Pandora.Pattern.Category ((.), ($)) import Pandora.Pattern.Functor.Traversable (Traversable ((->>))) import Pandora.Pattern.Object.Setoid (Setoid ((!=))) import Pandora.Pattern.Object.Semigroup ((+)) import Pandora.Pattern.Object.Quasiring (one)-import Pandora.Paradigm.Primary.Functor.Function ((!), (!!), (%))+import Pandora.Paradigm.Primary.Functor.Function ((!), (%))+import Pandora.Paradigm.Primary.Functor.Convergence (Convergence (Convergence)) import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Nothing))-import Pandora.Paradigm.Primary.Functor.Predicate (equate)+import Pandora.Paradigm.Primary.Functor.Predicate (Predicate, equate) import Pandora.Paradigm.Primary.Functor.Product (attached)-import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False))+import Pandora.Paradigm.Primary.Object.Boolean (Boolean) import Pandora.Paradigm.Primary.Object.Numerator (Numerator (Zero))-import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (reduce), find)+import Pandora.Paradigm.Schemes.T_U (type (<:.:>))+import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing), Morph (Find), find) import Pandora.Paradigm.Inventory.State (State, modify) import Pandora.Paradigm.Controlflow.Effect (run) -member :: forall e a . (Setoid a, Monotonic a e) => a -> e -> Boolean-member x = reduce @a @(Maybe a) (True !!) False . find (equate x)+type Set t f a = (Traversable t, Setoid a, Setoid (t a), Morphable (Find f) t) -subset :: (Monotonic a (t a), Traversable t, Setoid a, Setoid (t a)) => t a -> t a -> Boolean-subset ss s = Nothing != ss ->> find % s . equate+subset :: forall t f a . (Set t f a, Morphing (Find f) t ~ (Predicate <:.:> Maybe := (->))) => Convergence Boolean := t a+subset = Convergence $ \s ss -> Nothing != ss ->> find @f @t @Maybe % s . equate  cardinality :: Traversable t => t a -> Numerator cardinality s = attached . run @(State _) % Zero $ s ->> (modify @Numerator (+ one) !)

@@ -3,7 +3,7 @@ import Pandora.Paradigm.Structure.Ability.Morphable (Morphable, Morph (Push, Pop))  {- |-> When providing a new instance, you should ensure it satisfies this one law:+> When providing a new instance, you should ensure it satisfies: > * Idempotency: item @Push x . morph @Pop ≡ identity -} 

@@ -1,3 +1,4 @@+{-# OPTIONS_GHC -fno-warn-orphans #-} {-# LANGUAGE UndecidableInstances #-}  module Pandora.Paradigm.Structure.Modification.Comprehension where@@ -5,16 +6,26 @@ import Pandora.Core.Functor (type (:=)) import Pandora.Pattern.Category ((.), ($)) import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))+import Pandora.Pattern.Functor.Contravariant ((>$<)) import Pandora.Pattern.Functor.Pointable (Pointable (point)) import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))+import Pandora.Pattern.Functor.Alternative (Alternative ((<+>))) import Pandora.Pattern.Functor.Avoidable (Avoidable (empty)) import Pandora.Pattern.Functor.Traversable (Traversable ((->>))) import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))+import Pandora.Pattern.Functor.Monad (Monad)+import Pandora.Pattern.Transformer.Liftable (lift) import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))+import Pandora.Pattern.Object.Monoid (Monoid (zero))+import Pandora.Pattern.Object.Setoid (Setoid ((==)))+import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity)) import Pandora.Paradigm.Primary.Functor.Function ((%)) import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct)) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite)) import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>))+import Pandora.Paradigm.Schemes.T_U (T_U (T_U), type (<:.:>))+import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Push), premorph)+import Pandora.Paradigm.Structure.Ability.Nullable (Nullable (null))  newtype Comprehension t a = Comprehension (t <:.> Construction t := a) @@ -29,6 +40,12 @@ instance (Avoidable t, Pointable t) => Pointable (Comprehension t) where 	point = Comprehension . TU . point . Construct % empty +instance Alternative t => Alternative (Comprehension t) where+	Comprehension x <+> Comprehension y = Comprehension $ x <+> y++instance (Avoidable t, Alternative t) => Avoidable (Comprehension t) where+	empty = Comprehension empty+ instance Traversable (t <:.> Construction t) => Traversable (Comprehension t) where 	Comprehension x ->> f = Comprehension <$> x ->> f @@ -36,4 +53,22 @@ 	fs <*> xs = fs >>= \f -> xs >>= Comprehension . TU . point . point . f  instance (forall a . Semigroup (t <:.> Construction t := a), Bindable t) => Bindable (Comprehension t) where-	Comprehension (TU t) >>= f = Comprehension . TU $ t >>= \(Construct x xs) -> run $ run (f x) + run (Comprehension (TU xs) >>= f)+	Comprehension (TU t) >>= f = Comprehension . TU $ t >>= \(Construct x xs) -> run . run $ f x + (Comprehension (TU xs) >>= f)++instance (forall a . Semigroup (t <:.> Construction t := a), Pointable t, Avoidable t, Bindable t) => Monad (Comprehension t) where++instance Setoid (t <:.> Construction t := a) => Setoid (Comprehension t a) where+	Comprehension ls == Comprehension rs = ls == rs++instance Semigroup (t <:.> Construction t := a) => Semigroup (Comprehension t a) where+	Comprehension x + Comprehension y = Comprehension $ x + y++instance Monoid (t <:.> Construction t := a) => Monoid (Comprehension t a) where+	zero = Comprehension zero++instance Pointable t => Morphable Push (Comprehension t) where+	type Morphing Push (Comprehension t) = Identity <:.:> Comprehension t := (->)+	morphing (run . premorph -> xs) = T_U $ \(Identity x) -> Comprehension . lift . Construct x . run $ xs++instance Nullable (t <:.> Construction t) => Nullable (Comprehension t) where+	null = run >$< null

@@ -2,42 +2,27 @@  module Pandora.Paradigm.Structure.Modification.Prefixed where -import Pandora.Core.Functor (type (:=))+import Pandora.Core.Functor (type (:.), type (:=)) import Pandora.Pattern.Category ((.), ($))-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))-import Pandora.Pattern.Functor.Contravariant ((>$<))+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>))) import Pandora.Pattern.Functor.Pointable (Pointable (point))-import Pandora.Pattern.Functor.Extractable (Extractable (extract))-import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))-import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))-import Pandora.Pattern.Transformer.Liftable (lift)+import Pandora.Pattern.Functor.Traversable (Traversable ((->>), (->>>))) import Pandora.Pattern.Object.Monoid (Monoid (zero))-import Pandora.Pattern.Object.Setoid (Setoid)-import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just))-import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)), attached)-import Pandora.Paradigm.Primary.Functor.Predicate (equate)+import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:))) import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run, unite))-import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>))-import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic, find)-import Pandora.Paradigm.Structure.Interface.Dictionary (Dictionary ((?=))) -type Keyed k = Product k <:.> Maybe--newtype Prefixed t k a = Prefixed (t <:.> Keyed k := a)+newtype Prefixed t k a = Prefixed (t :. Product k := a)  instance Interpreted (Prefixed t k) where-	type Primary (Prefixed t k) a = t <:.> Keyed k := a+	type Primary (Prefixed t k) a = t :. Product k := a 	run ~(Prefixed x) = x 	unite = Prefixed  instance Covariant t => Covariant (Prefixed t k) where-	f <$> Prefixed x = Prefixed $ f <$> x+	f <$> Prefixed x = Prefixed $ f <$$> x  instance Traversable t => Traversable (Prefixed t k) where-	Prefixed x ->> f = Prefixed <$> x ->> f+	Prefixed x ->> f = Prefixed <$> x ->>> f  instance (Monoid k, Pointable t) => Pointable (Prefixed t k) where-	point = Prefixed . lift . TU . (:*:) zero . Just--instance (Monotonic (Keyed k a) (t (Keyed k a)), Setoid k) => Dictionary a k (Prefixed t k) where-	k ?= Prefixed x = find @(Keyed k a) (attached . run >$< equate k) (run x) >>= extract . run+	point = Prefixed . point . (:*:) zero

@@ -3,7 +3,7 @@ module Pandora.Paradigm.Structure.Some.Binary where  import Pandora.Core.Functor (type (:.), type (:=))-import Pandora.Pattern.Category ((.), ($), (/))+import Pandora.Pattern.Category (identity, (.), ($), (/)) import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), comap)) import Pandora.Pattern.Functor.Traversable (Traversable ((->>))) import Pandora.Pattern.Functor.Extractable (extract)@@ -15,7 +15,9 @@ import Pandora.Paradigm.Primary.Object.Ordering (order) import Pandora.Paradigm.Primary.Object.Numerator (Numerator (Numerator, Zero)) import Pandora.Paradigm.Primary.Object.Denumerator (Denumerator (One))-import Pandora.Paradigm.Primary.Functor.Function ((!), (%), (&))+import Pandora.Paradigm.Primary.Functor (Comparison)+import Pandora.Paradigm.Primary.Functor.Convergence (Convergence (Convergence))+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))@@ -33,7 +35,7 @@ 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), premorph, collate)+import Pandora.Paradigm.Structure.Ability.Morphable (Morphable (Morphing, morphing), Morph (Rotate, Into, Insert), morph, premorph) import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substructural, substructure), sub, substitute) import Pandora.Paradigm.Structure.Ability.Zipper (Zipper) @@ -45,11 +47,12 @@ 	(Construct / extract x $ Both / rebalance (deconstruct x) / rebalance (deconstruct y)) 	(Construct / extract x $ Both / rebalance (deconstruct x) / y) -instance (forall a . Chain a) => Morphable Insert Binary where-	type Morphing Insert Binary = Identity <:.:> Binary := (->)-	morphing (run . premorph -> Nothing) = T_U $ \(Identity x) -> lift . Construct x $ End-	morphing (run . premorph -> Just ne) = T_U $ \(Identity x) -> lift $ x <=> extract ne-		& order (ne & substitute @Left (collate @Insert x)) ne (ne & substitute @Right (collate @Insert x))+instance Morphable Insert Binary where+	type Morphing Insert Binary = (Identity <:.:> Comparison := (:*:)) <:.:> Binary := (->)+	morphing (run . premorph -> Nothing) = T_U $ \(T_U (Identity x :*: _)) -> lift . Construct x $ End+	morphing (run . premorph -> Just ne) = T_U $ \(T_U (Identity x :*: Convergence f)) ->+		let continue xs = run / morph @Insert xs $ twosome / Identity x / Convergence f+		in lift $ f x (extract ne) & order (ne & substitute @Left continue) ne (ne & substitute @Right continue)  instance (forall a . Chain a) => Focusable Root Binary where 	type Focusing Root Binary a = Maybe a@@ -66,12 +69,12 @@  instance Substructure Left Binary where 	type Substructural Left Binary = Binary-	substructure empty_tree@(run . extract . run -> Nothing) = Store $ extract (run empty_tree) :*: (!) empty_tree+	substructure (run . extract . run -> Nothing) = Store $ empty :*: lift . identity 	substructure (run . extract . run -> Just tree) = lift . lift <$> sub @Left tree  instance Substructure Right Binary where 	type Substructural Right Binary = Binary-	substructure empty_tree@(run . extract . run -> Nothing) = Store $ extract (run empty_tree) :*: (!) empty_tree+	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@@ -88,10 +91,12 @@ 	type Morphing (Into Binary) (Construction Wye) = Binary 	morphing = lift . premorph -instance (forall a . Chain a) => Morphable Insert (Construction Wye) where-	type Morphing Insert (Construction Wye) = Identity <:.:> Construction Wye := (->)-	morphing (premorph -> xs) = T_U $ \(Identity x) -> let change = lift . resolve (collate @Insert x) (Construct x End) . run in-		x <=> extract xs & order (over / sub @Left / change / xs) xs (over / sub @Right / change / xs)+instance Morphable Insert (Construction Wye) where+	type Morphing Insert (Construction Wye) = (Identity <:.:> Comparison := (:*:)) <:.:> Construction Wye := (->)+	morphing (premorph -> ne) = T_U $ \(T_U (Identity x :*: Convergence f)) ->+		let continue xs = run / morph @Insert @(Nonempty Binary) xs $ twosome / Identity x / Convergence f in+		let change = lift . resolve continue (Construct x End) . run in+		f x (extract ne) & order (over / sub @Left / change / ne) ne (over / sub @Right / change / ne)  instance Focusable Root (Construction Wye) where 	type Focusing Root (Construction Wye) a = a@@ -108,8 +113,8 @@  instance Substructure Left (Construction Wye) where 	type Substructural Left (Construction Wye) = Binary-	substructure empty_tree@(extract . run -> Construct _ End) =-		Store $ empty :*: (empty_tree !)+	substructure (extract . run -> Construct x End) =+		Store $ empty :*: lift . resolve (Construct x . Left) (Construct x End) . 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)) =@@ -119,8 +124,8 @@  instance Substructure Right (Construction Wye) where 	type Substructural Right (Construction Wye) = Binary-	substructure emtpy_tree@(extract . run -> Construct _ End) =-		Store $ empty :*: (emtpy_tree !)+	substructure (extract . run -> Construct x End) =+		Store $ empty :*: lift . resolve (Construct x . Right) (Construct x End) . 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)) =

@@ -4,13 +4,18 @@  import Pandora.Core.Functor (type (:.), type (:=)) import Pandora.Pattern ((.|..))-import Pandora.Pattern.Category ((.), ($), identity)+import Pandora.Pattern.Category ((.), (/), ($), identity) 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.Traversable (Traversable ((->>))) import Pandora.Pattern.Functor.Extendable (Extendable ((=>>)))+import Pandora.Pattern.Functor.Bivariant ((<->))+import Pandora.Pattern.Functor.Adjoint ((|-))+import Pandora.Pattern.Functor () 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))@@ -21,12 +26,13 @@ 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 (:*:), twosome)+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))-import Pandora.Paradigm.Inventory.State (State, fold)+import Pandora.Paradigm.Primary.Transformer.Reverse (Reverse (Reverse))+import Pandora.Paradigm.Inventory.State (State, fold, modify) import Pandora.Paradigm.Inventory.Store (Store (Store)) import Pandora.Paradigm.Inventory.Optics (view) import Pandora.Paradigm.Controlflow.Effect.Interpreted (run, (||=))@@ -36,10 +42,10 @@ 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.Deletable (Deletable ((-=))) 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), premorph, rotate, item)+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), Segment (Tail), sub, subview) import Pandora.Paradigm.Structure.Interface.Stack (Stack) @@ -65,6 +71,24 @@ 	type Morphing Pop List = List 	morphing (premorph -> xs) = resolve deconstruct Nothing ||= xs +instance Morphable (Find Element) List where+	type Morphing (Find Element) List = Predicate <:.:> Maybe := (->)+	morphing (premorph -> TU Nothing) = T_U $ \_ -> Nothing+	morphing (premorph -> TU (Just (Construct x xs))) = T_U $ \p ->+		run p x ? Just x $ (find @Element @List @Maybe / p / TU xs)++instance Morphable (Delete First) List where+	type Morphing (Delete First) List = Predicate <:.:> List := (->)+	morphing (premorph -> TU Nothing) = T_U $ \_ -> TU Nothing+	morphing (premorph -> TU (Just (Construct x xs))) = T_U $ \p ->+		run p x ? TU xs $ lift . Construct x . run . filter @First @List p $ TU xs++instance Morphable (Delete All) List where+	type Morphing (Delete All) List = Predicate <:.:> List := (->)+	morphing (premorph -> TU Nothing) = T_U $ \_ -> TU Nothing+	morphing (premorph -> TU (Just (Construct x xs))) = T_U $ \p ->+		run p x ? filter @All @List p (TU xs) $ lift . Construct x . run . filter @All @List p $ TU xs+ instance Stack List where  instance Focusable Head List where@@ -86,16 +110,6 @@ 	substructure (run . extract . run -> Just ns) = lift . lift <$> sub @Tail ns 	substructure (run . extract . run -> Nothing) = Store $ empty :*: lift . identity -instance Deletable List where-	_ -= TU Nothing = TU Nothing-	x -= TU (Just (Construct y ys)) = x == y ? TU ys-		$ lift . Construct y . run . (-=) @List x $ TU ys--filter :: forall a . Predicate a -> List a -> List a-filter (Predicate p) = TU . extract-	. run @(State (Maybe :. Nonempty List := a)) % Nothing-	. fold (\now new -> p now ? Just (Construct now new) $ new)- -- | 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)@@ -133,30 +147,76 @@  type instance Zipper List = Tap (List <:.:> List := (:*:)) +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+ instance {-# OVERLAPS #-} Extendable (Tap (List <:.:> List := (:*:))) where-	z =>> f = let move rtt = TU . deconstruct $ rtt .-+ z-		in f <$> Tap z (twosome (move $ run . rotate @Left) (move $ run . rotate @Right))+	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 (bs :*: fs))) = TU-		$ Tap % twosome (subview @Tail bs) (item @Push x fs) <$> view (focus @Head) bs+	morphing (premorph -> Tap x (T_U (future :*: past))) = TU+		$ Tap % twosome (subview @Tail future) (item @Push x past) <$> view (focus @Head) 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 (bs :*: fs))) = TU-		$ Tap % twosome (item @Push x bs) (subview @Tail fs) <$> view (focus @Head) fs+	morphing (premorph -> Tap x (T_U (future :*: past))) = TU+		$ Tap % twosome (item @Push x future) (subview @Tail past) <$> view (focus @Head) past +instance Morphable (Into (Tap (List <:.:> List := (:*:)))) List where+	type Morphing (Into (Tap (List <:.:> List := (:*:)))) List = Maybe <:.> Zipper List+	morphing (premorph -> list) = (into @(Zipper List) <$>) ||= list++instance Morphable (Into List) (Tap (List <:.:> List := (:*:))) where+	type Morphing (Into List) (Tap (List <:.:> List := (:*:))) = List+	morphing (premorph -> Tap x (T_U (future :*: past))) = attached . run @(State _)+		% item @Push x future $ past ->> modify . item @Push @List+ type instance Zipper (Construction Maybe) = Tap (Construction Maybe <:.:> Construction Maybe := (:*:)) +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 (bs :*: fs))) = TU-		$ Tap (extract bs) . twosome % (item @Push x fs) <$> deconstruct bs+	morphing (premorph -> Tap x (T_U (future :*: past))) = TU $ Tap (extract future) . twosome % item @Push x past <$> deconstruct future  instance Morphable (Rotate Right) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where 	type Morphing (Rotate Right) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) = Maybe <:.> Zipper (Construction Maybe)-	morphing (premorph -> Tap x (T_U (bs :*: fs))) = TU $ Tap (extract fs) . twosome (item @Push x bs) <$> deconstruct fs+	morphing (premorph -> Tap x (T_U (future :*: past))) = TU $ Tap (extract past) . twosome (item @Push x future) <$> deconstruct past++instance Morphable (Into (Tap (List <:.:> List := (:*:)))) (Construction Maybe) where+	type Morphing (Into (Tap (List <:.:> List := (:*:)))) (Construction Maybe) = Zipper List+	morphing (premorph -> ne) = Tap / extract ne $ twosome / view (sub @Tail) ne / empty++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++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)+	morphing (premorph -> zipper) = let spread x y = (:*:) <$> x <*> y in TU $ Tap (extract zipper) . T_U <$> ((|- spread) . (run <-> run) . run $ lower zipper)++instance Morphable (Into (Construction Maybe)) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where+	type Morphing (Into (Construction Maybe)) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) = Construction Maybe+	morphing (premorph -> Tap x (T_U (future :*: past))) = attached . run @(State _)+		% item @Push x future $ past ->> modify . item @Push @(Nonempty List)++instance Morphable (Into List) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) where+	type Morphing (Into List) (Tap (Construction Maybe <:.:> Construction Maybe := (:*:))) = List+	morphing (premorph -> Tap x (T_U (future :*: past))) = attached . run @(State _)+		% item @Push x (lift future) $ past ->> modify . item @Push @List  instance Monotonic a (Maybe <:.> Construction Maybe := a) where 	reduce f r = reduce f r . run

@@ -2,16 +2,20 @@  module Pandora.Paradigm.Structure.Some.Rose where -import Pandora.Pattern.Category ((.), ($))+import Pandora.Core.Functor (type (:.), type (:=))+import Pandora.Pattern.Category ((.), ($), (/)) import Pandora.Pattern.Functor.Covariant (Covariant (comap))+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.Paradigm.Primary.Object.Boolean (Boolean (True, False))+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.Maybe (Maybe (Just, Nothing))-import Pandora.Paradigm.Primary.Functor.Predicate (Predicate (Predicate))-import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)))+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 (<:.>))@@ -19,9 +23,11 @@ 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.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.Some.List (List)  type Rose = Maybe <:.> Construction List@@ -51,3 +57,15 @@ 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 Setoid k => Morphable (Lookup Element) (Prefixed Rose k) where+	type Morphing (Lookup Element) (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++find_rose_sub_tree :: forall k a . Setoid k => Nonempty List k -> Nonempty Rose := k :*: a -> Maybe a+find_rose_sub_tree (Construct k Nothing) tree = k == attached (extract tree) ? Just (extract $ extract tree) $ Nothing+find_rose_sub_tree (Construct k (Just ks)) tree = k != attached (extract tree) ? Nothing $ subtree >>= find_rose_sub_tree ks where++	subtree :: Maybe :. Nonempty Rose := k :*: a+	subtree = find @Element / attached . extract >$< equate (extract ks) / deconstruct tree

@@ -8,7 +8,7 @@ infixl 3 -|, |-, -|$, $|-, $$|-, $$$|-, $$$$|-  {- |-> When providing a new instance, you should ensure it satisfies the four laws:+> When providing a new instance, you should ensure it satisfies: > * Left adjunction identity: phi cozero ≡ identity > * Right adjunction identity: psi zero ≡ identity > * Left adjunction interchange: phi f ≡ comap f . eta

@@ -5,7 +5,7 @@ infixl 3 <+>  {- |-> When providing a new instance, you should ensure it satisfies the two laws:+> When providing a new instance, you should ensure it satisfies: > * Associativity of <+>: (x <+> y) <+> z ≡ x <+> (y <+> z) > * Left-distributes <$> over <+>: f <$> (x <+> y) ≡ (f <$> x) <+> (f <$> y) -}

@@ -9,7 +9,7 @@ infixl 1 <****>  {- |-> When providing a new instance, you should ensure it satisfies the three laws:+> When providing a new instance, you should ensure it satisfies: > * Interpreted: (.) <$> u <*> v <*> w ≡ u <*> (v <*> w) > * Left interchange: x <*> (f <$> y) ≡ (. f) <$> x <*> y > * Right interchange: f <$> (x <*> y) ≡ (f .) <$> x <*> y@@ -19,7 +19,6 @@ 	{-# MINIMAL (<*>) #-} 	-- | Infix version of 'apply' 	(<*>) :: t (a -> b) -> t a -> t b- 	-- | Prefix version of '<*>' 	apply :: t (a -> b) -> t a -> t b 	apply f x = f <*> x@@ -32,7 +31,9 @@ 	-- | Repeat an action indefinitely 	forever :: t a -> t b 	forever x = x *> forever x-+	-- | Flipped version of '<*>'+	(<%>) :: t a -> t (a -> b) -> t b+	x <%> f = (\x' f' -> f' x') <$> x <*> f 	-- | Infix versions of `apply` with various nesting levels 	(<**>) :: Applicative u => t :. u := (a -> b) -> t :. u := a -> t :. u := b 	f <**> x = (<*>) <$> f <*> x

@@ -3,7 +3,7 @@ import Pandora.Pattern.Functor.Alternative (Alternative)  {- |-> When providing a new instance, you should ensure it satisfies the two laws:+> When providing a new instance, you should ensure it satisfies: > * Left absorption: x <+> empty ≡ x > * Right absorption: empty <+> x ≡ x -}

@@ -7,7 +7,7 @@ infixr 1 =<<, <=<, >=>  {- |-> When providing a new instance, you should ensure it satisfies the one law:+> When providing a new instance, you should ensure it satisfies : > * Interchange: t >>= f = join (f <$> t) -} 

@@ -3,7 +3,7 @@ infixl 4 <->  {- |-> When providing a new instance, you should ensure it satisfies the two laws:+> When providing a new instance, you should ensure it satisfies: > * Identity: bimap identity identity ≡ identity > * Parametricity: bimap  (f . g) (h . i) ≡ bimap f h . bimap g i -}

@@ -7,7 +7,7 @@ > Let f :: (Pointable t, Bindable t) => t a -> b > Let g :: (Pointable t, Bindable t) => t a -> b -> When providing a new instance, you should ensure it satisfies the three laws:+> When providing a new instance, you should ensure it satisfies: > * Left identity: extend extract ≡ identity > * Right identity: extract . extend f ≡ f > * Associativity: extend f . extend g ≡ extend (f . extend g)

@@ -5,7 +5,7 @@ infixl 4 >$<, $<, >$  {- |-> When providing a new instance, you should ensure it satisfies the two laws:+> When providing a new instance, you should ensure it satisfies: > * Identity morphism: contramap identity ≡ identity > * Interpreted of morphisms: contramap f . contramap g ≡ contramap (g . f) -}

@@ -13,7 +13,7 @@ infixl 4 <&&&&>  {- |-> When providing a new instance, you should ensure it satisfies the two laws:+> When providing a new instance, you should ensure it satisfies: > * Identity morphism: comap identity ≡ identity > * Interpreted of morphisms: comap (f . g) ≡ comap f . comap g -}

@@ -6,7 +6,7 @@ {- | > Let f :: Distributive g => (a -> g b) -> When providing a new instance, you should ensure it satisfies the two laws:+> When providing a new instance, you should ensure it satisfies: > * Identity morphism: distribute . distribute ≡ identity > * Interchange collection: collect f ≡ distribute . comap f -}

@@ -3,7 +3,7 @@ infixl 4 >->  {- |-> When providing a new instance, you should ensure it satisfies the two laws:+> When providing a new instance, you should ensure it satisfies: > * Identity: dimap identity identity ≡ identity > * Interpreted: dimap (f . g) (h . i) ≡ dimap g h . dimap f i -}

@@ -7,7 +7,7 @@ infixr 1 <<=, =<=, =>=  {- |-> When providing a new instance, you should ensure it satisfies the three laws:+> When providing a new instance, you should ensure it satisfies: > * Duplication interchange: comap (comap f) . duplicate ≡ duplicate . comap f > * Extension interchange: extend f ≡ comap f . duplicate -}

@@ -1,7 +1,7 @@ module Pandora.Pattern.Functor.Invariant where  {- |-> When providing a new instance, you should ensure it satisfies the two laws:+> When providing a new instance, you should ensure it satisfies: > Identity morphisms: invmap identity identity = identity > Interpreted of morphisms: invmap g j . invmap f h = invmap (g . f) (h . j) -}

@@ -8,7 +8,7 @@ > Let g :: (Pointable t, Bindable t) => a -> t a > Let h :: (Pointable t, Bindable t) => t a -> When providing a new instance, you should ensure it satisfies the three laws:+> When providing a new instance, you should ensure it satisfies: > * Left identity: point a >>= f ≡ f a > * Right identity: h >>= point ≡ h > * Associativity: h >>= (f >=> g) ≡ (h >>= f) >>= g

@@ -6,3 +6,6 @@ class Covariant t => Pointable t where 	{-# MINIMAL point #-} 	point :: a :=> t++	pass :: t ()+	pass = point ()

@@ -4,7 +4,7 @@ import Pandora.Pattern.Functor.Pointable (Pointable)  {- |-> When providing a new instance, you should ensure it satisfies the three laws:+> When providing a new instance, you should ensure it satisfies: > * Isomorphism (to): tabulate . index ≡ identity > * Isomorphism (from): index . tabulate ≡ identity > * Right adjoint: tabulate . point ≡ point

@@ -9,7 +9,7 @@ > Let f :: (Applicative t, Applicative g) => t a -> u a > Let p :: (Pointable t, Pointable g) => t a -> u a -> When providing a new instance, you should ensure it satisfies the four laws:+> When providing a new instance, you should ensure it satisfies: > * Numeratority of traversing: g . traverse f ≡ traverse (g . f) > * Numeratority of sequencing: f . sequence = sequence . comap f > * Preserving point: p (point x) ≡ point x

@@ -9,5 +9,6 @@ import Pandora.Pattern.Object.Semiring as Exports import Pandora.Pattern.Object.Ringoid as Exports import Pandora.Pattern.Object.Semigroup as Exports+import Pandora.Pattern.Object.Cycle as Exports import Pandora.Pattern.Object.Chain as Exports import Pandora.Pattern.Object.Setoid as Exports

@@ -7,7 +7,7 @@ infixl 4 <=>, <, <=, >=, >  {- |-> When providing a new instance, you should ensure it satisfies the three laws:+> When providing a new instance, you should ensure it satisfies: > * Reflexivity: x <= x ≡ True > * Transitivity: x <= y && y <= z ≡ True ===> x <= z ≡ True > * Antisymmetry: x <= y && y <= x ≡ True ===> x == y ≡ True

@@ -0,0 +1,14 @@+module Pandora.Pattern.Object.Cycle (Cycle (..)) where++import Pandora.Pattern.Object.Chain (Chain)++{- |+> When providing a new instance, you should ensure it satisfies:+> * Transitivity: x ≡ previous (next x)+-}++-- | Strict ternary relation order+class Chain a => Cycle a where+	{-# MINIMAL previous, next #-}+	previous :: a -> a+	next :: a -> a

@@ -6,7 +6,7 @@ infixl 6 -  {- |-> When providing a new instance, you should ensure it satisfies the two laws:+> When providing a new instance, you should ensure it satisfies: > * Right absorption: x + invert x ≡ zero > * Left absorption: invert x + x ≡ zero -}

@@ -3,7 +3,7 @@ import Pandora.Pattern.Object.Semilattice (Infimum, Supremum)  {- |-> When providing a new instance, you should ensure it satisfies the one law:+> When providing a new instance, you should ensure it satisfies: > * Absorption: a \/ (a /\ b) ≡ a /\ (a \/ b) ≡ a -} 

@@ -3,7 +3,7 @@ import Pandora.Pattern.Object.Semigroup (Semigroup)  {- |-> When providing a new instance, you should ensure it satisfies the two laws:+> When providing a new instance, you should ensure it satisfies: > * Right absorption: zero + x ≡ x > * Left absorption: x + zero ≡ x -}

@@ -4,7 +4,7 @@ import Pandora.Pattern.Object.Ringoid (Ringoid)  {- |-> When providing a new instance, you should ensure it satisfies the one law:+> When providing a new instance, you should ensure it satisfies: > * Additive identity is a multiplicative annihilator: zero * x = x  * zero = zero -} 

@@ -3,7 +3,7 @@ import Pandora.Pattern.Object.Group (Group)  {- |-> When providing a new instance, you should ensure it satisfies the one law:+> When providing a new instance, you should ensure it satisfies: > * Commutativity of addition: x + y ≡ y + x -} 

@@ -5,7 +5,7 @@ infixl 7 *  {- |-> When providing a new instance, you should ensure it satisfies the two laws:+> When providing a new instance, you should ensure it satisfies: > * Left distributivity: x * (y + z) ≡ x * y + x * z > * Right distributivity: (y + z) * x ≡ y * x + z * x -}

@@ -3,7 +3,7 @@ infixl 6 +  {- |-> When providing a new instance, you should ensure it satisfies the one law:+> When providing a new instance, you should ensure it satisfies: > * Associativity: x + (y + z) ≡ (x + y) + z -} 

@@ -1,7 +1,7 @@ module Pandora.Pattern.Object.Semilattice (Infimum (..), Supremum (..), Semilattice) where  {- |-> When providing a new instance, you should ensure it satisfies the three laws:+> When providing a new instance, you should ensure it satisfies: > * Associativity: x /\ (y /\ z) ≡ (x /\ y) /\ z > * Commutativity: x /\ y ≡ y /\ x > * Idempotency: x /\ x ≡ x@@ -12,7 +12,7 @@ 	(/\) :: a -> a -> a  {- |-> When providing a new instance, you should ensure it satisfies the three laws:+> When providing a new instance, you should ensure it satisfies: > * Associativity: x \/ (y \/ z) ≡ (x \/ y) \/ z > * Commutativity: x \/ y ≡ y \/ x > * Idempotency: x \/ x ≡ x

@@ -3,7 +3,7 @@ import Pandora.Pattern.Object.Ringoid (Ringoid)  {- |-> When providing a new instance, you should ensure it satisfies one law:+> When providing a new instance, you should ensure it satisfies: > * Associativity: x * (y * z) ≡ (x * y) * z -} 

@@ -5,7 +5,7 @@ infix 4 ==, !=  {- |-> When providing a new instance, you should ensure it satisfies the four laws:+> When providing a new instance, you should ensure it satisfies: > * Reflexivity: x == x ≡ True > * Symmetry: x == y ≡ y == x > * Transitivity: x == y * y == z ≡ True ===> x == z ≡ True

@@ -1,5 +1,5 @@ name:                pandora-version:             0.3.8+version:             0.3.9 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@@ -48,7 +48,7 @@     Pandora.Paradigm.Primary.Functor.Wye     Pandora.Paradigm.Primary.Functor.Wedge     Pandora.Paradigm.Primary.Functor.Predicate-    Pandora.Paradigm.Primary.Functor.Equivalence+    Pandora.Paradigm.Primary.Functor.Convergence     Pandora.Paradigm.Primary.Transformer     Pandora.Paradigm.Primary.Transformer.Backwards     Pandora.Paradigm.Primary.Transformer.Reverse@@ -96,7 +96,6 @@     Pandora.Paradigm.Structure     Pandora.Paradigm.Structure.Ability     Pandora.Paradigm.Structure.Ability.Morphable-    Pandora.Paradigm.Structure.Ability.Deletable     Pandora.Paradigm.Structure.Ability.Accessible     Pandora.Paradigm.Structure.Ability.Focusable     Pandora.Paradigm.Structure.Ability.Measurable@@ -146,17 +145,18 @@     Pandora.Pattern.Functor.Bivariant     -- Typeclassess about object internals     Pandora.Pattern.Object+    Pandora.Pattern.Object.Setoid     Pandora.Pattern.Object.Chain+    Pandora.Pattern.Object.Cycle+    Pandora.Pattern.Object.Semigroup+    Pandora.Pattern.Object.Monoid     Pandora.Pattern.Object.Group     Pandora.Pattern.Object.Lattice-    Pandora.Pattern.Object.Monoid     Pandora.Pattern.Object.Quasiring     Pandora.Pattern.Object.Ring     Pandora.Pattern.Object.Ringoid-    Pandora.Pattern.Object.Semigroup     Pandora.Pattern.Object.Semilattice     Pandora.Pattern.Object.Semiring-    Pandora.Pattern.Object.Setoid     -- Typeclassess about object composition of functors     Pandora.Pattern.Transformer     Pandora.Pattern.Transformer.Hoistable