joint 0.1.2 → 0.1.3

raw patch · 8 files changed

+53/−33 lines, 8 files

Files

Control/Joint/Base/Configured.hs +34/−0
Control/Joint/Base/Either.hs +2/−1
Control/Joint/Base/Maybe.hs +2/−1
Control/Joint/Base/Reader.hs +0/−26
Control/Joint/Base/State.hs +2/−1
Control/Joint/Modulator.hs +7/−0
Control/Joint/Transformer.hs +3/−2
joint.cabal +3/−2

+ Control/Joint/Base/Configured.hs view

@@ -0,0 +1,34 @@+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

Control/Joint/Base/Either.hs view

@@ -1,7 +1,7 @@ module Control.Joint.Base.Either where  import Control.Joint.Composition (Composition (Primary, run))-import Control.Joint.Transformer (Transformer (Schema, embed, build))+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@@ -22,3 +22,4 @@ 	type Schema (Either e) u = UT (Either e) u 	embed x = UT $ Right <$> x 	build x = UT . pure $ x+	unite = UT

Control/Joint/Base/Maybe.hs view

@@ -1,7 +1,7 @@ module Control.Joint.Base.Maybe where  import Control.Joint.Composition (Composition (Primary, run))-import Control.Joint.Transformer (Transformer (Schema, embed, build))+import Control.Joint.Transformer (Transformer (Schema, embed, build, unite)) import Control.Joint.Schemes.UT (UT (UT))  instance Functor u => Functor (UT Maybe u) where@@ -22,3 +22,4 @@ 	type Schema Maybe u = UT Maybe u 	embed x = UT $ Just <$> x 	build x = UT . pure $ x+	unite = UT

− Control/Joint/Base/Reader.hs

@@ -1,26 +0,0 @@-module Control.Joint.Base.Reader where--import Control.Joint.Composition (Composition (Primary, run))-import Control.Joint.Transformer (Transformer (Schema, embed, build))-import Control.Joint.Schemes.TU (TU (TU))--newtype Reader e a = Reader (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 (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

Control/Joint/Base/State.hs view

@@ -2,7 +2,7 @@  import Control.Joint.Core (type (:.), type (:=)) import Control.Joint.Composition (Composition (Primary, run))-import Control.Joint.Transformer (Transformer (Schema, embed, build))+import Control.Joint.Transformer (Transformer (Schema, embed, build, unite)) import Control.Joint.Schemes.TUT (TUT (TUT))  newtype State s a = State ((->) s :. (,) s := a)@@ -31,6 +31,7 @@ 	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

+ Control/Joint/Modulator.hs view

@@ -0,0 +1,7 @@+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

Control/Joint/Transformer.hs view

@@ -1,13 +1,14 @@ module Control.Joint.Transformer (Transformer (..), type (:>)) where  import Control.Joint.Core (type (~>))-import Control.Joint.Composition (Composition)+import Control.Joint.Composition (Composition (Primary))  class Composition t => Transformer t where-	{-# MINIMAL embed, build #-}+	{-# 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

joint.cabal view

@@ -1,5 +1,5 @@ name:                joint-version:             0.1.2+version:             0.1.3 synopsis:            Trying to compose non-composable homepage:            https://github.com/iokasimov/joint license:             BSD3@@ -20,13 +20,14 @@     Control.Joint.Core     Control.Joint.Composition     Control.Joint.Transformer+    Control.Joint.Modulator     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.Reader     Control.Joint.Base.State   build-depends: base == 4.*   default-language: Haskell2010