summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoriokasimovmt <>2020-05-22 12:25:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-05-22 12:25:00 (GMT)
commit9c13e1deec0d291eda9c4a41c98820b5cbd9368e (patch)
tree948107699e154c2fb7b9eb5b30a94730e21da1fd
parent755567d331cbb87fc454e92e92ce997e4f2db5f6 (diff)
version 0.2.8HEAD0.2.8master
-rwxr-xr-xCHANGELOG.md14
-rw-r--r--Pandora/Paradigm/Inventory/State.hs2
-rw-r--r--Pandora/Paradigm/Primary.hs3
-rw-r--r--Pandora/Paradigm/Primary/Functor.hs20
-rw-r--r--Pandora/Paradigm/Primary/Functor/Conclusion.hs18
-rw-r--r--Pandora/Paradigm/Primary/Functor/Delta.hs30
-rw-r--r--Pandora/Paradigm/Primary/Functor/Identity.hs6
-rw-r--r--Pandora/Paradigm/Primary/Functor/Maybe.hs16
-rw-r--r--Pandora/Paradigm/Primary/Functor/Predicate.hs2
-rw-r--r--Pandora/Paradigm/Primary/Functor/These.hs26
-rw-r--r--Pandora/Paradigm/Primary/Functor/Validation.hs8
-rw-r--r--Pandora/Paradigm/Primary/Functor/Variation.hs26
-rw-r--r--Pandora/Paradigm/Primary/Functor/Wedge.hs26
-rw-r--r--Pandora/Paradigm/Primary/Object.hs4
-rw-r--r--Pandora/Paradigm/Primary/Object/Boolean.hs37
-rw-r--r--Pandora/Paradigm/Primary/Object/Ordering.hs8
-rw-r--r--Pandora/Paradigm/Primary/Transformer.hs1
-rw-r--r--Pandora/Paradigm/Primary/Transformer/Construction.hs4
-rw-r--r--Pandora/Paradigm/Primary/Transformer/Jack.hs6
-rw-r--r--Pandora/Paradigm/Primary/Transformer/Outline.hs43
-rw-r--r--Pandora/Paradigm/Structure.hs4
-rw-r--r--Pandora/Paradigm/Structure/Ability.hs5
-rw-r--r--Pandora/Paradigm/Structure/Ability/Focusable.hs9
-rw-r--r--Pandora/Paradigm/Structure/Ability/Nonempty.hs (renamed from Pandora/Paradigm/Structure/Variation/Nonempty.hs)2
-rw-r--r--Pandora/Paradigm/Structure/Ability/Substructure.hs8
-rw-r--r--Pandora/Paradigm/Structure/Binary.hs80
-rw-r--r--Pandora/Paradigm/Structure/Rose.hs46
-rw-r--r--Pandora/Paradigm/Structure/Stack.hs30
-rw-r--r--Pandora/Paradigm/Structure/Variation/Substructure.hs8
-rw-r--r--Pandora/Pattern/Functor/Avoidable.hs1
-rw-r--r--Pandora/Pattern/Functor/Bindable.hs8
-rw-r--r--Pandora/Pattern/Functor/Determinable.hs1
-rw-r--r--Pandora/Pattern/Functor/Distributive.hs1
-rw-r--r--Pandora/Pattern/Functor/Extractable.hs1
-rw-r--r--Pandora/Pattern/Functor/Pointable.hs1
-rw-r--r--Pandora/Pattern/Object/Chain.hs30
-rw-r--r--Pandora/Pattern/Object/Setoid.hs43
-rw-r--r--Pandora/Pattern/Transformer/Hoistable.hs3
-rw-r--r--pandora.cabal18
39 files changed, 418 insertions, 181 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 148902d..0b2ea41 100755
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -216,3 +216,17 @@
* Replace `UT` joint scheme with `TU` in data structures
* Change `sub` method of `Substructure` - it always returns `Tagged` value
* Rename `Construction` constructor of `Construction` to `Construct`
+
+# 0.2.8
+* Define `Outline` free applicative transformer
+* Define `Delta` datatype
+* Define `Wedge` datatype
+* Rename `Variation` to `These`
+* Define two experimental methods in `Bindable` class - `$>>=` and `>>=$`
+* Define `here` and `there` methods from `Wedge` to `Maybe`
+* Move `Boolean` definition to its own module
+* Move `Ordering` definition to its own module
+* Rename `Variation` submodule to `Ability` and create umbrella-module
+* Define `Focusable` typeclass for getting root and creating singleton
+* Replace `top` method of `Stack` structure with `Focusable` instance
+* Add `Covariant` constraint on `natural transformation` in `Hoistable` typeclass
diff --git a/Pandora/Paradigm/Inventory/State.hs b/Pandora/Paradigm/Inventory/State.hs
index 8d9ffaa..8f1dd1a 100644
--- a/Pandora/Paradigm/Inventory/State.hs
+++ b/Pandora/Paradigm/Inventory/State.hs
@@ -16,12 +16,12 @@ import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
import Pandora.Pattern.Functor.Monad (Monad)
import Pandora.Pattern.Functor.Adjoint ((|-))
import Pandora.Pattern.Functor.Divariant (($))
-import Pandora.Pattern.Object.Setoid (bool)
import Pandora.Paradigm.Controlflow.Joint.Adaptable (Adaptable (adapt))
import Pandora.Paradigm.Controlflow.Joint.Interpreted (Interpreted (Primary, run))
import Pandora.Paradigm.Controlflow.Joint.Transformer.Monadic (Monadic (lay, wrap), (:>) (TM))
import Pandora.Paradigm.Controlflow.Joint.Schematic (Schematic)
import Pandora.Paradigm.Controlflow.Joint.Schemes.TUT (TUT (TUT))
+import Pandora.Paradigm.Primary.Object.Boolean (bool)
import Pandora.Paradigm.Primary.Functor.Predicate (Predicate (predicate))
import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)), type (:*:), delta)
diff --git a/Pandora/Paradigm/Primary.hs b/Pandora/Paradigm/Primary.hs
index 31a7598..bbcd3d5 100644
--- a/Pandora/Paradigm/Primary.hs
+++ b/Pandora/Paradigm/Primary.hs
@@ -1,4 +1,5 @@
module Pandora.Paradigm.Primary (module Exports) where
-import Pandora.Paradigm.Primary.Functor as Exports
import Pandora.Paradigm.Primary.Transformer as Exports
+import Pandora.Paradigm.Primary.Functor as Exports
+import Pandora.Paradigm.Primary.Object as Exports
diff --git a/Pandora/Paradigm/Primary/Functor.hs b/Pandora/Paradigm/Primary/Functor.hs
index 8dcf1d3..6c12e74 100644
--- a/Pandora/Paradigm/Primary/Functor.hs
+++ b/Pandora/Paradigm/Primary/Functor.hs
@@ -1,9 +1,10 @@
-module Pandora.Paradigm.Primary.Functor (module Exports, note, hush, left, right, this, that) where
+module Pandora.Paradigm.Primary.Functor (module Exports, note, hush, left, right, this, that, here, there) where
import Pandora.Paradigm.Primary.Functor.Fix as Exports
import Pandora.Paradigm.Primary.Functor.Predicate as Exports
-import Pandora.Paradigm.Primary.Functor.Variation as Exports
+import Pandora.Paradigm.Primary.Functor.These as Exports
import Pandora.Paradigm.Primary.Functor.Validation as Exports
+import Pandora.Paradigm.Primary.Functor.Wedge as Exports
import Pandora.Paradigm.Primary.Functor.Wye as Exports
import Pandora.Paradigm.Primary.Functor.Edges as Exports
import Pandora.Paradigm.Primary.Functor.Conclusion as Exports
@@ -12,6 +13,7 @@ import Pandora.Paradigm.Primary.Functor.Endo as Exports
import Pandora.Paradigm.Primary.Functor.Proxy as Exports
import Pandora.Paradigm.Primary.Functor.Tagged as Exports
import Pandora.Paradigm.Primary.Functor.Product as Exports
+import Pandora.Paradigm.Primary.Functor.Delta as Exports
import Pandora.Paradigm.Primary.Functor.Constant as Exports
import Pandora.Paradigm.Primary.Functor.Identity as Exports
@@ -36,12 +38,22 @@ right (Left _) = Nothing
right (Right rs) = Just rs
right End = Nothing
-this :: Variation e ~> Maybe
+this :: These e ~> Maybe
this (This x) = Just x
this (That _) = Nothing
this (These _ x) = Just x
-that :: Variation e a -> Maybe e
+that :: These e a -> Maybe e
that (This _) = Nothing
that (That x) = Just x
that (These y _) = Just y
+
+here :: Wedge e a -> Maybe e
+here Nowhere = Nothing
+here (Here x) = Just x
+here (There _) = Nothing
+
+there :: Wedge e ~> Maybe
+there Nowhere = Nothing
+there (Here _) = Nothing
+there (There x) = Just x
diff --git a/Pandora/Paradigm/Primary/Functor/Conclusion.hs b/Pandora/Paradigm/Primary/Functor/Conclusion.hs
index c704752..09f8bcf 100644
--- a/Pandora/Paradigm/Primary/Functor/Conclusion.hs
+++ b/Pandora/Paradigm/Primary/Functor/Conclusion.hs
@@ -2,11 +2,6 @@ module Pandora.Paradigm.Primary.Functor.Conclusion (Conclusion (..), Failable, c
import Pandora.Core.Functor (type (~>))
import Pandora.Pattern.Category ((.))
-import Pandora.Paradigm.Controlflow.Joint.Interpreted (Interpreted (Primary, run))
-import Pandora.Paradigm.Controlflow.Joint.Transformer.Monadic (Monadic (lay, wrap), (:>) (TM))
-import Pandora.Paradigm.Controlflow.Joint.Schematic (Schematic)
-import Pandora.Paradigm.Controlflow.Joint.Adaptable (Adaptable (adapt))
-import Pandora.Paradigm.Controlflow.Joint.Schemes.UT (UT (UT))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>)))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
@@ -16,9 +11,16 @@ import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
import Pandora.Pattern.Functor.Monad (Monad)
import Pandora.Pattern.Functor.Bivariant (Bivariant ((<->)))
import Pandora.Pattern.Functor.Divariant (($))
-import Pandora.Pattern.Object.Setoid (Setoid ((==)), Boolean (False))
-import Pandora.Pattern.Object.Chain (Chain ((<=>)), Ordering (Less, Greater))
+import Pandora.Pattern.Object.Setoid (Setoid ((==)))
+import Pandora.Pattern.Object.Chain (Chain ((<=>)))
import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
+import Pandora.Paradigm.Primary.Object.Boolean (Boolean (False))
+import Pandora.Paradigm.Primary.Object.Ordering (Ordering (Less, Greater))
+import Pandora.Paradigm.Controlflow.Joint.Interpreted (Interpreted (Primary, run))
+import Pandora.Paradigm.Controlflow.Joint.Transformer.Monadic (Monadic (lay, wrap), (:>) (TM))
+import Pandora.Paradigm.Controlflow.Joint.Schematic (Schematic)
+import Pandora.Paradigm.Controlflow.Joint.Adaptable (Adaptable (adapt))
+import Pandora.Paradigm.Controlflow.Joint.Schemes.UT (UT (UT))
data Conclusion e a = Failure e | Success a
@@ -48,7 +50,7 @@ instance Bindable (Conclusion e) where
instance Monad (Conclusion e) where
instance Bivariant Conclusion where
- f <-> g = conclusion (Failure . f) (Success . g)
+ f <-> g = conclusion (Failure . f) (Success . g)
instance (Setoid e, Setoid a) => Setoid (Conclusion e a) where
Success x == Success y = x == y
diff --git a/Pandora/Paradigm/Primary/Functor/Delta.hs b/Pandora/Paradigm/Primary/Functor/Delta.hs
new file mode 100644
index 0000000..c0fdcec
--- /dev/null
+++ b/Pandora/Paradigm/Primary/Functor/Delta.hs
@@ -0,0 +1,30 @@
+module Pandora.Paradigm.Primary.Functor.Delta (Delta (..), type (:^:)) where
+
+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.Functor.Representable (Representable (Representation, (<#>), tabulate))
+import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False))
+
+data Delta a = a :^: a
+
+type (:^:) = Delta
+
+instance Covariant Delta where
+ f <$> x :^: y = f x :^: f y
+
+instance Pointable Delta where
+ point x = x :^: x
+
+instance Applicative Delta where
+ f :^: g <*> x :^: y = f x :^: g y
+
+instance Traversable Delta where
+ x :^: y ->> f = (:^:) <$> f x <*> f y
+
+instance Representable Delta where
+ type Representation Delta = Boolean
+ True <#> (x :^: _) = x
+ False <#> (_ :^: y) = y
+ tabulate f = f True :^: f False
diff --git a/Pandora/Paradigm/Primary/Functor/Identity.hs b/Pandora/Paradigm/Primary/Functor/Identity.hs
index f8b3b70..c382382 100644
--- a/Pandora/Paradigm/Primary/Functor/Identity.hs
+++ b/Pandora/Paradigm/Primary/Functor/Identity.hs
@@ -11,6 +11,7 @@ import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
import Pandora.Pattern.Functor.Extendable (Extendable ((=>>)))
import Pandora.Pattern.Functor.Monad (Monad)
import Pandora.Pattern.Functor.Comonad (Comonad)
+import Pandora.Pattern.Functor.Representable (Representable (Representation, (<#>), tabulate))
import Pandora.Pattern.Functor.Adjoint (Adjoint ((-|), (|-)))
import Pandora.Pattern.Functor.Divariant (($))
import Pandora.Pattern.Object.Setoid (Setoid ((==)))
@@ -53,6 +54,11 @@ instance Extendable Identity where
instance Comonad Identity
+instance Representable Identity where
+ type Representation Identity = ()
+ () <#> Identity x = x
+ tabulate f = Identity $ f ()
+
instance Adjoint Identity Identity where
x -| f = Identity . f . Identity $ x
x |- g = extract . extract . comap g $ x
diff --git a/Pandora/Paradigm/Primary/Functor/Maybe.hs b/Pandora/Paradigm/Primary/Functor/Maybe.hs
index 0a36f9b..68afbc6 100644
--- a/Pandora/Paradigm/Primary/Functor/Maybe.hs
+++ b/Pandora/Paradigm/Primary/Functor/Maybe.hs
@@ -1,10 +1,5 @@
module Pandora.Paradigm.Primary.Functor.Maybe (Maybe (..), Optional, maybe, nothing) where
-import Pandora.Paradigm.Controlflow.Joint.Interpreted (Interpreted (Primary, run))
-import Pandora.Paradigm.Controlflow.Joint.Transformer.Monadic (Monadic (lay, wrap), (:>) (TM))
-import Pandora.Paradigm.Controlflow.Joint.Schematic (Schematic)
-import Pandora.Paradigm.Controlflow.Joint.Adaptable (Adaptable (adapt))
-import Pandora.Paradigm.Controlflow.Joint.Schemes.UT (UT (UT))
import Pandora.Pattern.Category ((.))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>)))
import Pandora.Pattern.Functor.Avoidable (Avoidable (empty))
@@ -15,12 +10,19 @@ import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
import Pandora.Pattern.Functor.Monad (Monad)
import Pandora.Pattern.Functor.Divariant (($))
-import Pandora.Pattern.Object.Setoid (Setoid ((==)), Boolean (True, False))
-import Pandora.Pattern.Object.Chain (Chain ((<=>)), Ordering (Less, Equal, Greater))
+import Pandora.Pattern.Object.Setoid (Setoid ((==)))
+import Pandora.Pattern.Object.Chain (Chain ((<=>)))
import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
import Pandora.Pattern.Object.Monoid (Monoid (zero))
import Pandora.Pattern.Object.Semilattice (Infimum ((/\)), Supremum ((\/)))
import Pandora.Pattern.Object.Lattice (Lattice)
+import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False))
+import Pandora.Paradigm.Primary.Object.Ordering (Ordering (Less, Equal, Greater))
+import Pandora.Paradigm.Controlflow.Joint.Interpreted (Interpreted (Primary, run))
+import Pandora.Paradigm.Controlflow.Joint.Transformer.Monadic (Monadic (lay, wrap), (:>) (TM))
+import Pandora.Paradigm.Controlflow.Joint.Schematic (Schematic)
+import Pandora.Paradigm.Controlflow.Joint.Adaptable (Adaptable (adapt))
+import Pandora.Paradigm.Controlflow.Joint.Schemes.UT (UT (UT))
data Maybe a = Nothing | Just a
diff --git a/Pandora/Paradigm/Primary/Functor/Predicate.hs b/Pandora/Paradigm/Primary/Functor/Predicate.hs
index 81fe049..36119af 100644
--- a/Pandora/Paradigm/Primary/Functor/Predicate.hs
+++ b/Pandora/Paradigm/Primary/Functor/Predicate.hs
@@ -5,7 +5,7 @@ import Pandora.Pattern.Category ((.))
import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))
import Pandora.Pattern.Functor.Determinable (Determinable (determine))
import Pandora.Pattern.Functor.Divariant (($))
-import Pandora.Pattern.Object.Setoid (Boolean (True))
+import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True))
newtype Predicate a = Predicate { predicate :: a -> Boolean }
diff --git a/Pandora/Paradigm/Primary/Functor/These.hs b/Pandora/Paradigm/Primary/Functor/These.hs
new file mode 100644
index 0000000..05a568c
--- /dev/null
+++ b/Pandora/Paradigm/Primary/Functor/These.hs
@@ -0,0 +1,26 @@
+module Pandora.Paradigm.Primary.Functor.These (These (..), these) where
+
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
+import Pandora.Pattern.Functor.Pointable (Pointable (point))
+import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
+import Pandora.Pattern.Functor.Divariant (($))
+
+data These e a = This a | That e | These e a
+
+instance Covariant (These e) where
+ f <$> This x = This $ f x
+ _ <$> That y = That y
+ f <$> These y x = These y $ f x
+
+instance Pointable (These e) where
+ point = This
+
+instance Traversable (These e) where
+ This x ->> f = This <$> f x
+ That y ->> _ = point $ That y
+ These y x ->> f = These y <$> f x
+
+these :: (a -> r) -> (e -> r) -> (e -> a -> r) -> These e a -> r
+these f _ _ (This x) = f x
+these _ g _ (That y) = g y
+these _ _ h (These y x) = h y x
diff --git a/Pandora/Paradigm/Primary/Functor/Validation.hs b/Pandora/Paradigm/Primary/Functor/Validation.hs
index 7c519a5..2b090a4 100644
--- a/Pandora/Paradigm/Primary/Functor/Validation.hs
+++ b/Pandora/Paradigm/Primary/Functor/Validation.hs
@@ -8,9 +8,11 @@ import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
import Pandora.Pattern.Functor.Bivariant (Bivariant ((<->)))
import Pandora.Pattern.Functor.Divariant (($))
-import Pandora.Pattern.Object.Setoid (Setoid ((==)), Boolean (False))
-import Pandora.Pattern.Object.Chain (Chain ((<=>)), Ordering (Less, Greater))
+import Pandora.Pattern.Object.Setoid (Setoid ((==)))
+import Pandora.Pattern.Object.Chain (Chain ((<=>)))
import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
+import Pandora.Paradigm.Primary.Object.Boolean (Boolean (False))
+import Pandora.Paradigm.Primary.Object.Ordering (Ordering (Less, Greater))
data Validation e a = Flaws e | Validated a
@@ -36,7 +38,7 @@ instance Traversable (Validation e) where
Flaws e ->> _ = point $ Flaws e
instance Bivariant Validation where
- f <-> g = validation (Flaws . f) (Validated . g)
+ f <-> g = validation (Flaws . f) (Validated . g)
instance (Setoid e, Setoid a) => Setoid (Validation e a) where
Validated x == Validated y = x == y
diff --git a/Pandora/Paradigm/Primary/Functor/Variation.hs b/Pandora/Paradigm/Primary/Functor/Variation.hs
deleted file mode 100644
index 1130f8d..0000000
--- a/Pandora/Paradigm/Primary/Functor/Variation.hs
+++ /dev/null
@@ -1,26 +0,0 @@
-module Pandora.Paradigm.Primary.Functor.Variation (Variation (..), variation) where
-
-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
-import Pandora.Pattern.Functor.Pointable (Pointable (point))
-import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
-import Pandora.Pattern.Functor.Divariant (($))
-
-data Variation e a = This a | That e | These e a
-
-instance Covariant (Variation e) where
- f <$> This x = This $ f x
- _ <$> That y = That y
- f <$> These y x = These y (f x)
-
-instance Pointable (Variation e) where
- point = This
-
-instance Traversable (Variation e) where
- This x ->> f = This <$> f x
- That y ->> _ = point $ That y
- These y x ->> f = These y <$> f x
-
-variation :: (a -> r) -> (e -> r) -> (e -> a -> r) -> Variation e a -> r
-variation f _ _ (This x) = f x
-variation _ g _ (That y) = g y
-variation _ _ h (These y x) = h y x
diff --git a/Pandora/Paradigm/Primary/Functor/Wedge.hs b/Pandora/Paradigm/Primary/Functor/Wedge.hs
new file mode 100644
index 0000000..26c7dae
--- /dev/null
+++ b/Pandora/Paradigm/Primary/Functor/Wedge.hs
@@ -0,0 +1,26 @@
+module Pandora.Paradigm.Primary.Functor.Wedge (Wedge (..), wedge) where
+
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
+import Pandora.Pattern.Functor.Pointable (Pointable (point))
+import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
+import Pandora.Pattern.Functor.Divariant (($))
+
+data Wedge e a = Nowhere | Here e | There a
+
+instance Covariant (Wedge e) where
+ _ <$> Nowhere = Nowhere
+ _ <$> Here x = Here x
+ f <$> There x = There $ f x
+
+instance Pointable (Wedge e) where
+ point = There
+
+instance Traversable (Wedge e) where
+ Nowhere ->> _ = point Nowhere
+ Here x ->> _ = point $ Here x
+ There x ->> f = There <$> f x
+
+wedge :: (e -> r) -> (a -> r) -> r -> Wedge e a -> r
+wedge f _ _ (Here x) = f x
+wedge _ g _ (There x) = g x
+wedge _ _ r Nowhere = r
diff --git a/Pandora/Paradigm/Primary/Object.hs b/Pandora/Paradigm/Primary/Object.hs
new file mode 100644
index 0000000..3a7b691
--- /dev/null
+++ b/Pandora/Paradigm/Primary/Object.hs
@@ -0,0 +1,4 @@
+module Pandora.Paradigm.Primary.Object (module Exports) where
+
+import Pandora.Paradigm.Primary.Object.Ordering as Exports
+import Pandora.Paradigm.Primary.Object.Boolean as Exports
diff --git a/Pandora/Paradigm/Primary/Object/Boolean.hs b/Pandora/Paradigm/Primary/Object/Boolean.hs
new file mode 100644
index 0000000..db0c84d
--- /dev/null
+++ b/Pandora/Paradigm/Primary/Object/Boolean.hs
@@ -0,0 +1,37 @@
+module Pandora.Paradigm.Primary.Object.Boolean (Boolean (..), bool, (?)) where
+
+import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
+import Pandora.Pattern.Object.Ringoid (Ringoid ((*)))
+import Pandora.Pattern.Object.Monoid (Monoid (zero))
+import Pandora.Pattern.Object.Quasiring (Quasiring (one))
+import Pandora.Pattern.Object.Group (Group (invert))
+
+infixr 1 ?
+
+data Boolean = True | False
+
+bool :: a -> a -> Boolean -> a
+bool x _ False = x
+bool _ y True = y
+
+(?) :: Boolean -> a -> a -> a
+(?) True x _ = x
+(?) False _ y = y
+
+instance Semigroup Boolean where
+ False + False = False
+ _ + _ = True
+
+instance Ringoid Boolean where
+ True * True = True
+ _ * _ = False
+
+instance Monoid Boolean where
+ zero = False
+
+instance Quasiring Boolean where
+ one = True
+
+instance Group Boolean where
+ invert False = True
+ invert True = False
diff --git a/Pandora/Paradigm/Primary/Object/Ordering.hs b/Pandora/Paradigm/Primary/Object/Ordering.hs
new file mode 100644
index 0000000..0d5bebc
--- /dev/null
+++ b/Pandora/Paradigm/Primary/Object/Ordering.hs
@@ -0,0 +1,8 @@
+module Pandora.Paradigm.Primary.Object.Ordering (Ordering (..), order) where
+
+data Ordering = Less | Equal | Greater
+
+order :: a -> a -> a -> Ordering -> a
+order x _ _ Less = x
+order _ y _ Equal = y
+order _ _ z Greater = z
diff --git a/Pandora/Paradigm/Primary/Transformer.hs b/Pandora/Paradigm/Primary/Transformer.hs
index 9ac1019..bba032f 100644
--- a/Pandora/Paradigm/Primary/Transformer.hs
+++ b/Pandora/Paradigm/Primary/Transformer.hs
@@ -5,6 +5,7 @@ import Pandora.Paradigm.Primary.Transformer.Continuation as Exports
import Pandora.Paradigm.Primary.Transformer.Kan as Exports
import Pandora.Paradigm.Primary.Transformer.Jet as Exports
import Pandora.Paradigm.Primary.Transformer.Jack as Exports
+import Pandora.Paradigm.Primary.Transformer.Outline as Exports
import Pandora.Paradigm.Primary.Transformer.Instruction as Exports
import Pandora.Paradigm.Primary.Transformer.Construction as Exports
import Pandora.Paradigm.Primary.Transformer.Reverse as Exports
diff --git a/Pandora/Paradigm/Primary/Transformer/Construction.hs b/Pandora/Paradigm/Primary/Transformer/Construction.hs
index 982c750..34d27ad 100644
--- a/Pandora/Paradigm/Primary/Transformer/Construction.hs
+++ b/Pandora/Paradigm/Primary/Transformer/Construction.hs
@@ -14,6 +14,7 @@ import Pandora.Pattern.Functor.Extendable (Extendable ((=>>), extend))
import Pandora.Pattern.Functor.Monad (Monad)
import Pandora.Pattern.Functor.Comonad (Comonad)
import Pandora.Pattern.Transformer.Lowerable (Lowerable (lower))
+import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))
import Pandora.Pattern.Functor.Divariant (($))
import Pandora.Pattern.Object.Setoid (Setoid ((==)))
import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
@@ -51,6 +52,9 @@ instance Covariant t => Comonad (Construction t) where
instance Lowerable Construction where
lower (Construct _ xs) = extract <$> xs
+instance Hoistable Construction where
+ hoist f (Construct x xs) = Construct x . f $ hoist f <$> xs
+
instance (Setoid a, forall b . Setoid b => Setoid (t b)) => Setoid (Construction t a) where
Construct x xs == Construct y ys = (x == y) * (xs == ys)
diff --git a/Pandora/Paradigm/Primary/Transformer/Jack.hs b/Pandora/Paradigm/Primary/Transformer/Jack.hs
index 7339cac..43853c2 100644
--- a/Pandora/Paradigm/Primary/Transformer/Jack.hs
+++ b/Pandora/Paradigm/Primary/Transformer/Jack.hs
@@ -11,8 +11,10 @@ import Pandora.Pattern.Functor.Traversable (Traversable ((->>), traverse))
import Pandora.Pattern.Functor.Distributive (Distributive ((>>-), distribute))
import Pandora.Pattern.Transformer.Liftable (Liftable (lift))
import Pandora.Pattern.Functor.Divariant (($))
-import Pandora.Pattern.Object.Setoid (Setoid ((==)), Boolean (False))
-import Pandora.Pattern.Object.Chain (Chain ((<=>)), Ordering (Less, Greater))
+import Pandora.Pattern.Object.Setoid (Setoid ((==)))
+import Pandora.Pattern.Object.Chain (Chain ((<=>)))
+import Pandora.Paradigm.Primary.Object.Boolean (Boolean (False))
+import Pandora.Paradigm.Primary.Object.Ordering (Ordering (Less, Greater))
data Jack t a = It a | Other (t a)
diff --git a/Pandora/Paradigm/Primary/Transformer/Outline.hs b/Pandora/Paradigm/Primary/Transformer/Outline.hs
new file mode 100644
index 0000000..0a3e8d5
--- /dev/null
+++ b/Pandora/Paradigm/Primary/Transformer/Outline.hs
@@ -0,0 +1,43 @@
+module Pandora.Paradigm.Primary.Transformer.Outline (Outline (..)) where
+
+import Pandora.Core.Morphism ((%))
+import Pandora.Pattern.Category (identity, (.))
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
+import Pandora.Pattern.Functor.Pointable (Pointable (point))
+import Pandora.Pattern.Functor.Extractable (Extractable (extract))
+import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
+import Pandora.Pattern.Functor.Divariant (($))
+import Pandora.Pattern.Transformer.Liftable (Liftable (lift))
+import Pandora.Pattern.Transformer.Hoistable (Hoistable (hoist))
+import Pandora.Paradigm.Controlflow.Joint.Interpreted (Interpreted (Primary, run))
+
+data Outline t a where
+ Line :: a -> Outline t a
+ Outlined :: t a -> Outline t (a -> b) -> Outline t b
+
+instance Covariant (Outline t) where
+ f <$> Line a = Line $ f a
+ f <$> Outlined x y = Outlined x ((.) f <$> y)
+
+instance Pointable (Outline t) where
+ point = Line
+
+instance Extractable t => Extractable (Outline t) where
+ extract (Line x) = x
+ extract (Outlined x y) = extract y $ extract x
+
+instance Applicative (Outline f) where
+ Line f <*> y = f <$> y
+ Outlined x y <*> z = Outlined x ((%) <$> y <*> z)
+
+instance Liftable Outline where
+ lift t = Outlined t (Line identity)
+
+instance Hoistable Outline where
+ hoist _ (Line x) = Line x
+ hoist f (Outlined x y) = Outlined (f x) (hoist f y)
+
+instance (Pointable t, Applicative t) => Interpreted (Outline t) where
+ type Primary (Outline t) a = t a
+ run (Line x) = point x
+ run (Outlined t f) = run f <*> t
diff --git a/Pandora/Paradigm/Structure.hs b/Pandora/Paradigm/Structure.hs
index b770610..81e75ce 100644
--- a/Pandora/Paradigm/Structure.hs
+++ b/Pandora/Paradigm/Structure.hs
@@ -1,7 +1,7 @@
module Pandora.Paradigm.Structure (module Exports) where
-import Pandora.Paradigm.Structure.Variation.Substructure as Exports
-import Pandora.Paradigm.Structure.Variation.Nonempty as Exports
+import Pandora.Paradigm.Structure.Ability.Substructure as Exports
+import Pandora.Paradigm.Structure.Ability.Nonempty as Exports
import Pandora.Paradigm.Structure.Rose as Exports
import Pandora.Paradigm.Structure.Binary as Exports
import Pandora.Paradigm.Structure.Stack as Exports
diff --git a/Pandora/Paradigm/Structure/Ability.hs b/Pandora/Paradigm/Structure/Ability.hs
new file mode 100644
index 0000000..1654598
--- /dev/null
+++ b/Pandora/Paradigm/Structure/Ability.hs
@@ -0,0 +1,5 @@
+module Pandora.Paradigm.Structure.Ability (module Exports) where
+
+import Pandora.Paradigm.Structure.Ability.Substructure as Exports
+import Pandora.Paradigm.Structure.Ability.Focusable as Exports
+import Pandora.Paradigm.Structure.Ability.Nonempty as Exports
diff --git a/Pandora/Paradigm/Structure/Ability/Focusable.hs b/Pandora/Paradigm/Structure/Ability/Focusable.hs
new file mode 100644
index 0000000..9f8489b
--- /dev/null
+++ b/Pandora/Paradigm/Structure/Ability/Focusable.hs
@@ -0,0 +1,9 @@
+module Pandora.Paradigm.Structure.Ability.Focusable (Focusable (..)) where
+
+import Pandora.Core.Functor (type (|->))
+import Pandora.Paradigm.Inventory.Optics (type (:-.))
+
+class Focusable t where
+ type Focus (t :: * -> *) a
+ top :: t a :-. Focus t a
+ singleton :: a |-> t
diff --git a/Pandora/Paradigm/Structure/Variation/Nonempty.hs b/Pandora/Paradigm/Structure/Ability/Nonempty.hs
index 0f8fc2f..265109c 100644
--- a/Pandora/Paradigm/Structure/Variation/Nonempty.hs
+++ b/Pandora/Paradigm/Structure/Ability/Nonempty.hs
@@ -1,4 +1,4 @@
-module Pandora.Paradigm.Structure.Variation.Nonempty (Nonempty) where
+module Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty) where
-- | Type synonymous for at least one element data structure
type family Nonempty (s :: * -> *) = (r :: * -> *) | r -> s
diff --git a/Pandora/Paradigm/Structure/Ability/Substructure.hs b/Pandora/Paradigm/Structure/Ability/Substructure.hs
new file mode 100644
index 0000000..40db62c
--- /dev/null
+++ b/Pandora/Paradigm/Structure/Ability/Substructure.hs
@@ -0,0 +1,8 @@
+module Pandora.Paradigm.Structure.Ability.Substructure (Substructure (..)) where
+
+import Pandora.Paradigm.Inventory.Optics (type (:-.))
+import Pandora.Paradigm.Primary.Functor.Tagged (Tagged)
+
+class Substructure f t where
+ type Substructural (f :: * -> k) (t :: * -> *) a
+ sub :: t a :-. Tagged f (Substructural f t a)
diff --git a/Pandora/Paradigm/Structure/Binary.hs b/Pandora/Paradigm/Structure/Binary.hs
index 9a9dce8..5aeee7d 100644
--- a/Pandora/Paradigm/Structure/Binary.hs
+++ b/Pandora/Paradigm/Structure/Binary.hs
@@ -2,23 +2,26 @@
module Pandora.Paradigm.Structure.Binary (Binary, insert) where
+import Pandora.Core.Functor (type (:.), type (:=))
import Pandora.Core.Morphism ((&), (%), (!))
import Pandora.Pattern.Category ((.))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
import Pandora.Pattern.Functor.Extractable (extract)
import Pandora.Pattern.Functor.Divariant (($))
-import Pandora.Pattern.Object.Chain (Chain ((<=>)), order)
+import Pandora.Pattern.Object.Chain (Chain ((<=>)))
+import Pandora.Paradigm.Primary.Object.Ordering (order)
import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing), maybe)
import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)))
import Pandora.Paradigm.Primary.Functor.Wye (Wye (End, Left, Right, Both))
import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag))
-import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct))
+import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct)
import Pandora.Paradigm.Controlflow.Joint.Schemes.TU (TU (TU))
import Pandora.Paradigm.Controlflow.Joint.Interpreted (run)
import Pandora.Paradigm.Inventory.Store (Store (Store))
import Pandora.Paradigm.Inventory.Optics ((%~))
-import Pandora.Paradigm.Structure.Variation.Nonempty (Nonempty)
-import Pandora.Paradigm.Structure.Variation.Substructure (Substructure (Output, sub))
+import Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty)
+import Pandora.Paradigm.Structure.Ability.Focusable (Focusable (Focus, top, singleton))
+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substructural, sub))
type Binary = TU Covariant Covariant Maybe (Construction Wye)
@@ -28,8 +31,22 @@ insert x tree@(TU (Just (Construct y _))) = x <=> y & order
(sub @Left %~ (insert x <$>) $ tree) tree
(sub @Right %~ (insert x <$>) $ tree)
+rebalance :: Chain a => (Wye :. Construction Wye := a) -> Nonempty Binary a
+rebalance (Both x y) = extract x <=> extract y & order
+ (Construct (extract y) $ Both x (rebalance $ deconstruct y))
+ (Construct (extract x) $ Both (rebalance $ deconstruct x) (rebalance $ deconstruct y))
+ (Construct (extract x) $ Both (rebalance $ deconstruct x) y)
+
+instance (forall a . Chain a) => Focusable Binary where
+ type Focus Binary a = Maybe a
+ top (TU Nothing) = Store . (:*:) Nothing $ TU . (<$>) (Construct % End)
+ top (TU (Just x)) = Store . (:*:) (Just $ extract x) $ maybe
+ (TU . Just . rebalance $ deconstruct x)
+ (TU . Just . Construct % deconstruct x)
+ singleton = TU . Just . Construct % End
+
instance Substructure Left Binary where
- type Output Left Binary a = Binary a
+ type Substructural Left Binary a = Binary a
sub (TU Nothing) = Store $ (:*:) (Tag $ TU Nothing) $ (TU Nothing !)
sub t@(TU (Just (Construct x End))) = Store $ (:*:) (Tag $ TU Nothing) $
maybe t (TU . Just . Construct x . Left) . run . extract
@@ -41,35 +58,40 @@ instance Substructure Left Binary where
maybe (TU (Just (Construct x (Right rst)))) (TU . Just . Construct x . Both % rst) . run . extract
instance Substructure Right Binary where
- type Output Right Binary a = Binary a
- sub (TU Nothing) = Store $ Tag (TU Nothing) :*: (!) (TU Nothing)
- sub t@(TU (Just (Construct x End))) = Store $ (:*:) (Tag $ TU Nothing) $
- maybe t (TU . Just . Construct x . Right) . run . extract
- sub t@(TU (Just (Construct x (Left lst)))) = Store $ (:*:) (Tag $ TU Nothing) $
- maybe t (TU . Just . Construct x . Both lst) . run . extract
- sub (TU (Just (Construct x (Right rst)))) = Store $ (:*:) (Tag . TU . Just $ rst) $
- maybe (TU . Just . Construct x $ End) (TU . Just . Construct x . Right) . run . extract
- sub (TU (Just (Construct x (Both lst rst)))) = Store $ (:*:) (Tag . TU . Just $ rst) $
- maybe (TU (Just (Construct x (Left lst)))) (TU . Just . Construct x . Both lst) . run . extract
+ type Substructural Right Binary a = Binary a
+ sub (TU Nothing) = Store $ Tag (TU Nothing) :*: (TU Nothing !)
+ sub t@(TU (Just (Construct x End))) = Store $ Tag (TU Nothing)
+ :*: maybe t (TU . Just . Construct x . Right) . run . extract
+ sub t@(TU (Just (Construct x (Left lst)))) = Store $ Tag (TU Nothing)
+ :*: maybe t (TU . Just . Construct x . Both lst) . run . extract
+ sub (TU (Just (Construct x (Right rst)))) = Store $ (Tag . TU . Just $ rst)
+ :*: maybe (TU . Just . Construct x $ End) (TU . Just . Construct x . Right) . run . extract
+ sub (TU (Just (Construct x (Both lst rst)))) = Store $ (Tag . TU . Just $ rst)
+ :*: maybe (TU . Just . Construct x $ Left lst) (TU . Just . Construct x . Both lst) . run . extract
type instance Nonempty Binary = Construction Wye
+instance Focusable (Construction Wye) where
+ type Focus (Construction Wye) a = a
+ top (Construct x xs) = Store $ x :*: Construct % xs
+ singleton = Construct % End
+
instance Substructure Left (Construction Wye) where
- type Output Left (Construction Wye) a = Maybe (Construction Wye a)
+ type Substructural Left (Construction Wye) a = Maybe :. Construction Wye := a
sub (Construct x End) = Store $ Tag Nothing :*: (Construct x End !)
- sub (Construct x (Left lst)) = Store $ (:*:) (Tag . Just $ lst) $
- maybe (Construct x End) (Construct x . Left) . extract
- sub tree@(Construct x (Right rst)) = Store $ (:*:) (Tag Nothing) $
- maybe tree (Construct x . Both % rst) . extract
- sub (Construct x (Both lst rst)) = Store $ (:*:) (Tag . Just $ lst) $
- maybe (Construct x $ Right rst) (Construct x . Both % rst) . extract
+ sub (Construct x (Left lst)) = Store $ Tag (Just lst)
+ :*: maybe (Construct x End) (Construct x . Left) . extract
+ sub tree@(Construct x (Right rst)) = Store $ Tag Nothing
+ :*: maybe tree (Construct x . Both % rst) . extract
+ sub (Construct x (Both lst rst)) = Store $ Tag (Just lst)
+ :*: maybe (Construct x $ Right rst) (Construct x . Both % rst) . extract
instance Substructure Right (Construction Wye) where
- type Output Right (Construction Wye) a = Maybe (Construction Wye a)
+ type Substructural Right (Construction Wye) a = Maybe :. Construction Wye := a
sub (Construct x End) = Store $ Tag Nothing :*: (Construct x End !)
- sub tree@(Construct x (Left lst)) = Store $ (:*:) (Tag Nothing) $
- maybe tree (Construct x . Both lst) . extract
- sub (Construct x (Right rst)) = Store $ (:*:) (Tag . Just $ rst) $
- maybe (Construct x End) (Construct x . Right) . extract
- sub (Construct x (Both lst rst)) = Store $ (:*:) (Tag . Just $ rst) $
- maybe (Construct x $ Left lst) (Construct x . Both lst) . extract
+ sub tree@(Construct x (Left lst)) = Store $ Tag Nothing
+ :*: maybe tree (Construct x . Both lst) . extract
+ sub (Construct x (Right rst)) = Store $ Tag (Just rst)
+ :*: maybe (Construct x End) (Construct x . Right) . extract
+ sub (Construct x (Both lst rst)) = Store $ Tag (Just rst)
+ :*: maybe (Construct x $ Left lst) (Construct x . Both lst) . extract
diff --git a/Pandora/Paradigm/Structure/Rose.hs b/Pandora/Paradigm/Structure/Rose.hs
index 42265dc..b87f696 100644
--- a/Pandora/Paradigm/Structure/Rose.hs
+++ b/Pandora/Paradigm/Structure/Rose.hs
@@ -1,9 +1,47 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
module Pandora.Paradigm.Structure.Rose (Rose) where
-import Pandora.Pattern.Functor.Covariant (Covariant)
-import Pandora.Paradigm.Primary.Functor.Maybe (Maybe)
-import Pandora.Paradigm.Primary.Transformer.Construction (Construction)
+import Pandora.Core.Functor (type (:.), type (:=))
+import Pandora.Core.Morphism ((!), (%))
+import Pandora.Pattern.Category ((.))
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
+import Pandora.Pattern.Functor.Extractable (extract)
+import Pandora.Pattern.Functor.Avoidable (Avoidable (empty))
+import Pandora.Pattern.Functor.Divariant (($))
+import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing), maybe)
+import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)))
+import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag))
+import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct)
+import Pandora.Paradigm.Controlflow.Joint.Schemes.TU (TU (TU))
+import Pandora.Paradigm.Inventory.Store (Store (Store))
import Pandora.Paradigm.Structure.Stack (Stack)
-import Pandora.Paradigm.Controlflow.Joint.Schemes.TU (TU)
+import Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty)
+import Pandora.Paradigm.Structure.Ability.Focusable (Focusable (Focus, top, singleton))
+import Pandora.Paradigm.Structure.Ability.Substructure (Substructure (Substructural, sub))
type Rose = TU Covariant Covariant Maybe (Construction Stack)
+
+instance Focusable Rose where
+ type Focus Rose a = Maybe a
+ top (TU Nothing) = Store $ Nothing :*: TU . (<$>) (Construct % empty)
+ top (TU (Just x)) = Store $ Just (extract x) :*: maybe
+ (TU $ Just x) -- TODO: Nothing at top's lens - should it remove something?
+ (TU . Just . Construct % deconstruct x)
+ singleton = TU . Just . Construct % empty
+
+instance Substructure Just Rose where
+ type Substructural Just Rose a = Stack :. Construction Stack := a
+ sub (TU Nothing) = Store $ Tag (TU Nothing) :*: (TU Nothing !)
+ sub (TU (Just (Construct x xs))) = Store $ Tag xs :*: TU . Just . Construct x . extract
+
+type instance Nonempty Rose = Construction Stack
+
+instance Substructure Just (Construction Stack) where
+ type Substructural Just (Construction Stack) a = Stack :. Construction Stack := a
+ sub (Construct x xs) = Store $ Tag xs :*: Construct x . extract
+
+instance Focusable (Construction Stack) where
+ type Focus (Construction Stack) a = a
+ top rose = Store $ extract rose :*: Construct % deconstruct rose
+ singleton = Construct % empty
diff --git a/Pandora/Paradigm/Structure/Stack.hs b/Pandora/Paradigm/Structure/Stack.hs
index b850a74..661ff8f 100644
--- a/Pandora/Paradigm/Structure/Stack.hs
+++ b/Pandora/Paradigm/Structure/Stack.hs
@@ -1,9 +1,9 @@
{-# OPTIONS_GHC -fno-warn-orphans #-}
-module Pandora.Paradigm.Structure.Stack (Stack, push, top, pop, filter, linearize) where
+module Pandora.Paradigm.Structure.Stack (Stack, push, pop, filter, linearize) where
import Pandora.Core.Functor (type (~>))
-import Pandora.Core.Morphism ((&))
+import Pandora.Core.Morphism ((&), (%))
import Pandora.Pattern.Category ((.))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
import Pandora.Pattern.Functor.Alternative ((<+>))
@@ -13,25 +13,24 @@ import Pandora.Pattern.Functor.Extractable (extract)
import Pandora.Pattern.Functor.Traversable (Traversable)
import Pandora.Pattern.Functor.Bindable ((>>=))
import Pandora.Pattern.Functor.Divariant (($))
-import Pandora.Pattern.Object.Setoid (Setoid ((==)), (?))
+import Pandora.Pattern.Object.Setoid (Setoid ((==)))
import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
import Pandora.Pattern.Object.Monoid (Monoid (zero))
+import Pandora.Paradigm.Primary.Object.Boolean ((?))
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.Transformer.Construction (Construction (Construct), deconstruct)
import Pandora.Paradigm.Inventory.State (fold)
import Pandora.Paradigm.Inventory.Store (Store (Store))
-import Pandora.Paradigm.Inventory.Optics (type (:-.))
import Pandora.Paradigm.Controlflow.Joint.Interpreted (run)
import Pandora.Paradigm.Controlflow.Joint.Schemes.TU (TU (TU))
-import Pandora.Paradigm.Structure.Variation.Nonempty (Nonempty)
+import Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty)
+import Pandora.Paradigm.Structure.Ability.Focusable (Focusable (Focus, top, singleton))
-- | Linear data structure that serves as a collection of elements
type Stack = TU Covariant Covariant Maybe (Construction Maybe)
-type instance Nonempty Stack = Construction Maybe
-
instance Setoid a => Setoid (Stack a) where
TU ls == TU rs = ls == rs
@@ -43,10 +42,19 @@ instance Semigroup (Stack a) where
instance Monoid (Stack a) where
zero = TU Nothing
-top :: Stack a :-. Maybe a
-top stack = Store $ (:*:) (extract <$> run stack) $ \case
- Just x -> stack & pop & push x
- Nothing -> pop stack
+instance Focusable Stack where
+ type Focus Stack a = Maybe a
+ top stack = Store $ (:*:) (extract <$> run stack) $ \case
+ Just x -> stack & pop & push x
+ Nothing -> pop stack
+ singleton = TU . Just . Construct % Nothing
+
+type instance Nonempty Stack = Construction Maybe
+
+instance Focusable (Construction Maybe) where
+ type Focus (Construction Maybe) a = a
+ top stack = Store $ extract stack :*: Construct % deconstruct stack
+ singleton = Construct % Nothing
push :: a -> Stack a -> Stack a
push x (TU stack) = TU $ (Construct x . Just <$> stack) <+> (point . point) x
diff --git a/Pandora/Paradigm/Structure/Variation/Substructure.hs b/Pandora/Paradigm/Structure/Variation/Substructure.hs
deleted file mode 100644
index 3a2a30c..0000000
--- a/Pandora/Paradigm/Structure/Variation/Substructure.hs
+++ /dev/null
@@ -1,8 +0,0 @@
-module Pandora.Paradigm.Structure.Variation.Substructure (Substructure (..)) where
-
-import Pandora.Paradigm.Inventory.Optics (type (:-.))
-import Pandora.Paradigm.Primary.Functor.Tagged (Tagged)
-
-class Substructure f t where
- type Output (f :: * -> k) (t :: * -> *) a
- sub :: t a :-. Tagged f (Output f t a)
diff --git a/Pandora/Pattern/Functor/Avoidable.hs b/Pandora/Pattern/Functor/Avoidable.hs
index 55d807a..b694c9d 100644
--- a/Pandora/Pattern/Functor/Avoidable.hs
+++ b/Pandora/Pattern/Functor/Avoidable.hs
@@ -9,4 +9,5 @@ import Pandora.Pattern.Functor.Alternative (Alternative)
-}
class Alternative t => Avoidable t where
+ {-# MINIMAL empty #-}
empty :: t a
diff --git a/Pandora/Pattern/Functor/Bindable.hs b/Pandora/Pattern/Functor/Bindable.hs
index cffacbd..0b6146f 100644
--- a/Pandora/Pattern/Functor/Bindable.hs
+++ b/Pandora/Pattern/Functor/Bindable.hs
@@ -3,7 +3,7 @@ module Pandora.Pattern.Functor.Bindable (Bindable (..)) where
import Pandora.Core.Functor (type (:.), type (:=))
import Pandora.Core.Morphism ((%))
import Pandora.Pattern.Category (identity)
-import Pandora.Pattern.Functor.Covariant (Covariant)
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
infixl 1 >>=
infixr 1 =<<, <=<, >=>
@@ -34,5 +34,11 @@ class Covariant t => Bindable t where
(<=<) :: (b -> t c) -> (a -> t b) -> (a -> t c)
(<=<) = (%) (>=>)
+ -- | Experimental methods
+ ($>>=) :: Covariant u => (a -> t b) -> u :. t := a -> u :. t := b
+ f $>>= x = (>>= f) <$> x
+ (>>=$) :: (t b -> c) -> (a -> t b) -> t a -> c
+ f >>=$ g = f <$> (>>= g)
+
instance Bindable ((->) e) where
f >>= g = \x -> g (f x) x
diff --git a/Pandora/Pattern/Functor/Determinable.hs b/Pandora/Pattern/Functor/Determinable.hs
index b51b7ad..dfab75c 100644
--- a/Pandora/Pattern/Functor/Determinable.hs
+++ b/Pandora/Pattern/Functor/Determinable.hs
@@ -3,4 +3,5 @@ module Pandora.Pattern.Functor.Determinable (Determinable (..)) where
import Pandora.Pattern.Functor.Contravariant (Contravariant)
class Contravariant t => Determinable t where
+ {-# MINIMAL determine #-}
determine :: t a
diff --git a/Pandora/Pattern/Functor/Distributive.hs b/Pandora/Pattern/Functor/Distributive.hs
index 2157d2e..a7d734f 100644
--- a/Pandora/Pattern/Functor/Distributive.hs
+++ b/Pandora/Pattern/Functor/Distributive.hs
@@ -4,6 +4,7 @@ import Pandora.Core.Functor (type (:.), type (:=))
import Pandora.Core.Morphism ((%))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
import Pandora.Pattern.Category (identity, (.))
+
{- |
> Let f :: Distributive g => (a -> g b)
diff --git a/Pandora/Pattern/Functor/Extractable.hs b/Pandora/Pattern/Functor/Extractable.hs
index 6983464..7bee73d 100644
--- a/Pandora/Pattern/Functor/Extractable.hs
+++ b/Pandora/Pattern/Functor/Extractable.hs
@@ -5,6 +5,7 @@ import Pandora.Pattern.Functor.Covariant (Covariant)
import Pandora.Pattern.Object.Monoid (Monoid (zero))
class Covariant t => Extractable t where
+ {-# MINIMAL extract #-}
extract :: a <-| t
instance Monoid e => Extractable ((->) e) where
diff --git a/Pandora/Pattern/Functor/Pointable.hs b/Pandora/Pattern/Functor/Pointable.hs
index c260370..8e2b1fe 100644
--- a/Pandora/Pattern/Functor/Pointable.hs
+++ b/Pandora/Pattern/Functor/Pointable.hs
@@ -5,6 +5,7 @@ import Pandora.Core.Morphism ((!))
import Pandora.Pattern.Functor.Covariant (Covariant)
class Covariant t => Pointable t where
+ {-# MINIMAL point #-}
point :: a |-> t
instance Pointable ((->) e) where
diff --git a/Pandora/Pattern/Object/Chain.hs b/Pandora/Pattern/Object/Chain.hs
index 6d766b3..79c3321 100644
--- a/Pandora/Pattern/Object/Chain.hs
+++ b/Pandora/Pattern/Object/Chain.hs
@@ -1,6 +1,8 @@
-module Pandora.Pattern.Object.Chain (Ordering (..), order, Chain (..)) where
+module Pandora.Pattern.Object.Chain (Chain (..)) where
-import Pandora.Pattern.Object.Setoid (Setoid ((==)), Boolean (True, False))
+import Pandora.Pattern.Object.Setoid (Setoid)
+import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False))
+import Pandora.Paradigm.Primary.Object.Ordering (Ordering, order)
{- |
> When providing a new instance, you should ensure it satisfies the three laws:
@@ -21,27 +23,3 @@ class Setoid a => Chain a where
x > y = order False False True (x <=> y)
(>=) :: a -> a -> Boolean
x >= y = order False True True (x <=> y)
-
-data Ordering = Less | Equal | Greater
-
-order :: a -> a -> a -> Ordering -> a
-order x _ _ Less = x
-order _ y _ Equal = y
-order _ _ z Greater = z
-
-instance Setoid Ordering where
- Less == Less = True
- Equal == Equal = True
- Greater == Greater = True
- _ == _ = False
-
-instance Chain Ordering where
- Less <=> Less = Equal
- Less <=> Equal = Less
- Less <=> Greater = Less
- Equal <=> Less = Greater
- Equal <=> Equal = Equal
- Equal <=> Greater = Less
- Greater <=> Less = Greater
- Greater <=> Equal = Greater
- Greater <=> Greater = Equal
diff --git a/Pandora/Pattern/Object/Setoid.hs b/Pandora/Pattern/Object/Setoid.hs
index 3c79821..9231439 100644
--- a/Pandora/Pattern/Object/Setoid.hs
+++ b/Pandora/Pattern/Object/Setoid.hs
@@ -1,12 +1,8 @@
-module Pandora.Pattern.Object.Setoid (Boolean (..), (?), bool, Setoid (..)) where
+module Pandora.Pattern.Object.Setoid (Setoid (..)) where
-import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
-import Pandora.Pattern.Object.Ringoid (Ringoid ((*)))
-import Pandora.Pattern.Object.Monoid (Monoid (zero))
-import Pandora.Pattern.Object.Quasiring (Quasiring (one))
-import Pandora.Pattern.Object.Group (Group (invert))
+import Pandora.Pattern.Object.Group (invert)
+import Pandora.Paradigm.Primary.Object.Boolean (Boolean)
-infixr 1 ?
infix 4 ==, /=
{- |
@@ -23,36 +19,3 @@ class Setoid a where
(/=) :: a -> a -> Boolean
(/=) x y = invert (x == y)
-
-data Boolean = True | False
-
-bool :: a -> a -> Boolean -> a
-bool x _ False = x
-bool _ y True = y
-
-(?) :: Boolean -> a -> a -> a
-(?) True x _ = x
-(?) False _ y = y
-
-instance Setoid Boolean where
- True == True = True
- False == False = True
- _ == _ = False
-
-instance Semigroup Boolean where
- False + False = False
- _ + _ = True
-
-instance Ringoid Boolean where
- True * True = True
- _ * _ = False
-
-instance Monoid Boolean where
- zero = False
-
-instance Quasiring Boolean where
- one = True
-
-instance Group Boolean where
- invert False = True
- invert True = False
diff --git a/Pandora/Pattern/Transformer/Hoistable.hs b/Pandora/Pattern/Transformer/Hoistable.hs
index 94ed588..e55b4cb 100644
--- a/Pandora/Pattern/Transformer/Hoistable.hs
+++ b/Pandora/Pattern/Transformer/Hoistable.hs
@@ -1,6 +1,7 @@
module Pandora.Pattern.Transformer.Hoistable (Hoistable (..)) where
import Pandora.Core.Functor (type (~>))
+import Pandora.Pattern.Functor.Covariant (Covariant)
{- |
> When providing a new instance, you should ensure it satisfies one law:
@@ -9,4 +10,4 @@ import Pandora.Core.Functor (type (~>))
-}
class Hoistable t where
- hoist :: u ~> v -> t u ~> t v
+ hoist :: Covariant u => u ~> v -> t u ~> t v
diff --git a/pandora.cabal b/pandora.cabal
index 33a19c1..46f6a5b 100644
--- a/pandora.cabal
+++ b/pandora.cabal
@@ -1,5 +1,5 @@
name: pandora
-version: 0.2.7
+version: 0.2.8
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
@@ -26,10 +26,15 @@ library
Pandora.Paradigm
-- Basic constructions
+
Pandora.Paradigm.Primary
+ Pandora.Paradigm.Primary.Object
+ Pandora.Paradigm.Primary.Object.Boolean
+ Pandora.Paradigm.Primary.Object.Ordering
Pandora.Paradigm.Primary.Functor
Pandora.Paradigm.Primary.Functor.Conclusion
Pandora.Paradigm.Primary.Functor.Constant
+ Pandora.Paradigm.Primary.Functor.Delta
Pandora.Paradigm.Primary.Functor.Edges
Pandora.Paradigm.Primary.Functor.Endo
Pandora.Paradigm.Primary.Functor.Fix
@@ -39,15 +44,17 @@ library
Pandora.Paradigm.Primary.Functor.Product
Pandora.Paradigm.Primary.Functor.Proxy
Pandora.Paradigm.Primary.Functor.Tagged
+ Pandora.Paradigm.Primary.Functor.These
Pandora.Paradigm.Primary.Functor.Validation
- Pandora.Paradigm.Primary.Functor.Variation
Pandora.Paradigm.Primary.Functor.Wye
+ Pandora.Paradigm.Primary.Functor.Wedge
Pandora.Paradigm.Primary.Transformer
Pandora.Paradigm.Primary.Transformer.Backwards
Pandora.Paradigm.Primary.Transformer.Reverse
Pandora.Paradigm.Primary.Transformer.Continuation
Pandora.Paradigm.Primary.Transformer.Construction
Pandora.Paradigm.Primary.Transformer.Instruction
+ Pandora.Paradigm.Primary.Transformer.Outline
Pandora.Paradigm.Primary.Transformer.Jack
Pandora.Paradigm.Primary.Transformer.Jet
Pandora.Paradigm.Primary.Transformer.Kan
@@ -85,8 +92,10 @@ library
Pandora.Paradigm.Structure.Stack
Pandora.Paradigm.Structure.Binary
Pandora.Paradigm.Structure.Rose
- Pandora.Paradigm.Structure.Variation.Nonempty
- Pandora.Paradigm.Structure.Variation.Substructure
+ Pandora.Paradigm.Structure.Ability
+ Pandora.Paradigm.Structure.Ability.Focusable
+ Pandora.Paradigm.Structure.Ability.Nonempty
+ Pandora.Paradigm.Structure.Ability.Substructure
Pandora.Pattern
-- Category typeclass
@@ -125,7 +134,6 @@ library
Pandora.Pattern.Object.Semilattice
Pandora.Pattern.Object.Semiring
Pandora.Pattern.Object.Setoid
- -- Pandora.Pattern.Object.Property.Boolean
-- Typeclassess about object composition of functors
Pandora.Pattern.Transformer
Pandora.Pattern.Transformer.Hoistable