joint 0.1.8 → 0.1.9

raw patch · 14 files changed

+89/−31 lines, 14 files

Files

• Control/Joint.hs +2/−1
• Control/Joint/Concepts.hs +3/−0
• Control/Joint/Concepts/Lens.hs +27/−0
• Control/Joint/Core.hs +2/−3
• Control/Joint/Effects/Either.hs +4/−4
• Control/Joint/Effects/Maybe.hs +4/−4
• Control/Joint/Effects/Reader.hs +4/−4
• Control/Joint/Effects/State.hs +10/−9
• Control/Joint/Effects/Store.hs +12/−0
• Control/Joint/Effects/Writer.hs +10/−4
• Control/Joint/Schemes/TU.hs +3/−1
• Control/Joint/Schemes/TUT.hs +2/−0
• Control/Joint/Schemes/UT.hs +2/−0
• joint.cabal +4/−1

@@ -1,7 +1,8 @@ module Control.Joint (module Exports) where -import Control.Joint.Operators as Exports+import Control.Joint.Concepts as Exports import Control.Joint.Schemes as Exports import Control.Joint.Effects as Exports import Control.Joint.Abilities as Exports+import Control.Joint.Operators as Exports import Control.Joint.Core as Exports

@@ -0,0 +1,3 @@+module Control.Joint.Concepts (module Exports) where++import Control.Joint.Concepts.Lens as Exports

@@ -0,0 +1,27 @@+module Control.Joint.Concepts.Lens where++import "comonad" Control.Comonad (extract)++import Control.Joint.Abilities.Adaptable (adapt)+import Control.Joint.Effects.State (Stateful, State (State))+import Control.Joint.Effects.Store (Store (Store), pos, peek, retrofit)++type Lens s t = s -> Store t s++view :: Lens s t -> s -> t+view lens = pos . lens++set :: Lens s t -> t -> s -> s+set lens new = peek new . lens++over :: Lens s t -> (t -> t) -> s -> s+over lens f = extract . retrofit f . lens++zoom :: Stateful bg t => Lens bg ls -> State ls a -> t a+zoom lens (State f) = adapt . State $ (\(Store (p, g)) -> (\(x,y) -> (g x, y)) . f $ p) . lens++_1 :: Lens (a, b) a+_1 (x, y) = Store (x, \x' -> (x', y))++_2 :: Lens (a, b) b+_2 (x, y) = Store (y, \y' -> (x, y'))

@@ -1,8 +1,7 @@ module Control.Joint.Core where -infixr 2 :.-infixr 1 :=-infixr 0 ~>+infixr 0 :=, ~>+infixr 1 :.  -- | Functor composition type (:.) t u a = t (u a)

@@ -4,7 +4,7 @@ import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run)) import Control.Joint.Abilities.Transformer (Transformer (build, unite), Schema, (:>) (T)) import Control.Joint.Abilities.Adaptable (Adaptable (adapt))-import Control.Joint.Schemes (UT (UT))+import Control.Joint.Schemes (UT (UT), type (<.:>))  instance Interpreted (Either e) where 	type Primary (Either e) a = Either e a@@ -16,14 +16,14 @@ 	build x = T . UT . pure $ x 	unite = T . UT -instance Functor u => Functor (UT (Either e) u) where+instance Functor u => Functor (Either e <.:> u) where 	fmap f (UT x) = UT $ f <$$> x -instance Applicative u => Applicative (UT (Either e) u) where+instance Applicative u => Applicative (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+instance (Applicative u, Monad u) => Monad (Either e <.:> u) where 	UT x >>= f = UT $ x >>= either (pure . Left) (run . f)  type Failable e = Adaptable (Either e)

@@ -5,7 +5,7 @@ import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run)) import Control.Joint.Abilities.Transformer (Transformer (build, unite), Schema, (:>) (T)) import Control.Joint.Abilities.Adaptable (Adaptable (adapt))-import Control.Joint.Schemes (UT (UT))+import Control.Joint.Schemes (UT (UT), type (<.:>))  instance Interpreted Maybe where 	type Primary Maybe a = Maybe a@@ -17,14 +17,14 @@ 	build x = T . UT . pure $ x 	unite = T . UT -instance Functor u => Functor (UT Maybe u) where+instance Functor u => Functor (Maybe <.:> u) where 	fmap f (UT x) = UT $ f <$$> x -instance Applicative u => Applicative (UT Maybe u) where+instance Applicative u => Applicative (Maybe <.:> u) where 	pure = UT . pure . pure 	UT f <*> UT x = UT $ f <**> x -instance (Applicative u, Monad u) => Monad (UT Maybe u) where+instance (Applicative u, Monad u) => Monad (Maybe <.:> u) where 	UT x >>= f = UT $ x >>= maybe (pure Nothing) (run . f)  instance Completable (Either e) Maybe where

@@ -4,7 +4,7 @@ import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run)) import Control.Joint.Abilities.Transformer (Transformer (build, unite), Schema, (:>) (T)) import Control.Joint.Abilities.Adaptable (Adaptable (adapt))-import Control.Joint.Schemes (TU (TU))+import Control.Joint.Schemes (TU (TU), type (<:.>))  newtype Reader e a = Reader (e -> a) @@ -28,14 +28,14 @@ 	build x = T. TU $ pure <$> run x 	unite = T . TU -instance Functor u => Functor (TU ((->) e) u) where+instance Functor u => Functor ((->) e <:.> u) where 	fmap f (TU x) = TU $ f <$$> x -instance Applicative u => Applicative (TU ((->) e) u) where+instance Applicative u => Applicative ((->) e <:.> u) where 	pure = TU . pure . pure 	TU f <*> TU x = TU $ f <**> x -instance (Applicative u, Monad u) => Monad (TU ((->) e) u) where+instance (Applicative u, Monad u) => Monad ((->) e <:.> u) where 	TU x >>= f = TU $ \e -> x e >>= ($ e) . run . f  type Configured e = Adaptable (Reader e)

@@ -3,11 +3,12 @@ import Control.Applicative (Alternative (empty, (<|>)))  import Control.Joint.Core (type (:.), type (:=))+import Control.Joint.Operators ((<$$>)) import Control.Joint.Abilities.Completable (Completable (complete)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run)) 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.Schemes (TUT (TUT), type (<:<.>:>)) import Control.Joint.Effects.Reader (Reader (Reader)) import Control.Joint.Effects.Writer (Writer (Writer)) @@ -32,23 +33,23 @@ 	type Primary (State s) a = (->) s :. (,) s := a 	run (State x) = x -type instance Schema (State s) = TUT ((->) s) ((,) s)+type instance Schema (State s) = (->) s <:<.>:> (,) s  instance Transformer (State s) where 	build x = T . TUT $ pure <$> run x 	unite = T . TUT -instance Functor u => Functor (TUT ((->) s) ((,) s)  u) where-	fmap f (TUT x) = TUT $ \old -> (fmap . fmap) f $ x old+instance Functor u => Functor ((->) s <:<.>:> (,) s := u) where+	fmap f (TUT x) = TUT $ \old -> f <$$> x old -instance Monad u => Applicative (TUT ((->) s) ((,) s) u) where+instance Monad u => Applicative ((->) 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+	TUT f <*> TUT x = TUT $ \old -> f old >>= \(new, g) -> g <$$> x new -instance Monad u => Monad (TUT ((->) s) ((,) s) u) where+instance Monad u => Monad ((->) 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+instance (Alternative u, Monad u) => Alternative ((->) s <:<.>:> (,) s := u) where 	TUT x <|> TUT y = TUT $ \s -> x s <|> y s 	empty = TUT $ \_ -> empty @@ -56,7 +57,7 @@ 	complete (Reader f) = State (\e -> (e, f e))  instance Completable (Writer e) (State e) where-	complete (Writer (e, x)) = State (\e -> (e, x))+	complete (Writer (e, x)) = State $ \e -> (e, x)  type Stateful e = Adaptable (State e) 

@@ -18,3 +18,15 @@ instance Interpreted (Store s) where 	type Primary (Store s) a = (,) s :. (->) s := a 	run (Store x) = x++pos :: Store s a -> s+pos (Store (s, _)) = s++seek :: s -> Store s a -> Store s a+seek s (Store (_, f)) = Store (s, f)++peek :: s -> Store s a -> a+peek s (Store (_, f)) = f s++retrofit :: (s -> s) -> Store s a -> Store s a+retrofit g (Store (s, f)) = Store (g s, f)

@@ -1,10 +1,12 @@ module Control.Joint.Effects.Writer where +import Control.Applicative (Alternative (empty, (<|>)))+ import Control.Joint.Operators ((<$$>), (<**>)) import Control.Joint.Abilities.Interpreted (Interpreted (Primary, run)) import Control.Joint.Abilities.Transformer (Transformer (build, unite), Schema, (:>) (T)) import Control.Joint.Abilities.Adaptable (Adaptable (adapt))-import Control.Joint.Schemes (UT (UT))+import Control.Joint.Schemes (UT (UT), type (<.:>) )  newtype Writer e a = Writer (e, a) @@ -30,14 +32,18 @@ 	build = T . UT . pure . run 	unite = T . UT -instance Functor u => Functor (UT ((,) e) u) where+instance Functor u => Functor ((,) e <.:> u) where 	fmap f (UT x) = UT $ f <$$> x -instance (Monoid e, Applicative u) => Applicative (UT ((,) e) u) where+instance (Monoid e, Applicative u) => Applicative ((,) e <.:> u) where 	pure = UT . pure . pure 	UT f <*> UT x = UT $ f <**> x -instance (Monoid e, Applicative u, Monad u) => Monad (UT ((,) e) u) where+instance (Monoid e, Alternative u) => Alternative ((,) e <.:> u) where+	x <|> y = UT $ run x <|> run y+	empty = UT empty++instance (Monoid e, Applicative u, Monad u) => Monad ((,) e <.:> u) where 	UT x >>= f = UT $ x >>= \(acc, v) -> (\(acc', y) -> (acc <> acc', y)) <$> run (f v)  type Accumulated e t = Adaptable (Writer e) t

@@ -9,7 +9,9 @@  newtype TU t u a = TU (t :. u := a) -instance Interpreted (TU t u) where+type (<:.>) = TU++instance Interpreted (t <:.> u) where 	type Primary (TU t u) a = t :. u := a 	run (TU x) = x 

@@ -9,6 +9,8 @@  newtype TUT t t' u a = TUT (t :. u :. t' := a) +type (<:<.>:>) = TUT+ instance Interpreted (TUT t t' u) where 	type Primary (TUT t t' u) a = t :. u :. t' := a 	run (TUT x) = x

@@ -9,6 +9,8 @@  newtype UT t u a = UT (u :. t := a) +type (<.:>) = UT+ instance Interpreted (UT t u) where 	type Primary (UT t u) a = u :. t := a 	run (UT x) = x

@@ -1,5 +1,5 @@ name:                joint-version:             0.1.8+version:             0.1.9 synopsis:            Trying to compose non-composable homepage:            https://github.com/iokasimov/joint license:             BSD3@@ -36,6 +36,8 @@     Control.Joint.Effects.Store     Control.Joint.Effects.Maybe     Control.Joint.Effects.Either+    Control.Joint.Concepts+    Control.Joint.Concepts.Lens   build-depends: base == 4.*, transformers, comonad, adjunctions, distributive   default-language: Haskell2010   ghc-options: -fno-warn-tabs@@ -48,6 +50,7 @@     LiberalTypeSynonyms     MultiParamTypeClasses     PackageImports+    PolyKinds     RankNTypes     TupleSections     TypeFamilies