summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoriokasimovmt <>2021-04-08 04:50:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2021-04-08 04:50:00 (GMT)
commitf4ca02408bafac6d8b44ed46387247c635b88932 (patch)
tree06bcc1487ca6ceed9fac88668556b17880681bfc
parent9932aa20518450ad0f727ec5d724663ae4c3993e (diff)
version 0.3.9HEAD0.3.9master
-rwxr-xr-xCHANGELOG.md18
-rw-r--r--Pandora/Paradigm/Controlflow/Effect/Interpreted.hs4
-rw-r--r--Pandora/Paradigm/Inventory/Imprint.hs4
-rw-r--r--Pandora/Paradigm/Inventory/State.hs3
-rw-r--r--Pandora/Paradigm/Primary.hs5
-rw-r--r--Pandora/Paradigm/Primary/Functor.hs10
-rw-r--r--Pandora/Paradigm/Primary/Functor/Convergence.hs16
-rw-r--r--Pandora/Paradigm/Primary/Functor/Equivalence.hs17
-rw-r--r--Pandora/Paradigm/Primary/Functor/Wye.hs18
-rw-r--r--Pandora/Paradigm/Primary/Transformer/Flip.hs5
-rw-r--r--Pandora/Paradigm/Structure.hs4
-rw-r--r--Pandora/Paradigm/Structure/Ability.hs1
-rw-r--r--Pandora/Paradigm/Structure/Ability/Deletable.hs9
-rw-r--r--Pandora/Paradigm/Structure/Ability/Monotonic.hs7
-rw-r--r--Pandora/Paradigm/Structure/Ability/Morphable.hs27
-rw-r--r--Pandora/Paradigm/Structure/Ability/Substructure.hs4
-rw-r--r--Pandora/Paradigm/Structure/Interface/Dictionary.hs17
-rw-r--r--Pandora/Paradigm/Structure/Interface/Set.hs20
-rw-r--r--Pandora/Paradigm/Structure/Interface/Stack.hs2
-rw-r--r--Pandora/Paradigm/Structure/Modification/Comprehension.hs37
-rw-r--r--Pandora/Paradigm/Structure/Modification/Prefixed.hs33
-rw-r--r--Pandora/Paradigm/Structure/Some/Binary.hs41
-rw-r--r--Pandora/Paradigm/Structure/Some/List.hs110
-rw-r--r--Pandora/Paradigm/Structure/Some/Rose.hs26
-rw-r--r--Pandora/Pattern/Functor/Adjoint.hs2
-rw-r--r--Pandora/Pattern/Functor/Alternative.hs2
-rw-r--r--Pandora/Pattern/Functor/Applicative.hs7
-rw-r--r--Pandora/Pattern/Functor/Avoidable.hs2
-rw-r--r--Pandora/Pattern/Functor/Bindable.hs2
-rw-r--r--Pandora/Pattern/Functor/Bivariant.hs2
-rw-r--r--Pandora/Pattern/Functor/Comonad.hs2
-rw-r--r--Pandora/Pattern/Functor/Contravariant.hs2
-rw-r--r--Pandora/Pattern/Functor/Covariant.hs2
-rw-r--r--Pandora/Pattern/Functor/Distributive.hs2
-rw-r--r--Pandora/Pattern/Functor/Divariant.hs2
-rw-r--r--Pandora/Pattern/Functor/Extendable.hs2
-rw-r--r--Pandora/Pattern/Functor/Invariant.hs2
-rw-r--r--Pandora/Pattern/Functor/Monad.hs2
-rw-r--r--Pandora/Pattern/Functor/Pointable.hs3
-rw-r--r--Pandora/Pattern/Functor/Representable.hs2
-rw-r--r--Pandora/Pattern/Functor/Traversable.hs2
-rw-r--r--Pandora/Pattern/Object.hs1
-rw-r--r--Pandora/Pattern/Object/Chain.hs2
-rw-r--r--Pandora/Pattern/Object/Cycle.hs14
-rw-r--r--Pandora/Pattern/Object/Group.hs2
-rw-r--r--Pandora/Pattern/Object/Lattice.hs2
-rw-r--r--Pandora/Pattern/Object/Monoid.hs2
-rw-r--r--Pandora/Pattern/Object/Quasiring.hs2
-rw-r--r--Pandora/Pattern/Object/Ring.hs2
-rw-r--r--Pandora/Pattern/Object/Ringoid.hs2
-rw-r--r--Pandora/Pattern/Object/Semigroup.hs2
-rw-r--r--Pandora/Pattern/Object/Semilattice.hs4
-rw-r--r--Pandora/Pattern/Object/Semiring.hs2
-rw-r--r--Pandora/Pattern/Object/Setoid.hs2
-rw-r--r--pandora.cabal12
55 files changed, 354 insertions, 175 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 518f714..159f14c 100755
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -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
diff --git a/Pandora/Paradigm/Controlflow/Effect/Interpreted.hs b/Pandora/Paradigm/Controlflow/Effect/Interpreted.hs
index b7281a4..bb2db40 100644
--- a/Pandora/Paradigm/Controlflow/Effect/Interpreted.hs
+++ b/Pandora/Paradigm/Controlflow/Effect/Interpreted.hs
@@ -13,10 +13,10 @@ class Interpreted t where
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)
diff --git a/Pandora/Paradigm/Inventory/Imprint.hs b/Pandora/Paradigm/Inventory/Imprint.hs
index f7a698a..707158f 100644
--- a/Pandora/Paradigm/Inventory/Imprint.hs
+++ b/Pandora/Paradigm/Inventory/Imprint.hs
@@ -12,7 +12,7 @@ import Pandora.Pattern.Functor.Divariant (Divariant ((>->)))
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 @@ instance Monoid e => Extractable (Imprint e) where
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 +)
diff --git a/Pandora/Paradigm/Inventory/State.hs b/Pandora/Paradigm/Inventory/State.hs
index 3f15338..b77506d 100644
--- a/Pandora/Paradigm/Inventory/State.hs
+++ b/Pandora/Paradigm/Inventory/State.hs
@@ -59,6 +59,9 @@ modify f = adapt . State $ \s -> let r = f s in r :*: r
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
diff --git a/Pandora/Paradigm/Primary.hs b/Pandora/Paradigm/Primary.hs
index fcdb88b..41cdd5f 100644
--- a/Pandora/Paradigm/Primary.hs
+++ b/Pandora/Paradigm/Primary.hs
@@ -31,6 +31,11 @@ instance Morphable (Into (Conclusion e)) Maybe where
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
diff --git a/Pandora/Paradigm/Primary/Functor.hs b/Pandora/Paradigm/Primary/Functor.hs
index 3f0acaa..a92dfce 100644
--- a/Pandora/Paradigm/Primary/Functor.hs
+++ b/Pandora/Paradigm/Primary/Functor.hs
@@ -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.Paradigm.Primary.Functor.Function as Exports
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)
diff --git a/Pandora/Paradigm/Primary/Functor/Convergence.hs b/Pandora/Paradigm/Primary/Functor/Convergence.hs
new file mode 100644
index 0000000..542bb0a
--- /dev/null
+++ b/Pandora/Paradigm/Primary/Functor/Convergence.hs
@@ -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'
diff --git a/Pandora/Paradigm/Primary/Functor/Equivalence.hs b/Pandora/Paradigm/Primary/Functor/Equivalence.hs
deleted file mode 100644
index 445c926..0000000
--- a/Pandora/Paradigm/Primary/Functor/Equivalence.hs
+++ /dev/null
@@ -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'
diff --git a/Pandora/Paradigm/Primary/Functor/Wye.hs b/Pandora/Paradigm/Primary/Functor/Wye.hs
index 8722274..fbf5286 100644
--- a/Pandora/Paradigm/Primary/Functor/Wye.hs
+++ b/Pandora/Paradigm/Primary/Functor/Wye.hs
@@ -6,6 +6,8 @@ import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
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
@@ -28,6 +30,22 @@ instance Monotonic a (Wye a) where
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
wye _ f _ _ (Left x) = f x
diff --git a/Pandora/Paradigm/Primary/Transformer/Flip.hs b/Pandora/Paradigm/Primary/Transformer/Flip.hs
index 594b5b9..70ece32 100644
--- a/Pandora/Paradigm/Primary/Transformer/Flip.hs
+++ b/Pandora/Paradigm/Primary/Transformer/Flip.hs
@@ -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 @@ instance Interpreted (Flip v a) where
unite = Flip
instance Bivariant v => Bivariant (Flip v) where
- f <-> g = \x -> unite $ g <-> f $ run x
+ f <-> g = \x -> (g <-> f) ||= x
diff --git a/Pandora/Paradigm/Structure.hs b/Pandora/Paradigm/Structure.hs
index 3135b5a..b02e1a6 100644
--- a/Pandora/Paradigm/Structure.hs
+++ b/Pandora/Paradigm/Structure.hs
@@ -13,7 +13,7 @@ import Pandora.Pattern.Functor.Extractable (extract)
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 (Postorder (Construction Maybe))) (Construction Wye) wh
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
diff --git a/Pandora/Paradigm/Structure/Ability.hs b/Pandora/Paradigm/Structure/Ability.hs
index ee9f1f9..9eea334 100644
--- a/Pandora/Paradigm/Structure/Ability.hs
+++ b/Pandora/Paradigm/Structure/Ability.hs
@@ -5,7 +5,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.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
diff --git a/Pandora/Paradigm/Structure/Ability/Deletable.hs b/Pandora/Paradigm/Structure/Ability/Deletable.hs
deleted file mode 100644
index b3627cb..0000000
--- a/Pandora/Paradigm/Structure/Ability/Deletable.hs
+++ /dev/null
@@ -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
diff --git a/Pandora/Paradigm/Structure/Ability/Monotonic.hs b/Pandora/Paradigm/Structure/Ability/Monotonic.hs
index 3335714..8122b63 100644
--- a/Pandora/Paradigm/Structure/Ability/Monotonic.hs
+++ b/Pandora/Paradigm/Structure/Ability/Monotonic.hs
@@ -2,11 +2,7 @@ module Pandora.Paradigm.Structure.Ability.Monotonic where
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 @@ class Monotonic a e where
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
diff --git a/Pandora/Paradigm/Structure/Ability/Morphable.hs b/Pandora/Paradigm/Structure/Ability/Morphable.hs
index 81dc9c7..6efcab2 100644
--- a/Pandora/Paradigm/Structure/Ability/Morphable.hs
+++ b/Pandora/Paradigm/Structure/Ability/Morphable.hs
@@ -5,12 +5,17 @@ module Pandora.Paradigm.Structure.Ability.Morphable where
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,7 +29,9 @@ 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
+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 @@ insert new xs = run / morph @(Insert f) 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
--- 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
diff --git a/Pandora/Paradigm/Structure/Ability/Substructure.hs b/Pandora/Paradigm/Structure/Ability/Substructure.hs
index aed6fd2..6ec0232 100644
--- a/Pandora/Paradigm/Structure/Ability/Substructure.hs
+++ b/Pandora/Paradigm/Structure/Ability/Substructure.hs
@@ -27,6 +27,4 @@ class Substructure f t where
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
diff --git a/Pandora/Paradigm/Structure/Interface/Dictionary.hs b/Pandora/Paradigm/Structure/Interface/Dictionary.hs
index 48915d6..d3293d2 100644
--- a/Pandora/Paradigm/Structure/Interface/Dictionary.hs
+++ b/Pandora/Paradigm/Structure/Interface/Dictionary.hs
@@ -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 (<:.>))
+
+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
-class Dictionary a k t where
- (?=) :: k -> t a -> Maybe a
+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
diff --git a/Pandora/Paradigm/Structure/Interface/Set.hs b/Pandora/Paradigm/Structure/Interface/Set.hs
index 7b58fa7..4bb2351 100644
--- a/Pandora/Paradigm/Structure/Interface/Set.hs
+++ b/Pandora/Paradigm/Structure/Interface/Set.hs
@@ -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) !)
diff --git a/Pandora/Paradigm/Structure/Interface/Stack.hs b/Pandora/Paradigm/Structure/Interface/Stack.hs
index 0235854..8eae423 100644
--- a/Pandora/Paradigm/Structure/Interface/Stack.hs
+++ b/Pandora/Paradigm/Structure/Interface/Stack.hs
@@ -3,7 +3,7 @@ module Pandora.Paradigm.Structure.Interface.Stack where
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
-}
diff --git a/Pandora/Paradigm/Structure/Modification/Comprehension.hs b/Pandora/Paradigm/Structure/Modification/Comprehension.hs
index 90c6e16..26306a1 100644
--- a/Pandora/Paradigm/Structure/Modification/Comprehension.hs
+++ b/Pandora/Paradigm/Structure/Modification/Comprehension.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE UndecidableInstances #-}
module Pandora.Paradigm.Structure.Modification.Comprehension where
@@ -5,16 +6,26 @@ module Pandora.Paradigm.Structure.Modification.Comprehension where
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 Covariant (t <:.> Construction t) => Covariant (Comprehension t) where
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 @@ instance (forall a . Semigroup (t <:.> Construction t := a), Bindable t, Pointab
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
diff --git a/Pandora/Paradigm/Structure/Modification/Prefixed.hs b/Pandora/Paradigm/Structure/Modification/Prefixed.hs
index 6d63573..e5fa660 100644
--- a/Pandora/Paradigm/Structure/Modification/Prefixed.hs
+++ b/Pandora/Paradigm/Structure/Modification/Prefixed.hs
@@ -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
diff --git a/Pandora/Paradigm/Structure/Some/Binary.hs b/Pandora/Paradigm/Structure/Some/Binary.hs
index 710b656..4c9207f 100644
--- a/Pandora/Paradigm/Structure/Some/Binary.hs
+++ b/Pandora/Paradigm/Structure/Some/Binary.hs
@@ -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.Boolean (Boolean (True, False))
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.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), 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 @@ rebalance (Both x y) = extract x <=> extract y & order
(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 Nullable Binary where
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 @@ instance Morphable (Into Binary) (Construction Wye) where
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 Measurable Heighth (Construction Wye) where
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 Left (Construction Wye) where
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)) =
diff --git a/Pandora/Paradigm/Structure/Some/List.hs b/Pandora/Paradigm/Structure/Some/List.hs
index c41b138..485837c 100644
--- a/Pandora/Paradigm/Structure/Some/List.hs
+++ b/Pandora/Paradigm/Structure/Some/List.hs
@@ -4,13 +4,18 @@ module Pandora.Paradigm.Structure.Some.List where
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.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 (:*:), 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.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.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 @@ instance Morphable Pop List where
type Morphing Pop List = List
morphing (premorph -> xs) = resolve deconstruct Nothing ||= xs
+instance Morphable (Find Element) List where
+ type Morphing (Find Element) List = Predicate <:.:> Maybe := (->)
+ 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 @@ instance Substructure Tail List where
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 @@ instance Substructure Tail (Construction Maybe) where
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
diff --git a/Pandora/Paradigm/Structure/Some/Rose.hs b/Pandora/Paradigm/Structure/Some/Rose.hs
index 8e0e671..b2da2f0 100644
--- a/Pandora/Paradigm/Structure/Some/Rose.hs
+++ b/Pandora/Paradigm/Structure/Some/Rose.hs
@@ -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.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.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 Focusable Root (Construction List) where
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
diff --git a/Pandora/Pattern/Functor/Adjoint.hs b/Pandora/Pattern/Functor/Adjoint.hs
index a10a157..43cdb99 100644
--- a/Pandora/Pattern/Functor/Adjoint.hs
+++ b/Pandora/Pattern/Functor/Adjoint.hs
@@ -8,7 +8,7 @@ type (-|) = Adjoint
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
diff --git a/Pandora/Pattern/Functor/Alternative.hs b/Pandora/Pattern/Functor/Alternative.hs
index 30f4cdd..f71325c 100644
--- a/Pandora/Pattern/Functor/Alternative.hs
+++ b/Pandora/Pattern/Functor/Alternative.hs
@@ -5,7 +5,7 @@ import Pandora.Pattern.Functor.Covariant (Covariant)
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)
-}
diff --git a/Pandora/Pattern/Functor/Applicative.hs b/Pandora/Pattern/Functor/Applicative.hs
index fee9384..3bf083f 100644
--- a/Pandora/Pattern/Functor/Applicative.hs
+++ b/Pandora/Pattern/Functor/Applicative.hs
@@ -9,7 +9,7 @@ infixl 2 <***>
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 @@ class Covariant t => Applicative t where
{-# 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 @@ class Covariant t => Applicative t where
-- | 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
diff --git a/Pandora/Pattern/Functor/Avoidable.hs b/Pandora/Pattern/Functor/Avoidable.hs
index 408a250..8a8b53b 100644
--- a/Pandora/Pattern/Functor/Avoidable.hs
+++ b/Pandora/Pattern/Functor/Avoidable.hs
@@ -3,7 +3,7 @@ module Pandora.Pattern.Functor.Avoidable where
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
-}
diff --git a/Pandora/Pattern/Functor/Bindable.hs b/Pandora/Pattern/Functor/Bindable.hs
index d3fbe28..50eef1b 100644
--- a/Pandora/Pattern/Functor/Bindable.hs
+++ b/Pandora/Pattern/Functor/Bindable.hs
@@ -7,7 +7,7 @@ infixl 1 >>=
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)
-}
diff --git a/Pandora/Pattern/Functor/Bivariant.hs b/Pandora/Pattern/Functor/Bivariant.hs
index 80e0b62..789cf67 100644
--- a/Pandora/Pattern/Functor/Bivariant.hs
+++ b/Pandora/Pattern/Functor/Bivariant.hs
@@ -3,7 +3,7 @@ module Pandora.Pattern.Functor.Bivariant where
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
-}
diff --git a/Pandora/Pattern/Functor/Comonad.hs b/Pandora/Pattern/Functor/Comonad.hs
index 382c15f..0d09456 100644
--- a/Pandora/Pattern/Functor/Comonad.hs
+++ b/Pandora/Pattern/Functor/Comonad.hs
@@ -7,7 +7,7 @@ import Pandora.Pattern.Functor.Extendable (Extendable)
> 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)
diff --git a/Pandora/Pattern/Functor/Contravariant.hs b/Pandora/Pattern/Functor/Contravariant.hs
index f7e5023..5a155ce 100644
--- a/Pandora/Pattern/Functor/Contravariant.hs
+++ b/Pandora/Pattern/Functor/Contravariant.hs
@@ -5,7 +5,7 @@ import Pandora.Core.Functor (type (:.), type (:=))
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)
-}
diff --git a/Pandora/Pattern/Functor/Covariant.hs b/Pandora/Pattern/Functor/Covariant.hs
index bcebead..e0cb92b 100644
--- a/Pandora/Pattern/Functor/Covariant.hs
+++ b/Pandora/Pattern/Functor/Covariant.hs
@@ -13,7 +13,7 @@ infixl 3 <&&&>
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
-}
diff --git a/Pandora/Pattern/Functor/Distributive.hs b/Pandora/Pattern/Functor/Distributive.hs
index b35b473..eee48ce 100644
--- a/Pandora/Pattern/Functor/Distributive.hs
+++ b/Pandora/Pattern/Functor/Distributive.hs
@@ -6,7 +6,7 @@ import Pandora.Pattern.Functor.Covariant (Covariant)
{- |
> 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
-}
diff --git a/Pandora/Pattern/Functor/Divariant.hs b/Pandora/Pattern/Functor/Divariant.hs
index b9a99f8..6dbc7c1 100644
--- a/Pandora/Pattern/Functor/Divariant.hs
+++ b/Pandora/Pattern/Functor/Divariant.hs
@@ -3,7 +3,7 @@ module Pandora.Pattern.Functor.Divariant where
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
-}
diff --git a/Pandora/Pattern/Functor/Extendable.hs b/Pandora/Pattern/Functor/Extendable.hs
index 76cb19f..760567b 100644
--- a/Pandora/Pattern/Functor/Extendable.hs
+++ b/Pandora/Pattern/Functor/Extendable.hs
@@ -7,7 +7,7 @@ infixl 1 =>>
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
-}
diff --git a/Pandora/Pattern/Functor/Invariant.hs b/Pandora/Pattern/Functor/Invariant.hs
index 80e5713..5c4321b 100644
--- a/Pandora/Pattern/Functor/Invariant.hs
+++ b/Pandora/Pattern/Functor/Invariant.hs
@@ -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)
-}
diff --git a/Pandora/Pattern/Functor/Monad.hs b/Pandora/Pattern/Functor/Monad.hs
index beb6a7d..95c1bed 100644
--- a/Pandora/Pattern/Functor/Monad.hs
+++ b/Pandora/Pattern/Functor/Monad.hs
@@ -8,7 +8,7 @@ import Pandora.Pattern.Functor.Pointable (Pointable (point))
> 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
diff --git a/Pandora/Pattern/Functor/Pointable.hs b/Pandora/Pattern/Functor/Pointable.hs
index 21ec8cf..4ff63fe 100644
--- a/Pandora/Pattern/Functor/Pointable.hs
+++ b/Pandora/Pattern/Functor/Pointable.hs
@@ -6,3 +6,6 @@ import Pandora.Pattern.Functor.Covariant (Covariant)
class Covariant t => Pointable t where
{-# MINIMAL point #-}
point :: a :=> t
+
+ pass :: t ()
+ pass = point ()
diff --git a/Pandora/Pattern/Functor/Representable.hs b/Pandora/Pattern/Functor/Representable.hs
index 726e06a..f358f53 100644
--- a/Pandora/Pattern/Functor/Representable.hs
+++ b/Pandora/Pattern/Functor/Representable.hs
@@ -4,7 +4,7 @@ import Pandora.Core.Functor (type (<:=))
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
diff --git a/Pandora/Pattern/Functor/Traversable.hs b/Pandora/Pattern/Functor/Traversable.hs
index ad34de0..46dd7a5 100644
--- a/Pandora/Pattern/Functor/Traversable.hs
+++ b/Pandora/Pattern/Functor/Traversable.hs
@@ -9,7 +9,7 @@ import Pandora.Pattern.Functor.Pointable (Pointable)
> 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
diff --git a/Pandora/Pattern/Object.hs b/Pandora/Pattern/Object.hs
index 03cdeb3..7dbb1ef 100644
--- a/Pandora/Pattern/Object.hs
+++ b/Pandora/Pattern/Object.hs
@@ -9,5 +9,6 @@ import Pandora.Pattern.Object.Quasiring as Exports
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
diff --git a/Pandora/Pattern/Object/Chain.hs b/Pandora/Pattern/Object/Chain.hs
index 122bee4..b3e4887 100644
--- a/Pandora/Pattern/Object/Chain.hs
+++ b/Pandora/Pattern/Object/Chain.hs
@@ -7,7 +7,7 @@ import Pandora.Paradigm.Primary.Object.Ordering (Ordering, order)
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
diff --git a/Pandora/Pattern/Object/Cycle.hs b/Pandora/Pattern/Object/Cycle.hs
new file mode 100644
index 0000000..1dd9e78
--- /dev/null
+++ b/Pandora/Pattern/Object/Cycle.hs
@@ -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
diff --git a/Pandora/Pattern/Object/Group.hs b/Pandora/Pattern/Object/Group.hs
index 311a01d..d09a04e 100644
--- a/Pandora/Pattern/Object/Group.hs
+++ b/Pandora/Pattern/Object/Group.hs
@@ -6,7 +6,7 @@ import Pandora.Pattern.Object.Monoid (Monoid)
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
-}
diff --git a/Pandora/Pattern/Object/Lattice.hs b/Pandora/Pattern/Object/Lattice.hs
index 45b3058..602c1a5 100644
--- a/Pandora/Pattern/Object/Lattice.hs
+++ b/Pandora/Pattern/Object/Lattice.hs
@@ -3,7 +3,7 @@ module Pandora.Pattern.Object.Lattice (Lattice) where
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
-}
diff --git a/Pandora/Pattern/Object/Monoid.hs b/Pandora/Pattern/Object/Monoid.hs
index 3b5dfe8..7622fec 100644
--- a/Pandora/Pattern/Object/Monoid.hs
+++ b/Pandora/Pattern/Object/Monoid.hs
@@ -3,7 +3,7 @@ module Pandora.Pattern.Object.Monoid (Monoid (..)) where
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
-}
diff --git a/Pandora/Pattern/Object/Quasiring.hs b/Pandora/Pattern/Object/Quasiring.hs
index 3dc9d29..c3e3fb0 100644
--- a/Pandora/Pattern/Object/Quasiring.hs
+++ b/Pandora/Pattern/Object/Quasiring.hs
@@ -4,7 +4,7 @@ import Pandora.Pattern.Object.Monoid (Monoid)
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
-}
diff --git a/Pandora/Pattern/Object/Ring.hs b/Pandora/Pattern/Object/Ring.hs
index 25a0136..af78a58 100644
--- a/Pandora/Pattern/Object/Ring.hs
+++ b/Pandora/Pattern/Object/Ring.hs
@@ -3,7 +3,7 @@ module Pandora.Pattern.Object.Ring (Ring) where
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
-}
diff --git a/Pandora/Pattern/Object/Ringoid.hs b/Pandora/Pattern/Object/Ringoid.hs
index 8b70152..10a8c68 100644
--- a/Pandora/Pattern/Object/Ringoid.hs
+++ b/Pandora/Pattern/Object/Ringoid.hs
@@ -5,7 +5,7 @@ import Pandora.Pattern.Object.Semigroup (Semigroup)
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
-}
diff --git a/Pandora/Pattern/Object/Semigroup.hs b/Pandora/Pattern/Object/Semigroup.hs
index 735e059..c9ae1e9 100644
--- a/Pandora/Pattern/Object/Semigroup.hs
+++ b/Pandora/Pattern/Object/Semigroup.hs
@@ -3,7 +3,7 @@ module Pandora.Pattern.Object.Semigroup (Semigroup (..)) where
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
-}
diff --git a/Pandora/Pattern/Object/Semilattice.hs b/Pandora/Pattern/Object/Semilattice.hs
index b82d9ee..a4fd933 100644
--- a/Pandora/Pattern/Object/Semilattice.hs
+++ b/Pandora/Pattern/Object/Semilattice.hs
@@ -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 @@ class Infimum a where
(/\) :: 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
diff --git a/Pandora/Pattern/Object/Semiring.hs b/Pandora/Pattern/Object/Semiring.hs
index fb79629..3ce4bee 100644
--- a/Pandora/Pattern/Object/Semiring.hs
+++ b/Pandora/Pattern/Object/Semiring.hs
@@ -3,7 +3,7 @@ module Pandora.Pattern.Object.Semiring (Semiring) where
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
-}
diff --git a/Pandora/Pattern/Object/Setoid.hs b/Pandora/Pattern/Object/Setoid.hs
index ffd2c5c..7017834 100644
--- a/Pandora/Pattern/Object/Setoid.hs
+++ b/Pandora/Pattern/Object/Setoid.hs
@@ -5,7 +5,7 @@ import Pandora.Paradigm.Primary.Object.Boolean (Boolean (False, True), (?))
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
diff --git a/pandora.cabal b/pandora.cabal
index a2ee168..c0fd6ff 100644
--- a/pandora.cabal
+++ b/pandora.cabal
@@ -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 @@ library
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 @@ library
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 @@ library
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