joint 0.1.3 → 0.1.4

raw patch · 22 files changed

+316/−177 lines, 22 files

Files

• Control/Joint/Abilities.hs +6/−0
• Control/Joint/Abilities/Composition.hs +6/−0
• Control/Joint/Abilities/Liftable.hs +67/−0
• Control/Joint/Abilities/Modulator.hs +7/−0
• Control/Joint/Abilities/Transformer.hs +28/−0
• Control/Joint/Base/Configured.hs +0/−34
• Control/Joint/Base/Either.hs +0/−25
• Control/Joint/Base/Maybe.hs +0/−25
• Control/Joint/Base/State.hs +0/−53
• Control/Joint/Composition.hs +0/−6
• Control/Joint/Core.hs +2/−2
• Control/Joint/Effects.hs +6/−0
• Control/Joint/Effects/Either.hs +30/−0
• Control/Joint/Effects/Maybe.hs +30/−0
• Control/Joint/Effects/Reader.hs +52/−0
• Control/Joint/Effects/State.hs +62/−0
• Control/Joint/Modulator.hs +0/−7
• Control/Joint/Schemes/TU.hs +1/−1
• Control/Joint/Schemes/TUT.hs +1/−1
• Control/Joint/Schemes/UT.hs +1/−1
• Control/Joint/Transformer.hs +0/−14
• joint.cabal +17/−8

@@ -0,0 +1,6 @@+module Control.Joint.Abilities (module Exports) where++import Control.Joint.Abilities.Liftable as Exports+import Control.Joint.Abilities.Modulator as Exports+import Control.Joint.Abilities.Transformer as Exports+import Control.Joint.Abilities.Composition as Exports

@@ -0,0 +1,6 @@+module Control.Joint.Abilities.Composition (Composition (..)) where++class Composition t where+	{-# MINIMAL run #-}+	type Primary t a :: *+	run :: t a -> Primary t a

@@ -0,0 +1,67 @@+module Control.Joint.Abilities.Liftable where++import Control.Joint.Abilities.Transformer (Transformer (Schema, build, embed), (:>) (T))++class Liftable (eff :: * -> *) (schema :: * -> *) where+	lift :: eff a -> schema a++instance (Functor u, Transformer t) => Liftable u (t :> u) where+	lift = T . embed++instance (Applicative u, Transformer t) => Liftable t (t :> u) where+	lift = T . build++instance (Functor (Schema u v), Applicative v, Transformer u, Transformer t)+	=> Liftable u (t :> u :> v) where+	lift = T . embed . T . build++instance (Functor (Schema u v), Functor v, Transformer u, Transformer t)+	=> Liftable v (t :> u :> v) where+	lift = T . embed . T . embed++instance (Functor (Schema u v), Functor (Schema v w), Functor (Schema u (v :> w))+	, Applicative v, Applicative w, Transformer u, Transformer t, Transformer v)+		=> Liftable v (t :> u :> v :> w) where+	lift = T . embed . T . embed . T . build++instance (Functor (Schema u v), Functor (Schema v w), Functor (Schema u (v :> w))+	, Applicative v, Functor w, Transformer t, Transformer u, Transformer v)+		=> Liftable w (t :> u :> v :> w) where+	lift = T . embed . T . embed . T . embed++instance (Functor (Schema u (v :> w :> x)), Functor (Schema v (w :> x)), Functor (Schema w x)+	, Functor x, Transformer t, Transformer u, Transformer v, Transformer w)+		=> Liftable x (t :> u :> v :> w :> x) where+	lift = T . embed . T . embed . T . embed . T . embed++instance (Functor (Schema u (v :> w :> x)), Functor (Schema v (w :> x)), Functor (Schema w x)+	, Applicative x, Transformer t, Transformer u, Transformer v, Transformer w)+		=> Liftable w (t :> u :> v :> w :> x) where+	lift = T . embed . T . embed . T . embed . T . build++instance (Functor (Schema u (v :> w :> x)), Functor (Schema v (w :> x)), Functor (Schema w x), Functor (Schema x y)+	, Functor (Schema w (x :> y)), Functor (Schema v (w :> x :> y)), Functor (Schema u (v :> w :> x :> y))+		, Functor y, Transformer t, Transformer u, Transformer v, Transformer w, Transformer x)+			=> Liftable y (t :> u :> v :> w :> x :> y) where+	lift = T . embed . T . embed . T . embed . T . embed . T . embed++instance (Functor (Schema u (v :> w :> x)), Functor (Schema v (w :> x)), Functor (Schema w x)+	, Functor (Schema x y), Functor (Schema w (x :> y)), Functor (Schema v (w :> x :> y))+		, Functor (Schema u (v :> w :> x :> y)), Functor y+		, Applicative y, Transformer t, Transformer u, Transformer v, Transformer w, Transformer x)+			=> Liftable x (t :> u :> v :> w :> x :> y) where+	lift = T . embed . T . embed . T . embed . T . embed . T . build++instance (Functor (Schema u (v :> w :> x :> y :> z)), Functor (Schema v (w :> x :> y :> z))+	, Functor (Schema w (x :> y :> z)), Functor (Schema x (y :> z)), Functor (Schema y z)+		, Functor z, Transformer t, Transformer u, Transformer v+			, Transformer w, Transformer x, Transformer z, Transformer y)+				=> Liftable z (t :> u :> v :> w :> x :> y :> z) where+	lift = T . embed . T . embed . T . embed . T . embed . T . embed . T . embed++instance (Functor (Schema u (v :> w :> x :> y :> z)), Functor (Schema v (w :> x :> y :> z))+	, Functor (Schema w (x :> y :> z)), Functor (Schema x (y :> z)), Functor (Schema y z)+		, Applicative z, Transformer t, Transformer u, Transformer v+			, Transformer w, Transformer x, Transformer z, Transformer y)+				=> Liftable y (t :> u :> v :> w :> x :> y :> z) where+	lift = T . embed . T . embed . T . embed . T . embed . T . embed . T . build

@@ -0,0 +1,7 @@+module Control.Joint.Abilities.Modulator where++import Control.Joint.Abilities.Transformer (Transformer (Schema))++class Transformer t => Modulator t where+	{-# MINIMAL (-<$>-) #-}+	(-<$>-) :: (u a -> v b) -> Schema t u a -> Schema t v b

@@ -0,0 +1,28 @@+module Control.Joint.Abilities.Transformer (Transformer (..), (:>) (..)) where++import Control.Joint.Core (type (~>))+import Control.Joint.Abilities.Composition (Composition (Primary, run))++class Composition t => Transformer t where+	{-# MINIMAL embed, build, unite #-}+	type Schema (t :: * -> *) (u :: * -> *) = (r :: * -> *) | r -> t u+	embed :: Functor u => u ~> Schema t u+	build :: Applicative u => t ~> Schema t u+	unite :: Primary (Schema t u) a -> Schema t u a++infixr 0 :>+newtype (:>) t u a = T { trans :: Transformer t => (Schema t u a) }++instance (Composition (Schema t u), Transformer t) => Composition (t :> u) where+	type Primary (t :> u) a = Primary (Schema t u) a+	run (T x) = run x++instance Functor (Schema t u) => Functor (t :> u) where+	fmap f (T x) = T $ f <$> x++instance (Transformer t, Applicative (Schema t u)) => Applicative (t :> u) where+	pure = T . pure+	T f <*> T x = T $ f <*> x++instance (Transformer t, Monad (Schema t u)) => Monad (t :> u) where+	T x >>= f = T $ x >>= trans . f

@@ -1,34 +0,0 @@-module Control.Joint.Base.Configured where--import Control.Joint.Composition (Composition (Primary, run))-import Control.Joint.Transformer (Transformer (Schema, embed, build, unite))-import Control.Joint.Modulator (Modulator ((-<$>-)))-import Control.Joint.Schemes.TU (TU (TU))--newtype Configured e a = Configured (e -> a)--instance Functor u => Functor (TU ((->) e) u) where-	fmap f (TU x) = TU $ \r -> f <$> x r--instance Applicative u => Applicative (TU ((->) e) u) where-	pure = TU . pure . pure-	TU f <*> TU x = TU $ \r -> f r <*> x r--instance (Applicative u, Monad u) => Monad (TU ((->) e) u) where-	TU x >>= f = TU $ \e -> x e >>= ($ e) . run . f--instance Composition (Configured e) where-	type Primary (Configured e) a = (->) e a-	run (Configured x) = x--instance Transformer (Configured e) where-	type Schema (Configured e) u = TU ((->) e) u-	embed x = TU . const $ x-	build x = TU $ pure <$> run x-	unite = TU--instance Modulator (Configured e) where-	f -<$>- (TU x) = TU $ f <$> x--ask :: Configured e e-ask = Configured $ \e -> e

@@ -1,25 +0,0 @@-module Control.Joint.Base.Either where--import Control.Joint.Composition (Composition (Primary, run))-import Control.Joint.Transformer (Transformer (Schema, embed, build, unite))-import Control.Joint.Schemes.UT (UT (UT))--instance Functor u => Functor (UT (Either e) u) where-	fmap f (UT x) = UT $ (fmap . fmap) f x--instance Applicative u => Applicative (UT (Either e) u) where-	pure = UT . pure . pure-	UT f <*> UT x = UT $ (<*>) <$> f <*> x--instance (Applicative u, Monad u) => Monad (UT (Either e) u) where-	UT x >>= f = UT $ x >>= either (pure . Left) (run . f)--instance Composition (Either e) where-	type Primary (Either e) a = Either e a-	run x = x--instance Transformer (Either e) where-	type Schema (Either e) u = UT (Either e) u-	embed x = UT $ Right <$> x-	build x = UT . pure $ x-	unite = UT

@@ -1,25 +0,0 @@-module Control.Joint.Base.Maybe where--import Control.Joint.Composition (Composition (Primary, run))-import Control.Joint.Transformer (Transformer (Schema, embed, build, unite))-import Control.Joint.Schemes.UT (UT (UT))--instance Functor u => Functor (UT Maybe u) where-	fmap f (UT x) = UT $ (fmap . fmap) f x--instance Applicative u => Applicative (UT Maybe u) where-	pure = UT . pure . pure-	UT f <*> UT x = UT $ (<*>) <$> f <*> x--instance (Applicative u, Monad u) => Monad (UT Maybe u) where-	UT x >>= f = UT $ x >>= maybe (pure Nothing) (run . f)--instance Composition Maybe where-	type Primary Maybe a = Maybe a-	run x = x--instance Transformer Maybe where-	type Schema Maybe u = UT Maybe u-	embed x = UT $ Just <$> x-	build x = UT . pure $ x-	unite = UT

@@ -1,53 +0,0 @@-module Control.Joint.Base.State where--import Control.Joint.Core (type (:.), type (:=))-import Control.Joint.Composition (Composition (Primary, run))-import Control.Joint.Transformer (Transformer (Schema, embed, build, unite))-import Control.Joint.Schemes.TUT (TUT (TUT))--newtype State s a = State ((->) s :. (,) s := a)--statefully :: s -> State s a -> (s, a)-statefully initial (State x) = x initial--instance Functor (State s) where-	fmap f (State x) = State $ \old -> f <$> x old--instance Applicative (State s) where-	pure x = State $ \s -> (s, x)-	State f <*> State x = State $ \old ->-		let latest = fst . x $ old in-			(latest, snd (f old) . snd . x $ old)--instance Monad (State s) where-	State x >>= f = State $ \old ->-		uncurry statefully $ f <$> x old--instance Composition (State s) where-	type Primary (State s) a = (->) s :. (,) s := a-	run (State x) = x--instance Transformer (State s) where-	type Schema (State s) u = TUT ((->) s) u ((,) s)-	embed x = TUT $ \s -> (s,) <$> x-	build x = TUT $ pure <$> run x-	unite = TUT--instance Functor u => Functor (TUT ((->) s) u ((,) s)) where-	fmap f (TUT x) = TUT $ \old -> (fmap . fmap) f $ x old--instance Monad u => Applicative (TUT ((->) s) u ((,) s)) where-	pure x = TUT $ \s -> pure (s, x)-	TUT f <*> TUT x = TUT $ \old -> f old >>= \(new, g) -> (fmap . fmap) g $ x new--instance Monad u => Monad (TUT ((->) s) u ((,) s)) where-	TUT x >>= f = TUT $ \old -> x old >>= \(new, y) -> ($ new) . run . f $ y--get :: State s s-get = State $ \s -> (s, s)--modify :: (s -> s) -> State s ()-modify f = State $ \s -> (f s, ())--put :: s -> State s ()-put s = State $ \_ -> (s, ())

@@ -1,6 +0,0 @@-module Control.Joint.Composition (Composition (..)) where--class Composition t where-	{-# MINIMAL run #-}-	type Primary t a :: *-	run :: t a -> Primary t a

@@ -1,7 +1,7 @@ module Control.Joint.Core where -infixr 1 :.-infixr 0 :=+infixr 2 :.+infixr 1 := infixr 0 ~>  -- | Functor composition

@@ -0,0 +1,6 @@+module Control.Joint.Effects (module Exports) where++import Control.Joint.Effects.State as Exports+import Control.Joint.Effects.Maybe as Exports+import Control.Joint.Effects.Either as Exports+import Control.Joint.Effects.Reader as Exports

@@ -0,0 +1,30 @@+module Control.Joint.Effects.Either where++import Control.Joint.Abilities.Composition (Composition (Primary, run))+import Control.Joint.Abilities.Transformer (Transformer (Schema, embed, build, unite))+import Control.Joint.Abilities.Liftable (Liftable (lift))+import Control.Joint.Schemes.TU (TU (TU))+import Control.Joint.Schemes.TUT (TUT (TUT))+import Control.Joint.Schemes.UT (UT (UT))++instance Functor u => Functor (UT (Either e) u) where+	fmap f (UT x) = UT $ (fmap . fmap) f x++instance Applicative u => Applicative (UT (Either e) u) where+	pure = UT . pure . pure+	UT f <*> UT x = UT $ (<*>) <$> f <*> x++instance (Applicative u, Monad u) => Monad (UT (Either e) u) where+	UT x >>= f = UT $ x >>= either (pure . Left) (run . f)++instance Composition (Either e) where+	type Primary (Either e) a = Either e a+	run x = x++instance Transformer (Either e) where+	type Schema (Either e) u = UT (Either e) u+	embed x = UT $ Right <$> x+	build x = UT . pure $ x+	unite = UT++type Failable e = Liftable (Either e)

@@ -0,0 +1,30 @@+module Control.Joint.Effects.Maybe where++import Control.Joint.Abilities.Composition (Composition (Primary, run))+import Control.Joint.Abilities.Transformer (Transformer (Schema, embed, build, unite))+import Control.Joint.Abilities.Liftable (Liftable (lift))+import Control.Joint.Schemes.TU (TU (TU))+import Control.Joint.Schemes.TUT (TUT (TUT))+import Control.Joint.Schemes.UT (UT (UT))++instance Functor u => Functor (UT Maybe u) where+	fmap f (UT x) = UT $ (fmap . fmap) f x++instance Applicative u => Applicative (UT Maybe u) where+	pure = UT . pure . pure+	UT f <*> UT x = UT $ (<*>) <$> f <*> x++instance (Applicative u, Monad u) => Monad (UT Maybe u) where+	UT x >>= f = UT $ x >>= maybe (pure Nothing) (run . f)++instance Composition Maybe where+	type Primary Maybe a = Maybe a+	run x = x++instance Transformer Maybe where+	type Schema Maybe u = UT Maybe u+	embed x = UT $ Just <$> x+	build x = UT . pure $ x+	unite = UT++type Optional = Liftable Maybe

@@ -0,0 +1,52 @@+module Control.Joint.Effects.Reader where++import Control.Joint.Abilities.Composition (Composition (Primary, run))+import Control.Joint.Abilities.Transformer (Transformer (Schema, embed, build, unite))+import Control.Joint.Abilities.Modulator (Modulator ((-<$>-)))+import Control.Joint.Abilities.Liftable (Liftable (lift))+import Control.Joint.Schemes.TU (TU (TU))+import Control.Joint.Schemes.TUT (TUT (TUT))+import Control.Joint.Schemes.UT (UT (UT))++newtype Reader e a = Reader (e -> a)++instance Functor (Reader e) where+	fmap f (Reader g) = Reader (f . g)++instance Applicative (Reader e) where+	pure = Reader . const+	Reader f <*> Reader g = Reader $ \e -> f e (g e)++instance Monad (Reader e) where+	Reader g >>= f = Reader $ \e -> run (f (g e)) e++instance Functor u => Functor (TU ((->) e) u) where+	fmap f (TU x) = TU $ \r -> f <$> x r++instance Applicative u => Applicative (TU ((->) e) u) where+	pure = TU . pure . pure+	TU f <*> TU x = TU $ \r -> f r <*> x r++instance (Applicative u, Monad u) => Monad (TU ((->) e) u) where+	TU x >>= f = TU $ \e -> x e >>= ($ e) . run . f++instance Composition (Reader e) where+	type Primary (Reader e) a = (->) e a+	run (Reader x) = x++instance Transformer (Reader e) where+	type Schema (Reader e) u = TU ((->) e) u+	embed x = TU . const $ x+	build x = TU $ pure <$> run x+	unite = TU++instance Modulator (Reader e) where+	f -<$>- (TU x) = TU $ f <$> x++ask :: Reader e e+ask = Reader $ \e -> e++instance Liftable (Reader e) ((->) e) where+	lift = run++type Configured e = Liftable (Reader e)

@@ -0,0 +1,62 @@+module Control.Joint.Effects.State where++import Control.Joint.Core (type (:.), type (:=))+import Control.Joint.Abilities.Composition (Composition (Primary, run))+import Control.Joint.Abilities.Transformer (Transformer (Schema, embed, build, unite))+import Control.Joint.Abilities.Liftable (Liftable (lift))+import Control.Joint.Schemes.TU (TU (TU))+import Control.Joint.Schemes.TUT (TUT (TUT))+import Control.Joint.Schemes.UT (UT (UT))+import Control.Joint.Effects.Reader (Reader (Reader))++newtype State s a = State ((->) s :. (,) s := a)++statefully :: s -> State s a -> (s, a)+statefully initial (State x) = x initial++instance Functor (State s) where+	fmap f (State x) = State $ \old -> f <$> x old++instance Applicative (State s) where+	pure x = State $ \s -> (s, x)+	State f <*> State x = State $ \old ->+		let latest = fst . x $ old in+			(latest, snd (f old) . snd . x $ old)++instance Monad (State s) where+	State x >>= f = State $ \old ->+		uncurry statefully $ f <$> x old++instance Composition (State s) where+	type Primary (State s) a = (->) s :. (,) s := a+	run (State x) = x++instance Transformer (State s) where+	type Schema (State s) u = TUT ((->) s) u ((,) s)+	embed x = TUT $ \s -> (s,) <$> x+	build x = TUT $ pure <$> run x+	unite = TUT++instance Functor u => Functor (TUT ((->) s) u ((,) s)) where+	fmap f (TUT x) = TUT $ \old -> (fmap . fmap) f $ x old++instance Monad u => Applicative (TUT ((->) s) u ((,) s)) where+	pure x = TUT $ \s -> pure (s, x)+	TUT f <*> TUT x = TUT $ \old -> f old >>= \(new, g) -> (fmap . fmap) g $ x new++instance Monad u => Monad (TUT ((->) s) u ((,) s)) where+	TUT x >>= f = TUT $ \old -> x old >>= \(new, y) -> ($ new) . run . f $ y++get :: State s s+get = State $ \s -> (s, s)++modify :: (s -> s) -> State s ()+modify f = State $ \s -> (f s, ())++put :: s -> State s ()+put s = State $ \_ -> (s, ())++instance Liftable (Reader e) (State e) where+	lift (Reader f) = State (\e -> (e, f e))++type Stateful e = Liftable (State e)

@@ -1,7 +0,0 @@-module Control.Joint.Modulator where--import Control.Joint.Transformer (Transformer (Schema))--class Transformer t => Modulator t where-	{-# MINIMAL (-<$>-) #-}-	(-<$>-) :: (u a -> v b) -> Schema t u a -> Schema t v b

@@ -1,7 +1,7 @@ module Control.Joint.Schemes.TU (TU (..)) where  import Control.Joint.Core (type (:.), type (:=))-import Control.Joint.Composition (Composition (Primary, run))+import Control.Joint.Abilities.Composition (Composition (Primary, run))  newtype TU t u a = TU (t :. u := a) 

@@ -1,7 +1,7 @@ module Control.Joint.Schemes.TUT (TUT (..)) where  import Control.Joint.Core (type (:.), type (:=))-import Control.Joint.Composition (Composition (Primary, run))+import Control.Joint.Abilities.Composition (Composition (Primary, run))  newtype TUT t u t' a = TUT (t :. u :. t' := a) 

@@ -1,7 +1,7 @@ module Control.Joint.Schemes.UT (UT (..)) where  import Control.Joint.Core (type (:.), type (:=))-import Control.Joint.Composition (Composition (Primary, run))+import Control.Joint.Abilities.Composition (Composition (Primary, run))  newtype UT t u a = UT (u :. t := a) 

@@ -1,14 +0,0 @@-module Control.Joint.Transformer (Transformer (..), type (:>)) where--import Control.Joint.Core (type (~>))-import Control.Joint.Composition (Composition (Primary))--class Composition t => Transformer t where-	{-# MINIMAL embed, build, unite #-}-	type Schema (t :: * -> *) (u :: * -> *) = (r :: * -> *) | r -> t u-	embed :: Functor u => u ~> Schema t u-	build :: Applicative u => t ~> Schema t u-	unite :: Primary (Schema t u) a -> Schema t u a--infixr 1 :>-type (:>) t u a = Transformer t => Schema t u a

@@ -1,5 +1,5 @@ name:                joint-version:             0.1.3+version:             0.1.4 synopsis:            Trying to compose non-composable homepage:            https://github.com/iokasimov/joint license:             BSD3@@ -18,25 +18,34 @@ library   exposed-modules:     Control.Joint.Core-    Control.Joint.Composition-    Control.Joint.Transformer-    Control.Joint.Modulator+    Control.Joint.Abilities+    Control.Joint.Abilities.Composition+    Control.Joint.Abilities.Transformer+    Control.Joint.Abilities.Modulator+    Control.Joint.Abilities.Liftable     Control.Joint.Schemes     Control.Joint.Schemes.TU     Control.Joint.Schemes.UT     Control.Joint.Schemes.TUT-    Control.Joint.Base.Configured-    Control.Joint.Base.Maybe-    Control.Joint.Base.Either-    Control.Joint.Base.State+    Control.Joint.Effects+    Control.Joint.Effects.Maybe+    Control.Joint.Effects.Either+    Control.Joint.Effects.State+    Control.Joint.Effects.Reader   build-depends: base == 4.*   default-language: Haskell2010   ghc-options: -fno-warn-tabs   default-extensions:+    ConstraintKinds+    ExistentialQuantification+    FlexibleContexts     FlexibleInstances     LiberalTypeSynonyms+    MultiParamTypeClasses     RankNTypes     TupleSections     TypeFamilies     TypeFamilyDependencies     TypeOperators+    QuantifiedConstraints+    UndecidableInstances