summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authoriokasimovmt <>2019-07-11 19:21:00 (GMT)
committerhdiff <hdiff@hdiff.luite.com>2019-07-11 19:21:00 (GMT)
commita3c1249897547833e4a5786995db278b1d18a821 (patch)
tree9b254c38255e132fc9df51831aa5dc8bec78c199
parentf183c2467b05410ea022100e92693a6315df59dd (diff)
version 0.1.80.1.8
-rwxr-xr-xCHANGELOG.md13
-rw-r--r--Pandora/Core.hs5
-rw-r--r--Pandora/Paradigm.hs7
-rw-r--r--Pandora/Paradigm/Basis/Conclusion.hs32
-rw-r--r--Pandora/Paradigm/Basis/Jet.hs6
-rw-r--r--Pandora/Paradigm/Basis/Maybe.hs32
-rw-r--r--Pandora/Paradigm/Inventory/Stateful.hs30
-rw-r--r--Pandora/Paradigm/Inventory/Storage.hs2
-rw-r--r--Pandora/Paradigm/Junction/Composition.hs228
-rw-r--r--Pandora/Paradigm/Junction/Schemes.hs7
-rw-r--r--Pandora/Paradigm/Junction/Schemes/TU.hs60
-rw-r--r--Pandora/Paradigm/Junction/Schemes/TUV.hs88
-rw-r--r--Pandora/Paradigm/Junction/Schemes/TUVW.hs120
-rw-r--r--Pandora/Paradigm/Junction/Schemes/UT.hs67
-rw-r--r--Pandora/Paradigm/Junction/Schemes/UTU.hs67
-rw-r--r--Pandora/Paradigm/Junction/Transformer.hs121
-rw-r--r--Pandora/Paradigm/Structure/Stack.hs9
-rw-r--r--Pandora/Pattern.hs4
-rw-r--r--Pandora/Pattern/Functor/Covariant.hs2
-rw-r--r--pandora.cabal13
20 files changed, 549 insertions, 364 deletions
diff --git a/CHANGELOG.md b/CHANGELOG.md
index 656c225..20a8ab7 100755
--- a/CHANGELOG.md
+++ b/CHANGELOG.md
@@ -71,3 +71,16 @@
* Define `curry` and `uncurry` for `Product` datatype
* Flip arguments of `statefully` method of `Stateful` datatype
* Exclude inner effects from `Environmental`, `Storage` and `Stateful` datatypes
+
+# 0.1.8
+* Rename `T` junction scheme to `UT` and move it to `Schemes` submodule and remove `up` method
+* Rename `Y` junction scheme to `UTU` and move it to `Schemes` submodule and remove `:>:` type operator
+* Add variance type arguments to `UT`, `UTU` and `TUT` schemes
+* Rename `U` to `TU`, `UU` to `TUV`, `UUU` to `TUVW` and put them into `Schemes` module
+* Define `Composition` typeclass and define its instances for `TU`, `TUV`, `TUVW`, `UT` and `UTU`
+* Define `Transformer` typeclass and define its instance for `Stateful` datatype
+* Replace `transform` on `lay` and add `equip` method in `Transformer` typeclass
+* Define `Covariant`, `Applicative`, `Pointable`, `Bindable` and `Monad` instances for `Stateful` transformer
+* Remove `:!:` type operator
+* Define `Composition` and `Transformer` instances for `Maybe` and `Conclusion`
+* Define `Core`, `Paradigm` and `Pattern` umbrella modules
diff --git a/Pandora/Core.hs b/Pandora/Core.hs
new file mode 100644
index 0000000..a5fd8ee
--- /dev/null
+++ b/Pandora/Core.hs
@@ -0,0 +1,5 @@
+module Pandora.Core (module Exports) where
+
+import Pandora.Core.Transformation as Exports
+import Pandora.Core.Morphism as Exports
+import Pandora.Core.Functor as Exports
diff --git a/Pandora/Paradigm.hs b/Pandora/Paradigm.hs
new file mode 100644
index 0000000..f084d52
--- /dev/null
+++ b/Pandora/Paradigm.hs
@@ -0,0 +1,7 @@
+module Pandora.Paradigm (module Exports) where
+
+import Pandora.Paradigm.Structure as Exports
+import Pandora.Paradigm.Junction as Exports
+import Pandora.Paradigm.Inventory as Exports
+import Pandora.Paradigm.Controlflow as Exports
+import Pandora.Paradigm.Basis as Exports
diff --git a/Pandora/Paradigm/Basis/Conclusion.hs b/Pandora/Paradigm/Basis/Conclusion.hs
index 64e0fc1..aa5bbde 100644
--- a/Pandora/Paradigm/Basis/Conclusion.hs
+++ b/Pandora/Paradigm/Basis/Conclusion.hs
@@ -1,11 +1,13 @@
module Pandora.Paradigm.Basis.Conclusion (Conclusion (..), conclusion, fail) where
import Pandora.Core.Morphism ((.), ($))
-import Pandora.Paradigm.Junction.Transformer (T (T, t), type (:!:))
-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
+import Pandora.Paradigm.Junction.Composition (Composition (Outline, composition))
+import Pandora.Paradigm.Junction.Transformer (Transformer (Layout, lay, equip))
+import Pandora.Paradigm.Junction.Schemes.UT (UT (UT))
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>)))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
-import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
+import Pandora.Pattern.Functor.Applicative (Applicative ((<*>), apply))
import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
import Pandora.Pattern.Functor.Monad (Monad)
@@ -40,10 +42,28 @@ instance Bindable (Conclusion e) where
instance Monad (Conclusion e) where
-instance (Pointable t, Bindable t) => Bindable (Conclusion e :!: t) where
- T x >>= f = T $ x >>= conclusion (point . Failure) (t . f)
+instance Composition (Conclusion e) where
+ type Outline (Conclusion e) a = Conclusion e a
+ composition x = x
-instance Monad t => Monad (Conclusion e :!: t) where
+instance Transformer (Conclusion e) where
+ type Layout (Conclusion e) u a = UT (Conclusion e) () (Conclusion e) u a
+ lay x = UT $ Success <$> x
+ equip x = UT . point $ x
+
+instance Covariant u => Covariant (UT (Conclusion e) () (Conclusion e) u) where
+ f <$> UT x = UT $ f <$$> x
+
+instance Applicative u => Applicative (UT (Conclusion e) () (Conclusion e) u) where
+ UT f <*> UT x = UT $ apply <$> f <*> x
+
+instance Pointable u => Pointable (UT (Conclusion e) () (Conclusion e) u) where
+ point = UT . point . point
+
+instance (Pointable u, Bindable u) => Bindable (UT (Conclusion e) () (Conclusion e) u) where
+ UT x >>= f = UT $ x >>= conclusion (point . Failure) (composition . f)
+
+instance Monad u => Monad (UT (Conclusion e) () (Conclusion e) u) where
instance (Setoid e, Setoid a) => Setoid (Conclusion e a) where
Success x == Success y = x == y
diff --git a/Pandora/Paradigm/Basis/Jet.hs b/Pandora/Paradigm/Basis/Jet.hs
index 6313760..1411af4 100644
--- a/Pandora/Paradigm/Basis/Jet.hs
+++ b/Pandora/Paradigm/Basis/Jet.hs
@@ -7,15 +7,15 @@ import Pandora.Pattern.Functor.Extractable (Extractable (extract))
import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
import Pandora.Pattern.Functor.Traversable (Traversable ((->>), (->>>)))
-infixr 5 :-
+infixr 6 :-
data Jet t a = a :- Jet t (t a)
instance Covariant t => Covariant (Jet t) where
- f <$> a :- as = f a :- (f <$$> as)
+ f <$> a :- as = f a :- f <$$> as
instance Traversable t => Traversable (Jet t) where
- (a :- as) ->> f = (:-) <$> f a <*> as ->>> f
+ a :- as ->> f = (:-) <$> f a <*> as ->>> f
instance (forall t' . Avoidable t') => Pointable (Jet t) where
point x = x :- idle
diff --git a/Pandora/Paradigm/Basis/Maybe.hs b/Pandora/Paradigm/Basis/Maybe.hs
index 15a4c27..317d9c9 100644
--- a/Pandora/Paradigm/Basis/Maybe.hs
+++ b/Pandora/Paradigm/Basis/Maybe.hs
@@ -1,12 +1,14 @@
module Pandora.Paradigm.Basis.Maybe (Maybe (..), maybe) where
import Pandora.Core.Morphism ((.), ($))
-import Pandora.Paradigm.Junction.Transformer (T (T, t), type (:!:))
-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
+import Pandora.Paradigm.Junction.Composition (Composition (Outline, composition))
+import Pandora.Paradigm.Junction.Transformer (Transformer (Layout, lay, equip))
+import Pandora.Paradigm.Junction.Schemes.UT (UT (UT))
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>)))
import Pandora.Pattern.Functor.Avoidable (Avoidable (idle))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
-import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
+import Pandora.Pattern.Functor.Applicative (Applicative ((<*>), apply))
import Pandora.Pattern.Functor.Traversable (Traversable ((->>)))
import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
import Pandora.Pattern.Functor.Monad (Monad)
@@ -47,10 +49,28 @@ instance Bindable Maybe where
instance Monad Maybe where
-instance (Pointable t, Bindable t) => Bindable (Maybe :!: t) where
- T x >>= f = T $ x >>= maybe (point Nothing) (t . f)
+instance Composition Maybe where
+ type Outline Maybe a = Maybe a
+ composition x = x
-instance Monad t => Monad (Maybe :!: t) where
+instance Transformer Maybe where
+ type Layout Maybe u a = UT Maybe () Maybe u a
+ lay x = UT $ Just <$> x
+ equip x = UT . point $ x
+
+instance Covariant u => Covariant (UT Maybe () Maybe u) where
+ f <$> UT x = UT $ f <$$> x
+
+instance Applicative u => Applicative (UT Maybe () Maybe u) where
+ UT f <*> UT x = UT $ apply <$> f <*> x
+
+instance Pointable u => Pointable (UT Maybe () Maybe u) where
+ point = UT . point . point
+
+instance (Pointable u, Bindable u) => Bindable (UT Maybe () Maybe u) where
+ UT x >>= f = UT $ x >>= maybe (point Nothing) (composition . f)
+
+instance Monad u => Monad (UT Maybe () Maybe u) where
instance Setoid a => Setoid (Maybe a) where
Just x == Just y = x == y
diff --git a/Pandora/Paradigm/Inventory/Stateful.hs b/Pandora/Paradigm/Inventory/Stateful.hs
index 4e12609..94a10d3 100644
--- a/Pandora/Paradigm/Inventory/Stateful.hs
+++ b/Pandora/Paradigm/Inventory/Stateful.hs
@@ -3,7 +3,9 @@ module Pandora.Paradigm.Inventory.Stateful
import Pandora.Core.Functor (type (:.:), type (><))
import Pandora.Core.Morphism ((.), ($))
-import Pandora.Paradigm.Basis.Identity (Identity)
+import Pandora.Paradigm.Junction.Composition (Composition (Outline, composition))
+import Pandora.Paradigm.Junction.Transformer (Transformer (Layout, lay, equip))
+import Pandora.Paradigm.Junction.Schemes.TUV (TUV (TUV))
import Pandora.Paradigm.Basis.Predicate (Predicate (predicate))
import Pandora.Paradigm.Basis.Product (Product ((:*:)), type (:*:), attached, delta, uncurry)
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), ($>), (<$$>)))
@@ -15,12 +17,11 @@ 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.Liftable (Liftable (lift))
import Pandora.Pattern.Object.Setoid (bool)
newtype Stateful s a = Stateful ((->) s :.: (:*:) s >< a)
-statefully :: s -> Stateful s a -> (s :*: a)
+statefully :: s -> Stateful s a -> s :*: a
statefully initial (Stateful state) = state initial
instance Covariant (Stateful s) where
@@ -55,3 +56,26 @@ fold start op struct = extract . statefully start $
find :: (Pointable u, Avoidable u, Alternative u, Traversable t) => Predicate a -> t a -> u a
find p struct = fold idle (\x s -> (<+>) s . bool idle (point x) . predicate p $ x) struct
+
+instance Composition (Stateful s) where
+ type Outline (Stateful s) a = (->) s :.: (:*:) s >< a
+ composition (Stateful x) = x
+
+instance Transformer (Stateful s) where
+ type Layout (Stateful s) u a = TUV Stateful () Stateful ((->) s) u ((:*:) s) a
+ lay x = TUV $ \s -> (s :*:) <$> x
+ equip x = TUV $ point <$> composition x
+
+instance Covariant u => Covariant (TUV Stateful () Stateful ((->) s) u ((:*:) s)) where
+ f <$> TUV x = TUV $ \old -> f <$$> x old
+
+instance Bindable u => Applicative (TUV Stateful () Stateful ((->) s) u ((:*:) s)) where
+ TUV f <*> TUV x = TUV $ \old -> f old >>= \(new :*: g) -> g <$$> x new
+
+instance Pointable u => Pointable (TUV Stateful () Stateful ((->) s) u ((:*:) s)) where
+ point x = TUV $ \s -> point $ s :*: x
+
+instance Bindable u => Bindable (TUV Stateful () Stateful ((->) s) u ((:*:) s)) where
+ TUV x >>= f = TUV $ \old -> x old >>= \(new :*: y) -> ($ new) . composition . f $ y
+
+instance Monad u => Monad (TUV Stateful () Stateful ((->) s) u ((:*:) s)) where
diff --git a/Pandora/Paradigm/Inventory/Storage.hs b/Pandora/Paradigm/Inventory/Storage.hs
index ae9d664..a217118 100644
--- a/Pandora/Paradigm/Inventory/Storage.hs
+++ b/Pandora/Paradigm/Inventory/Storage.hs
@@ -2,12 +2,10 @@ module Pandora.Paradigm.Inventory.Storage (Storage (..), position, access, retro
import Pandora.Core.Functor (type (:.:), type (><))
import Pandora.Core.Morphism ((.), ($), (?))
-import Pandora.Paradigm.Basis.Identity (Identity)
import Pandora.Paradigm.Basis.Product (Product ((:*:)), type (:*:))
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
import Pandora.Pattern.Functor.Extractable (Extractable (extract))
import Pandora.Pattern.Functor.Extendable (Extendable ((=>>)))
-import Pandora.Pattern.Functor.Applicative (Applicative ((<*>)))
import Pandora.Pattern.Functor.Comonad (Comonad)
newtype Storage p a = Storage { stored :: (:*:) p :.: (->) p >< a }
diff --git a/Pandora/Paradigm/Junction/Composition.hs b/Pandora/Paradigm/Junction/Composition.hs
index c6c070a..90d2ddf 100644
--- a/Pandora/Paradigm/Junction/Composition.hs
+++ b/Pandora/Paradigm/Junction/Composition.hs
@@ -1,224 +1,6 @@
-module Pandora.Paradigm.Junction.Composition (U (..), UU (..), UUU (..)) where
+module Pandora.Paradigm.Junction.Composition (Composition (..)) where
-import Pandora.Core.Functor (Variant (Co, Contra), type (:.:))
-import Pandora.Core.Morphism ((.), ($))
-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>), (<$$$>), (<$$$$>), comap))
-import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<), (>$$<), (>$$$<), (>$$$$<), contramap))
-import Pandora.Pattern.Functor.Extractable (Extractable (extract))
-import Pandora.Pattern.Functor.Avoidable (Avoidable (idle))
-import Pandora.Pattern.Functor.Pointable (Pointable (point))
-import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
-import Pandora.Pattern.Functor.Applicative (Applicative ((<*>), apply))
-import Pandora.Pattern.Functor.Traversable (Traversable ((->>), (->>>), (->>>>), (->>>>>)))
-import Pandora.Pattern.Functor.Distributive (Distributive ((>>-), distribute))
-import Pandora.Pattern.Functor.Adjoint (Adjoint (phi, psi))
-
-type (:-|:) t u = (Extractable t, Pointable t, Extractable u, Pointable u, Adjoint t u)
-
-
-newtype U ct cu t u a = U { u :: (t :.: u) a }
-
-instance (Covariant t, Covariant u) => Covariant (U 'Co 'Co t u) where
- f <$> U x = U $ f <$$> x
-
-instance (Covariant t, Contravariant u) => Contravariant (U 'Co 'Contra t u) where
- f >$< U x = U $ contramap f <$> x
-
-instance (Contravariant t, Covariant u) => Contravariant (U 'Contra 'Co t u) where
- f >$< U x = U $ contramap (comap f) x
-
-instance (Contravariant t, Contravariant u) => Covariant (U 'Contra 'Contra t u) where
- f <$> U x = U $ f >$$< x
-
-instance (Pointable t, Pointable u) => Pointable (U 'Co 'Co t u) where
- point = U . point . point
-
-instance (Extractable t, Extractable u) => Extractable (U 'Co 'Co t u) where
- extract = extract . extract . u
-
-instance (Avoidable t, Covariant u) => Avoidable (U 'Co 'Co t u) where
- idle = U idle
-
-instance (Applicative t, Applicative u) => Applicative (U 'Co 'Co t u) where
- U f <*> U x = U $ apply <$> f <*> x
-
-instance (Alternative t, Covariant u) => Alternative (U 'Co 'Co t u) where
- U x <+> U y = U $ x <+> y
-
-instance (Traversable t, Traversable u) => Traversable (U 'Co 'Co t u) where
- U x ->> f = U <$> x ->>> f
-
-instance (Distributive t, Distributive u) => Distributive (U 'Co 'Co t u) where
- x >>- f = U . comap distribute . distribute $ u . f <$> x
-
-instance (t :-|: u, v :-|: w) => Adjoint (U 'Co 'Co t v) (U 'Co 'Co u w) where
- phi f = point . f . point
- psi f = extract . extract . comap f
-
-
-newtype UU ct cu cv t u v a = UU { uu :: (t :.: u :.: v) a }
-
-instance (Covariant t, Covariant u, Covariant v)
- => Covariant (UU 'Co 'Co 'Co t u v) where
- f <$> UU x = UU $ f <$$$> x
-
-instance (Covariant t, Covariant u, Contravariant v)
- => Contravariant (UU 'Co 'Co 'Contra t u v) where
- f >$< UU x = UU $ (f >$<) <$$> x
-
-instance (Covariant t, Contravariant u, Covariant v)
- => Contravariant (UU 'Co 'Contra 'Co t u v) where
- f >$< UU x = UU $ contramap (comap f) <$> x
-
-instance (Contravariant t, Covariant u, Covariant v)
- => Contravariant (UU 'Contra 'Co 'Co t u v) where
- f >$< UU x = UU $ (f <$$>) >$< x
-
-instance (Contravariant t, Contravariant u, Covariant v)
- => Covariant (UU 'Contra 'Contra 'Co t u v) where
- f <$> UU x = UU $ contramap (comap f) >$< x
-
-instance (Covariant t, Contravariant u, Contravariant v)
- => Covariant (UU 'Co 'Contra 'Contra t u v) where
- f <$> UU x = UU $ (f >$$<) <$> x
-
-instance (Contravariant t, Covariant u, Contravariant v)
- => Covariant (UU 'Contra 'Co 'Contra t u v) where
- f <$> UU x = UU $ comap (contramap f) >$< x
-
-instance (Contravariant t, Contravariant u, Contravariant v)
- => Contravariant (UU 'Contra 'Contra 'Contra t u v) where
- f >$< UU x = UU $ f >$$$< x
-
-instance (Pointable t, Pointable u, Pointable v)
- => Pointable (UU 'Co 'Co 'Co t u v) where
- point = UU . point . point . point
-
-instance (Extractable t, Extractable u, Extractable v)
- => Extractable (UU 'Co 'Co 'Co t u v) where
- extract = extract . extract . extract . uu
-
-instance (Avoidable t, Covariant u, Covariant v)
- => Avoidable (UU 'Co 'Co 'Co t u v) where
- idle = UU idle
-
-instance (Applicative t, Applicative u, Applicative v)
- => Applicative (UU 'Co 'Co 'Co t u v) where
- UU f <*> UU x = UU $ ((apply <$>) . (apply <$$>) $ f) <*> x
-
-instance (Alternative t, Covariant u, Covariant v)
- => Alternative (UU 'Co 'Co 'Co t u v) where
- UU x <+> UU y = UU $ x <+> y
-
-instance (Traversable t, Traversable u, Traversable v)
- => Traversable (UU 'Co 'Co 'Co t u v) where
- UU x ->> f = UU <$> x ->>>> f
-
-instance (Distributive t, Distributive u, Distributive v)
- => Distributive (UU 'Co 'Co 'Co t u v) where
- x >>- f = UU . (distribute <$$>) . (distribute <$>) . distribute $ uu . f <$> x
-
-instance (t :-|: w, v :-|: x, u :-|: y)
- => Adjoint (UU 'Co 'Co 'Co t v u) (UU 'Co 'Co 'Co w x y) where
- phi f = point . f . point
- psi f = extract . extract . comap f
-
-
-newtype UUU ct cu cv cw t u v w a = UUU { uuu :: (t :.: u :.: v :.: w) a }
-
-instance (Covariant t, Covariant u, Covariant v, Covariant w)
- => Covariant (UUU 'Co 'Co 'Co 'Co t u v w) where
- f <$> UUU x = UUU $ f <$$$$> x
-
-instance (Covariant t, Covariant u, Covariant v, Contravariant w)
- => Contravariant (UUU 'Co 'Co 'Co 'Contra t u v w) where
- f >$< UUU x = UUU $ (f >$<) <$$$> x
-
-instance (Covariant t, Covariant u, Contravariant v, Covariant w)
- => Contravariant (UUU 'Co 'Co 'Contra 'Co t u v w) where
- f >$< UUU x = UUU $ (contramap (comap f)) <$$> x
-
-instance (Covariant t, Contravariant u, Covariant v, Covariant w)
- => Contravariant (UUU 'Co 'Contra 'Co 'Co t u v w) where
- f >$< UUU x = UUU $ (contramap (comap (comap f))) <$> x
-
-instance (Contravariant t, Covariant u, Covariant v, Covariant w)
- => Contravariant (UUU 'Contra 'Co 'Co 'Co t u v w) where
- f >$< UUU x = UUU $ (f <$$$>) >$< x
-
-instance (Contravariant t, Contravariant u, Covariant v, Covariant w)
- => Covariant (UUU 'Contra 'Contra 'Co 'Co t u v w) where
- f <$> UUU x = UUU $ (contramap . contramap . comap . comap $ f) x
-
-instance (Covariant t, Contravariant u, Contravariant v, Covariant w)
- => Covariant (UUU 'Co 'Contra 'Contra 'Co t u v w) where
- f <$> UUU x = UUU $ (comap . contramap . contramap . comap $ f) x
-
-instance (Covariant t, Covariant u, Contravariant v, Contravariant w)
- => Covariant (UUU 'Co 'Co 'Contra 'Contra t u v w) where
- f <$> UUU x = UUU $ (f >$$<) <$$> x
-
-instance (Covariant t, Contravariant u, Covariant v, Contravariant w)
- => Covariant (UUU 'Co 'Contra 'Co 'Contra t u v w) where
- f <$> UUU x = UUU $ (comap . contramap . comap . contramap $ f) x
-
-instance (Contravariant t, Covariant u, Contravariant v, Covariant w)
- => Covariant (UUU 'Contra 'Co 'Contra 'Co t u v w) where
- f <$> UUU x = UUU $ (contramap . comap . contramap . comap $ f) x
-
-instance (Contravariant t, Covariant u, Covariant v, Contravariant w)
- => Covariant (UUU 'Contra 'Co 'Co 'Contra t u v w) where
- f <$> UUU x = UUU $ (contramap . comap . comap . contramap $ f) x
-
-instance (Contravariant t, Contravariant u, Contravariant v, Covariant w)
- => Contravariant (UUU 'Contra 'Contra 'Contra 'Co t u v w) where
- f >$< UUU x = UUU $ (f <$>) >$$$< x
-
-instance (Covariant t, Contravariant u, Contravariant v, Contravariant w)
- => Contravariant (UUU 'Co 'Contra 'Contra 'Contra t u v w) where
- f >$< UUU x = UUU $ (f >$$$<) <$> x
-
-instance (Contravariant t, Covariant u, Contravariant v, Contravariant w)
- => Contravariant (UUU 'Contra 'Co 'Contra 'Contra t u v w) where
- f >$< UUU x = UUU $ (contramap . comap . contramap . contramap) f x
-
-instance (Contravariant t, Contravariant u, Covariant v, Contravariant w)
- => Contravariant (UUU 'Contra 'Contra 'Co 'Contra t u v w) where
- f >$< UUU x = UUU $ (contramap . contramap . comap . contramap) f x
-
-instance (Contravariant t, Contravariant u, Contravariant v, Contravariant w)
- => Covariant (UUU 'Contra 'Contra 'Contra 'Contra t u v w) where
- f <$> UUU x = UUU $ f >$$$$< x
-
-instance (Pointable t, Pointable u, Pointable v, Pointable w)
- => Pointable (UUU 'Co 'Co 'Co 'Co t u v w) where
- point = UUU . point . point . point . point
-
-instance (Extractable t, Extractable u, Extractable v, Extractable w)
- => Extractable (UUU 'Co 'Co 'Co 'Co t u v w) where
- extract = extract . extract . extract . extract . uuu
-
-instance (Avoidable t, Covariant u, Covariant v, Covariant w)
- => Avoidable (UUU 'Co 'Co 'Co 'Co t u v w) where
- idle = UUU idle
-
-instance (Applicative t, Applicative u, Applicative v, Applicative w)
- => Applicative (UUU 'Co 'Co 'Co 'Co t u v w) where
- UUU f <*> UUU x = UUU $ ((apply <$>) . (apply <$$>) . (apply <$$$>) $ f) <*> x
-
-instance (Alternative t, Covariant u, Covariant v, Covariant w)
- => Alternative (UUU 'Co 'Co 'Co 'Co t u v w) where
- UUU x <+> UUU y = UUU $ x <+> y
-
-instance (Traversable t, Traversable u, Traversable v, Traversable w)
- => Traversable (UUU 'Co 'Co 'Co 'Co t u v w) where
- UUU x ->> f = UUU <$> x ->>>>> f
-
-instance (Distributive t, Distributive u, Distributive v, Distributive w)
- => Distributive (UUU 'Co 'Co 'Co 'Co t u v w) where
- x >>- f = UUU . (distribute <$$$>) . (distribute <$$>) . (distribute <$>) . distribute $ uuu . f <$> x
-
-instance (t :-|: u, v :-|: w, q :-|: q, r :-|: s)
- => Adjoint (UUU 'Co 'Co 'Co 'Co t v q r) (UUU 'Co 'Co 'Co 'Co u w q s) where
- phi f = point . f . point
- psi f = extract . extract . comap f
+class Composition t where
+ {-# MINIMAL composition #-}
+ type Outline t a :: *
+ composition :: t a -> Outline t a
diff --git a/Pandora/Paradigm/Junction/Schemes.hs b/Pandora/Paradigm/Junction/Schemes.hs
new file mode 100644
index 0000000..2ea0d94
--- /dev/null
+++ b/Pandora/Paradigm/Junction/Schemes.hs
@@ -0,0 +1,7 @@
+module Pandora.Paradigm.Junction.Schemes (module Exports) where
+
+import Pandora.Paradigm.Junction.Schemes.UTU as Exports
+import Pandora.Paradigm.Junction.Schemes.UT as Exports
+import Pandora.Paradigm.Junction.Schemes.TUVW as Exports
+import Pandora.Paradigm.Junction.Schemes.TUV as Exports
+import Pandora.Paradigm.Junction.Schemes.TU as Exports
diff --git a/Pandora/Paradigm/Junction/Schemes/TU.hs b/Pandora/Paradigm/Junction/Schemes/TU.hs
new file mode 100644
index 0000000..e9d6b17
--- /dev/null
+++ b/Pandora/Paradigm/Junction/Schemes/TU.hs
@@ -0,0 +1,60 @@
+module Pandora.Paradigm.Junction.Schemes.TU (TU (..)) where
+
+import Pandora.Core.Functor (Variant (Co, Contra), type (:.:), type (><))
+import Pandora.Core.Morphism ((.), ($))
+import Pandora.Paradigm.Junction.Composition (Composition (Outline, composition))
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>), comap))
+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<), (>$$<)))
+import Pandora.Pattern.Functor.Extractable (Extractable (extract))
+import Pandora.Pattern.Functor.Avoidable (Avoidable (idle))
+import Pandora.Pattern.Functor.Pointable (Pointable (point))
+import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
+import Pandora.Pattern.Functor.Applicative (Applicative ((<*>), apply))
+import Pandora.Pattern.Functor.Traversable (Traversable ((->>), (->>>)))
+import Pandora.Pattern.Functor.Distributive (Distributive ((>>-), distribute))
+import Pandora.Pattern.Functor.Adjoint (Adjoint (phi, psi))
+
+newtype TU ct cu t u a = TU (t :.: u >< a)
+
+instance Composition (TU ct cu t u) where
+ type Outline (TU ct cu t u) a = t :.: u >< a
+ composition (TU x) = x
+
+instance (Covariant t, Covariant u) => Covariant (TU 'Co 'Co t u) where
+ f <$> TU x = TU $ f <$$> x
+
+instance (Covariant t, Contravariant u) => Contravariant (TU 'Co 'Contra t u) where
+ f >$< TU x = TU $ (f >$<) <$> x
+
+instance (Contravariant t, Covariant u) => Contravariant (TU 'Contra 'Co t u) where
+ f >$< TU x = TU $ (f <$>) >$< x
+
+instance (Contravariant t, Contravariant u) => Covariant (TU 'Contra 'Contra t u) where
+ f <$> TU x = TU $ f >$$< x
+
+instance (Pointable t, Pointable u) => Pointable (TU 'Co 'Co t u) where
+ point = TU . point . point
+
+instance (Extractable t, Extractable u) => Extractable (TU 'Co 'Co t u) where
+ extract = extract . extract . composition
+
+instance (Avoidable t, Covariant u) => Avoidable (TU 'Co 'Co t u) where
+ idle = TU idle
+
+instance (Applicative t, Applicative u) => Applicative (TU 'Co 'Co t u) where
+ TU f <*> TU x = TU $ apply <$> f <*> x
+
+instance (Alternative t, Covariant u) => Alternative (TU 'Co 'Co t u) where
+ TU x <+> TU y = TU $ x <+> y
+
+instance (Traversable t, Traversable u) => Traversable (TU 'Co 'Co t u) where
+ TU x ->> f = TU <$> x ->>> f
+
+instance (Distributive t, Distributive u) => Distributive (TU 'Co 'Co t u) where
+ x >>- f = TU . comap distribute . distribute $ composition . f <$> x
+
+type (:-|:) t u = (Extractable t, Pointable t, Extractable u, Pointable u, Adjoint t u)
+
+instance (t :-|: u, v :-|: w) => Adjoint (TU 'Co 'Co t v) (TU 'Co 'Co u w) where
+ phi f = point . f . point
+ psi f = extract . extract . comap f
diff --git a/Pandora/Paradigm/Junction/Schemes/TUV.hs b/Pandora/Paradigm/Junction/Schemes/TUV.hs
new file mode 100644
index 0000000..18eb069
--- /dev/null
+++ b/Pandora/Paradigm/Junction/Schemes/TUV.hs
@@ -0,0 +1,88 @@
+module Pandora.Paradigm.Junction.Schemes.TUV (TUV (..)) where
+
+import Pandora.Core.Functor (Variant (Co, Contra), type (:.:), type (><))
+import Pandora.Core.Morphism ((.), ($))
+import Pandora.Paradigm.Junction.Composition (Composition (Outline, composition))
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>), (<$$$>), comap))
+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<), (>$$<), (>$$$<)), contramap)
+import Pandora.Pattern.Functor.Extractable (Extractable (extract))
+import Pandora.Pattern.Functor.Avoidable (Avoidable (idle))
+import Pandora.Pattern.Functor.Pointable (Pointable (point))
+import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
+import Pandora.Pattern.Functor.Applicative (Applicative ((<*>), apply))
+import Pandora.Pattern.Functor.Traversable (Traversable ((->>), (->>>>)))
+import Pandora.Pattern.Functor.Distributive (Distributive ((>>-), distribute))
+import Pandora.Pattern.Functor.Adjoint (Adjoint (phi, psi))
+
+newtype TUV ct cu cv t u v a = TUV (t :.: u :.: v >< a)
+
+instance Composition (TUV ct cu cv t u v) where
+ type Outline (TUV ct cu cv t u v) a = t :.: u :.: v >< a
+ composition (TUV x) = x
+
+instance (Covariant t, Covariant u, Covariant v)
+ => Covariant (TUV 'Co 'Co 'Co t u v) where
+ f <$> TUV x = TUV $ f <$$$> x
+
+instance (Covariant t, Covariant u, Contravariant v)
+ => Contravariant (TUV 'Co 'Co 'Contra t u v) where
+ f >$< TUV x = TUV $ (f >$<) <$$> x
+
+instance (Covariant t, Contravariant u, Covariant v)
+ => Contravariant (TUV 'Co 'Contra 'Co t u v) where
+ f >$< TUV x = TUV $ contramap (comap f) <$> x
+
+instance (Contravariant t, Covariant u, Covariant v)
+ => Contravariant (TUV 'Contra 'Co 'Co t u v) where
+ f >$< TUV x = TUV $ (f <$$>) >$< x
+
+instance (Contravariant t, Contravariant u, Covariant v)
+ => Covariant (TUV 'Contra 'Contra 'Co t u v) where
+ f <$> TUV x = TUV $ contramap (comap f) >$< x
+
+instance (Covariant t, Contravariant u, Contravariant v)
+ => Covariant (TUV 'Co 'Contra 'Contra t u v) where
+ f <$> TUV x = TUV $ (f >$$<) <$> x
+
+instance (Contravariant t, Covariant u, Contravariant v)
+ => Covariant (TUV 'Contra 'Co 'Contra t u v) where
+ f <$> TUV x = TUV $ comap (contramap f) >$< x
+
+instance (Contravariant t, Contravariant u, Contravariant v)
+ => Contravariant (TUV 'Contra 'Contra 'Contra t u v) where
+ f >$< TUV x = TUV $ f >$$$< x
+
+instance (Pointable t, Pointable u, Pointable v)
+ => Pointable (TUV 'Co 'Co 'Co t u v) where
+ point = TUV . point . point . point
+
+instance (Extractable t, Extractable u, Extractable v)
+ => Extractable (TUV 'Co 'Co 'Co t u v) where
+ extract = extract . extract . extract . composition
+
+instance (Avoidable t, Covariant u, Covariant v)
+ => Avoidable (TUV 'Co 'Co 'Co t u v) where
+ idle = TUV idle
+
+instance (Applicative t, Applicative u, Applicative v)
+ => Applicative (TUV 'Co 'Co 'Co t u v) where
+ TUV f <*> TUV x = TUV $ ((apply <$>) . (apply <$$>) $ f) <*> x
+
+instance (Alternative t, Covariant u, Covariant v)
+ => Alternative (TUV 'Co 'Co 'Co t u v) where
+ TUV x <+> TUV y = TUV $ x <+> y
+
+instance (Traversable t, Traversable u, Traversable v)
+ => Traversable (TUV 'Co 'Co 'Co t u v) where
+ TUV x ->> f = TUV <$> x ->>>> f
+
+instance (Distributive t, Distributive u, Distributive v)
+ => Distributive (TUV 'Co 'Co 'Co t u v) where
+ x >>- f = TUV . (distribute <$$>) . (distribute <$>) . distribute $ composition . f <$> x
+
+type (:-|:) t u = (Extractable t, Pointable t, Extractable u, Pointable u, Adjoint t u)
+
+instance (t :-|: w, v :-|: x, u :-|: y)
+ => Adjoint (TUV 'Co 'Co 'Co t v u) (TUV 'Co 'Co 'Co w x y) where
+ phi f = point . f . point
+ psi f = extract . extract . comap f
diff --git a/Pandora/Paradigm/Junction/Schemes/TUVW.hs b/Pandora/Paradigm/Junction/Schemes/TUVW.hs
new file mode 100644
index 0000000..c355e8d
--- /dev/null
+++ b/Pandora/Paradigm/Junction/Schemes/TUVW.hs
@@ -0,0 +1,120 @@
+module Pandora.Paradigm.Junction.Schemes.TUVW (TUVW (..)) where
+
+import Pandora.Core.Functor (Variant (Co, Contra), type (:.:), type (><))
+import Pandora.Core.Morphism ((.), ($))
+import Pandora.Paradigm.Junction.Composition (Composition (Outline, composition))
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>), (<$$$>), (<$$$$>), comap))
+import Pandora.Pattern.Functor.Contravariant (Contravariant ((>$<), (>$$<), (>$$$<), (>$$$$<), contramap))
+import Pandora.Pattern.Functor.Extractable (Extractable (extract))
+import Pandora.Pattern.Functor.Avoidable (Avoidable (idle))
+import Pandora.Pattern.Functor.Pointable (Pointable (point))
+import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
+import Pandora.Pattern.Functor.Applicative (Applicative ((<*>), apply))
+import Pandora.Pattern.Functor.Traversable (Traversable ((->>), (->>>>>)))
+import Pandora.Pattern.Functor.Distributive (Distributive ((>>-), distribute))
+import Pandora.Pattern.Functor.Adjoint (Adjoint (phi, psi))
+
+newtype TUVW ct cu cv cw t u v w a = TUVW (t :.: u :.: v :.: w >< a)
+
+instance Composition (TUVW ct cu cv cw t u v w) where
+ type Outline (TUVW ct cu cv cw t u v w) a = t :.: u :.: v :.: w >< a
+ composition (TUVW x) = x
+
+instance (Covariant t, Covariant u, Covariant v, Covariant w)
+ => Covariant (TUVW 'Co 'Co 'Co 'Co t u v w) where
+ f <$> TUVW x = TUVW $ f <$$$$> x
+
+instance (Covariant t, Covariant u, Covariant v, Contravariant w)
+ => Contravariant (TUVW 'Co 'Co 'Co 'Contra t u v w) where
+ f >$< TUVW x = TUVW $ (f >$<) <$$$> x
+
+instance (Covariant t, Covariant u, Contravariant v, Covariant w)
+ => Contravariant (TUVW 'Co 'Co 'Contra 'Co t u v w) where
+ f >$< TUVW x = TUVW $ (contramap (comap f)) <$$> x
+
+instance (Covariant t, Contravariant u, Covariant v, Covariant w)
+ => Contravariant (TUVW 'Co 'Contra 'Co 'Co t u v w) where
+ f >$< TUVW x = TUVW $ (contramap (comap (comap f))) <$> x
+
+instance (Contravariant t, Covariant u, Covariant v, Covariant w)
+ => Contravariant (TUVW 'Contra 'Co 'Co 'Co t u v w) where
+ f >$< TUVW x = TUVW $ (f <$$$>) >$< x
+
+instance (Contravariant t, Contravariant u, Covariant v, Covariant w)
+ => Covariant (TUVW 'Contra 'Contra 'Co 'Co t u v w) where
+ f <$> TUVW x = TUVW $ (contramap . contramap . comap . comap $ f) x
+
+instance (Covariant t, Contravariant u, Contravariant v, Covariant w)
+ => Covariant (TUVW 'Co 'Contra 'Contra 'Co t u v w) where
+ f <$> TUVW x = TUVW $ (comap . contramap . contramap . comap $ f) x
+
+instance (Covariant t, Covariant u, Contravariant v, Contravariant w)
+ => Covariant (TUVW 'Co 'Co 'Contra 'Contra t u v w) where
+ f <$> TUVW x = TUVW $ (f >$$<) <$$> x
+
+instance (Covariant t, Contravariant u, Covariant v, Contravariant w)
+ => Covariant (TUVW 'Co 'Contra 'Co 'Contra t u v w) where
+ f <$> TUVW x = TUVW $ (comap . contramap . comap . contramap $ f) x
+
+instance (Contravariant t, Covariant u, Contravariant v, Covariant w)
+ => Covariant (TUVW 'Contra 'Co 'Contra 'Co t u v w) where
+ f <$> TUVW x = TUVW $ (contramap . comap . contramap . comap $ f) x
+
+instance (Contravariant t, Covariant u, Covariant v, Contravariant w)
+ => Covariant (TUVW 'Contra 'Co 'Co 'Contra t u v w) where
+ f <$> TUVW x = TUVW $ (contramap . comap . comap . contramap $ f) x
+
+instance (Contravariant t, Contravariant u, Contravariant v, Covariant w)
+ => Contravariant (TUVW 'Contra 'Contra 'Contra 'Co t u v w) where
+ f >$< TUVW x = TUVW $ (f <$>) >$$$< x
+
+instance (Covariant t, Contravariant u, Contravariant v, Contravariant w)
+ => Contravariant (TUVW 'Co 'Contra 'Contra 'Contra t u v w) where
+ f >$< TUVW x = TUVW $ (f >$$$<) <$> x
+
+instance (Contravariant t, Covariant u, Contravariant v, Contravariant w)
+ => Contravariant (TUVW 'Contra 'Co 'Contra 'Contra t u v w) where
+ f >$< TUVW x = TUVW $ (contramap . comap . contramap . contramap) f x
+
+instance (Contravariant t, Contravariant u, Covariant v, Contravariant w)
+ => Contravariant (TUVW 'Contra 'Contra 'Co 'Contra t u v w) where
+ f >$< TUVW x = TUVW $ (contramap . contramap . comap . contramap) f x
+
+instance (Contravariant t, Contravariant u, Contravariant v, Contravariant w)
+ => Covariant (TUVW 'Contra 'Contra 'Contra 'Contra t u v w) where
+ f <$> TUVW x = TUVW $ f >$$$$< x
+
+instance (Pointable t, Pointable u, Pointable v, Pointable w)
+ => Pointable (TUVW 'Co 'Co 'Co 'Co t u v w) where
+ point = TUVW . point . point . point . point
+
+instance (Extractable t, Extractable u, Extractable v, Extractable w)
+ => Extractable (TUVW 'Co 'Co 'Co 'Co t u v w) where
+ extract = extract . extract . extract . extract . composition
+
+instance (Avoidable t, Covariant u, Covariant v, Covariant w)
+ => Avoidable (TUVW 'Co 'Co 'Co 'Co t u v w) where
+ idle = TUVW idle
+
+instance (Applicative t, Applicative u, Applicative v, Applicative w)
+ => Applicative (TUVW 'Co 'Co 'Co 'Co t u v w) where
+ TUVW f <*> TUVW x = TUVW $ ((apply <$>) . (apply <$$>) . (apply <$$$>) $ f) <*> x
+
+instance (Alternative t, Covariant u, Covariant v, Covariant w)
+ => Alternative (TUVW 'Co 'Co 'Co 'Co t u v w) where
+ TUVW x <+> TUVW y = TUVW $ x <+> y
+
+instance (Traversable t, Traversable u, Traversable v, Traversable w)
+ => Traversable (TUVW 'Co 'Co 'Co 'Co t u v w) where
+ TUVW x ->> f = TUVW <$> x ->>>>> f
+
+instance (Distributive t, Distributive u, Distributive v, Distributive w)
+ => Distributive (TUVW 'Co 'Co 'Co 'Co t u v w) where
+ x >>- f = TUVW . (distribute <$$$>) . (distribute <$$>) . (distribute <$>) . distribute $ composition . f <$> x
+
+type (:-|:) t u = (Extractable t, Pointable t, Extractable u, Pointable u, Adjoint t u)
+
+instance (t :-|: u, v :-|: w, q :-|: q, r :-|: s)
+ => Adjoint (TUVW 'Co 'Co 'Co 'Co t v q r) (TUVW 'Co 'Co 'Co 'Co u w q s) where
+ phi f = point . f . point
+ psi f = extract . extract . comap f
diff --git a/Pandora/Paradigm/Junction/Schemes/UT.hs b/Pandora/Paradigm/Junction/Schemes/UT.hs
new file mode 100644
index 0000000..8b81def
--- /dev/null
+++ b/Pandora/Paradigm/Junction/Schemes/UT.hs
@@ -0,0 +1,67 @@
+module Pandora.Paradigm.Junction.Schemes.UT (UT (..)) where
+
+import Pandora.Core.Functor (Variant (Co), type (:.:), type (><))
+import Pandora.Core.Morphism ((.), ($))
+import Pandora.Paradigm.Junction.Composition (Composition (Outline, composition))
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>), comap))
+import Pandora.Pattern.Functor.Pointable (Pointable (point))
+import Pandora.Pattern.Functor.Extractable (Extractable (extract))
+import Pandora.Pattern.Functor.Avoidable (Avoidable (idle))
+import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
+import Pandora.Pattern.Functor.Applicative (Applicative ((<*>), apply))
+import Pandora.Pattern.Functor.Traversable (Traversable ((->>), (->>>)))
+import Pandora.Pattern.Functor.Distributive (Distributive ((>>-), distribute))
+import Pandora.Pattern.Functor.Liftable (Liftable (lift))
+import Pandora.Pattern.Functor.Lowerable (Lowerable (lower))
+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))
+
+newtype UT ct cu t u a = UT (u :.: t >< a)
+
+instance Composition (UT ct cu t u) where
+ type Outline (UT ct cu t u) a = u :.: t >< a
+ composition (UT x) = x
+
+instance (Covariant t, Covariant u) => Covariant (UT 'Co 'Co t u) where
+ f <$> UT x = UT $ f <$$> x
+
+instance (Pointable t, Pointable u) => Pointable (UT 'Co 'Co t u) where
+ point = UT . point . point
+
+instance (Extractable t, Extractable u) => Extractable (UT 'Co 'Co t u) where
+ extract = extract . extract . composition
+
+instance (Covariant t, Avoidable u) => Avoidable (UT 'Co 'Co t u) where
+ idle = UT idle
+
+instance (Covariant t, Alternative u) => Alternative (UT 'Co 'Co t u) where
+ UT x <+> UT y = UT $ x <+> y
+
+instance (Applicative t, Applicative u) => Applicative (UT 'Co 'Co t u) where
+ UT f <*> UT x = UT $ apply <$> f <*> x
+
+instance Pointable t => Liftable (UT 'Co 'Co t) where
+ lift x = UT $ point <$> x
+
+instance Extractable t => Lowerable (UT 'Co 'Co t) where
+ lower (UT x) = extract <$> x
+
+instance (Traversable t, Traversable u) => Traversable (UT 'Co 'Co t u) where
+ UT x ->> f = UT <$> x ->>> f
+
+instance (Distributive t, Distributive u) => Distributive (UT 'Co 'Co t u) where
+ x >>- f = UT . comap distribute . distribute $ composition . f <$> x
+
+instance Setoid (u :.: t >< a) => Setoid (UT 'Co 'Co t u a) where
+ UT x == UT y = x == y
+
+instance Chain (u :.: t >< a) => Chain (UT 'Co 'Co t u a) where
+ UT x <=> UT y = x <=> y
+
+instance Semigroup (u :.: t >< a) => Semigroup (UT 'Co 'Co t u a) where
+ UT x + UT y = UT $ x + y
+
+instance Monoid (u :.: t >< a) => Monoid (UT 'Co 'Co t u a) where
+ zero = UT zero
diff --git a/Pandora/Paradigm/Junction/Schemes/UTU.hs b/Pandora/Paradigm/Junction/Schemes/UTU.hs
new file mode 100644
index 0000000..944a61a
--- /dev/null
+++ b/Pandora/Paradigm/Junction/Schemes/UTU.hs
@@ -0,0 +1,67 @@
+module Pandora.Paradigm.Junction.Schemes.UTU (UTU (..)) where
+
+import Pandora.Core.Functor (Variant (Co), type (:.:), type (><))
+import Pandora.Core.Morphism ((.), ($))
+import Pandora.Paradigm.Junction.Composition (Composition (Outline, composition))
+import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>), comap))
+import Pandora.Pattern.Functor.Pointable (Pointable (point))
+import Pandora.Pattern.Functor.Extractable (Extractable (extract))
+import Pandora.Pattern.Functor.Avoidable (Avoidable (idle))
+import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
+import Pandora.Pattern.Functor.Applicative (Applicative ((<*>), apply))
+import Pandora.Pattern.Functor.Traversable (Traversable ((->>), (->>>)))
+import Pandora.Pattern.Functor.Distributive (Distributive ((>>-), distribute))
+import Pandora.Pattern.Functor.Liftable (Liftable (lift))
+import Pandora.Pattern.Functor.Lowerable (Lowerable (lower))
+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))
+
+newtype UTU ct cu t u a = UTU (u :.: t u >< a)
+
+instance Composition (UTU ct cu t u) where
+ type Outline (UTU ct cu t u) a = u :.: t u >< a
+ composition (UTU x) = x
+
+instance (Covariant (t u), Covariant u) => Covariant (UTU 'Co 'Co t u) where
+ f <$> UTU x = UTU $ f <$$> x
+
+instance (Pointable (t u), Pointable u) => Pointable (UTU 'Co 'Co t u) where
+ point = UTU . point . point
+
+instance (Extractable (t u), Extractable u) => Extractable (UTU 'Co 'Co t u) where
+ extract = extract . extract . composition
+
+instance (Covariant (t u), Avoidable u) => Avoidable (UTU 'Co 'Co t u) where
+ idle = UTU idle
+
+instance (Covariant (t u), Alternative u) => Alternative (UTU 'Co 'Co t u) where
+ UTU x <+> UTU y = UTU $ x <+> y
+
+instance (Applicative (t u), Applicative u) => Applicative (UTU 'Co 'Co t u) where
+ UTU f <*> UTU x = UTU $ apply <$> f <*> x
+
+instance (Traversable (t u), Traversable u) => Traversable (UTU 'Co 'Co t u) where
+ UTU x ->> f = UTU <$> x ->>> f
+
+instance (Distributive (t u), Distributive u) => Distributive (UTU 'Co 'Co t u) where
+ x >>- f = UTU . comap distribute . distribute $ composition . f <$> x
+
+instance (forall u' . Pointable u', Liftable t) => Liftable (UTU 'Co 'Co t) where
+ lift = UTU . point . lift
+
+instance (forall u' . Extractable u', Lowerable t) => Lowerable (UTU 'Co 'Co t) where
+ lower = lower . extract . composition
+
+instance (forall u' . Setoid (u' :.: t u' >< a)) => Setoid (UTU 'Co 'Co t u a) where
+ UTU x == UTU y = x == y
+
+instance (forall u' . Chain (u' :.: t u' >< a)) => Chain (UTU 'Co 'Co t u a) where
+ UTU x <=> UTU y = x <=> y
+
+instance (forall u' . Semigroup (u' :.: t u' >< a)) => Semigroup (UTU 'Co 'Co t u a) where
+ UTU x + UTU y = UTU $ x + y
+
+instance (forall u' . Monoid (u' :.: t u' >< a)) => Monoid (UTU 'Co 'Co t u a) where
+ zero = UTU zero
diff --git a/Pandora/Paradigm/Junction/Transformer.hs b/Pandora/Paradigm/Junction/Transformer.hs
index fcc1486..812479b 100644
--- a/Pandora/Paradigm/Junction/Transformer.hs
+++ b/Pandora/Paradigm/Junction/Transformer.hs
@@ -1,115 +1,10 @@
-module Pandora.Paradigm.Junction.Transformer (T (..), type (:!:), up, Y (..), type (:>:)) where
+module Pandora.Paradigm.Junction.Transformer (Transformer (..)) where
-import Pandora.Core.Functor (type (:.:))
-import Pandora.Core.Morphism ((.), ($))
-import Pandora.Pattern.Functor.Covariant (Covariant ((<$>), (<$$>), comap))
-import Pandora.Pattern.Functor.Pointable (Pointable (point))
-import Pandora.Pattern.Functor.Extractable (Extractable (extract))
-import Pandora.Pattern.Functor.Avoidable (Avoidable (idle))
-import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
-import Pandora.Pattern.Functor.Applicative (Applicative ((<*>), apply))
-import Pandora.Pattern.Functor.Traversable (Traversable ((->>), (->>>)))
-import Pandora.Pattern.Functor.Distributive (Distributive ((>>-), distribute))
-import Pandora.Pattern.Functor.Liftable (Liftable (lift))
-import Pandora.Pattern.Functor.Lowerable (Lowerable (lower))
-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.Functor.Covariant (Covariant)
+import Pandora.Pattern.Functor.Pointable (Pointable)
-infixr 0 :!:, :>:
-type (:!:) t u = T t u
-type (:>:) t u = Y t u
-
-
-newtype T t u a = T { t :: (u :.: t) a }
-
-instance (Covariant t, Covariant u) => Covariant (T t u) where
- f <$> T x = T $ f <$$> x
-
-instance (Pointable t, Pointable u) => Pointable (T t u) where
- point = T . point . point
-
-instance (Extractable t, Extractable u) => Extractable (T t u) where
- extract = extract . extract . t
-
-instance (Covariant t, Avoidable u) => Avoidable (T t u) where
- idle = T idle
-
-instance (Covariant t, Alternative u) => Alternative (T t u) where
- T x <+> T y = T $ x <+> y
-
-instance (Applicative t, Applicative u) => Applicative (T t u) where
- T f <*> T x = T $ apply <$> f <*> x
-
-instance Pointable t => Liftable (T t) where
- lift x = T $ point <$> x
-
-instance Extractable t => Lowerable (T t) where
- lower (T x) = extract <$> x
-
-instance (Traversable t, Traversable u) => Traversable (T t u) where
- T x ->> f = T <$> x ->>> f
-
-instance (Distributive t, Distributive u) => Distributive (T t u) where
- x >>- f = T . comap distribute . distribute $ t . f <$> x
-
-instance Setoid ((u :.: t) a) => Setoid (T t u a) where
- T x == T y = x == y
-
-instance Chain ((u :.: t) a) => Chain (T t u a) where
- T x <=> T y = x <=> y
-
-instance Semigroup ((u :.: t) a) => Semigroup (T t u a) where
- T x + T y = T $ x + y
-
-instance Monoid ((u :.: t) a) => Monoid (T t u a) where
- zero = T zero
-
-up :: Pointable u => t a -> T t u a
-up = T . point
-
-
-newtype Y t u a = Y { y :: (u :.: t u) a }
-
-instance (Covariant (t u), Covariant u) => Covariant (Y t u) where
- f <$> Y x = Y $ f <$$> x
-
-instance (Pointable (t u), Pointable u) => Pointable (Y t u) where
- point = Y . point . point
-
-instance (Extractable (t u), Extractable u) => Extractable (Y t u) where
- extract = extract . extract . y
-
-instance (Covariant (t u), Avoidable u) => Avoidable (Y t u) where
- idle = Y idle
-
-instance (Covariant (t u), Alternative u) => Alternative (Y t u) where
- Y x <+> Y y = Y $ x <+> y
-
-instance (Applicative (t u), Applicative u) => Applicative (Y t u) where
- Y f <*> Y x = Y $ apply <$> f <*> x
-
-instance (Traversable (t u), Traversable u) => Traversable (Y t u) where
- Y x ->> f = Y <$> x ->>> f
-
-instance (Distributive (t u), Distributive u) => Distributive (Y t u) where
- x >>- f = Y . comap distribute . distribute $ y . f <$> x
-
-instance (forall u' . Pointable u', Liftable t) => Liftable (Y t) where
- lift = Y . point . lift
-
-instance (forall u' . Extractable u', Lowerable t) => Lowerable (Y t) where
- lower = lower . extract . y
-
-instance (forall u' . Setoid ((u' :.: t u') a)) => Setoid (Y t u a) where
- Y x == Y y = x == y
-
-instance (forall u' . Chain ((u' :.: t u') a)) => Chain (Y t u a) where
- Y x <=> Y y = x <=> y
-
-instance (forall u' . Semigroup ((u' :.: t u') a)) => Semigroup (Y t u a) where
- Y x + Y y = Y $ x + y
-
-instance (forall u' . Monoid ((u' :.: t u') a)) => Monoid (Y t u a) where
- zero = Y zero
+class Transformer t where
+ {-# MINIMAL lay, equip #-}
+ type Layout (t :: * -> *) (u :: * -> *) (a :: *) = r | r -> t u
+ lay :: Covariant u => u a -> Layout t u a
+ equip :: Pointable u => t a -> Layout t u a
diff --git a/Pandora/Paradigm/Structure/Stack.hs b/Pandora/Paradigm/Structure/Stack.hs
index e506b84..7c4868f 100644
--- a/Pandora/Paradigm/Structure/Stack.hs
+++ b/Pandora/Paradigm/Structure/Stack.hs
@@ -1,11 +1,9 @@
module Pandora.Paradigm.Structure.Stack (Stack, push, top, pop, linearize) where
-import Pandora.Core.Functor (type (:.:))
-import Pandora.Core.Morphism ((.), ($))
+import Pandora.Core.Functor (type (:.:), type (><))
+import Pandora.Core.Morphism ((.))
import Pandora.Paradigm.Basis.Twister (Twister ((:<)), unwrap)
import Pandora.Paradigm.Basis.Maybe (Maybe (Just, Nothing))
-import Pandora.Paradigm.Basis.Predicate (Predicate (Predicate))
-import Pandora.Paradigm.Junction.Transformer (Y (Y), type (:>:))
import Pandora.Paradigm.Inventory.Stateful (fold)
import Pandora.Pattern.Functor.Covariant (Covariant ((<$>)))
import Pandora.Pattern.Functor.Pointable (Pointable (point))
@@ -13,10 +11,9 @@ import Pandora.Pattern.Functor.Extractable (Extractable (extract))
import Pandora.Pattern.Functor.Alternative (Alternative ((<+>)))
import Pandora.Pattern.Functor.Traversable (Traversable)
import Pandora.Pattern.Functor.Bindable (Bindable ((>>=)))
-import Pandora.Pattern.Object.Setoid (bool)
-- | Linear data structure that serves as a collection of elements
-type Stack a = (Maybe :.: Twister Maybe) a
+type Stack a = Maybe :.: Twister Maybe >< a
push :: a -> Stack a -> Stack a
push x stack = ((:<) x . Just <$> stack) <+> (point . point) x
diff --git a/Pandora/Pattern.hs b/Pandora/Pattern.hs
new file mode 100644
index 0000000..681632d
--- /dev/null
+++ b/Pandora/Pattern.hs
@@ -0,0 +1,4 @@
+module Pandora.Pattern (module Exports) where
+
+import Pandora.Pattern.Object as Exports
+import Pandora.Pattern.Functor as Exports
diff --git a/Pandora/Pattern/Functor/Covariant.hs b/Pandora/Pattern/Functor/Covariant.hs
index 90d52b1..156e9d3 100644
--- a/Pandora/Pattern/Functor/Covariant.hs
+++ b/Pandora/Pattern/Functor/Covariant.hs
@@ -50,7 +50,7 @@ class Covariant (t :: * -> *) where
x <&&> f = f <$$> x
(<&&&>) :: (Covariant u, Covariant v)
=> t :.: u :.: v >< a -> (a -> b) -> t :.: u :.: v >< b
-
+ x <&&&> f = f <$$$> x
(<&&&&>) :: (Covariant u, Covariant v, Covariant w)
=> t :.: u :.: v :.: w >< a -> (a -> b) -> t :.: u :.: v :.: w >< b
x <&&&&> f = f <$$$$> x
diff --git a/pandora.cabal b/pandora.cabal
index e496c2f..d519115 100644
--- a/pandora.cabal
+++ b/pandora.cabal
@@ -1,5 +1,5 @@
name: pandora
-version: 0.1.7
+version: 0.1.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
@@ -20,9 +20,12 @@ source-repository head
library
exposed-modules:
-- Axioms set
+ Pandora.Core
Pandora.Core.Functor
Pandora.Core.Morphism
Pandora.Core.Transformation
+
+ Pandora.Paradigm
-- Basic constructions
Pandora.Paradigm.Basis
Pandora.Paradigm.Basis.Conclusion
@@ -50,6 +53,12 @@ library
Pandora.Paradigm.Junction.Composition
Pandora.Paradigm.Junction.Transformer
Pandora.Paradigm.Junction.Kan
+ Pandora.Paradigm.Junction.Schemes
+ Pandora.Paradigm.Junction.Schemes.TU
+ Pandora.Paradigm.Junction.Schemes.TUV
+ Pandora.Paradigm.Junction.Schemes.TUVW
+ Pandora.Paradigm.Junction.Schemes.UT
+ Pandora.Paradigm.Junction.Schemes.UTU
-- Control flow primitives
Pandora.Paradigm.Controlflow
Pandora.Paradigm.Controlflow.Observable
@@ -65,6 +74,8 @@ library
Pandora.Paradigm.Structure.Stack
Pandora.Paradigm.Structure.Graph
Pandora.Paradigm.Structure.Binary
+
+ Pandora.Pattern
-- Functor typeclassess
Pandora.Pattern.Functor
Pandora.Pattern.Functor.Adjoint