diff --git a/example/Example.hs b/example/Example.hs --- a/example/Example.hs +++ b/example/Example.hs @@ -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 diff --git a/multistate.cabal b/multistate.cabal --- a/multistate.cabal +++ b/multistate.cabal @@ -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 diff --git a/src/Control/Monad/MultiReader.hs b/src/Control/Monad/MultiReader.hs --- a/src/Control/Monad/MultiReader.hs +++ b/src/Control/Monad/MultiReader.hs @@ -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 diff --git a/src/Control/Monad/MultiState.hs b/src/Control/Monad/MultiState.hs --- a/src/Control/Monad/MultiState.hs +++ b/src/Control/Monad/MultiState.hs @@ -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 diff --git a/src/Data/HList/HList.hs b/src/Data/HList/HList.hs --- a/src/Data/HList/HList.hs +++ b/src/Data/HList/HList.hs @@ -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 diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -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