multistate 0.1.3.2 → 0.2.0.0
raw patch · 6 files changed
+102/−93 lines, 6 filesdep −tfp
Dependencies removed: tfp
Files
- example/Example.hs +12/−8
- multistate.cabal +29/−9
- src/Control/Monad/MultiReader.hs +13/−25
- src/Control/Monad/MultiState.hs +13/−25
- src/Data/HList/HList.hs +22/−15
- test/Test.hs +13/−11
example/Example.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-} module Main where @@ -14,7 +16,7 @@ {- Small example showing- 1) a MultiState containing a Char and a [Char],+ 1) a MultiState containing a Char and a String, 2) the polymorphic mGet, 3) how to initially put values into the MultiState using withMultiState, 4) the type inference at work - note that there was no need to annotate@@ -23,16 +25,18 @@ simpleExample :: IO () simpleExample = evalMultiStateT- $ withMultiState 'H'- $ withMultiState "ello, World!"+ $ withMultiState 'H' -- add a Char to the state+ $ withMultiState "ello, World!" -- add a String to the state $ do- -- the monad here is MultiStateT (Cons [Char] (Cons Char Null)) IO+ -- the monad here is MultiStateT '[String, Char] IO let combinedPrint = do c <- mGet cs <- mGet+ -- i <- mGet -- No instance for (Control.Monad.MultiState.ContainsType Int '[])+ -- lift $ print $ (i :: Int) lift $ putStrLn (c:cs) combinedPrint- mSet 'J'+ mSet 'J' -- we set the Char in the state to 'J' combinedPrint -- output:@@ -79,7 +83,7 @@ -- we cannot use any of the account methods here, because state is empty -- logAccount -- -->- -- No instance for (Control.Monad.MultiState.ContainsType Account Null)+ -- No instance for (Control.Monad.MultiState.ContainsType Account '[]) withMultiState (Account 0.0) $ do -- state contains an Account. logAccount modAccount (+10.0)@@ -105,8 +109,8 @@ mapM_ putStrLn $ execWriter accountCalculation ---whatIsNotPossible :: MultiStateT (Cons [Char] Null) IO ()---whatIsNotPossible = mGet >>= (lift . print) -- type ambiguous+-- whatIsNotPossible :: MultiStateT '[String] IO ()+-- whatIsNotPossible = mGet >>= (lift . print) -- type ambiguous -- another thing that is not directly possible is the restriction to -- specific values, i.e. a function
multistate.cabal view
@@ -1,6 +1,6 @@ Name: multistate-Version: 0.1.3.2-Cabal-Version: >= 1.8+Version: 0.2.0.0+Cabal-Version: >= 1.10 Build-Type: Simple license: BSD3 license-file: LICENSE@@ -34,10 +34,10 @@ > $ withMultiState 'H' > $ withMultiState "ello, World!" > $ do- > -- the monad here is MultiStateT (Cons [Char] (Cons Char Null)) IO+ > -- the monad here is MultiStateT '[String, Char] IO > let combinedPrint = do -- no type signature necessary > c <- mGet -- type of mGet inferred to be m Char- > cs <- mGet -- inferred to be m [Char]+ > cs <- mGet -- inferred to be m String > lift $ putStrLn (c:cs) > combinedPrint > mSet 'J' -- similarly for the setter@@ -57,7 +57,7 @@ but the current state does not contain that type, the error message is something like .- > Control.Monad.MultiState.ContainsType Foo Null+ > No instance for (Control.Monad.MultiState.ContainsType Foo '[]) . where @Foo@ is the missing type. .@@ -72,6 +72,21 @@ These "lifting instances" would be necessary to achieve full compatability with existing transformers. Ping me if you find anything specific missing.+ .+ == Changelog+ .+ * 0.2.0.0:+ .+ * Start using DataKinds and TypeOperators to make the HList+ representation more readable. The translation roughly is:+ .+ > Null -> '[]+ > Cons a Null -> '[a]+ > Cons a b -> a ': b+ > TNull -> HNil+ > TCons a b -> a :+: b+ .+ * Remove dependency on `tfp` package. source-repository head type: git@@ -86,6 +101,8 @@ default: False library {+ default-language:+ Haskell2010 exposed-modules: Data.HList.HList Control.Monad.MultiState@@ -94,9 +111,8 @@ build-depends: base >= 4.6 && <4.8, mtl >= 2.1 && <2.3,- tfp >= 0.8 && <0.9, transformers >= 0.3 && <0.5- extensions:+ default-extensions: GADTs TypeFamilies MultiParamTypeClasses@@ -104,11 +120,15 @@ FlexibleInstances OverlappingInstances UndecidableInstances+ TypeOperators+ DataKinds ghc-options: -Wall hs-source-dirs: src } executable multistate-test {+ default-language:+ Haskell2010 if flag(build-test) { buildable: True build-depends:@@ -116,7 +136,6 @@ -- given by library multistate, base,- tfp, transformers } else { buildable: False@@ -127,6 +146,8 @@ } executable multistate-example {+ default-language:+ Haskell2010 if flag(build-example) { buildable: True build-depends:@@ -135,7 +156,6 @@ multistate, base, mtl,- tfp, transformers } else { buildable: False
src/Control/Monad/MultiReader.hs view
@@ -1,9 +1,3 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverlappingInstances #-}-{-# LANGUAGE UndecidableInstances #-}- -- | The multi-valued version of mtl's Reader / ReaderT -- / MonadReader module Control.Monad.MultiReader@@ -20,9 +14,6 @@ , evalMultiReaderT , evalMultiReaderTWithInitial , mapMultiReaderT- -- * re-exports- , Cons -- re-export that stuff to allow writing type signatures.- , Null ) where @@ -41,9 +32,6 @@ , writer , pass ) -import Types.Data.List ( Cons- , Null- , Append ) import Data.Functor.Identity ( Identity ) import Control.Applicative ( Applicative(..) )@@ -76,7 +64,7 @@ } -- | A MultiReader transformer carrying an empty state.-type MultiReaderTNull = MultiReaderT Null+type MultiReaderTNull = MultiReaderT '[] -- | A reader monad parameterized by the list of types x of the environment -- / input to carry.@@ -123,13 +111,13 @@ --instance (Monad m) => MonadMultiReaderRaw a (MultiReaderT a m) where -- mAskRaw = MultiReaderT $ get -instance ContainsType a (Cons a xs) where- setHListElem a (TCons _ xs) = TCons a xs- getHListElem (TCons x _) = x+instance ContainsType a (a ': xs) where+ setHListElem a (_ :+: xs) = a :+: xs+ getHListElem (x :+: _) = x -instance (ContainsType a xs) => ContainsType a (Cons x xs) where- setHListElem a (TCons x xs) = TCons x $ setHListElem a xs- getHListElem (TCons _ xs) = getHListElem xs+instance (ContainsType a xs) => ContainsType a (x ': xs) where+ setHListElem a (x :+: xs) = x :+: setHListElem a xs+ getHListElem (_ :+: xs) = getHListElem xs instance (Functor f) => Functor (MultiReaderT x f) where fmap f = MultiReaderT . fmap f . runMultiReaderTRaw@@ -151,11 +139,11 @@ -- Think "Execute this computation with this additional value as environment". withMultiReader :: Monad m => x- -> MultiReaderT (Cons x xs) m a+ -> MultiReaderT (x ': xs) m a -> MultiReaderT xs m a withMultiReader x k = MultiReaderT $ do s <- get- (a, TCons _ s') <- lift $ runStateT (runMultiReaderTRaw k) (TCons x s)+ (a, _ :+: s') <- lift $ runStateT (runMultiReaderTRaw k) (x :+: s) put s' return a @@ -171,8 +159,8 @@ => HList xs -> MultiReaderT (Append xs ys) m a -> MultiReaderT ys m a-withMultiReaders TNull = id-withMultiReaders (TCons x xs) = withMultiReaders xs . withMultiReader x+withMultiReaders HNil = id+withMultiReaders (x :+: xs) = withMultiReaders xs . withMultiReader x instance (Monad m, ContainsType a c) => MonadMultiReader a (MultiReaderT c m) where@@ -198,8 +186,8 @@ -- * 'evalMultiReaderTWithInitial' -- * simplify the computation using 'withMultiReader' / 'withMultiReaders', -- then use 'evalMultiReaderT' on the result.-evalMultiReaderT :: Monad m => MultiReaderT Null m a -> m a-evalMultiReaderT k = evalStateT (runMultiReaderTRaw k) TNull+evalMultiReaderT :: Monad m => MultiReaderT '[] m a -> m a+evalMultiReaderT k = evalStateT (runMultiReaderTRaw k) HNil -- | Evaluate a reader computation with the given environment. evalMultiReaderTWithInitial :: Monad m
src/Control/Monad/MultiState.hs view
@@ -1,9 +1,3 @@-{-# LANGUAGE GADTs #-}-{-# LANGUAGE MultiParamTypeClasses #-}-{-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE OverlappingInstances #-}-{-# LANGUAGE UndecidableInstances #-}- -- | The multi-valued version of mtl's State / StateT -- / MonadState module Control.Monad.MultiState@@ -21,9 +15,6 @@ , evalMultiStateT , evalMultiStateTWithInitial , mapMultiStateT- -- * re-exports- , Cons -- re-export that stuff to allow writing type signatures.- , Null ) where @@ -42,9 +33,6 @@ , writer , pass ) -import Types.Data.List ( Cons- , Null- , Append ) import Data.Functor.Identity ( Identity ) import Control.Applicative ( Applicative(..) )@@ -77,7 +65,7 @@ } -- | A MultiState transformer carrying an empty state.-type MultiStateTNull = MultiStateT Null+type MultiStateTNull = MultiStateT '[] -- | A state monad parameterized by the list of types x of the state to carry. --@@ -98,13 +86,13 @@ -- | state get function for values of type @a@. mGet :: m a -instance ContainsType a (Cons a xs) where- setHListElem a (TCons _ xs) = TCons a xs- getHListElem (TCons x _) = x+instance ContainsType a (a ': xs) where+ setHListElem a (_ :+: xs) = a :+: xs+ getHListElem (x :+: _) = x -instance (ContainsType a xs) => ContainsType a (Cons x xs) where- setHListElem a (TCons x xs) = TCons x $ setHListElem a xs- getHListElem (TCons _ xs) = getHListElem xs+instance (ContainsType a xs) => ContainsType a (x ': xs) where+ setHListElem a (x :+: xs) = x :+: setHListElem a xs+ getHListElem (_ :+: xs) = getHListElem xs instance (Functor f) => Functor (MultiStateT x f) where fmap f = MultiStateT . fmap f . runMultiStateTRaw@@ -126,13 +114,13 @@ -- Think "Execute this computation with this additional value as state". withMultiState :: Monad m => x -- ^ The value to add- -> MultiStateT (Cons x xs) m a -- ^ The computation using the+ -> MultiStateT (x ': xs) m a -- ^ The computation using the -- enlarged state -> MultiStateT xs m a -- ^ An computation using the -- smaller state withMultiState x k = MultiStateT $ do s <- get- (a, TCons _ s') <- lift $ runStateT (runMultiStateTRaw k) (TCons x s)+ (a, _ :+: s') <- lift $ runStateT (runMultiStateTRaw k) (x :+: s) put s' return a @@ -150,8 +138,8 @@ -- enlarged state -> MultiStateT ys m a -- ^ A computation using the -- smaller state-withMultiStates TNull = id-withMultiStates (TCons x xs) = withMultiStates xs . withMultiState x+withMultiStates HNil = id+withMultiStates (x :+: xs) = withMultiStates xs . withMultiState x instance (Monad m, ContainsType a c) => MonadMultiState a (MultiStateT c m) where@@ -177,8 +165,8 @@ -- * 'evalMultiStateTWithInitial' -- * simplify the computation using 'withMultiState' / 'withMultiStates', -- then use 'evalMultiStateT' on the result.-evalMultiStateT :: Monad m => MultiStateT Null m a -> m a-evalMultiStateT k = evalStateT (runMultiStateTRaw k) TNull+evalMultiStateT :: Monad m => MultiStateT '[] m a -> m a+evalMultiStateT k = evalStateT (runMultiStateTRaw k) HNil -- | Evaluate a state computation with the given initial state. evalMultiStateTWithInitial :: Monad m
src/Data/HList/HList.hs view
@@ -1,5 +1,7 @@ {-# LANGUAGE GADTs #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-} -- | A GADT HList implementation --@@ -7,35 +9,40 @@ -- for something so simple. module Data.HList.HList ( HList(..)+ , Append ) where import Prelude hiding (reverse) -import Types.Data.List ( Cons, Null ) import Data.Monoid -data HList a where- TCons :: x -> HList xs -> HList (Cons x xs)- TNull :: HList Null+data HList :: [*] -> * where+ HNil :: HList '[]+ (:+:) :: x -> HList xs -> HList (x ': xs)+ -- TCons :: x -> HList xs -> HList (Cons x xs)+ -- TNull :: HList Null -instance Show (HList Null) where+instance Show (HList '[]) where show _ = "()" -instance (Show a, Show (HList b)) => Show (HList (Cons a b)) where- show (TCons x y) = "(" ++ show x ++ "," ++ show y ++ ")"+instance (Show a, Show (HList b)) => Show (HList (a ': b)) where+ show (x :+: y) = "(" ++ show x ++ "," ++ show y ++ ")" -instance Monoid (HList Null) where- mempty = TNull- mappend _ _ = TNull+instance Monoid (HList '[]) where+ mempty = HNil+ mappend _ _ = HNil instance (Monoid x, Monoid (HList xs))- => Monoid (HList (Cons x xs))+ => Monoid (HList (x ': xs)) where- mempty = TCons mempty mempty- mappend (TCons x1 xs1) (TCons x2 xs2) =- TCons (x1 `mappend` x2)- (xs1 `mappend` xs2)+ mempty = mempty :+: mempty+ mappend (x1 :+: xs1) (x2 :+: xs2) = (x1 `mappend` x2)+ :+: (xs1 `mappend` xs2)++type family Append (l1::[*]) (l2::[*]) :: [*]+type instance Append '[] l2 = l2+type instance Append (car1 ': cdr2) l2 = car1 ': Append cdr2 l2
test/Test.hs view
@@ -1,3 +1,6 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+ module Main where @@ -5,7 +8,6 @@ import Data.Functor.Identity import qualified Control.Monad.MultiState as MS import qualified Control.Monad.MultiReader as MR-import Types.Data.List ( Cons, Null ) import Control.Applicative ( Applicative, (<$>), (<*>) ) @@ -13,32 +15,32 @@ type Tests = [(Bool, String)] -runEvalMS :: MS.MultiStateT Null Identity a -> a+runEvalMS :: MS.MultiStateT '[] Identity a -> a runEvalMS = runIdentity . MS.evalMultiStateT-runEvalMR :: MR.MultiReaderT Null Identity a -> a+runEvalMR :: MR.MultiReaderT '[] Identity a -> a runEvalMR = runIdentity . MR.evalMultiReaderT -runnerMS :: a -> MS.MultiStateT (Cons a Null) Identity a -> a+runnerMS :: a -> MS.MultiStateT '[a] Identity a -> a runnerMS x m = runIdentity $ MS.evalMultiStateT $ MS.withMultiState x m-runnerMR :: a -> MR.MultiReaderT (Cons a Null) Identity a -> a+runnerMR :: a -> MR.MultiReaderT '[a] Identity a -> a runnerMR x m = runIdentity $ MR.evalMultiReaderT $ MR.withMultiReader x m -runnerMS_ :: a -> MS.MultiStateT (Cons a Null) Identity b -> a+runnerMS_ :: a -> MS.MultiStateT '[a] Identity b -> a runnerMS_ x m = runIdentity $ MS.evalMultiStateT $ MS.withMultiState x (m >> MS.mGet)-runnerMR_ :: a -> MR.MultiReaderT (Cons a Null) Identity b -> a+runnerMR_ :: a -> MR.MultiReaderT '[a] Identity b -> a runnerMR_ x m = runIdentity $ MR.evalMultiReaderT $ MR.withMultiReader x (m >> MR.mAsk) -intRunnerMS :: Int -> MS.MultiStateT (Cons Int Null) Identity Int -> Int+intRunnerMS :: Int -> MS.MultiStateT '[Int] Identity Int -> Int intRunnerMS = runnerMS-intRunnerMS_ :: Int -> MS.MultiStateT (Cons Int Null) Identity b -> Int+intRunnerMS_ :: Int -> MS.MultiStateT '[Int] Identity b -> Int intRunnerMS_ = runnerMS_-intRunnerMR :: Int -> MR.MultiReaderT (Cons Int Null) Identity Int -> Int+intRunnerMR :: Int -> MR.MultiReaderT '[Int] Identity Int -> Int intRunnerMR = runnerMR-intRunnerMR_ :: Int -> MR.MultiReaderT (Cons Int Null) Identity b -> Int+intRunnerMR_ :: Int -> MR.MultiReaderT '[Int] Identity b -> Int intRunnerMR_ = runnerMR_ mrAskTuple :: ( Applicative m