joint 0.1.7 → 0.1.8

raw patch · 16 files changed

+320/−201 lines, 16 filesdep +adjunctionsdep +comonaddep +distributivePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: adjunctions, comonad, distributive

API changes (from Hackage documentation)

Files

• Control/Joint/Abilities.hs +1/−1
• Control/Joint/Abilities/Adaptable.hs +208/−2
• Control/Joint/Abilities/Completable.hs +6/−0
• Control/Joint/Abilities/Liftable.hs +0/−146
• Control/Joint/Abilities/Transformer.hs +9/−5
• Control/Joint/Effects.hs +1/−0
• Control/Joint/Effects/Either.hs +6/−6
• Control/Joint/Effects/Maybe.hs +9/−9
• Control/Joint/Effects/Reader.hs +6/−6
• Control/Joint/Effects/State.hs +13/−13
• Control/Joint/Effects/Store.hs +20/−0
• Control/Joint/Effects/Writer.hs +6/−6
• Control/Joint/Schemes/TU.hs +11/−1
• Control/Joint/Schemes/TUT.hs +8/−2
• Control/Joint/Schemes/UT.hs +11/−1
• joint.cabal +5/−3

@@ -1,6 +1,6 @@ module Control.Joint.Abilities (module Exports) where -import Control.Joint.Abilities.Liftable as Exports import Control.Joint.Abilities.Adaptable as Exports+import Control.Joint.Abilities.Completable as Exports import Control.Joint.Abilities.Transformer as Exports import Control.Joint.Abilities.Interpreted as Exports

@@ -1,6 +1,212 @@ module Control.Joint.Abilities.Adaptable where +import "transformers" Control.Monad.Trans.Class (MonadTrans (lift))+ import Control.Joint.Core (type (~>))+import Control.Joint.Abilities.Interpreted (Interpreted (run))+import Control.Joint.Abilities.Transformer (Transformer (build), Schema, (:>) (T, trans)) -class Adaptable (subeff :: * -> *) (eff :: * -> *) | subeff -> eff where-	adapt :: subeff ~> eff+class Adaptable (eff :: * -> *) (schema :: * -> *) where+	{-# MINIMAL adapt #-}+	adapt :: eff ~> schema++type Embedding t u = (Transformer t, Monad u)+type Building t u = (Transformer t, Applicative u)++instance Adaptable t t where+	adapt = id++instance (Monad u, MonadTrans ((:>) t)) => Adaptable u (t :> u) where+	adapt = lift++instance Building t u => Adaptable t (t :> u) where+	adapt = build++instance+	( Embedding t (Schema u v)+	, MonadTrans ((:>) t)+	, Building u v+	) => Adaptable u (t :> u :> v) where+	adapt = lift . build++instance+	( Embedding t (Schema u v)+	, Embedding u v+	, MonadTrans ((:>) t)+	, MonadTrans ((:>) u)+	) => Adaptable v (t :> u :> v) where+	adapt = lift . lift++instance+	( Embedding t (Schema u (v :> w))+	, Embedding u (Schema v w)+	, MonadTrans ((:>) t)+	, MonadTrans ((:>) u)+	, Building v w+	) => Adaptable v (t :> u :> v :> w) where+	adapt = lift . lift . build++instance+	( Embedding t (Schema u v)+	, Embedding t (Schema u (v :> w))+	, Embedding u (Schema v w)+	, Embedding v w+	, MonadTrans ((:>) t)+	, MonadTrans ((:>) u)+	, MonadTrans ((:>) v)+	) => Adaptable w (t :> u :> v :> w) where+	adapt = lift . lift . lift++instance (Embedding t (Schema u (v :> w :> x))+	, Embedding u (Schema v (w :> x))+	, Embedding v (Schema w x)+	, Embedding w x+	, MonadTrans ((:>) t)+	, MonadTrans ((:>) u)+	, MonadTrans ((:>) v)+	, MonadTrans ((:>) w)+	) => Adaptable x (t :> u :> v :> w :> x) where+	adapt = lift . lift . lift . lift++instance (Embedding t (Schema u (v :> w :> x))+	, Embedding u (Schema v (w :> x))+	, Embedding v (Schema w x)+	, Building w x+	, MonadTrans ((:>) t)+	, MonadTrans ((:>) u)+	, MonadTrans ((:>) v)+	) => Adaptable w (t :> u :> v :> w :> x) where+	adapt = lift . lift . lift . build++instance+	( Embedding t (Schema u (v :> w :> x :> y))+	, Embedding u (Schema v (w :> x :> y))+	, Embedding v (Schema w (x :> y))+	, Embedding w (Schema x y)+	, Embedding x y+	, MonadTrans ((:>) t)+	, MonadTrans ((:>) u)+	, MonadTrans ((:>) v)+	, MonadTrans ((:>) w)+	, MonadTrans ((:>) x)+	) => Adaptable y (t :> u :> v :> w :> x :> y) where+	adapt = lift . lift . lift . lift . lift++instance+	( Embedding t (Schema u (v :> w :> x :> y))+	, Embedding u (Schema v (w :> x :> y))+	, Embedding v (Schema w (x :> y))+	, Embedding w (Schema x y)+	, Building x y+	, MonadTrans ((:>) t)+	, MonadTrans ((:>) u)+	, MonadTrans ((:>) v)+	, MonadTrans ((:>) w)+	) => Adaptable x (t :> u :> v :> w :> x :> y) where+	adapt = lift . lift . lift . lift . build++instance+	( Embedding t (Schema u (v :> w :> x :> y :> z))+	, Embedding u (Schema v (w :> x :> y :> z))+	, Embedding v (Schema w (x :> y :> z))+	, Embedding w (Schema x (y :> z))+	, Embedding x (Schema y z)+	, Embedding y z+	, MonadTrans ((:>) t)+	, MonadTrans ((:>) u)+	, MonadTrans ((:>) v)+	, MonadTrans ((:>) w)+	, MonadTrans ((:>) x)+	, MonadTrans ((:>) y)+	) => Adaptable z (t :> u :> v :> w :> x :> y :> z) where+	adapt = lift . lift . lift . lift . lift . lift++instance+	( Embedding t (Schema u (v :> w :> x :> y :> z))+	, Embedding u (Schema v (w :> x :> y :> z))+	, Embedding v (Schema w (x :> y :> z))+	, Embedding w (Schema x (y :> z))+	, Embedding x (Schema y z)+	, Building y z+	, MonadTrans ((:>) t)+	, MonadTrans ((:>) u)+	, MonadTrans ((:>) v)+	, MonadTrans ((:>) w)+	, MonadTrans ((:>) x)+	) => Adaptable y (t :> u :> v :> w :> x :> y :> z) where+	adapt = lift . lift . lift . lift . lift . build++instance+	( Embedding t (Schema u (v :> w :> x :> y :> z :> f))+	, Embedding u (Schema v (w :> x :> y :> z :> f))+	, Embedding v (Schema w (x :> y :> z :> f))+	, Embedding w (Schema x (y :> z :> f))+	, Embedding x (Schema y (z :> f))+	, Embedding y (Schema z f)+	, Embedding z f+	, MonadTrans ((:>) t)+	, MonadTrans ((:>) u)+	, MonadTrans ((:>) v)+	, MonadTrans ((:>) w)+	, MonadTrans ((:>) x)+	, MonadTrans ((:>) y)+	, MonadTrans ((:>) z)+	) => Adaptable f (t :> u :> v :> w :> x :> y :> z :> f) where+	adapt = lift . lift . lift . lift . lift . lift . lift++instance+	( Embedding t (Schema u (v :> w :> x :> y :> z :> f))+	, Embedding u (Schema v (w :> x :> y :> z :> f))+	, Embedding v (Schema w (x :> y :> z :> f))+	, Embedding w (Schema x (y :> z :> f))+	, Embedding x (Schema y (z :> f))+	, Embedding y (Schema z f)+	, Building z f+	, MonadTrans ((:>) t)+	, MonadTrans ((:>) u)+	, MonadTrans ((:>) v)+	, MonadTrans ((:>) w)+	, MonadTrans ((:>) x)+	, MonadTrans ((:>) y)+	, MonadTrans ((:>) z)+	) => Adaptable z (t :> u :> v :> w :> x :> y :> z :> f) where+	adapt = lift . lift . lift . lift . lift . lift . build++instance+	( Embedding t (Schema u (v :> w :> x :> y :> z :> f :> h))+	, Embedding u (Schema v (w :> x :> y :> z :> f :> h))+	, Embedding v (Schema w (x :> y :> z :> f :> h))+	, Embedding w (Schema x (y :> z :> f :> h))+	, Embedding x (Schema y (z :> f :> h))+	, Embedding y (Schema z (f :> h))+	, Embedding z (Schema f h)+	, Embedding f h+	, MonadTrans ((:>) t)+	, MonadTrans ((:>) u)+	, MonadTrans ((:>) v)+	, MonadTrans ((:>) w)+	, MonadTrans ((:>) x)+	, MonadTrans ((:>) y)+	, MonadTrans ((:>) z)+	, MonadTrans ((:>) f)+	) => Adaptable h (t :> u :> v :> w :> x :> y :> z :> f :> h) where+	adapt = lift . lift . lift . lift . lift . lift . lift . lift++instance+	( Embedding t (Schema u (v :> w :> x :> y :> z :> f :> h))+	, Embedding u (Schema v (w :> x :> y :> z :> f :> h))+	, Embedding v (Schema w (x :> y :> z :> f :> h))+	, Embedding w (Schema x (y :> z :> f :> h))+	, Embedding x (Schema y (z :> f :> h))+	, Embedding y (Schema z (f :> h))+	, Embedding z (Schema f h)+	, Building f h+	, MonadTrans ((:>) t)+	, MonadTrans ((:>) u)+	, MonadTrans ((:>) v)+	, MonadTrans ((:>) w)+	, MonadTrans ((:>) x)+	, MonadTrans ((:>) y)+	, MonadTrans ((:>) z)+	) => Adaptable f (t :> u :> v :> w :> x :> y :> z :> f :> h) where+	adapt = lift . lift . lift . lift . lift . lift . lift . build

@@ -0,0 +1,6 @@+module Control.Joint.Abilities.Completable where++import Control.Joint.Core (type (~>))++class Completable (subeff :: * -> *) (eff :: * -> *) | subeff -> eff where+	complete :: subeff ~> eff

@@ -1,146 +0,0 @@-module Control.Joint.Abilities.Liftable where--import Control.Joint.Core (type (~>))-import Control.Joint.Abilities.Interpreted (Interpreted (run))-import Control.Joint.Abilities.Transformer (Transformer (Schema, build, embed), (:>) (T, trans))--class Liftable (eff :: * -> *) (schema :: * -> *) where-	{-# MINIMAL lift #-}-	lift :: eff ~> schema--type Embedding t u = (Transformer t, Functor u)-type Building t u = (Transformer t, Applicative u)--instance Liftable t t where-	lift = id--instance Embedding t u => Liftable u (t :> u) where-	lift = embed--instance Building t u => Liftable t (t :> u) where-	lift = build--instance-	( Embedding t (Schema u v)-	, Building u v-	) => Liftable u (t :> u :> v) where-	lift = embed . build--instance-	( Embedding t (Schema u v)-	, Embedding u v-	) => Liftable v (t :> u :> v) where-	lift = embed . embed--instance-	( Embedding t (Schema u (v :> w))-	, Embedding u (Schema v w)-	, Building v w-	) => Liftable v (t :> u :> v :> w) where-	lift = embed . embed . build--instance-	( Embedding t (Schema u v)-	, Embedding t (Schema u (v :> w))-	, Embedding u (Schema v w)-	, Embedding v w-	) => Liftable w (t :> u :> v :> w) where-	lift = embed . embed . embed--instance (Embedding t (Schema u (v :> w :> x))-	, Embedding u (Schema v (w :> x))-	, Embedding v (Schema w x)-	, Embedding w x-	) => Liftable x (t :> u :> v :> w :> x) where-	lift = embed . embed . embed . embed--instance (Embedding t (Schema u (v :> w :> x))-	, Embedding u (Schema v (w :> x))-	, Embedding v (Schema w x)-	, Building w x-	) => Liftable w (t :> u :> v :> w :> x) where-	lift = embed . embed . embed . build--instance-	( Embedding t (Schema u (v :> w :> x :> y))-	, Embedding u (Schema v (w :> x :> y))-	, Embedding v (Schema w (x :> y))-	, Embedding w (Schema x y)-	, Embedding x y-	) => Liftable y (t :> u :> v :> w :> x :> y) where-	lift = embed . embed . embed . embed . embed--instance-	( Embedding t (Schema u (v :> w :> x :> y))-	, Embedding u (Schema v (w :> x :> y))-	, Embedding v (Schema w (x :> y))-	, Embedding w (Schema x y)-	, Building x y-	) => Liftable x (t :> u :> v :> w :> x :> y) where-	lift = embed . embed . embed . embed . build--instance-	( Embedding t (Schema u (v :> w :> x :> y :> z))-	, Embedding u (Schema v (w :> x :> y :> z))-	, Embedding v (Schema w (x :> y :> z))-	, Embedding w (Schema x (y :> z))-	, Embedding x (Schema y z)-	, Embedding y z-	) => Liftable z (t :> u :> v :> w :> x :> y :> z) where-	lift = embed . embed . embed . embed . embed . embed--instance-	( Embedding t (Schema u (v :> w :> x :> y :> z))-	, Embedding u (Schema v (w :> x :> y :> z))-	, Embedding v (Schema w (x :> y :> z))-	, Embedding w (Schema x (y :> z))-	, Embedding x (Schema y z)-	, Building y z-	) => Liftable y (t :> u :> v :> w :> x :> y :> z) where-	lift = embed . embed . embed . embed . embed . build--instance-	( Embedding t (Schema u (v :> w :> x :> y :> z :> f))-	, Embedding u (Schema v (w :> x :> y :> z :> f))-	, Embedding v (Schema w (x :> y :> z :> f))-	, Embedding w (Schema x (y :> z :> f))-	, Embedding x (Schema y (z :> f))-	, Embedding y (Schema z f)-	, Embedding z f-	) => Liftable f (t :> u :> v :> w :> x :> y :> z :> f) where-	lift = embed . embed . embed . embed . embed . embed . embed--instance-	( Embedding t (Schema u (v :> w :> x :> y :> z :> f))-	, Embedding u (Schema v (w :> x :> y :> z :> f))-	, Embedding v (Schema w (x :> y :> z :> f))-	, Embedding w (Schema x (y :> z :> f))-	, Embedding x (Schema y (z :> f))-	, Embedding y (Schema z f)-	, Building z f-	) => Liftable z (t :> u :> v :> w :> x :> y :> z :> f) where-	lift = embed . embed . embed . embed . embed . embed . build--instance-	( Embedding t (Schema u (v :> w :> x :> y :> z :> f :> h))-	, Embedding u (Schema v (w :> x :> y :> z :> f :> h))-	, Embedding v (Schema w (x :> y :> z :> f :> h))-	, Embedding w (Schema x (y :> z :> f :> h))-	, Embedding x (Schema y (z :> f :> h))-	, Embedding y (Schema z (f :> h))-	, Embedding z (Schema f h)-	, Embedding f h-	) => Liftable h (t :> u :> v :> w :> x :> y :> z :> f :> h) where-	lift = embed . embed . embed . embed . embed . embed . embed . embed--instance-	( Embedding t (Schema u (v :> w :> x :> y :> z :> f :> h))-	, Embedding u (Schema v (w :> x :> y :> z :> f :> h))-	, Embedding v (Schema w (x :> y :> z :> f :> h))-	, Embedding w (Schema x (y :> z :> f :> h))-	, Embedding x (Schema y (z :> f :> h))-	, Embedding y (Schema z (f :> h))-	, Embedding z (Schema f h)-	, Building f h-	) => Liftable f (t :> u :> v :> w :> x :> y :> z :> f :> h) where-	lift = embed . embed . embed . embed . embed . embed . embed . build

@@ -1,14 +1,15 @@-module Control.Joint.Abilities.Transformer (Transformer (..), (:>) (..)) where+module Control.Joint.Abilities.Transformer where -import Control.Applicative (Alternative (empty, (<|>)))+import "base" Control.Applicative (Alternative (empty, (<|>)))+import "transformers" Control.Monad.Trans.Class (MonadTrans (lift))  import Control.Joint.Core (type (~>)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run)) +type family Schema (t :: * -> *) = (r :: (* -> *) -> * -> *) | r -> t+ class Interpreted t => Transformer t where-	{-# MINIMAL embed, build, unite #-}-	type Schema (t :: * -> *) = (r :: (* -> *) -> * -> *) | r -> t-	embed :: Functor u => u ~> t :> u+	{-# MINIMAL build, unite #-} 	build :: Applicative u => t ~> t :> u 	unite :: Primary (Schema t u) a -> (t :> u) a @@ -32,3 +33,6 @@ instance (Interpreted (Schema t u), Transformer t) => Interpreted (t :> u) where 	type Primary (t :> u) a = Primary (Schema t u) a 	run (T x) = run x++instance MonadTrans (Schema t) => MonadTrans ((:>) t) where+	lift = T . lift

@@ -2,6 +2,7 @@  import Control.Joint.Effects.Maybe as Exports import Control.Joint.Effects.Either as Exports+import Control.Joint.Effects.Store as Exports import Control.Joint.Effects.State as Exports import Control.Joint.Effects.Writer as Exports import Control.Joint.Effects.Reader as Exports

@@ -2,17 +2,17 @@  import Control.Joint.Operators ((<$$>), (<**>)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run))-import Control.Joint.Abilities.Transformer (Transformer (Schema, embed, build, unite), (:>) (T))-import Control.Joint.Abilities.Liftable (Liftable (lift))+import Control.Joint.Abilities.Transformer (Transformer (build, unite), Schema, (:>) (T))+import Control.Joint.Abilities.Adaptable (Adaptable (adapt)) import Control.Joint.Schemes (UT (UT))  instance Interpreted (Either e) where 	type Primary (Either e) a = Either e a 	run x = x +type instance Schema (Either e) = UT (Either e)+ instance Transformer (Either e) where-	type Schema (Either e) = UT (Either e)-	embed x = T . UT $ Right <$> x 	build x = T . UT . pure $ x 	unite = T . UT @@ -26,7 +26,7 @@ instance (Applicative u, Monad u) => Monad (UT (Either e) u) where 	UT x >>= f = UT $ x >>= either (pure . Left) (run . f) -type Failable e = Liftable (Either e)+type Failable e = Adaptable (Either e)  failure :: Failable e t => e -> t a-failure = lift . Left+failure = adapt . Left

@@ -1,19 +1,19 @@ module Control.Joint.Effects.Maybe where  import Control.Joint.Operators ((<$$>), (<**>))-import Control.Joint.Abilities.Adaptable (Adaptable (adapt))+import Control.Joint.Abilities.Completable (Completable (complete)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run))-import Control.Joint.Abilities.Transformer (Transformer (Schema, embed, build, unite), (:>) (T))-import Control.Joint.Abilities.Liftable (Liftable (lift))+import Control.Joint.Abilities.Transformer (Transformer (build, unite), Schema, (:>) (T))+import Control.Joint.Abilities.Adaptable (Adaptable (adapt)) import Control.Joint.Schemes (UT (UT))  instance Interpreted Maybe where 	type Primary Maybe a = Maybe a 	run x = x +type instance Schema Maybe = UT Maybe+ instance Transformer Maybe where-	type Schema Maybe = UT Maybe-	embed x = T . UT $ Just <$> x 	build x = T . UT . pure $ x 	unite = T . UT @@ -27,10 +27,10 @@ instance (Applicative u, Monad u) => Monad (UT Maybe u) where 	UT x >>= f = UT $ x >>= maybe (pure Nothing) (run . f) -instance Adaptable (Either e) Maybe where-	adapt = either (const Nothing) Just+instance Completable (Either e) Maybe where+	complete = either (const Nothing) Just -type Optional = Liftable Maybe+type Optional = Adaptable Maybe  nothing :: Optional t => t a-nothing = lift Nothing+nothing = adapt Nothing

@@ -2,8 +2,8 @@  import Control.Joint.Operators ((<$$>), (<**>)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run))-import Control.Joint.Abilities.Transformer (Transformer (Schema, embed, build, unite), (:>) (T))-import Control.Joint.Abilities.Liftable (Liftable (lift))+import Control.Joint.Abilities.Transformer (Transformer (build, unite), Schema, (:>) (T))+import Control.Joint.Abilities.Adaptable (Adaptable (adapt)) import Control.Joint.Schemes (TU (TU))  newtype Reader e a = Reader (e -> a)@@ -22,9 +22,9 @@ 	type Primary (Reader e) a = (->) e a 	run (Reader x) = x +type instance Schema (Reader e) = TU ((->) e)+ instance Transformer (Reader e) where-	type Schema (Reader e) = TU ((->) e)-	embed x = T . TU . const $ x 	build x = T. TU $ pure <$> run x 	unite = T . TU @@ -38,7 +38,7 @@ instance (Applicative u, Monad u) => Monad (TU ((->) e) u) where 	TU x >>= f = TU $ \e -> x e >>= ($ e) . run . f -type Configured e = Liftable (Reader e)+type Configured e = Adaptable (Reader e)  get :: Configured e t => t e-get = lift $ Reader id+get = adapt $ Reader id

@@ -3,10 +3,10 @@ import Control.Applicative (Alternative (empty, (<|>)))  import Control.Joint.Core (type (:.), type (:=))-import Control.Joint.Abilities.Adaptable (Adaptable (adapt))+import Control.Joint.Abilities.Completable (Completable (complete)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run))-import Control.Joint.Abilities.Transformer (Transformer (Schema, embed, build, unite), (:>) (T))-import Control.Joint.Abilities.Liftable (Liftable (lift))+import Control.Joint.Abilities.Transformer (Transformer (build, unite), Schema, (:>) (T))+import Control.Joint.Abilities.Adaptable (Adaptable (adapt)) import Control.Joint.Schemes (TUT (TUT)) import Control.Joint.Effects.Reader (Reader (Reader)) import Control.Joint.Effects.Writer (Writer (Writer))@@ -32,9 +32,9 @@ 	type Primary (State s) a = (->) s :. (,) s := a 	run (State x) = x +type instance Schema (State s) = TUT ((->) s) ((,) s)+ instance Transformer (State s) where-	type Schema (State s) = TUT ((->) s) ((,) s)-	embed x = T . TUT $ \s -> (s,) <$> x 	build x = T . TUT $ pure <$> run x 	unite = T . TUT @@ -52,19 +52,19 @@ 	TUT x <|> TUT y = TUT $ \s -> x s <|> y s 	empty = TUT $ \_ -> empty -instance Adaptable (Reader e) (State e) where-	adapt (Reader f) = State (\e -> (e, f e))+instance Completable (Reader e) (State e) where+	complete (Reader f) = State (\e -> (e, f e)) -instance Adaptable (Writer e) (State e) where-	adapt (Writer (e, x)) = State (\e -> (e, x))+instance Completable (Writer e) (State e) where+	complete (Writer (e, x)) = State (\e -> (e, x)) -type Stateful e = Liftable (State e)+type Stateful e = Adaptable (State e)  modify :: Stateful s t => (s -> s) -> t ()-modify f = lift $ State $ \s -> (f s, ())+modify f = adapt $ State $ \s -> (f s, ())  current :: Stateful s t => t s-current = lift $ State $ \s -> (s, s)+current = adapt $ State $ \s -> (s, s)  replace :: Stateful s t => s -> t ()-replace new = lift $ State $ \_ -> (new, ())+replace new = adapt $ State $ \_ -> (new, ())

@@ -0,0 +1,20 @@+module Control.Joint.Effects.Store where++import "comonad" Control.Comonad (Comonad (extract, extend))++import Control.Joint.Core (type (:.), type (:=))+import Control.Joint.Operators ((<$$>))+import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run))++newtype Store s a = Store ((,) s :. (->) s := a)++instance Functor (Store s) where+	fmap f (Store x) = Store $ f <$$> x++instance Comonad (Store s) where+	extend f (Store (s, g)) = Store (s, \s' -> f (Store (s', g)))+	extract (Store (s, g)) = g s++instance Interpreted (Store s) where+	type Primary (Store s) a = (,) s :. (->) s := a+	run (Store x) = x

@@ -2,8 +2,8 @@  import Control.Joint.Operators ((<$$>), (<**>)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run))-import Control.Joint.Abilities.Transformer (Transformer (Schema, embed, build, unite), (:>) (T))-import Control.Joint.Abilities.Liftable (Liftable (lift))+import Control.Joint.Abilities.Transformer (Transformer (build, unite), Schema, (:>) (T))+import Control.Joint.Abilities.Adaptable (Adaptable (adapt)) import Control.Joint.Schemes (UT (UT))  newtype Writer e a = Writer (e, a)@@ -24,9 +24,9 @@ 	type Primary (Writer e) a = (e, a) 	run (Writer x) = x +type instance Schema (Writer e) = UT ((,) e)+ instance Monoid e => Transformer (Writer e) where-	type Schema (Writer e) = UT ((,) e)-	embed x = T . UT $ (,) mempty <$> x 	build = T . UT . pure . run 	unite = T . UT @@ -40,7 +40,7 @@ instance (Monoid e, Applicative u, Monad u) => Monad (UT ((,) e) u) where 	UT x >>= f = UT $ x >>= \(acc, v) -> (\(acc', y) -> (acc <> acc', y)) <$> run (f v) -type Accumulated e t = Liftable (Writer e) t+type Accumulated e t = Adaptable (Writer e) t  add :: Accumulated e t => e -> t ()-add s = lift $ Writer (s, ())+add s = adapt $ Writer (s, ())

@@ -1,5 +1,9 @@-module Control.Joint.Schemes.TU (TU (..)) where+module Control.Joint.Schemes.TU where +import "comonad" Control.Comonad (Comonad (extract))+import "comonad" Control.Comonad.Trans.Class (ComonadTrans (lower))+import "transformers" Control.Monad.Trans.Class (MonadTrans (lift))+ import Control.Joint.Core (type (:.), type (:=)) import Control.Joint.Abilities (Interpreted (Primary, run)) @@ -8,3 +12,9 @@ instance Interpreted (TU t u) where 	type Primary (TU t u) a = t :. u := a 	run (TU x) = x++instance Monad t => MonadTrans (TU t) where+	lift = TU . return++instance Comonad t => ComonadTrans (TU t) where+	lower (TU x) = extract x

@@ -1,11 +1,17 @@-module Control.Joint.Schemes.TUT (TUT (..)) where+module Control.Joint.Schemes.TUT where +import "adjunctions" Data.Functor.Adjunction (Adjunction (leftAdjunct))+import "distributive" Data.Distributive (Distributive (collect))+import "transformers" Control.Monad.Trans.Class (MonadTrans (lift))+ import Control.Joint.Core (type (:.), type (:=)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run)) --- TODO: think about decomposing it on UT and TU newtype TUT t t' u a = TUT (t :. u :. t' := a)  instance Interpreted (TUT t t' u) where 	type Primary (TUT t t' u) a = t :. u :. t' := a 	run (TUT x) = x++instance (Adjunction t' t, Distributive t) => MonadTrans (TUT t t') where+	lift = TUT . collect (leftAdjunct id)

@@ -1,5 +1,9 @@-module Control.Joint.Schemes.UT (UT (..)) where+module Control.Joint.Schemes.UT where +import "comonad" Control.Comonad (Comonad (extract))+import "comonad" Control.Comonad.Trans.Class (ComonadTrans (lower))+import "transformers" Control.Monad.Trans.Class (MonadTrans (lift))+ import Control.Joint.Core (type (:.), type (:=)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run)) @@ -8,3 +12,9 @@ instance Interpreted (UT t u) where 	type Primary (UT t u) a = u :. t := a 	run (UT x) = x++instance Monad t => MonadTrans (UT t) where+	lift x = UT $ return <$> x++instance Comonad t => ComonadTrans (UT t) where+	lower (UT x) = extract <$> x

@@ -1,5 +1,5 @@ name:                joint-version:             0.1.7+version:             0.1.8 synopsis:            Trying to compose non-composable homepage:            https://github.com/iokasimov/joint license:             BSD3@@ -22,8 +22,8 @@     Control.Joint.Abilities     Control.Joint.Abilities.Interpreted     Control.Joint.Abilities.Transformer+    Control.Joint.Abilities.Completable     Control.Joint.Abilities.Adaptable-    Control.Joint.Abilities.Liftable     Control.Joint.Schemes     Control.Joint.Schemes.TU     Control.Joint.Schemes.UT@@ -33,9 +33,10 @@     Control.Joint.Effects.Reader     Control.Joint.Effects.Writer     Control.Joint.Effects.State+    Control.Joint.Effects.Store     Control.Joint.Effects.Maybe     Control.Joint.Effects.Either-  build-depends: base == 4.*, transformers+  build-depends: base == 4.*, transformers, comonad, adjunctions, distributive   default-language: Haskell2010   ghc-options: -fno-warn-tabs   default-extensions:@@ -46,6 +47,7 @@     FunctionalDependencies     LiberalTypeSynonyms     MultiParamTypeClasses+    PackageImports     RankNTypes     TupleSections     TypeFamilies