summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoriokasimovmt <>2020-11-21 07:30:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2020-11-21 07:30:00 (GMT)
commita63c55db99577a7b2d2f23c4067287efc4422aeb (patch)
tree384245479c7e524eb458e7d398cf4e49c6a16104
parent4e7c024c940dc2ba7bcdbbdee3d91beb039eaf0e (diff)
version 0.3.2HEAD0.3.2master
-rwxr-xr-xCHANGELOG.md15
-rw-r--r--Pandora/Paradigm/Controlflow/Effect/Adaptable.hs148
-rw-r--r--Pandora/Paradigm/Controlflow/Effect/Transformer/Comonadic.hs2
-rw-r--r--Pandora/Paradigm/Controlflow/Effect/Transformer/Monadic.hs6
-rw-r--r--Pandora/Paradigm/Inventory/Accumulator.hs2
-rw-r--r--Pandora/Paradigm/Inventory/Environment.hs2
-rw-r--r--Pandora/Paradigm/Inventory/Equipment.hs2
-rw-r--r--Pandora/Paradigm/Inventory/Imprint.hs2
-rw-r--r--Pandora/Paradigm/Inventory/State.hs52
-rw-r--r--Pandora/Paradigm/Inventory/Store.hs6
-rw-r--r--Pandora/Paradigm/Primary/Functor.hs2
-rw-r--r--Pandora/Paradigm/Primary/Functor/Conclusion.hs30
-rw-r--r--Pandora/Paradigm/Primary/Functor/Delta.hs4
-rw-r--r--Pandora/Paradigm/Primary/Functor/Maybe.hs21
-rw-r--r--Pandora/Paradigm/Primary/Functor/Predicate.hs12
-rw-r--r--Pandora/Paradigm/Primary/Functor/Product.hs55
-rw-r--r--Pandora/Paradigm/Primary/Transformer/Backwards.hs2
-rw-r--r--Pandora/Paradigm/Primary/Transformer/Construction.hs56
-rw-r--r--Pandora/Paradigm/Primary/Transformer/Continuation.hs3
-rw-r--r--Pandora/Paradigm/Primary/Transformer/Day.hs3
-rw-r--r--Pandora/Paradigm/Primary/Transformer/Kan.hs4
-rw-r--r--Pandora/Paradigm/Primary/Transformer/Reverse.hs2
-rw-r--r--Pandora/Paradigm/Primary/Transformer/Tap.hs4
-rw-r--r--Pandora/Paradigm/Schemes/TU.hs2
-rw-r--r--Pandora/Paradigm/Schemes/TUT.hs2
-rw-r--r--Pandora/Paradigm/Schemes/TUVW.hs2
-rw-r--r--Pandora/Paradigm/Schemes/UT.hs2
-rw-r--r--Pandora/Paradigm/Schemes/UTU.hs2
-rw-r--r--Pandora/Paradigm/Structure.hs32
-rw-r--r--Pandora/Paradigm/Structure/Ability/Comprehension.hs2
-rw-r--r--Pandora/Paradigm/Structure/Ability/Monotonic.hs12
-rw-r--r--Pandora/Paradigm/Structure/Ability/Rotatable.hs8
-rw-r--r--Pandora/Paradigm/Structure/Interface/Set.hs17
-rw-r--r--Pandora/Paradigm/Structure/Splay.hs16
-rw-r--r--Pandora/Paradigm/Structure/Stack.hs48
-rw-r--r--Pandora/Paradigm/Structure/Stream.hs30
-rw-r--r--Pandora/Pattern.hs16
-rw-r--r--Pandora/Pattern/Functor/Adjoint.hs2
-rw-r--r--Pandora/Pattern/Functor/Covariant.hs12
-rw-r--r--Pandora/Pattern/Functor/Monad.hs17
-rw-r--r--pandora.cabal2
41 files changed, 462 insertions, 197 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index d25c359..b60dd7a 100755
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -68,7 +68,6 @@
* Rename `ask` to `env` method of `Environmental` datatype
* Introduce `><` type operator to separate functors from its arguments
* Define `Determinable` typeclass and define its instance for `Predicate`
-* Define `curry` and `uncurry` for `Product` datatype
* Flip arguments of `statefully` method of `Stateful` datatype
* Exclude inner effects from `Environmental`, `Storage` and `Stateful` datatypes
@@ -269,3 +268,17 @@
* Remove `lay` method of `Monadic` type class, use `lift` instead
* Remove `flick` method of `Comonadic` type class, use `lower` instead
* Change `lift` constraint: from `Covariant` to `Traversable`
+
+# 0.3.2
+* Define experimental methods: `->>=`, `>>=-`, `-=<<`, `=<<-`
+* Define `interruptable` method for `Continuation`
+* Define `Catchable` typeclass to catch errors from `Conclusion`
+* Define `repeat` method of `Stream` datatype
+* Define `subset` method of `Set` interface
+* Define `satisfy` method in `Predicate` module
+* Make `fold` and `find` stateful expressions
+* Define `equate` method of `Predicate` dataype
+* Define `Zipper` instance of `Nonempty Stack`
+* Define `forward'` and `backward'` methods for `Zipper` of `Nonempty Stack`
+* Rename `iterate` method of `Monotonic` typeclass to `bypass`
+* Rename `coiterate` method of `Construction` datatype to `iterate`
diff --git a/Pandora/Paradigm/Controlflow/Effect/Adaptable.hs b/Pandora/Paradigm/Controlflow/Effect/Adaptable.hs
index 7081a9e..0cab607 100644
--- a/Pandora/Paradigm/Controlflow/Effect/Adaptable.hs
+++ b/Pandora/Paradigm/Controlflow/Effect/Adaptable.hs
@@ -7,7 +7,6 @@ import Pandora.Pattern.Category (identity, (.))
import Pandora.Pattern.Functor.Covariant (Covariant)
import Pandora.Pattern.Functor.Pointable (Pointable)
import Pandora.Pattern.Functor.Extractable (Extractable)
-import Pandora.Pattern.Functor.Traversable (Traversable)
import Pandora.Pattern.Functor.Comonad (Comonad)
import Pandora.Pattern.Functor.Monad (Monad)
import Pandora.Pattern.Transformer (Liftable (lift), Lowerable (lower), Hoistable (hoist))
@@ -18,7 +17,7 @@ class Adaptable t u where
{-# MINIMAL adapt #-}
adapt :: t ~> u
-type Lifting t u = (Transformer Monad t, Liftable (Schematic Monad t), Traversable u)
+type Lifting t u = (Transformer Monad t, Liftable (Schematic Monad t), Covariant u)
type Lowering t u = (Transformer Comonad t, Lowerable (Schematic Comonad t), Covariant u)
type Wrappable t u = (Transformer Monad t, Pointable u)
type Bringable t u = (Transformer Comonad t, Extractable u)
@@ -41,7 +40,7 @@ instance (Covariant (t :< u), Bringable t u) => Adaptable (t :< u) t where
instance
( Covariant (t :> u :> v)
, Liftable (Schematic Monad t)
- , Traversable (Schematic Monad u v)
+ , Covariant (Schematic Monad u v)
, Wrappable u v
) => Adaptable u (t :> u :> v) where
adapt = lift . wrap
@@ -328,7 +327,7 @@ instance (Covariant u, Hoistable ((:>) t), Adaptable u u') => Adaptable (t :> u)
instance
( Covariant u
, Covariant v
- , Traversable (Schematic Monad u v)
+ , Covariant (Schematic Monad u v)
, Hoistable ((:>) (t :> u))
, Hoistable (Schematic Monad t)
, Hoistable (Schematic Monad u)
@@ -338,9 +337,9 @@ instance
instance
( Covariant u, Covariant v, Covariant w
- , Traversable (Schematic Monad u v)
- , Traversable (Schematic Monad u (v :> w))
- , Traversable (Schematic Monad v w)
+ , Covariant (Schematic Monad u v)
+ , Covariant (Schematic Monad u (v :> w))
+ , Covariant (Schematic Monad v w)
, Hoistable ((:>) (t :> u :> v))
, Hoistable (Schematic Monad t)
, Hoistable (Schematic Monad u)
@@ -351,11 +350,11 @@ instance
instance
( Covariant u, Covariant v, Covariant w, Covariant x
- , Traversable (Schematic Monad u v)
- , Traversable (Schematic Monad u (v :> w))
- , Traversable (Schematic Monad v (w :> x))
- , Traversable (Schematic Monad u (v :> (w :> x)))
- , Traversable (Schematic Monad w x)
+ , Covariant (Schematic Monad u v)
+ , Covariant (Schematic Monad u (v :> w))
+ , Covariant (Schematic Monad u (v :> (w :> x)))
+ , Covariant (Schematic Monad v (w :> x))
+ , Covariant (Schematic Monad w x)
, Hoistable ((:>) (t :> u :> v))
, Hoistable (Schematic Monad t)
, Hoistable (Schematic Monad u)
@@ -364,3 +363,128 @@ instance
, Adaptable x x'
) => Adaptable (t :> u :> v :> w :> x) (t :> u :> v :> w :> x') where
adapt = hoist (hoist (hoist (hoist adapt)))
+
+instance
+ ( Covariant u, Covariant v, Covariant w, Covariant x, Covariant y
+ , Covariant (Schematic Monad u v)
+ , Covariant (Schematic Monad u (v :> w))
+ , Covariant (Schematic Monad u (v :> (w :> x)))
+ , Covariant (Schematic Monad u (v :> (w :> (x :> y))))
+ , Covariant (Schematic Monad v (w :> x))
+ , Covariant (Schematic Monad v (w :> (x :> y)))
+ , Covariant (Schematic Monad w (x :> y))
+ , Covariant (Schematic Monad x y)
+ , Hoistable ((:>) (t :> u :> v :> w))
+ , Hoistable (Schematic Monad t)
+ , Hoistable (Schematic Monad u)
+ , Hoistable (Schematic Monad v)
+ , Hoistable (Schematic Monad w)
+ , Hoistable (Schematic Monad x)
+ , Adaptable y y'
+ ) => Adaptable (t :> u :> v :> w :> x :> y) (t :> u :> v :> w :> x :> y') where
+ adapt = hoist (hoist (hoist (hoist (hoist adapt))))
+
+instance
+ ( Covariant u, Covariant v, Covariant w, Covariant x, Covariant y, Covariant z
+ , Covariant (Schematic Monad u v)
+ , Covariant (Schematic Monad u (v :> w))
+ , Covariant (Schematic Monad u (v :> (w :> x)))
+ , Covariant (Schematic Monad u (v :> (w :> (x :> y))))
+ , Covariant (Schematic Monad u (v :> (w :> (x :> (y :> z)))))
+ , Covariant (Schematic Monad v (w :> x))
+ , Covariant (Schematic Monad v (w :> (x :> y)))
+ , Covariant (Schematic Monad v (w :> (x :> (y :> z))))
+ , Covariant (Schematic Monad w (x :> y))
+ , Covariant (Schematic Monad w (x :> (y :> z)))
+ , Covariant (Schematic Monad x y)
+ , Covariant (Schematic Monad x (y :> z))
+ , Covariant (Schematic Monad y z)
+ , Hoistable ((:>) (t :> u :> v :> w))
+ , Hoistable (Schematic Monad t)
+ , Hoistable (Schematic Monad u)
+ , Hoistable (Schematic Monad v)
+ , Hoistable (Schematic Monad w)
+ , Hoistable (Schematic Monad x)
+ , Hoistable (Schematic Monad y)
+ , Adaptable z z'
+ ) => Adaptable (t :> u :> v :> w :> x :> y :> z)
+ (t :> u :> v :> w :> x :> y :> z') where
+ adapt = hoist (hoist (hoist (hoist (hoist adapt))))
+
+instance
+ ( Covariant u, Covariant v, Covariant w, Covariant x
+ , Covariant y, Covariant z, Covariant f
+ , Covariant (Schematic Monad u v)
+ , Covariant (Schematic Monad u (v :> w))
+ , Covariant (Schematic Monad u (v :> (w :> x)))
+ , Covariant (Schematic Monad u (v :> (w :> (x :> y))))
+ , Covariant (Schematic Monad u (v :> (w :> (x :> (y :> z)))))
+ , Covariant (Schematic Monad u (v :> (w :> (x :> (y :> (z :> f))))))
+ , Covariant (Schematic Monad v (w :> x))
+ , Covariant (Schematic Monad v (w :> (x :> y)))
+ , Covariant (Schematic Monad v (w :> (x :> (y :> z))))
+ , Covariant (Schematic Monad v (w :> (x :> (y :> (z :> f)))))
+ , Covariant (Schematic Monad w (x :> y))
+ , Covariant (Schematic Monad w (x :> (y :> z)))
+ , Covariant (Schematic Monad w (x :> (y :> (z :> f))))
+ , Covariant (Schematic Monad x y)
+ , Covariant (Schematic Monad x (y :> z))
+ , Covariant (Schematic Monad x (y :> (z :> f)))
+ , Covariant (Schematic Monad y z)
+ , Covariant (Schematic Monad y (z :> f))
+ , Covariant (Schematic Monad z f)
+ , Hoistable ((:>) (t :> u :> v :> w))
+ , Hoistable (Schematic Monad t)
+ , Hoistable (Schematic Monad u)
+ , Hoistable (Schematic Monad v)
+ , Hoistable (Schematic Monad w)
+ , Hoistable (Schematic Monad x)
+ , Hoistable (Schematic Monad y)
+ , Hoistable (Schematic Monad z)
+ , Adaptable f f'
+ ) => Adaptable (t :> u :> v :> w :> x :> y :> z :> f)
+ (t :> u :> v :> w :> x :> y :> z :> f') where
+ adapt = hoist (hoist (hoist (hoist (hoist (hoist adapt)))))
+
+instance
+ ( Covariant u, Covariant v, Covariant w, Covariant x
+ , Covariant y, Covariant z, Covariant f, Covariant h
+ , Covariant (Schematic Monad u v)
+ , Covariant (Schematic Monad u (v :> w))
+ , Covariant (Schematic Monad u (v :> (w :> x)))
+ , Covariant (Schematic Monad u (v :> (w :> (x :> y))))
+ , Covariant (Schematic Monad u (v :> (w :> (x :> (y :> z)))))
+ , Covariant (Schematic Monad u (v :> (w :> (x :> (y :> (z :> f))))))
+ , Covariant (Schematic Monad u (v :> (w :> (x :> (y :> (z :> (f :> h)))))))
+ , Covariant (Schematic Monad v (w :> x))
+ , Covariant (Schematic Monad v (w :> (x :> y)))
+ , Covariant (Schematic Monad v (w :> (x :> (y :> z))))
+ , Covariant (Schematic Monad v (w :> (x :> (y :> (z :> f)))))
+ , Covariant (Schematic Monad v (w :> (x :> (y :> (z :> (f :> h))))))
+ , Covariant (Schematic Monad w (x :> y))
+ , Covariant (Schematic Monad w (x :> (y :> z)))
+ , Covariant (Schematic Monad w (x :> (y :> (z :> f))))
+ , Covariant (Schematic Monad w (x :> (y :> (z :> (f :> h)))))
+ , Covariant (Schematic Monad x y)
+ , Covariant (Schematic Monad x (y :> z))
+ , Covariant (Schematic Monad x (y :> (z :> f)))
+ , Covariant (Schematic Monad x (y :> (z :> (f :> h))))
+ , Covariant (Schematic Monad y z)
+ , Covariant (Schematic Monad y (z :> f))
+ , Covariant (Schematic Monad y (z :> (f :> h)))
+ , Covariant (Schematic Monad z f)
+ , Covariant (Schematic Monad z (f :> h))
+ , Covariant (Schematic Monad f h)
+ , Hoistable ((:>) (t :> u :> v :> w))
+ , Hoistable (Schematic Monad t)
+ , Hoistable (Schematic Monad u)
+ , Hoistable (Schematic Monad v)
+ , Hoistable (Schematic Monad w)
+ , Hoistable (Schematic Monad x)
+ , Hoistable (Schematic Monad y)
+ , Hoistable (Schematic Monad z)
+ , Hoistable (Schematic Monad f)
+ , Adaptable h h'
+ ) => Adaptable (t :> u :> v :> w :> x :> y :> z :> f :> h)
+ (t :> u :> v :> w :> x :> y :> z :> f :> h') where
+ adapt = hoist (hoist (hoist (hoist (hoist (hoist (hoist adapt))))))
diff --git a/Pandora/Paradigm/Controlflow/Effect/Transformer/Comonadic.hs b/Pandora/Paradigm/Controlflow/Effect/Transformer/Comonadic.hs
index ae56afd..9f00adf 100644
--- a/Pandora/Paradigm/Controlflow/Effect/Transformer/Comonadic.hs
+++ b/Pandora/Paradigm/Controlflow/Effect/Transformer/Comonadic.hs
@@ -62,4 +62,4 @@ instance Hoistable (Schematic Comonad t) => Hoistable ((:<) t) where
instance (Interpreted (Schematic Comonad t u)) => Interpreted (t :< u) where
type Primary (t :< u) a = Primary (Schematic Comonad t u) a
- run (TC x) = run x
+ run ~(TC x) = run x
diff --git a/Pandora/Paradigm/Controlflow/Effect/Transformer/Monadic.hs b/Pandora/Paradigm/Controlflow/Effect/Transformer/Monadic.hs
index 956fd02..7dd1bd6 100644
--- a/Pandora/Paradigm/Controlflow/Effect/Transformer/Monadic.hs
+++ b/Pandora/Paradigm/Controlflow/Effect/Transformer/Monadic.hs
@@ -9,6 +9,7 @@ import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Extractable (Extractable (extract))
import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
+import Pandora.Pattern.Functor.Avoidable (Avoidable (empty))
import Pandora.Pattern.Functor.Distributive (Distributive ((>>-)))
import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
@@ -40,6 +41,9 @@ instance Applicative (Schematic Monad t u) => Applicative (t :> u) where
instance Alternative (Schematic Monad t u) => Alternative (t :> u) where
TM x <+> TM y = TM $ x <+> y
+instance Avoidable (Schematic Monad t u) => Avoidable (t :> u) where
+ empty = TM empty
+
instance Traversable (Schematic Monad t u) => Traversable (t :> u) where
TM x ->> f = TM <$> x ->> f
@@ -62,4 +66,4 @@ instance Hoistable (Schematic Monad t) => Hoistable ((:>) t) where
instance (Interpreted (Schematic Monad t u)) => Interpreted (t :> u) where
type Primary (t :> u) a = Primary (Schematic Monad t u) a
- run (TM x) = run x
+ run ~(TM x) = run x
diff --git a/Pandora/Paradigm/Inventory/Accumulator.hs b/Pandora/Paradigm/Inventory/Accumulator.hs
index bd9f560..f8f293a 100644
--- a/Pandora/Paradigm/Inventory/Accumulator.hs
+++ b/Pandora/Paradigm/Inventory/Accumulator.hs
@@ -36,7 +36,7 @@ type instance Schematic Monad (Accumulator e) = (<.:>) ((:*:) e)
instance Interpreted (Accumulator e) where
type Primary (Accumulator e) a = e :*: a
- run (Accumulator x) = x
+ run ~(Accumulator x) = x
instance Monoid e => Monadic (Accumulator e) where
wrap = TM . UT . point . run
diff --git a/Pandora/Paradigm/Inventory/Environment.hs b/Pandora/Paradigm/Inventory/Environment.hs
index 7468957..73e8981 100644
--- a/Pandora/Paradigm/Inventory/Environment.hs
+++ b/Pandora/Paradigm/Inventory/Environment.hs
@@ -36,7 +36,7 @@ instance Monad (Environment e) where
instance Interpreted (Environment e) where
type Primary (Environment e) a = (->) e a
- run (Environment x) = x
+ run ~(Environment x) = x
type instance Schematic Monad (Environment e) = (<:.>) ((->) e)
diff --git a/Pandora/Paradigm/Inventory/Equipment.hs b/Pandora/Paradigm/Inventory/Equipment.hs
index 866ba88..57a8efa 100644
--- a/Pandora/Paradigm/Inventory/Equipment.hs
+++ b/Pandora/Paradigm/Inventory/Equipment.hs
@@ -26,7 +26,7 @@ instance Extendable (Equipment e) where
instance Interpreted (Equipment e) where
type Primary (Equipment e) a = e :*: a
- run (Equipment x) = x
+ run ~(Equipment x) = x
type instance Schematic Comonad (Equipment e) = (<:.>) ((:*:) e)
diff --git a/Pandora/Paradigm/Inventory/Imprint.hs b/Pandora/Paradigm/Inventory/Imprint.hs
index 727f5cb..79c7ef3 100644
--- a/Pandora/Paradigm/Inventory/Imprint.hs
+++ b/Pandora/Paradigm/Inventory/Imprint.hs
@@ -32,7 +32,7 @@ instance Semigroup e => Extendable (Imprint e) where
instance Interpreted (Imprint e) where
type Primary (Imprint e) a = (->) e a
- run (Imprint x) = x
+ run ~(Imprint x) = x
type instance Schematic Comonad (Imprint e) = (<.:>) ((->) e)
diff --git a/Pandora/Paradigm/Inventory/State.hs b/Pandora/Paradigm/Inventory/State.hs
index fc5dd11..1d70104 100644
--- a/Pandora/Paradigm/Inventory/State.hs
+++ b/Pandora/Paradigm/Inventory/State.hs
@@ -3,42 +3,43 @@
module Pandora.Paradigm.Inventory.State where
import Pandora.Core.Functor (type (:.), type (:=))
-import Pandora.Core.Morphism ((%))
import Pandora.Pattern.Category (identity, (.), ($))
-import Pandora.Pattern.Functor (Covariant ((<$>), (<$$>)), Avoidable (empty), Pointable (point), Applicative ((<*>), (*>)), Alternative ((<+>)), Traversable ((->>)), Bindable ((>>=), (>=>)), Monad, extract, (-|), (|-), (<*+>))
-import Pandora.Paradigm.Controlflow (Adaptable (adapt), Interpreted (Primary, run), Monadic (wrap), (:>) (TM), Schematic)
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>)))
+import Pandora.Pattern.Functor.Avoidable (Avoidable (empty))
+import Pandora.Pattern.Functor.Pointable (Pointable (point))
+import Pandora.Pattern.Functor.Applicative (Applicative ((<*>), (*>)))
+import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
+import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
+import Pandora.Pattern.Functor.Bindable (Bindable ((>>=), (>=>)))
+import Pandora.Pattern.Functor.Monad (Monad)
+import Pandora.Pattern.Functor.Adjoint ((-|), (|-))
+import Pandora.Pattern.Functor.Bivariant ((<->))
+import Pandora.Pattern.Functor ((<*+>))
+import Pandora.Paradigm.Controlflow.Effect.Adaptable (Adaptable (adapt))
+import Pandora.Paradigm.Controlflow.Effect.Interpreted (Interpreted (Primary, run), Schematic)
+import Pandora.Paradigm.Controlflow.Effect.Transformer.Monadic (Monadic (wrap), (:>) (TM))
import Pandora.Paradigm.Schemes.TUT (TUT (TUT), type (<:<.>:>))
-import Pandora.Paradigm.Primary.Functor (Predicate (Predicate), Product ((:*:)), type (:*:), delta)
-import Pandora.Paradigm.Primary.Object (bool)
+import Pandora.Paradigm.Primary.Functor (Product ((:*:)), type (:*:), delta)
newtype State s a = State ((->) s :. (:*:) s := a)
instance Covariant (State s) where
- f <$> State x = State $ \old -> f <$> x old
+ f <$> x = State $ (<$>) f . run x
instance Applicative (State s) where
- State f <*> State x = State $ \old ->
- let (new :*: g) = f old in g <$> x new
+ f <*> x = State $ (|- (<$>)) . (run x <-> identity) . run f
instance Pointable (State s) where
point = State . (-| identity)
instance Bindable (State s) where
- State x >>= f = State $ \old ->
- (|- run) $ f <$> x old
+ x >>= f = State $ (|- run) . (<$>) f . run x
instance Monad (State s) where
-fold :: Traversable t => s -> (a -> s -> s) -> t a -> s
-fold start op struct = extract . run @(State _) % start
- $ struct ->> modify . op *> current
-
-find :: (Pointable u, Avoidable u, Alternative u, Traversable t) => Predicate a -> t a -> u a
-find (Predicate p) = fold empty (\x s -> (<+>) s . bool empty (point x) . p $ x)
-
instance Interpreted (State s) where
type Primary (State s) a = (->) s :. (:*:) s := a
- run (State x) = x
+ run ~(State x) = x
type instance Schematic Monad (State s) = (->) s <:<.>:> (:*:) s
@@ -48,21 +49,21 @@ instance Monadic (State s) where
type Stateful s = Adaptable (State s)
instance Covariant u => Covariant ((->) s <:<.>:> (:*:) s := u) where
- f <$> TUT x = TUT $ (<$$>) f . x
+ f <$> x = TUT $ (<$$>) f . run x
instance Bindable u => Applicative ((->) s <:<.>:> (:*:) s := u) where
- TUT f <*> TUT x = TUT $ f >=> \(new :*: g) -> g <$$> x new
+ f <*> x = TUT $ run f >=> \ ~(new :*: g) -> g <$$> run x new
instance Pointable u => Pointable ((->) s <:<.>:> (:*:) s := u) where
point = TUT . (-| point)
instance Bindable u => Bindable ((->) s <:<.>:> (:*:) s := u) where
- TUT x >>= f = TUT $ x >=> \(new :*: y) -> ($ new) . run . f $ y
+ x >>= f = TUT $ run x >=> \ ~(new :*: y) -> ($ new) . run . f $ y
instance Monad u => Monad ((->) s <:<.>:> (:*:) s := u) where
instance Alternative u => Alternative ((->) s <:<.>:> (:*:) s := u) where
- TUT x <+> TUT y = TUT (x <*+> y)
+ x <+> y = TUT $ run x <*+> run y
instance Avoidable u => Avoidable ((->) s <:<.>:> (:*:) s := u) where
empty = TUT $ \_ -> empty
@@ -75,3 +76,10 @@ modify f = adapt . State $ (:*: ()) . f
replace :: Stateful s t => s -> t ()
replace s = adapt . State $ \_ -> s :*: ()
+
+type Memorable s t = (Pointable t, Applicative t, Stateful s t)
+
+fold :: (Traversable t, Memorable s u) => (a -> s -> s) -> t a -> u s
+fold op struct = struct ->> modify . op *> current
+
+type Decisive t = (Pointable t, Avoidable t, Alternative t, Applicative t)
diff --git a/Pandora/Paradigm/Inventory/Store.hs b/Pandora/Paradigm/Inventory/Store.hs
index 7da3816..72fb6ba 100644
--- a/Pandora/Paradigm/Inventory/Store.hs
+++ b/Pandora/Paradigm/Inventory/Store.hs
@@ -3,13 +3,13 @@
module Pandora.Paradigm.Inventory.Store where
import Pandora.Core (type (:.), type (:=), type (<-|), type (~>), (%))
+import Pandora.Pattern ((.|..))
import Pandora.Pattern.Category (identity, (.), ($))
-import Pandora.Pattern.Functor (Covariant ((<$>), (<$$>), (<$$$>)), Extractable (extract), Extendable ((=>>), (<<=$)), Comonad, (.|..), (-|), (|-))
+import Pandora.Pattern.Functor (Covariant ((<$>), (<$$>), (<$$$>)), Extractable (extract), Extendable ((=>>), (<<=$)), Comonad, (-|), (|-))
import Pandora.Paradigm.Primary.Functor (Product ((:*:)), type (:*:), attached)
import Pandora.Paradigm.Controlflow (Adaptable (adapt), Interpreted (Primary, run), Schematic, Comonadic (bring), (:<) (TC))
import Pandora.Paradigm.Schemes.TUT (TUT (TUT), type (<:<.>:>))
-
newtype Store p a = Store ((:*:) p :. (->) p := a)
instance Covariant (Store p) where
@@ -25,7 +25,7 @@ instance Comonad (Store p) where
instance Interpreted (Store p) where
type Primary (Store p) a = (:*:) p :. (->) p := a
- run (Store x) = x
+ run ~(Store x) = x
type instance Schematic Comonad (Store p) = (:*:) p <:<.>:> (->) p
diff --git a/Pandora/Paradigm/Primary/Functor.hs b/Pandora/Paradigm/Primary/Functor.hs
index bb16398..4b16f73 100644
--- a/Pandora/Paradigm/Primary/Functor.hs
+++ b/Pandora/Paradigm/Primary/Functor.hs
@@ -29,7 +29,7 @@ instance Adjoint (Product s) ((->) s) where
(-|) :: a -> ((s :*: a) -> b) -> (s -> b)
x -| f = \s -> f $ s :*: x
(|-) :: (s :*: a) -> (a -> s -> b) -> b
- (s :*: x) |- f = f x s
+ ~(s :*: x) |- f = f x s
note :: e -> Maybe ~> Conclusion e
note x = maybe (Failure x) Success
diff --git a/Pandora/Paradigm/Primary/Functor/Conclusion.hs b/Pandora/Paradigm/Primary/Functor/Conclusion.hs
index 7b08097..92ea387 100644
--- a/Pandora/Paradigm/Primary/Functor/Conclusion.hs
+++ b/Pandora/Paradigm/Primary/Functor/Conclusion.hs
@@ -1,7 +1,7 @@
module Pandora.Paradigm.Primary.Functor.Conclusion where
import Pandora.Core.Functor (type (~>))
-import Pandora.Pattern.Category ((.), ($))
+import Pandora.Pattern.Category (identity, (.), ($))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>)))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
@@ -18,7 +18,7 @@ import Pandora.Paradigm.Primary.Object.Ordering (Ordering (Less, Greater))
import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run))
import Pandora.Paradigm.Controlflow.Effect.Transformer.Monadic (Monadic (wrap), (:>) (TM))
import Pandora.Paradigm.Controlflow.Effect.Adaptable (Adaptable (adapt))
-import Pandora.Paradigm.Schemes.UT (UT (UT))
+import Pandora.Paradigm.Schemes.UT (UT (UT), type (<.:>))
data Conclusion e a = Failure e | Success a
@@ -77,28 +77,38 @@ fail _ (Success y) = Success y
instance Interpreted (Conclusion e) where
type Primary (Conclusion e) a = Conclusion e a
- run x = x
+ run = identity
-type instance Schematic Monad (Conclusion e) = UT Covariant Covariant (Conclusion e)
+type instance Schematic Monad (Conclusion e) = (<.:>) (Conclusion e)
instance Monadic (Conclusion e) where
- wrap x = TM . UT . point $ x
+ wrap = TM . UT . point
type Failable e = Adaptable (Conclusion e)
-instance Covariant u => Covariant (UT Covariant Covariant (Conclusion e) u) where
+instance Covariant u => Covariant (Conclusion e <.:> u) where
f <$> UT x = UT $ f <$$> x
-instance Applicative u => Applicative (UT Covariant Covariant (Conclusion e) u) where
+instance Applicative u => Applicative (Conclusion e <.:> u) where
UT f <*> UT x = UT $ (<*>) <$> f <*> x
-instance Pointable u => Pointable (UT Covariant Covariant (Conclusion e) u) where
+instance Pointable u => Pointable (Conclusion e <.:> u) where
point = UT . point . point
-instance (Pointable u, Bindable u) => Bindable (UT Covariant Covariant (Conclusion e) u) where
+instance (Pointable u, Bindable u) => Bindable (Conclusion e <.:> u) where
UT x >>= f = UT $ x >>= conclusion (point . Failure) (run . f)
-instance Monad u => Monad (UT Covariant Covariant (Conclusion e) u) where
+instance Monad u => Monad (Conclusion e <.:> u) where
failure :: Failable e t => e -> t a
failure = adapt . Failure
+
+class Catchable e t where
+ catch :: t a -> (e -> t a) -> t a
+
+instance Catchable e (Conclusion e) where
+ catch (Failure e) handle = handle e
+ catch (Success x) _ = Success x
+
+instance Monad u => Catchable e (Conclusion e <.:> u) where
+ catch (UT x) handle = UT $ x >>= conclusion (run . handle) (point . Success)
diff --git a/Pandora/Paradigm/Primary/Functor/Delta.hs b/Pandora/Paradigm/Primary/Functor/Delta.hs
index 0bafe50..7edc38d 100644
--- a/Pandora/Paradigm/Primary/Functor/Delta.hs
+++ b/Pandora/Paradigm/Primary/Functor/Delta.hs
@@ -6,6 +6,7 @@ import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
import Pandora.Pattern.Functor.Distributive (Distributive ((>>-)))
import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
+import Pandora.Pattern.Functor.Extendable (Extendable ((=>>)))
import Pandora.Pattern.Functor.Representable (Representable (Representation, (<#>), tabulate))
import Pandora.Pattern.Object.Setoid (Setoid ((==)))
import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
@@ -31,6 +32,9 @@ instance Distributive Delta where
instance Traversable Delta where
(x :^: y) ->> f = (:^:) <$> f x <*> f y
+instance Extendable Delta where
+ x =>> f = f x :^: f x
+
instance Representable Delta where
type Representation Delta = Boolean
True <#> (x :^: _) = x
diff --git a/Pandora/Paradigm/Primary/Functor/Maybe.hs b/Pandora/Paradigm/Primary/Functor/Maybe.hs
index 2841cb5..597cc3e 100644
--- a/Pandora/Paradigm/Primary/Functor/Maybe.hs
+++ b/Pandora/Paradigm/Primary/Functor/Maybe.hs
@@ -1,6 +1,6 @@
module Pandora.Paradigm.Primary.Functor.Maybe where
-import Pandora.Pattern.Category ((.), ($))
+import Pandora.Pattern.Category (identity, (.), ($))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>)))
import Pandora.Pattern.Functor.Avoidable (Avoidable (empty))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
@@ -20,7 +20,7 @@ import Pandora.Paradigm.Primary.Object.Ordering (Ordering (Less, Equal, Greater)
import Pandora.Paradigm.Controlflow.Effect.Interpreted (Schematic, Interpreted (Primary, run))
import Pandora.Paradigm.Controlflow.Effect.Transformer.Monadic (Monadic (wrap), (:>) (TM))
import Pandora.Paradigm.Controlflow.Effect.Adaptable (Adaptable (adapt))
-import Pandora.Paradigm.Schemes.UT (UT (UT))
+import Pandora.Paradigm.Schemes.UT (UT (UT), type (<.:>))
data Maybe a = Nothing | Just a
@@ -87,31 +87,30 @@ maybe :: b -> (a -> b) -> Maybe a -> b
maybe x _ Nothing = x
maybe _ f (Just y) = f y
--- type instance Schematic Monad Maybe u = UT Covariant Covariant Maybe u
-type instance Schematic Monad Maybe = UT Covariant Covariant Maybe
+type instance Schematic Monad Maybe = (<.:>) Maybe
instance Interpreted Maybe where
type Primary Maybe a = Maybe a
- run x = x
+ run = identity
instance Monadic Maybe where
- wrap x = TM . UT . point $ x
+ wrap = TM . UT . point
type Optional = Adaptable Maybe
-instance Covariant u => Covariant (UT Covariant Covariant Maybe u) where
+instance Covariant u => Covariant (Maybe <.:> u) where
f <$> UT x = UT $ f <$$> x
-instance Applicative u => Applicative (UT Covariant Covariant Maybe u) where
+instance Applicative u => Applicative (Maybe <.:> u) where
UT f <*> UT x = UT $ apply <$> f <*> x
-instance Pointable u => Pointable (UT Covariant Covariant Maybe u) where
+instance Pointable u => Pointable (Maybe <.:> u) where
point = UT . point . point
-instance (Pointable u, Bindable u) => Bindable (UT Covariant Covariant Maybe u) where
+instance (Pointable u, Bindable u) => Bindable (Maybe <.:> u) where
UT x >>= f = UT $ x >>= maybe (point Nothing) (run . f)
-instance Monad u => Monad (UT Covariant Covariant Maybe u) where
+instance Monad u => Monad (Maybe <.:> u) where
nothing :: Optional t => t a
nothing = adapt Nothing
diff --git a/Pandora/Paradigm/Primary/Functor/Predicate.hs b/Pandora/Paradigm/Primary/Functor/Predicate.hs
index 6fc339c..a2eb25c 100644
--- a/Pandora/Paradigm/Primary/Functor/Predicate.hs
+++ b/Pandora/Paradigm/Primary/Functor/Predicate.hs
@@ -1,10 +1,14 @@
module Pandora.Paradigm.Primary.Functor.Predicate where
+import Pandora.Core.Functor (type (|->))
import Pandora.Core.Morphism ((!))
import Pandora.Pattern.Category ((.), ($))
import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<)))
import Pandora.Pattern.Functor.Determinable (Determinable (determine))
-import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True))
+import Pandora.Pattern.Functor.Pointable (Pointable (point))
+import Pandora.Pattern.Functor.Avoidable (Avoidable (empty))
+import Pandora.Pattern.Object.Setoid (Setoid ((==)))
+import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True), (?))
newtype Predicate a = Predicate (a -> Boolean)
@@ -13,3 +17,9 @@ instance Contravariant Predicate where
instance Determinable Predicate where
determine = Predicate (True !)
+
+equate :: Setoid a => a |-> Predicate
+equate x = Predicate (== x)
+
+satisfy :: (Pointable t, Avoidable t) => Predicate a -> a -> t a
+satisfy (Predicate p) x = p x ? point x $ empty
diff --git a/Pandora/Paradigm/Primary/Functor/Product.hs b/Pandora/Paradigm/Primary/Functor/Product.hs
index 01f40aa..2eea18a 100644
--- a/Pandora/Paradigm/Primary/Functor/Product.hs
+++ b/Pandora/Paradigm/Primary/Functor/Product.hs
@@ -1,6 +1,5 @@
module Pandora.Paradigm.Primary.Functor.Product where
-import Pandora.Pattern.Category (($))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
import Pandora.Pattern.Functor.Extractable (Extractable (extract))
import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
@@ -15,7 +14,6 @@ import Pandora.Pattern.Object.Quasiring (Quasiring (one))
import Pandora.Pattern.Object.Semilattice (Infimum ((/\)), Supremum ((\/)))
import Pandora.Pattern.Object.Lattice (Lattice)
import Pandora.Pattern.Object.Group (Group (invert))
-import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (iterate))
infixr 1 :*:
@@ -24,62 +22,53 @@ data Product s a = s :*: a
type (:*:) = Product
instance Covariant (Product s) where
- f <$> (s :*: x) = s :*: f x
+ f <$> x = attached x :*: f (extract x)
instance Extractable (Product a) where
- extract (_ :*: y) = y
+ extract ~(_ :*: y) = y
instance Traversable (Product s) where
- (s :*: x) ->> f = (s :*:) <$> f x
+ x ->> f = (attached x :*:) <$> f (extract x)
instance Extendable (Product s) where
- (s :*: x) =>> f = s :*: f (s :*: x)
+ x =>> f = attached x :*: f (attached x :*: extract x)
instance Comonad (Product s) where
instance Bivariant Product where
- f <-> g = \(s :*: x) -> f s :*: g x
+ f <-> g = \ ~(s :*: x) -> f s :*: g x
-instance (Setoid s, Setoid a) => Setoid (Product s a) where
- (s :*: x) == (s' :*: x') = (s == s') * (x == x')
+instance (Setoid s, Setoid a) => Setoid (s :*: a) where
+ x == y = (attached x == attached y) * (extract x == extract y)
-instance (Semigroup s, Semigroup a) => Semigroup (Product s a) where
- (s :*: x) + (s' :*: x') = s + s' :*: x + x'
+instance (Semigroup s, Semigroup a) => Semigroup (s :*: a) where
+ x + y = attached x + attached y :*: extract x + extract y
-instance (Monoid s, Monoid a) => Monoid (Product s a) where
+instance (Monoid s, Monoid a) => Monoid (s :*: a) where
zero = zero :*: zero
-instance (Ringoid s, Ringoid a) => Ringoid (Product s a) where
- (s :*: x) * (s' :*: x') = s * s' :*: x * x'
+instance (Ringoid s, Ringoid a) => Ringoid (s :*: a) where
+ x * y = attached x * attached y :*: extract x * extract y
-instance (Quasiring s, Quasiring a) => Quasiring (Product s a) where
+instance (Quasiring s, Quasiring a) => Quasiring (s :*: a) where
one = one :*: one
-instance (Infimum s, Infimum a) => Infimum (Product s a) where
- (s :*: x) /\ (s' :*: x') = s /\ s' :*: x /\ x'
+instance (Infimum s, Infimum a) => Infimum (s :*: a) where
+ x /\ y = attached x /\ attached y :*: extract x /\ extract y
-instance (Supremum s, Supremum a) => Supremum (Product s a) where
- (s :*: x) \/ (s' :*: x') = s \/ s' :*: x \/ x'
+instance (Supremum s, Supremum a) => Supremum (s :*: a) where
+ x \/ y = attached x \/ attached y :*: extract x \/ extract y
-instance (Lattice s, Lattice a) => Lattice (Product s a) where
+instance (Lattice s, Lattice a) => Lattice (s :*: a) where
-instance (Group s, Group a) => Group (Product s a) where
- invert (s :*: x) = invert s :*: invert x
-
-instance Monotonic e a => Monotonic (Product a e) a where
- iterate f r (x :*: e) = iterate f (f x r) e
+instance (Group s, Group a) => Group (s :*: a) where
+ invert x = invert (attached x) :*: invert (extract x)
delta :: a -> a :*: a
delta x = x :*: x
swap :: a :*: b -> b :*: a
-swap (x :*: y) = y :*: x
+swap ~(x :*: y) = y :*: x
attached :: a :*: b -> a
-attached (x :*: _) = x
-
-curry :: (a :*: b -> c) -> a -> b -> c
-curry f x y = f $ x :*: y
-
-uncurry :: (a -> b -> c) -> (a :*: b -> c)
-uncurry f (x :*: y) = f x y
+attached ~(x :*: _) = x
diff --git a/Pandora/Paradigm/Primary/Transformer/Backwards.hs b/Pandora/Paradigm/Primary/Transformer/Backwards.hs
index ff20b1d..5006a1b 100644
--- a/Pandora/Paradigm/Primary/Transformer/Backwards.hs
+++ b/Pandora/Paradigm/Primary/Transformer/Backwards.hs
@@ -39,7 +39,7 @@ instance Contravariant t => Contravariant (Backwards t) where
instance Interpreted (Backwards t) where
type Primary (Backwards t) a = t a
- run (Backwards x) = x
+ run ~(Backwards x) = x
instance Liftable Backwards where
lift = Backwards
diff --git a/Pandora/Paradigm/Primary/Transformer/Construction.hs b/Pandora/Paradigm/Primary/Transformer/Construction.hs
index f772860..14aae93 100644
--- a/Pandora/Paradigm/Primary/Transformer/Construction.hs
+++ b/Pandora/Paradigm/Primary/Transformer/Construction.hs
@@ -19,28 +19,30 @@ import Pandora.Pattern.Object.Setoid (Setoid ((==)))
import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
import Pandora.Pattern.Object.Ringoid ((*))
import Pandora.Pattern.Object.Monoid (Monoid (zero))
+import Pandora.Paradigm.Controlflow (run)
import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>))
data Construction t a = Construct a (t :. Construction t := a)
instance Covariant t => Covariant (Construction t) where
- f <$> Construct x xs = Construct (f x) $ f <$$> xs
+ f <$> x = Construct (f $ extract x) $ f <$$> deconstruct x
instance Avoidable t => Pointable (Construction t) where
point x = Construct x empty
instance Covariant t => Extractable (Construction t) where
- extract (Construct x _) = x
+ extract ~(Construct x _) = x
instance Applicative t => Applicative (Construction t) where
- Construct f fs <*> Construct x xs = Construct (f x) $ fs <**> xs
+ f <*> x = Construct (extract f $ extract x)
+ $ deconstruct f <**> deconstruct x
instance Traversable t => Traversable (Construction t) where
- Construct x xs ->> f = Construct <$> f x <*> xs ->>> f
+ x ->> f = Construct <$> f (extract x) <*> deconstruct x ->>> f
instance Alternative t => Bindable (Construction t) where
- Construct x xs >>= f = case f x of
- Construct y ys -> Construct y $ ys <+> (>>= f) <$> xs
+ x >>= f = Construct (extract . f $ extract x)
+ $ (deconstruct . f $ extract x) <+> (>>= f) <$> deconstruct x
instance Covariant t => Extendable (Construction t) where
x =>> f = Construct (f x) $ extend f <$> deconstruct x
@@ -50,43 +52,43 @@ instance (Avoidable t, Alternative t) => Monad (Construction t) where
instance Covariant t => Comonad (Construction t) where
instance Lowerable Construction where
- lower (Construct _ xs) = extract <$> xs
+ lower x = extract <$> deconstruct x
instance Hoistable Construction where
- hoist f (Construct x xs) = Construct x . f $ hoist f <$> xs
+ hoist f x = Construct (extract x) . f $ hoist f <$> deconstruct x
-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)
+instance (Setoid a, forall b . Setoid b => Setoid (t b), Covariant t) => Setoid (Construction t a) where
+ x == y = (extract x == extract y) * (deconstruct x == deconstruct y)
-instance (Semigroup a, forall b . Semigroup b => Semigroup (t b)) => Semigroup (Construction t a) where
- Construct x xs + Construct y ys = Construct (x + y) $ xs + ys
+instance (Semigroup a, forall b . Semigroup b => Semigroup (t b), Covariant t) => Semigroup (Construction t a) where
+ x + y = Construct (extract x + extract y) $ deconstruct x + deconstruct y
-instance (Monoid a, forall b . Semigroup b => Monoid (t b)) => Monoid (Construction t a) where
+instance (Monoid a, forall b . Semigroup b => Monoid (t b), Covariant t) => Monoid (Construction t a) where
zero = Construct zero zero
deconstruct :: Construction t a -> (t :. Construction t) a
-deconstruct (Construct _ xs) = xs
+deconstruct ~(Construct _ xs) = xs
-coiterate :: Covariant t => a |-> t -> a |-> Construction t
-coiterate coalgebra x = Construct x $ coiterate coalgebra <$> coalgebra x
+iterate :: Covariant t => (a |-> t) -> (a |-> Construction t)
+iterate f x = Construct x $ iterate f <$> f x
section :: Comonad t => t ~> Construction t
-section as = Construct (extract as) $ extend section as
+section xs = Construct (extract xs) $ xs =>> section
-instance (Covariant t, Covariant u) => Covariant (u <:.> Construction t) where
- f <$> TU g = TU $ f <$$> g
+instance (Covariant u, Covariant t) => Covariant (t <:.> Construction u) where
+ f <$> g = TU $ f <$$> run g
-instance (Avoidable t, Pointable u) => Pointable (u <:.> Construction t) where
+instance (Avoidable u, Pointable t) => Pointable (t <:.> Construction u) where
point x = TU . point . Construct x $ empty
-instance (Applicative t, Applicative u) => Applicative (u <:.> Construction t) where
- TU f <*> TU x = TU $ f <**> x
+instance (Applicative u, Applicative t) => Applicative (t <:.> Construction u) where
+ f <*> x = TU $ run f <**> run x
-instance (Covariant t, Alternative u) => Alternative (u <:.> Construction t) where
- TU x <+> TU y = TU $ x <+> y
+instance (Covariant u, Alternative t) => Alternative (t <:.> Construction u) where
+ x <+> y = TU $ run x <+> run y
-instance (Covariant t, Avoidable u) => Avoidable (u <:.> Construction t) where
+instance (Covariant u, Avoidable t) => Avoidable (t <:.> Construction u) where
empty = TU empty
-instance (Traversable t, Traversable u) => Traversable (u <:.> Construction t) where
- TU g ->> f = TU <$> g ->>> f
+instance (Traversable u, Traversable t) => Traversable (t <:.> Construction u) where
+ g ->> f = TU <$> run g ->>> f
diff --git a/Pandora/Paradigm/Primary/Transformer/Continuation.hs b/Pandora/Paradigm/Primary/Transformer/Continuation.hs
index c239112..5c883cf 100644
--- a/Pandora/Paradigm/Primary/Transformer/Continuation.hs
+++ b/Pandora/Paradigm/Primary/Transformer/Continuation.hs
@@ -41,3 +41,6 @@ reset = lift . continue % point
-- | Capture the continuation up to the nearest enclosing 'reset' and pass it
shift :: Pointable t => ((a -> t r) -> Continuation r t r) -> Continuation r t a
shift f = Continuation $ continue % point . f
+
+interruptable :: Pointable t => ((a -> Continuation a t a) -> Continuation a t a) -> t a
+interruptable = continue % point . cwcc
diff --git a/Pandora/Paradigm/Primary/Transformer/Day.hs b/Pandora/Paradigm/Primary/Transformer/Day.hs
index e41b961..8b16a91 100644
--- a/Pandora/Paradigm/Primary/Transformer/Day.hs
+++ b/Pandora/Paradigm/Primary/Transformer/Day.hs
@@ -1,7 +1,8 @@
module Pandora.Paradigm.Primary.Transformer.Day where
+import Pandora.Pattern ((.|..))
import Pandora.Pattern.Category (($))
-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), (.|..))
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Extractable (Extractable (extract))
import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
diff --git a/Pandora/Paradigm/Primary/Transformer/Kan.hs b/Pandora/Paradigm/Primary/Transformer/Kan.hs
index b38fb3b..39f36eb 100644
--- a/Pandora/Paradigm/Primary/Transformer/Kan.hs
+++ b/Pandora/Paradigm/Primary/Transformer/Kan.hs
@@ -15,7 +15,7 @@ instance Contravariant (Kan Left t u b) where
instance Interpreted (Kan Left t u b) where
type Primary (Kan Left t u b) a = (t b -> a) -> u b
- run (Lan x) = x
+ run ~(Lan x) = x
data instance Kan Right t u b a = Ran ((a -> t b) -> u b)
@@ -24,4 +24,4 @@ instance Covariant (Kan Right t u b) where
instance Interpreted (Kan Right t u b) where
type Primary (Kan Right t u b) a = (a -> t b) -> u b
- run (Ran x) = x
+ run ~(Ran x) = x
diff --git a/Pandora/Paradigm/Primary/Transformer/Reverse.hs b/Pandora/Paradigm/Primary/Transformer/Reverse.hs
index e5941b3..06d4fcc 100644
--- a/Pandora/Paradigm/Primary/Transformer/Reverse.hs
+++ b/Pandora/Paradigm/Primary/Transformer/Reverse.hs
@@ -39,7 +39,7 @@ instance Contravariant t => Contravariant (Reverse t) where
instance Interpreted (Reverse t) where
type Primary (Reverse t) a = t a
- run (Reverse x) = x
+ run ~(Reverse x) = x
instance Liftable Reverse where
lift = Reverse
diff --git a/Pandora/Paradigm/Primary/Transformer/Tap.hs b/Pandora/Paradigm/Primary/Transformer/Tap.hs
index 604fbda..75b0654 100644
--- a/Pandora/Paradigm/Primary/Transformer/Tap.hs
+++ b/Pandora/Paradigm/Primary/Transformer/Tap.hs
@@ -32,9 +32,9 @@ instance Traversable t => Traversable (Tap t) where
Tap x xs ->> f = Tap <$> f x <*> xs ->> f
instance (Extractable t, Alternative t, Bindable t) => Bindable (Tap t) where
- Tap x xs >>= f = case f x of Tap y ys -> Tap y $ ys <+> (xs >>= lower . f)
+ Tap x xs >>= f = case f x of ~(Tap y ys) -> Tap y $ ys <+> (xs >>= lower . f)
-instance (Extractable t, Extendable t) => Extendable (Tap t) where
+instance Extendable t => Extendable (Tap t) where
x =>> f = Tap (f x) $ lower x =>> f . Tap (extract x)
instance Lowerable Tap where
diff --git a/Pandora/Paradigm/Schemes/TU.hs b/Pandora/Paradigm/Schemes/TU.hs
index b4a314d..8b5f326 100644
--- a/Pandora/Paradigm/Schemes/TU.hs
+++ b/Pandora/Paradigm/Schemes/TU.hs
@@ -20,7 +20,7 @@ type (>:.<) = TU Contravariant Contravariant
instance Interpreted (TU ct cu t u) where
type Primary (TU ct cu t u) a = t :. u := a
- run (TU x) = x
+ run ~(TU x) = x
instance Pointable t => Liftable (TU Covariant Covariant t) where
lift :: Covariant u => u ~> t <:.> u
diff --git a/Pandora/Paradigm/Schemes/TUT.hs b/Pandora/Paradigm/Schemes/TUT.hs
index b8ff540..7f56745 100644
--- a/Pandora/Paradigm/Schemes/TUT.hs
+++ b/Pandora/Paradigm/Schemes/TUT.hs
@@ -23,7 +23,7 @@ type (>:>.<:<) = TUT Contravariant Contravariant Contravariant
instance Interpreted (TUT ct ct' cu t t' u) where
type Primary (TUT ct ct' cu t t' u) a = t :. u :. t' := a
- run (TUT x) = x
+ run ~(TUT x) = x
instance (Adjoint t' t, Distributive t) => Liftable (t <:<.>:> t') where
lift :: Covariant u => u ~> t <:<.>:> t' := u
diff --git a/Pandora/Paradigm/Schemes/TUVW.hs b/Pandora/Paradigm/Schemes/TUVW.hs
index f8559b7..c504684 100644
--- a/Pandora/Paradigm/Schemes/TUVW.hs
+++ b/Pandora/Paradigm/Schemes/TUVW.hs
@@ -7,4 +7,4 @@ newtype TUVW ct cu cv cw t u v w a = TUVW (t :. u :. v :. w := a)
instance Interpreted (TUVW ct cu cv cw t u v w) where
type Primary (TUVW ct cu cv cw t u v w) a = t :. u :. v :. w := a
- run (TUVW x) = x
+ run ~(TUVW x) = x
diff --git a/Pandora/Paradigm/Schemes/UT.hs b/Pandora/Paradigm/Schemes/UT.hs
index 0fa1fed..e22411f 100644
--- a/Pandora/Paradigm/Schemes/UT.hs
+++ b/Pandora/Paradigm/Schemes/UT.hs
@@ -19,7 +19,7 @@ type (>.:<) = UT Contravariant Contravariant
instance Interpreted (UT ct cu t u) where
type Primary (UT ct cu t u) a = u :. t := a
- run (UT x) = x
+ run ~(UT x) = x
instance Pointable t => Liftable (UT Covariant Covariant t) where
lift :: Covariant u => u ~> t <.:> u
diff --git a/Pandora/Paradigm/Schemes/UTU.hs b/Pandora/Paradigm/Schemes/UTU.hs
index 6d8682d..2ef3857 100644
--- a/Pandora/Paradigm/Schemes/UTU.hs
+++ b/Pandora/Paradigm/Schemes/UTU.hs
@@ -18,4 +18,4 @@ type (>.>:<.<) = UTU Contravariant Contravariant Contravariant
instance Interpreted (UTU ct cu t u u') where
type Primary (UTU ct cu t u u') a = u :. t :. u' := a
- run (UTU x) = x
+ run ~(UTU x) = x
diff --git a/Pandora/Paradigm/Structure.hs b/Pandora/Paradigm/Structure.hs
index b10ad85..bcab8b3 100644
--- a/Pandora/Paradigm/Structure.hs
+++ b/Pandora/Paradigm/Structure.hs
@@ -8,10 +8,20 @@ import Pandora.Paradigm.Structure.Rose as Exports
import Pandora.Paradigm.Structure.Splay as Exports
import Pandora.Paradigm.Structure.Binary as Exports
import Pandora.Paradigm.Structure.Stack as Exports
+import Pandora.Paradigm.Structure.Stream as Exports
import Pandora.Pattern (($), (.), extract)
-import Pandora.Paradigm.Primary (Product ((:*:)), Tagged (Tag), Wye (Left, Right))
-import Pandora.Paradigm.Inventory (Store (Store))
+import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)
+import Pandora.Paradigm.Inventory (Store (Store), (^.), (.~))
+import Pandora.Paradigm.Primary.Functor.Delta (Delta ((:^:)))
+import Pandora.Paradigm.Primary.Functor.Product (Product ((:*:)), type (:*:), attached)
+import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag))
+import Pandora.Paradigm.Primary.Functor.Wye (Wye (Left, Right))
+import Pandora.Paradigm.Primary.Transformer.Tap (Tap (Tap))
+import Pandora.Paradigm.Schemes.TU (type (<:.>))
+
+instance Monotonic a s => Monotonic (s :*: a) s where
+ bypass f r x = bypass f (f (attached x) r) $ extract x
instance Substructure Left (Product s) where
type Substructural Left (Product s) a = s
@@ -20,3 +30,21 @@ instance Substructure Left (Product s) where
instance Substructure Right (Product s) where
type Substructural Right (Product s) a = a
substructure (extract -> s :*: x) = Store $ x :*: Tag . (s :*:)
+
+instance Substructure Left Delta where
+ type Substructural Left Delta a = a
+ substructure (extract -> l :^: r) = Store $ l :*: Tag . (:^: r)
+
+instance Substructure Right Delta where
+ type Substructural Right Delta a = a
+ substructure (extract -> l :^: r) = Store $ r :*: Tag . (l :^:)
+
+instance Substructure Left t => Substructure Left (Tap (t <:.> u)) where
+ type Substructural Left (Tap (t <:.> u)) a = Substructural Left t (u a)
+ substructure (extract -> Tap x xs) = Store $
+ sub @Left ^. run xs :*: Tag . (\new -> sub @Left .~ new $ Tap x xs)
+
+instance Substructure Right t => Substructure Right (Tap (t <:.> u)) where
+ type Substructural Right (Tap (t <:.> u)) a = Substructural Right t (u a)
+ substructure (extract -> Tap x xs) = Store $
+ sub @Right ^. run xs :*: Tag . (\new -> sub @Right .~ new $ Tap x xs)
diff --git a/Pandora/Paradigm/Structure/Ability/Comprehension.hs b/Pandora/Paradigm/Structure/Ability/Comprehension.hs
index d9ac678..745b500 100644
--- a/Pandora/Paradigm/Structure/Ability/Comprehension.hs
+++ b/Pandora/Paradigm/Structure/Ability/Comprehension.hs
@@ -15,7 +15,7 @@ newtype Comprehension t a = Comprehension (t <:.> Construction t := a)
instance Interpreted (Comprehension t) where
type Primary (Comprehension t) a = t <:.> Construction t := a
- run (Comprehension x) = x
+ run ~(Comprehension x) = x
instance Covariant (t <:.> Construction t) => Covariant (Comprehension t) where
f <$> Comprehension x = Comprehension $ f <$> x
diff --git a/Pandora/Paradigm/Structure/Ability/Monotonic.hs b/Pandora/Paradigm/Structure/Ability/Monotonic.hs
index 314e1e9..e7ce790 100644
--- a/Pandora/Paradigm/Structure/Ability/Monotonic.hs
+++ b/Pandora/Paradigm/Structure/Ability/Monotonic.hs
@@ -1,7 +1,15 @@
module Pandora.Paradigm.Structure.Ability.Monotonic where
+import Pandora.Pattern.Functor ((<+>))
+import Pandora.Pattern.Functor.Pointable (Pointable)
+import Pandora.Pattern.Functor.Avoidable (Avoidable (empty))
+import Pandora.Paradigm.Primary.Functor.Predicate (Predicate, satisfy)
+
class Monotonic e a where
- iterate :: (a -> r -> r) -> r -> e -> r
+ bypass :: (a -> r -> r) -> r -> e -> r
instance Monotonic a a where
- iterate f r x = f x r
+ bypass f r x = f x r
+
+find :: (Monotonic e a, Pointable t, Avoidable t) => Predicate a -> e -> t a
+find p struct = bypass (\x r -> r <+> satisfy p x) empty struct
diff --git a/Pandora/Paradigm/Structure/Ability/Rotatable.hs b/Pandora/Paradigm/Structure/Ability/Rotatable.hs
index 30ce0a5..90d4003 100644
--- a/Pandora/Paradigm/Structure/Ability/Rotatable.hs
+++ b/Pandora/Paradigm/Structure/Ability/Rotatable.hs
@@ -3,11 +3,11 @@
module Pandora.Paradigm.Structure.Ability.Rotatable where
import Pandora.Pattern.Category ((.))
-import Pandora.Paradigm.Primary.Functor.Maybe (Maybe)
import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag))
-class Rotatable (f :: k) t where
- rotation :: (Tagged f) (t a) -> Maybe (t a)
+class Rotatable f t where
+ type Rotational (f :: k) (t :: * -> *) a
+ rotation :: Tagged f (t a) -> Rotational f t a
-rotate :: forall f t a . Rotatable f t => t a -> Maybe (t a)
+rotate :: forall f t a . Rotatable f t => t a -> Rotational f t a
rotate = rotation . Tag @f
diff --git a/Pandora/Paradigm/Structure/Interface/Set.hs b/Pandora/Paradigm/Structure/Interface/Set.hs
index fbc4bbf..d06242c 100644
--- a/Pandora/Paradigm/Structure/Interface/Set.hs
+++ b/Pandora/Paradigm/Structure/Interface/Set.hs
@@ -1,7 +1,16 @@
module Pandora.Paradigm.Structure.Interface.Set where
-import Pandora.Pattern.Object.Setoid (Setoid)
-import Pandora.Paradigm.Primary.Object.Boolean (Boolean)
+import Pandora.Core.Morphism ((!), (%))
+import Pandora.Pattern.Category ((.))
+import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
+import Pandora.Pattern.Object.Setoid (Setoid ((/=)))
+import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Nothing), maybe)
+import Pandora.Paradigm.Primary.Functor.Predicate (equate)
+import Pandora.Paradigm.Primary.Object.Boolean (Boolean (True, False))
+import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic, find)
-class Set t where
- member :: Setoid a => a -> t a -> Boolean
+member :: (Setoid a, Monotonic e a) => a -> e -> Boolean
+member x = maybe False (True !) . find (equate x)
+
+subset :: (Monotonic (t a) a, Traversable t, Setoid a, Setoid (t a)) => t a -> t a -> Boolean
+subset ss s = Nothing /= (ss ->> find % s . equate)
diff --git a/Pandora/Paradigm/Structure/Splay.hs b/Pandora/Paradigm/Structure/Splay.hs
index 6eff780..89e8ac3 100644
--- a/Pandora/Paradigm/Structure/Splay.hs
+++ b/Pandora/Paradigm/Structure/Splay.hs
@@ -13,13 +13,14 @@ import Pandora.Paradigm.Primary.Functor.Wye (Wye (End, Left, Right, Both))
import Pandora.Paradigm.Primary.Functor.Tagged (Tagged (Tag))
import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct)
import Pandora.Paradigm.Inventory.Optics ((%~))
-import Pandora.Paradigm.Structure.Binary ()
-import Pandora.Paradigm.Structure.Ability.Rotatable (Rotatable (rotation), rotate)
+import Pandora.Paradigm.Structure.Ability.Rotatable (Rotatable (Rotational, rotation), rotate)
import Pandora.Paradigm.Structure.Ability.Substructure (sub)
+import Pandora.Paradigm.Structure.Binary ()
data Splay a = Zig a | Zag a
instance Rotatable (Left Zig) (Construction Wye) where
+ type Rotational (Left Zig) (Construction Wye) a = Maybe (Construction Wye a)
rotation (Tag (Construct parent st)) = Construct % subtree <$> found where
subtree = maybe_subtree a . Just . Construct parent $ maybe_subtree b c
@@ -29,6 +30,7 @@ instance Rotatable (Left Zig) (Construction Wye) where
c = right st
instance Rotatable (Right Zig) (Construction Wye) where
+ type Rotational (Right Zig) (Construction Wye) a = Maybe (Construction Wye a)
rotation (Tag (Construct parent st)) = Construct % subtree <$> found where
found = extract <$> right st
@@ -38,18 +40,20 @@ instance Rotatable (Right Zig) (Construction Wye) where
c = deconstruct <$> right st >>= right
instance Rotatable (Left (Zig Zig)) (Construction Wye) where
+ type Rotational (Left (Zig Zig)) (Construction Wye) a = Maybe (Construction Wye a)
rotation (Tag tree) = rotate @(Left Zig) tree >>= rotate @(Left Zig)
instance Rotatable (Right (Zig Zig)) (Construction Wye) where
+ type Rotational (Right (Zig Zig)) (Construction Wye) a = Maybe (Construction Wye a)
rotation (Tag tree) = rotate @(Right Zig) tree >>= rotate @(Right Zig)
instance Rotatable (Left (Zig Zag)) (Construction Wye) where
- rotation (Tag tree) = rotate @(Left Zig)
- $ sub @Left %~ (>>= rotate @(Right Zig)) $ tree
+ type Rotational (Left (Zig Zag)) (Construction Wye) a = Maybe (Construction Wye a)
+ rotation (Tag tree) = rotate @(Left Zig) $ sub @Left %~ (>>= rotate @(Right Zig)) $ tree
instance Rotatable (Right (Zig Zag)) (Construction Wye) where
- rotation (Tag tree) = rotate @(Right Zig)
- $ sub @Right %~ (>>= rotate @(Left Zig)) $ tree
+ type Rotational (Right (Zig Zag)) (Construction Wye) a = Maybe (Construction Wye a)
+ rotation (Tag tree) = rotate @(Right Zig) $ sub @Right %~ (>>= rotate @(Left Zig)) $ tree
maybe_subtree :: Maybe a -> Maybe a -> Wye a
maybe_subtree (Just x) (Just y) = Both x y
diff --git a/Pandora/Paradigm/Structure/Stack.hs b/Pandora/Paradigm/Structure/Stack.hs
index 31f5aa2..81b9be6 100644
--- a/Pandora/Paradigm/Structure/Stack.hs
+++ b/Pandora/Paradigm/Structure/Stack.hs
@@ -2,12 +2,12 @@
module Pandora.Paradigm.Structure.Stack where
-import Pandora.Core.Functor (type (~>))
-import Pandora.Core.Morphism ((&), (%), (!))
+import Pandora.Core.Functor (type (~>), type (:.), type (:=))
+import Pandora.Core.Morphism ((&), (%))
+import Pandora.Pattern ((.|..))
import Pandora.Pattern.Category ((.), ($))
-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)), (.|..))
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
import Pandora.Pattern.Functor.Alternative ((<+>))
-import Pandora.Pattern.Functor.Avoidable (empty)
import Pandora.Pattern.Functor.Pointable (point)
import Pandora.Pattern.Functor.Extractable (extract)
import Pandora.Pattern.Functor.Traversable (Traversable)
@@ -18,14 +18,13 @@ import Pandora.Pattern.Object.Semigroup (Semigroup ((+)))
import Pandora.Pattern.Object.Monoid (Monoid (zero))
import Pandora.Paradigm.Primary.Object.Boolean ((?))
import Pandora.Paradigm.Primary.Functor.Delta (Delta ((:^:)))
-import Pandora.Paradigm.Primary.Functor.Maybe (Maybe (Just, Nothing), maybe)
+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.Tagged (Tagged (Tag))
-import Pandora.Paradigm.Primary.Object (Boolean (True, False))
import Pandora.Paradigm.Primary.Transformer.Construction (Construction (Construct), deconstruct)
import Pandora.Paradigm.Primary.Transformer.Tap (Tap (Tap))
-import Pandora.Paradigm.Inventory.State (fold, find)
+import Pandora.Paradigm.Inventory.State (State, fold)
import Pandora.Paradigm.Inventory.Store (Store (Store))
import Pandora.Paradigm.Inventory.Optics ((^.))
import Pandora.Paradigm.Controlflow.Effect.Interpreted (run)
@@ -34,7 +33,7 @@ import Pandora.Paradigm.Structure.Ability.Nonempty (Nonempty)
import Pandora.Paradigm.Structure.Ability.Zipper (Zipper)
import Pandora.Paradigm.Structure.Ability.Focusable (Focusable (Focusing, focusing), Location (Head), focus)
import Pandora.Paradigm.Structure.Ability.Insertable (Insertable (insert))
-import Pandora.Paradigm.Structure.Interface.Set (Set (member))
+import Pandora.Paradigm.Structure.Ability.Monotonic (Monotonic (bypass))
-- | Linear data structure that serves as a collection of elements
type Stack = Maybe <:.> Construction Maybe
@@ -59,9 +58,6 @@ instance Focusable Head Stack where
instance Insertable Stack where
insert x (TU stack) = TU $ (Construct x . Just <$> stack) <+> (point . point) x
-instance Set Stack where
- member x = maybe False (True !) . find (Predicate (== x))
-
pop :: Stack ~> Stack
pop (TU stack) = TU $ stack >>= deconstruct
@@ -70,13 +66,14 @@ delete _ (TU Nothing) = TU Nothing
delete x (TU (Just (Construct y ys))) = x == y ? TU ys
$ lift . Construct y . run . delete x $ TU ys
-filter :: Predicate a -> Stack a -> Stack a
-filter (Predicate p) = TU . fold empty
- (\now new -> p now ? Just (Construct now new) $ new)
+filter :: forall a . Predicate a -> Stack a -> Stack a
+filter (Predicate p) = TU . extract
+ . run @(State (Maybe :. Nonempty Stack := a)) % Nothing
+ . fold (\now new -> p now ? Just (Construct now new) $ new)
-- | Transform any traversable structure into a stack
-linearize :: Traversable t => t ~> Stack
-linearize = TU . fold Nothing (Just .|.. Construct)
+linearize :: forall t a . Traversable t => t a -> Stack a
+linearize = TU . extract . run @(State (Maybe :. Nonempty Stack := a)) % Nothing . fold (Just .|.. Construct)
type instance Nonempty Stack = Construction Maybe
@@ -87,11 +84,24 @@ instance Focusable Head (Construction Maybe) where
instance Insertable (Construction Maybe) where
insert x = Construct x . Just
-type instance Zipper Stack = Tap (Delta <:.> Stack)
+instance Monotonic (Construction Maybe a) a where
+ bypass f r ~(Construct x xs) = f x $ bypass f r xs
-instance Covariant (Delta <:.> Stack) where
- f <$> (TU (bs :^: fs)) = TU $ f <$> bs :^: f <$> fs
+type instance Zipper Stack = Tap (Delta <:.> Stack)
forward, backward :: Zipper Stack a -> Maybe (Zipper Stack a)
forward (Tap x (TU (bs :^: fs))) = Tap % (TU $ insert x bs :^: pop fs) <$> focus @Head ^. fs
backward (Tap x (TU (bs :^: fs))) = Tap % (TU $ pop bs :^: insert x fs) <$> focus @Head ^. bs
+
+type instance Zipper (Construction Maybe) = Tap (Delta <:.> Construction Maybe)
+
+forward', backward' :: Zipper (Nonempty Stack) a -> Maybe (Zipper (Nonempty Stack) a)
+forward' (Tap x (TU (bs :^: fs))) = Tap (extract fs) . TU . (insert x bs :^:) <$> deconstruct fs
+backward' (Tap x (TU (bs :^: fs))) = Tap (extract bs) . TU . (:^: insert x fs) <$> deconstruct bs
+
+instance Monotonic (Maybe :. Construction Maybe := a) a where
+ bypass f r (Just x) = bypass f r x
+ bypass _ r Nothing = r
+
+instance Monotonic (Maybe <:.> Construction Maybe := a) a where
+ bypass f r ~(TU x) = bypass f r x
diff --git a/Pandora/Paradigm/Structure/Stream.hs b/Pandora/Paradigm/Structure/Stream.hs
index 892e7ab..000c5b5 100644
--- a/Pandora/Paradigm/Structure/Stream.hs
+++ b/Pandora/Paradigm/Structure/Stream.hs
@@ -1,6 +1,32 @@
+{-# OPTIONS_GHC -fno-warn-orphans #-}
+
module Pandora.Paradigm.Structure.Stream where
-import Pandora.Paradigm.Primary.Functor.Identity (Identity)
-import Pandora.Paradigm.Primary.Transformer.Construction (Construction)
+import Pandora.Pattern.Category ((.), ($))
+import Pandora.Pattern.Functor.Pointable (point)
+import Pandora.Pattern.Functor.Extractable (extract)
+import Pandora.Paradigm.Primary.Functor.Delta (Delta ((:^:)))
+import Pandora.Paradigm.Primary.Functor.Identity (Identity (Identity))
+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.Structure.Ability.Rotatable (Rotatable (Rotational, rotation))
+import Pandora.Paradigm.Structure.Ability.Zipper (Zipper)
+import Pandora.Paradigm.Schemes.TU (TU (TU), type (<:.>))
type Stream = Construction Identity
+
+type instance Zipper Stream = Tap (Delta <:.> Stream)
+
+instance Rotatable Left (Tap (Delta <:.> Stream)) where
+ type Rotational Left (Tap (Delta <:.> Stream)) a = Tap (Delta <:.> Stream) a
+ rotation (extract -> Tap x (TU (bs :^: fs))) = Tap (extract bs) . TU
+ $ extract (deconstruct bs) :^: Construct x (point fs)
+
+instance Rotatable Right (Tap (Delta <:.> Stream)) where
+ type Rotational Right (Tap (Delta <:.> Stream)) a = Tap (Delta <:.> Stream) a
+ rotation (extract -> Tap x (TU (bs :^: fs))) = Tap (extract fs) . TU
+ $ Construct x (point bs) :^: extract (deconstruct fs)
+
+repeat :: a -> Stream a
+repeat x = Construct x . Identity $ repeat x
diff --git a/Pandora/Pattern.hs b/Pandora/Pattern.hs
index 0950fb6..6a50a6a 100644
--- a/Pandora/Pattern.hs
+++ b/Pandora/Pattern.hs
@@ -1,6 +1,20 @@
-module Pandora.Pattern (module Exports) where
+module Pandora.Pattern (module Exports, (.|..), (.|...), (.|....)) where
import Pandora.Pattern.Object as Exports
import Pandora.Pattern.Transformer as Exports
import Pandora.Pattern.Functor as Exports
import Pandora.Pattern.Category as Exports
+
+import Pandora.Core.Functor (type (:.), type (:=))
+
+(.|..) :: (Category v, Covariant (v a))
+ => v c d -> v a :. v b := c -> v a :. v b := d
+f .|.. g = (f .) <$> g
+
+(.|...) :: (Category v, Covariant (v a), Covariant (v b))
+ => v d e -> v a :. v b :. v c := d -> v a :. v b :. v c := e
+f .|... g = (f .) <$$> g
+
+(.|....) :: (Category v, Covariant (v a), Covariant (v b), Covariant (v c))
+ => v e f -> v a :. v b :. v c :. v d := e -> v a :. v b :. v c :. v d := f
+f .|.... g = (f .) <$$$> g
diff --git a/Pandora/Pattern/Functor/Adjoint.hs b/Pandora/Pattern/Functor/Adjoint.hs
index e7cc6aa..4cabae3 100644
--- a/Pandora/Pattern/Functor/Adjoint.hs
+++ b/Pandora/Pattern/Functor/Adjoint.hs
@@ -6,7 +6,7 @@ import Pandora.Pattern.Functor.Covariant (Covariant)
type (-|) = Adjoint
-infixl 4 -|, |-
+infixl 3 -|, |-
{- |
> When providing a new instance, you should ensure it satisfies the four laws:
diff --git a/Pandora/Pattern/Functor/Covariant.hs b/Pandora/Pattern/Functor/Covariant.hs
index 63ed2b9..96fd208 100644
--- a/Pandora/Pattern/Functor/Covariant.hs
+++ b/Pandora/Pattern/Functor/Covariant.hs
@@ -58,15 +58,3 @@ class Covariant (t :: * -> *) where
instance Covariant ((->) a) where
(<$>) = (.)
-
-(.|..) :: (Category v, Covariant (v a))
- => v c d -> v a :. v b := c -> v a :. v b := d
-f .|.. g = (f .) <$> g
-
-(.|...) :: (Category v, Covariant (v a), Covariant (v b))
- => v d e -> v a :. v b :. v c := d -> v a :. v b :. v c := e
-f .|... g = (f .) <$$> g
-
-(.|....) :: (Category v, Covariant (v a), Covariant (v b), Covariant (v c))
- => v e f -> v a :. v b :. v c :. v d := e -> v a :. v b :. v c :. v d := f
-f .|.... g = (f .) <$$$> g
diff --git a/Pandora/Pattern/Functor/Monad.hs b/Pandora/Pattern/Functor/Monad.hs
index 9386d2b..beb6a7d 100644
--- a/Pandora/Pattern/Functor/Monad.hs
+++ b/Pandora/Pattern/Functor/Monad.hs
@@ -1,7 +1,7 @@
module Pandora.Pattern.Functor.Monad where
-import Pandora.Pattern.Functor.Bindable (Bindable)
-import Pandora.Pattern.Functor.Pointable (Pointable)
+import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
+import Pandora.Pattern.Functor.Pointable (Pointable (point))
{- |
> Let f :: (Pointable t, Bindable t) => a -> t a
@@ -14,4 +14,15 @@ import Pandora.Pattern.Functor.Pointable (Pointable)
> * Associativity: h >>= (f >=> g) ≡ (h >>= f) >>= g
-}
-class (Pointable t, Bindable t) => Monad t
+infixl 1 >>=-, ->>=
+infixr 1 -=<<, =<<-
+
+class (Pointable t, Bindable t) => Monad t where
+ (>>=-) :: t a -> t b -> t a
+ (>>=-) x y = x >>= \r -> y >>= \_ -> point r
+ (->>=) :: t a -> t b -> t b
+ (->>=) x y = x >>= \_ -> y >>= \r -> point r
+ (-=<<) :: t a -> t b -> t b
+ (-=<<) x y = x >>= \_ -> y >>= \r -> point r
+ (=<<-) :: t a -> t b -> t a
+ (=<<-) x y = x >>= \r -> y >>= \_ -> point r
diff --git a/pandora.cabal b/pandora.cabal
index 31c2578..457f554 100644
--- a/pandora.cabal
+++ b/pandora.cabal
@@ -1,5 +1,5 @@
name: pandora
-version: 0.3.1
+version: 0.3.2
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