joint 0.1.6 → 0.1.7

raw patch · 10 files changed

+79/−25 lines, 10 filesdep +transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: transformers

API changes (from Hackage documentation)

Files

• Control/Joint.hs +1/−0
• Control/Joint/Abilities/Transformer.hs +7/−1
• Control/Joint/Effects/Either.hs +4/−3
• Control/Joint/Effects/Maybe.hs +4/−3
• Control/Joint/Effects/Reader.hs +5/−4
• Control/Joint/Effects/State.hs +14/−6
• Control/Joint/Effects/Writer.hs +4/−3
• Control/Joint/Operators.hs +34/−0
• Control/Joint/Schemes/TUT.hs +3/−3
• joint.cabal +3/−2

@@ -1,5 +1,6 @@ module Control.Joint (module Exports) where +import Control.Joint.Operators as Exports import Control.Joint.Schemes as Exports import Control.Joint.Effects as Exports import Control.Joint.Abilities as Exports

@@ -1,11 +1,13 @@ module Control.Joint.Abilities.Transformer (Transformer (..), (:>) (..)) where +import Control.Applicative (Alternative (empty, (<|>)))+ import Control.Joint.Core (type (~>)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run))  class Interpreted t => Transformer t where 	{-# MINIMAL embed, build, unite #-}-	type Schema (t :: * -> *) (u :: * -> *) = (r :: * -> *) | r -> t u+	type Schema (t :: * -> *) = (r :: (* -> *) -> * -> *) | r -> t 	embed :: Functor u => u ~> t :> u 	build :: Applicative u => t ~> t :> u 	unite :: Primary (Schema t u) a -> (t :> u) a@@ -19,6 +21,10 @@ instance (Transformer t, Applicative (Schema t u)) => Applicative (t :> u) where 	pure = T . pure 	T f <*> T x = T $ f <*> x++instance (Transformer t, Alternative (Schema t u)) => Alternative (t :> u) where+	empty = T empty+	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,5 +1,6 @@ module Control.Joint.Effects.Either where +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))@@ -10,17 +11,17 @@ 	run x = x  instance Transformer (Either e) where-	type Schema (Either e) u = UT (Either e) u+	type Schema (Either e) = UT (Either e) 	embed x = T . UT $ Right <$> x 	build x = T . UT . pure $ x 	unite = T . UT  instance Functor u => Functor (UT (Either e) u) where-	fmap f (UT x) = UT $ (fmap . fmap) f x+	fmap f (UT x) = UT $ f <$$> x  instance Applicative u => Applicative (UT (Either e) u) where 	pure = UT . pure . pure-	UT f <*> UT x = UT $ (<*>) <$> f <*> x+	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)

@@ -1,5 +1,6 @@ module Control.Joint.Effects.Maybe where +import Control.Joint.Operators ((<$$>), (<**>)) import Control.Joint.Abilities.Adaptable (Adaptable (adapt)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run)) import Control.Joint.Abilities.Transformer (Transformer (Schema, embed, build, unite), (:>) (T))@@ -11,17 +12,17 @@ 	run x = x  instance Transformer Maybe where-	type Schema Maybe u = UT Maybe u+	type Schema Maybe = UT Maybe 	embed x = T . UT $ Just <$> x 	build x = T . UT . pure $ x 	unite = T . UT  instance Functor u => Functor (UT Maybe u) where-	fmap f (UT x) = UT $ (fmap . fmap) f x+	fmap f (UT x) = UT $ f <$$> x  instance Applicative u => Applicative (UT Maybe u) where 	pure = UT . pure . pure-	UT f <*> UT x = UT $ (<*>) <$> f <*> x+	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)

@@ -1,5 +1,6 @@ module Control.Joint.Effects.Reader where +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))@@ -22,17 +23,17 @@ 	run (Reader x) = x  instance Transformer (Reader e) where-	type Schema (Reader e) u = TU ((->) e) u+	type Schema (Reader e) = TU ((->) e) 	embed x = T . TU . const $ x 	build x = T. TU $ pure <$> run x 	unite = T . TU  instance Functor u => Functor (TU ((->) e) u) where-	fmap f (TU x) = TU $ \r -> f <$> x r+	fmap f (TU x) = TU $ f <$$> x  instance Applicative u => Applicative (TU ((->) e) u) where 	pure = TU . pure . pure-	TU f <*> TU x = TU $ \r -> f r <*> x r+	TU f <*> TU x = TU $ f <**> x  instance (Applicative u, Monad u) => Monad (TU ((->) e) u) where 	TU x >>= f = TU $ \e -> x e >>= ($ e) . run . f@@ -40,4 +41,4 @@ type Configured e = Liftable (Reader e)  get :: Configured e t => t e-get = lift $ Reader $ \e -> e+get = lift $ Reader id

@@ -1,5 +1,7 @@ module Control.Joint.Effects.State where +import Control.Applicative (Alternative (empty, (<|>)))+ import Control.Joint.Core (type (:.), type (:=)) import Control.Joint.Abilities.Adaptable (Adaptable (adapt)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run))@@ -20,8 +22,7 @@ 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)+		let (new, g) = f old in g <$> x new  instance Monad (State s) where 	State x >>= f = State $ \old ->@@ -32,21 +33,25 @@ 	run (State x) = x  instance Transformer (State s) where-	type Schema (State s) u = TUT ((->) s) u ((,) s)+	type Schema (State s) = TUT ((->) s) ((,) s) 	embed x = T . TUT $ \s -> (s,) <$> x 	build x = T . TUT $ pure <$> run x 	unite = T . TUT -instance Functor u => Functor (TUT ((->) s) u ((,) s)) where+instance Functor u => Functor (TUT ((->) s) ((,) s)  u) where 	fmap f (TUT x) = TUT $ \old -> (fmap . fmap) f $ x old -instance Monad u => Applicative (TUT ((->) s) u ((,) s)) where+instance Monad u => Applicative (TUT ((->) s) ((,) s) u) 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+instance Monad u => Monad (TUT ((->) s) ((,) s) u) where 	TUT x >>= f = TUT $ \old -> x old >>= \(new, y) -> ($ new) . run . f $ y +instance (Alternative u, Monad u) => Alternative (TUT ((->) s) ((,) s) u) where+	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)) @@ -60,3 +65,6 @@  current :: Stateful s t => t s current = lift $ State $ \s -> (s, s)++replace :: Stateful s t => s -> t ()+replace new = lift $ State $ \_ -> (new, ())

@@ -1,5 +1,6 @@ module Control.Joint.Effects.Writer where +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))@@ -24,17 +25,17 @@ 	run (Writer x) = x  instance Monoid e => Transformer (Writer e) where-	type Schema (Writer e) u = UT ((,) e) u+	type Schema (Writer e) = UT ((,) e) 	embed x = T . UT $ (,) mempty <$> x 	build = T . UT . pure . run 	unite = T . UT  instance Functor u => Functor (UT ((,) e) u) where-	fmap f (UT x) = UT $ (fmap . fmap) f x+	fmap f (UT x) = UT $ f <$$> x  instance (Monoid e, Applicative u) => Applicative (UT ((,) e) u) where 	pure = UT . pure . pure-	UT f <*> UT x = UT $ (<*>) <$> f <*> x+	UT f <*> UT x = UT $ f <**> x  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)

@@ -0,0 +1,34 @@+module Control.Joint.Operators where++import Control.Joint.Core ((:.), (:=))++(<$$>) :: (Functor t, Functor u) => (a -> b) -> t :. u := a -> t :. u := b+(<$$>) = (<$>) . (<$>)++(<$$$>) :: (Functor t, Functor u, Functor v)+	=> (a -> b) -> t :. u :. v := a -> t :. u :. v := b+(<$$$>) = (<$>) . (<$>) . (<$>)++(<$$$$>) :: (Functor t, Functor u, Functor v, Functor w)+	=> (a -> b) -> t :. u :. v :. w := a -> t :. u :. v :. w := b+(<$$$$>) = (<$>) . (<$>) . (<$>) . (<$>)+++(<**>) :: (Applicative t, Applicative u) => t :. u := (a -> b) -> t :. u := a -> t :. u := b+f <**> x = (<*>) <$> f <*> x++(<***>) :: (Applicative t, Applicative u, Applicative v) => t :. u :. v := (a -> b)+	-> t :. u :. v := a -> t :. u :. v := b+f <***> x = (<**>) <$> f <*> x++(<****>) :: (Applicative t, Applicative u, Applicative v, Applicative w)+	=> t :. u :. v :. w := (a -> b)+	-> t :. u :. v :. w := a+	-> t :. u :. v :. w := b+f <****> x = (<***>) <$> f <*> x++($>>=) :: (Functor u, Monad t) => (a -> t b) -> u :. t := a -> u :. t := b+f $>>= x = (>>= f) <$> x++(>>=$) :: Monad t => (t b -> c) -> (a -> t b) -> t a -> c+f >>=$ g = f <$> (>>= g)

@@ -4,8 +4,8 @@ import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run))  -- TODO: think about decomposing it on UT and TU-newtype TUT t u t' a = TUT (t :. u :. t' := a)+newtype TUT t t' u a = TUT (t :. u :. t' := a) -instance Interpreted (TUT t u t') where-	type Primary (TUT t u t') a = 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

@@ -1,5 +1,5 @@ name:                joint-version:             0.1.6+version:             0.1.7 synopsis:            Trying to compose non-composable homepage:            https://github.com/iokasimov/joint license:             BSD3@@ -28,13 +28,14 @@     Control.Joint.Schemes.TU     Control.Joint.Schemes.UT     Control.Joint.Schemes.TUT+    Control.Joint.Operators     Control.Joint.Effects     Control.Joint.Effects.Reader     Control.Joint.Effects.Writer     Control.Joint.Effects.State     Control.Joint.Effects.Maybe     Control.Joint.Effects.Either-  build-depends: base == 4.*+  build-depends: base == 4.*, transformers   default-language: Haskell2010   ghc-options: -fno-warn-tabs   default-extensions: