multistate 0.3.0.0 → 0.6.0.0

raw patch · 25 files changed

+2930/−689 lines, 25 filesdep +hspecdep +taggedPVP ok

version bump matches the API change (PVP)

Dependencies added: hspec, tagged

API changes (from Hackage documentation)

Files

• README.md +153/−0
• changelog.md +83/−0
• example/Example.hs +5/−3
• multistate.cabal +47/−30
• src/Control/Monad/MultiReader.hs +20/−211
• src/Control/Monad/MultiState.hs +32/−190
• src/Control/Monad/MultiWriter.hs +28/−144
• src/Control/Monad/Trans/MultiRWS.hs +61/−0
• src/Control/Monad/Trans/MultiRWS/Lazy.hs +405/−0
• src/Control/Monad/Trans/MultiRWS/Strict.hs +405/−0
• src/Control/Monad/Trans/MultiReader.hs +33/−0
• src/Control/Monad/Trans/MultiReader/Class.hs +53/−0
• src/Control/Monad/Trans/MultiReader/Lazy.hs +175/−0
• src/Control/Monad/Trans/MultiReader/Strict.hs +175/−0
• src/Control/Monad/Trans/MultiState.hs +48/−0
• src/Control/Monad/Trans/MultiState/Class.hs +29/−0
• src/Control/Monad/Trans/MultiState/Lazy.hs +245/−0
• src/Control/Monad/Trans/MultiState/Strict.hs +243/−0
• src/Control/Monad/Trans/MultiWriter.hs +40/−0
• src/Control/Monad/Trans/MultiWriter/Class.hs +24/−0
• src/Control/Monad/Trans/MultiWriter/Lazy.hs +222/−0
• src/Control/Monad/Trans/MultiWriter/Strict.hs +222/−0
• src/Data/HList/ContainsType.hs +23/−0
• src/Data/HList/HList.hs +27/−2
• test/Test.hs +132/−109

@@ -0,0 +1,153 @@+# multistate++[![Build Status](https://secure.travis-ci.org/lspitzner/multistate.svg)](http://travis-ci.org/lspitzner/multistate)++## Introduction++When using multiple Reader/Writer/State transformers in the same monad+stack, it becomes necessary to lift the operations in order to affect a+specific transformer.+Using heterogeneous lists (and all kinds of GHC extensions magic),+this package provides transformers that remove that necessity:+MultiReaderT/MultiWriterT/MultiStateT can contain a heterogeneous+list of values.++The type inferred for the getter/setter determines which value is+read/written.++## Example++~~~~+simpleExample :: IO ()+simpleExample = evalMultiStateT          -- start with an empty state,+                                         --   i.e. :: MultiStateT '[] IO+              $ withMultiState 'H'       -- "adding" a char to the state+              $ withMultiState "ello, World!" -- and a string+              $ do                       -- so:+  -- 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 String+        lift $ putStrLn (c:cs)+  combinedPrint+  mSet 'J'                     -- we modify the Char in the state.+                               -- again, the type is inferred,+                               -- without any manual lifting.+  combinedPrint+~~~~++The output is:++~~~~+Hello, World!+Jello, World!+~~~~++( you can find both this and a more complex example+  in an executable in the package. )++## Error Messages++If you try to execute an action that requires a specific type in the state,+but the current state does not contain that type, the error message is+something like++~~~~+No instance for (Control.Monad.MultiState.ContainsType Foo '[]) x+~~~~++where `Foo` is the missing type.++## Compatibility with Single-Valued Transformers++It is possible to run single-valued actions inside multi-valued+transformers using the `inflate` functions. A function transforming+a multi-valued transformer with exactly one element into a+single-valued transformer would be trivial, but it is currently not provided.++## Naming Scheme++(Will refer to StateT in this paragraph, but equally valid for Reader/Writer)+The mtl monad transformers make use of primarily three methods to "unwrap"+a transformed value:+`runStateT`, `evalStateT`, `execStateT`. These three all have a type+matching the pattern `s -> t m a -> m b`, they differ in what `b` is.+We will use a different naming scheme, for three reasons:++1) "run", "eval" and "exec" are not in any way intuitive, and should be+   suffixed in any case.++2) For MultiStateT, it makes sense to transform an existing transformer,+   adding another state. The signature would be close to that of runStateT,+   only without the unwrapping part, i.e. `s -> t m a -> t' m b`, where `s`+   is the initial state, and `t` is `t'` with another state added.++3) Sometimes you might want to add/run a single state, or a bunch of them.+   For example, when running an arbitrary StateT, you would need to provide+   a HList of initial states, and would receive a HList of final states.++Our naming scheme will instead be:++1) `runStateT.*` unwraps a StateT. A suffix controls+   what exactly is returned by the function. There is a special version for+   when the list of states is Nil, `runStateTNil`.++2) `withStateT.*` adds one or more states to a subcomputation. A suffix+   controls the exact return value.++~~~~+                 withStates+            /-------------------------------------------------------\+            |     withState                withState .. withState   v+StateT '[s, ..] m --------> StateT '[..] m --------> .. --------> StateT '[] m+            |                                                       |+            |                                                       |+            |   runStateT                            runStateTNil   |+            \--------------------> m .. <---------------------------/+~~~~++Specific functions are++~~~~+runMultiStateT = runStateTAS+runMultiStateTA  :: HList s -> MultiStateT s m a -> m a+runMultiStateTAS :: HList s -> MultiStateT s m a -> m (a, s)+runMultiStateTSA :: HList s -> MultiStateT s m a -> m (s, a)+runMultiStateTS  :: HList s -> MultiStateT s m a -> m s+runMultiStateT_  :: HList s -> MultiStateT s m a -> m ()++runMultiStateTNil  :: MultiStateT '[] m a -> m a+runMultiStateTNil_ :: MultiStateT '[] m a -> m ()++withMultiState = withStateAS+withMultiStateA  :: s -> MultiStateT (s ': ss) m a -> MultiStateT ss m a+withMultiStateAS :: s -> MultiStateT (s ': ss) m a -> MultiStateT ss m (a, s)+withMultiStateSA :: s -> MultiStateT (s ': ss) m a -> MultiStateT ss m (s, a)+withMultiStateS  :: s -> MultiStateT (s ': ss) m a -> MultiStateT ss m s+withMultiState_  :: s -> MultiStateT (s ': ss) m a -> MultiStateT ss m ()++withMultiStates = withStatesAS+withMultiStatesAS :: HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m (a, HList s1)+withMultiStatesSA :: HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m (HList s1, a)+withMultiStatesA  :: HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m a+withMultiStatesS  :: HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m (HList s1)+withMultiStates_  :: HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m ()+~~~~++## Known Deficits++This package currently lacks a complete set of "lifting instances", i.e.+instance definitions for classes such as mtl's MonadWriter "over" the newly+introduced monad transformers, as in++~~~~+instance (MonadWriter w m) => MonadWriter w (MultiStateT c m) where ..+~~~~++These "lifting instances" would be necessary+to achieve full compatibility with existing transformers. Ping me if you+find anything specific missing.++## Changelog++See changelog.md

@@ -0,0 +1,83 @@+# Changelog for [`multistate` package](https://hackage.haskell.org/package/multistate)++## 0.6.0.0 *June 2015*++  * Add `MultiRWST`++  * Add inflate functions (e.g. `StateT _ -> MultiStateT _`)++  * Improve lazyness++  * Move changelog from `README.md` to `changelog.md`++## 0.5.0.0 *March 2015*+    +  * Breaking changes (!):++    Refactor some parts of the interface, see "naming scheme" in  the README;+    The changes are:++      | old | new |+      | --- | --- |+      | `withMultiFoo` | `withMultiFooA` |+      | `withMultiFoos` | `withMultiFoosA` |+      | `mAskRaw` | `mGetRaw` |+      | | `mPutRaw` |+      | `evalMultiStateT` | `runMultiStateTNil` |+      | `evalMultiStateTWithInitial` | `runMultiStateTA` |+      | `evalMultiReaderT` | `runMultiReaderTNil` |+      | `evalMultiReaderTWithInitial` | `runMultiReaderTA` |+      | `execMultiWriterT` | `runMultiWriterTW` |++  * Start using hspec; Add proper cabal test-suite.++## 0.4.0.0: *March 2015*++  * Refactor from `Control.Monad.*` to `Control.Monad.Trans.*`++  * Put classes (`MonadMulti*`) into separate modules++  * Add Strict and Lazy variants++  * Deprecate previous modules++## 0.3.0.0 *Januar 2015*++  * Add `MultiWriter`++  * Fixity for `(:+:)`++  * support ghc-7.10++## 0.2.0.0 *Januar 2015*++  * 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.++## 0.1.3.2 *September 2014*+  +  * Add example++  * Clean up / Add dependencies++  * More documentation++## 0.1.2 *September 2014*++  * Expose `HList` module++  * Add haddocks++## 0.1.1 *June 2014*++  * First version published on hackage

@@ -7,13 +7,15 @@   -import Control.Monad.MultiState+import Control.Monad.Trans.MultiState  import Control.Applicative ( (<$>), (<*>) )  import Control.Monad.Trans ( lift ) import Control.Monad.Writer ++ {- Small example showing   1) a MultiState containing a Char and a String,@@ -24,7 +26,7 @@ -}  simpleExample :: IO ()-simpleExample = evalMultiStateT+simpleExample = runMultiStateTNil_               $ withMultiState 'H'              -- add a Char to the state               $ withMultiState "ello, World!" -- add a String to the state               $ do@@ -78,7 +80,7 @@   tell $ ["account balance = " ++ show x]  accountCalculation :: Writer [String] ()-accountCalculation = evalMultiStateT $ do+accountCalculation = runMultiStateTNil_ $ do   tell ["account calculation start"]   -- we cannot use any of the account methods here, because state is empty   -- logAccount

@@ -1,5 +1,5 @@ Name:          multistate-Version:       0.3.0.0+Version:       0.6.0.0 Cabal-Version: >= 1.10 Build-Type:    Simple license:       BSD3@@ -11,30 +11,33 @@ Bug-reports:   https://github.com/lspitzner/multistate/issues Stability:     Experimental category:      Control-tested-with:   GHC == 7.6.3, GHC == 7.8.3, GHC == 7.8.4, GHC == 7.10.0+tested-with:   GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.1 -Synopsis: like mtl's ReaderT/WriterT/StateT, but more than one contained-          value/type.+Synopsis: like mtl's ReaderT / WriterT / StateT, but more than one+          contained value/type. Description:-  When using multiple Read/Write/State transformers in the same monad stack,+  When using multiple Read\/Write\/State transformers in the same monad stack,   it becomes necessary to lift the operations in order to affect a specific   transformer.-  Using heterogenous lists (and all kinds of GHC extensions magic),+  Using heterogeneous lists (and all kinds of GHC extensions magic),   this package provides transformers that remove that necessity:-  MultiReaderT/MultiWriterT/MultiStateT can contain a heterogenous list of-  values.+  MultiReaderT\/MultiWriterT\/MultiStateT\/MultiRWST can contain a+  heterogeneous list of values.   .   See the <https://github.com/lspitzner/multistate README> for   a longer description.+  .+  The latest published version contains some breaking changes.+  Please complain if this causes problems (for future consideration). +extra-source-files:+    README.md+    changelog.md+ source-repository head   type: git   location: git@github.com:lspitzner/multistate.git -flag build-test-  description: Build the MultiState-test test program-  default: False- flag build-example   description: Build the MultiState-example example program   default: False@@ -44,14 +47,31 @@     Haskell2010   exposed-modules:     Data.HList.HList+    Data.HList.ContainsType     Control.Monad.MultiState     Control.Monad.MultiReader     Control.Monad.MultiWriter+    Control.Monad.Trans.MultiReader+    Control.Monad.Trans.MultiReader.Class+    Control.Monad.Trans.MultiReader.Lazy+    Control.Monad.Trans.MultiReader.Strict+    Control.Monad.Trans.MultiWriter+    Control.Monad.Trans.MultiWriter.Class+    Control.Monad.Trans.MultiWriter.Lazy+    Control.Monad.Trans.MultiWriter.Strict+    Control.Monad.Trans.MultiState+    Control.Monad.Trans.MultiState.Class+    Control.Monad.Trans.MultiState.Lazy+    Control.Monad.Trans.MultiState.Strict+    Control.Monad.Trans.MultiRWS+    Control.Monad.Trans.MultiRWS.Lazy+    Control.Monad.Trans.MultiRWS.Strict   other-modules:   build-depends:     base         >= 4.6   && <4.9,     mtl          >= 2.1   && <2.3,-    transformers >= 0.3   && <0.5+    transformers >= 0.3   && <0.5,+    tagged       >= 0.7   && <0.9   default-extensions:     GADTs     TypeFamilies@@ -66,23 +86,20 @@   hs-source-dirs: src } -executable multistate-test {-  default-language:-    Haskell2010-  if flag(build-test) {-    buildable: True-    build-depends:-      -- no version constraints necessary, because they are already-      -- given by library-      multistate,-      base,-      transformers-  } else {-    buildable: False-  }-  ghc-options: -Wall-  main-is: Test.hs-  hs-source-dirs: test+test-suite multistate-test {+  type:             exitcode-stdio-1.0+  default-language: Haskell2010+  buildable:        True+  build-depends:+    -- no version constraints necessary, because they are already+    -- given by library+    multistate,+    base,+    transformers,+    hspec+  ghc-options:      -Wall+  main-is:          Test.hs+  hs-source-dirs:   test }  executable multistate-example {

@@ -1,225 +1,34 @@ -- | The multi-valued version of mtl's Reader / ReaderT -- / MonadReader-module Control.Monad.MultiReader-  ( -- * MultiReaderT+module Control.Monad.MultiReader {-# DEPRECATED "Use Control.Monad.Trans.MultiReader instead" #-}+  (+  -- * MultiReaderT     MultiReaderT(..)   , MultiReaderTNull   , MultiReader   -- * MonadMultiReader class   , MonadMultiReader(..)-  -- * functions-  , mAskRaw+  -- * run-functions+  , runMultiReaderT+  , runMultiReaderT_+  , runMultiReaderTNil+  , runMultiReaderTNil_+  -- * with-functions (single Reader)   , withMultiReader+  , withMultiReader_+  -- * with-functions (multiple Readers)   , withMultiReaders-  , evalMultiReaderT-  , evalMultiReaderTWithInitial+  , withMultiReaders_+  -- * inflate-function (run ReaderT in MultiReaderT)+  , inflateReader+  -- * other functions   , mapMultiReaderT+  , mGetRaw+  , mPutRaw ) where   -import Data.HList.HList--import Control.Monad.State.Strict ( StateT(..)-                                  , MonadState(..)-                                  , evalStateT-                                  , mapStateT )-import Control.Monad.Trans.Class  ( MonadTrans-                                  , lift )-import Control.Monad.Writer.Class ( MonadWriter-                                  , listen-                                  , tell-                                  , writer-                                  , pass )--import Data.Functor.Identity      ( Identity )--import Control.Applicative        ( Applicative(..) )-import Control.Monad              ( liftM-                                  , ap )------ | A Reader transformer monad patameterized by:---   --- * x - The list of types constituting the environment / input (to be read),--- * m - The inner monad.--- --- 'MultiReaderT' corresponds to mtl's 'ReaderT', but can contain--- a heterogenous list of types.--- --- This heterogenous list is represented using Types.Data.List, i.e:--- ---   * @'[]@ - The empty list,---   * @a ': b@ - A list where @/a/@ is an arbitrary type---     and @/b/@ is the rest list.--- --- For example,--- --- > MultiReaderT '[Int, Bool] :: (* -> *) -> (* -> *)--- --- is a Reader transformer containing the types [Int, Bool].-newtype MultiReaderT x m a = MultiReaderT {-  runMultiReaderTRaw :: StateT (HList x) m a-}---- | A MultiReader transformer carrying an empty state.-type MultiReaderTNull = MultiReaderT '[]---- | A reader monad parameterized by the list of types x of the environment--- / input to carry.------ Similar to @Reader r = ReaderT r Identity@-type MultiReader x = MultiReaderT x Identity--class ContainsType a c where-  setHListElem :: a -> HList c -> HList c-  getHListElem :: HList c -> a---- | All methods must be defined.------ The idea is: Any monad stack is instance of @MonadMultiReader a@, iff--- the stack contains a @MultiReaderT x@ with /a/ element of /x/.-class (Monad m) => MonadMultiReader a m where-  mAsk :: m a -- ^ Access to a specific type in the environment.--{--it might make seem straightforward to define the following class that-corresponds to other transformer classes. But while we can define the the-class and its instances, there is a problem we try to use it, assuming that we-do not want to annotate the full type signature of the config:-  the type of the config can not be inferred properly. we would need a feature-  like "infer, as return type for this function, the only type for-  which there exists a valid chain of instance definitions that is needed to-  by this function".-  In other words, it is impossible to use the mAskRaw function without-  binding a concrete type for c, because otherwise the inference runs into-  some overlapping instances.-For this reason, I removed this type class and created a non-class function-mAskRaw, for which the type inference works because it involves no-type classes.-  lennart spitzner--}----class (Monad m) => MonadMultiReaderRaw c m where---  mAskRaw :: m (HList c)----instance (MonadTrans t, Monad (t m), MonadMultiReaderRaw c m)---      => MonadMultiReaderRaw c (t m) where---  mAskRaw = lift $ mAskRaw----instance (Monad m) => MonadMultiReaderRaw a (MultiReaderT a m) where---  mAskRaw = MultiReaderT $ get--instance ContainsType a (a ': xs) where-  setHListElem a (_ :+: xs) = a :+: xs-  getHListElem (x :+: _) = x--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--instance (Applicative m, Monad m) => Applicative (MultiReaderT x m) where-  pure = MultiReaderT . pure-  (<*>) = ap--instance Monad m => Monad (MultiReaderT x m) where-  return = MultiReaderT . return-  k >>= f = MultiReaderT $ runMultiReaderTRaw k >>= (runMultiReaderTRaw.f)--instance MonadTrans (MultiReaderT x) where-  lift = MultiReaderT . lift---- | Adds an element to the environment, thereby transforming a MultiReaderT--- carrying an environment with types /(x:xs)/ to a a MultiReaderT with /xs/.------ Think "Execute this computation with this additional value as environment".-withMultiReader :: Monad m-                => x-                -> MultiReaderT (x ': xs) m a-                -> MultiReaderT xs m a-withMultiReader x k = MultiReaderT $ do-  s <- get-  (a, _  :+: s') <- lift $ runStateT (runMultiReaderTRaw k) (x :+: s)-  put s'-  return a---- | Adds a heterogenous list of elements to the environment, thereby--- transforming a MultiReaderT carrying an environment with values--- over types /xs++ys/ to a MultiReaderT over /ys/.------ Similar to recursively adding single values with 'withMultiReader'.------ Note that /ys/ can be Null; in that case the return value can be--- evaluated further using 'evalMultiReaderT'.-withMultiReaders :: Monad m-                 => HList xs-                 -> MultiReaderT (Append xs ys) m a-                 -> MultiReaderT ys m a-withMultiReaders HNil = id-withMultiReaders (x :+: xs) = withMultiReaders xs . withMultiReader x--instance (Monad m, ContainsType a c)-      => MonadMultiReader a (MultiReaderT c m) where-  mAsk = MultiReaderT $ liftM getHListElem get--instance (MonadTrans t, Monad (t m), MonadMultiReader a m)-      => MonadMultiReader a (t m) where-  mAsk = lift $ mAsk---- | A raw extractor of the contained HList (i.e. the complete environment).------ For a possible usecase, see 'withMultiReaders'.-mAskRaw :: Monad m => MultiReaderT a m (HList a)-mAskRaw = MultiReaderT get---- | Evaluate a computation over an empty environment.------ Because the environment is empty, it does not need to be provided.------ If you want to evaluate a computation over any non-Null environment, either--- use--- --- * 'evalMultiReaderTWithInitial'--- * simplify the computation using 'withMultiReader' / 'withMultiReaders',---   then use 'evalMultiReaderT' on the result.-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-                            => HList a            -- ^ The initial state-                            -> MultiReaderT a m b -- ^ The computation to evaluate-                            -> m b-evalMultiReaderTWithInitial c k = evalStateT (runMultiReaderTRaw k) c---- | Map both the return value and the environment of a computation--- using the given function.------ Note that there is a difference to mtl's ReaderT,--- where it is /not/ possible to modify the environment.-mapMultiReaderT :: (m (a, HList w)-                -> m' (a', HList w))-                -> MultiReaderT w m a-                -> MultiReaderT w m' a'-mapMultiReaderT f = MultiReaderT . mapStateT f . runMultiReaderTRaw---- foreign lifting instances--instance (MonadState s m) => MonadState s (MultiReaderT c m) where-  put   = lift . put-  get   = lift $ get-  state = lift . state--instance (MonadWriter w m) => MonadWriter w (MultiReaderT c m) where-  writer = lift . writer-  tell   = lift . tell-  listen = MultiReaderT .-    mapStateT (liftM (\((a,w), w') -> ((a, w'), w)) . listen) .-    runMultiReaderTRaw-  pass = MultiReaderT .-    mapStateT (pass . liftM (\((a, f), w) -> ((a, w), f))) .-    runMultiReaderTRaw  +-- just re-export+import Control.Monad.Trans.MultiReader.Class+import Control.Monad.Trans.MultiReader.Lazy

@@ -1,6 +1,6 @@ -- | The multi-valued version of mtl's State / StateT -- / MonadState-module Control.Monad.MultiState+module Control.Monad.MultiState {-# DEPRECATED "Use Control.Monad.Trans.MultiState instead" #-}   (   -- * MultiStateT     MultiStateT(..)@@ -8,199 +8,41 @@   , MultiState   -- * MonadMultiState class   , MonadMultiState(..)-  -- * functions-  , mGetRaw+  -- * run-functions+  , runMultiStateT+  , runMultiStateTAS+  , runMultiStateTSA+  , runMultiStateTA+  , runMultiStateTS+  , runMultiStateT_+  , runMultiStateTNil+  , runMultiStateTNil_+  -- * with-functions (single state)   , withMultiState+  , withMultiStateAS+  , withMultiStateSA+  , withMultiStateA+  , withMultiStateS+  , withMultiState_+  -- * with-functions (multiple states)   , withMultiStates-  , evalMultiStateT-  , evalMultiStateTWithInitial+  , withMultiStatesAS+  , withMultiStatesSA+  , withMultiStatesA+  , withMultiStatesS+  , withMultiStates_+  -- * inflate-functions (run single state in multiple states)+  , inflateState+  , inflateReader+  , inflateWriter+  -- * other functions   , mapMultiStateT+  , mGetRaw+  , mPutRaw ) where   -import Data.HList.HList--import Control.Monad.State.Strict ( StateT(..)-                                  , MonadState(..)-                                  , evalStateT-                                  , mapStateT )-import Control.Monad.Trans.Class  ( MonadTrans-                                  , lift )-import Control.Monad.Writer.Class ( MonadWriter-                                  , listen-                                  , tell-                                  , writer-                                  , pass )--import Data.Functor.Identity      ( Identity )--import Control.Applicative        ( Applicative(..) )-import Control.Monad              ( liftM-                                  , ap )------ | A State transformer monad patameterized by:---   --- * x - The list of types constituting the state,--- * m - The inner monad.--- --- 'MultiStateT' corresponds to mtl's 'StateT', but can contain--- a heterogenous list of types.--- --- This heterogenous list is represented using Types.Data.List, i.e:--- ---   * @'[]@ - The empty list,---   * @a ': b@ - A list where @/a/@ is an arbitrary type---     and @/b/@ is the rest list.--- --- For example,--- --- > MultiStateT '[Int, Bool] :: (* -> *) -> (* -> *)--- --- is a State wrapper containing the types [Int, Bool].-newtype MultiStateT x m a = MultiStateT {-  runMultiStateTRaw :: StateT (HList x) m a-}---- | A MultiState transformer carrying an empty state.-type MultiStateTNull = MultiStateT '[]---- | A state monad parameterized by the list of types x of the state to carry.------ Similar to @State s = StateT s Identity@-type MultiState x = MultiStateT x Identity--class ContainsType a c where-  setHListElem :: a -> HList c -> HList c-  getHListElem :: HList c -> a---- | All methods must be defined.------ The idea is: Any monad stack is instance of @MonadMultiState a@, iff--- the stack contains a @MultiStateT x@ with /a/ element of /x/.-class (Monad m) => MonadMultiState a m where-  -- | state set function for values of type @a@.-  mSet :: a -> m ()-  -- | state get function for values of type @a@.-  mGet :: m a--instance ContainsType a (a ': xs) where-  setHListElem a (_ :+: xs) = a :+: xs-  getHListElem (x :+: _) = x--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--instance (Applicative m, Monad m) => Applicative (MultiStateT x m) where-  pure = MultiStateT . pure-  (<*>) = ap--instance Monad m => Monad (MultiStateT x m) where-  return = MultiStateT . return-  k >>= f = MultiStateT $ runMultiStateTRaw k >>= (runMultiStateTRaw.f)--instance MonadTrans (MultiStateT x) where-  lift = MultiStateT . lift---- | Adds an element to the state, thereby transforming a MultiStateT over--- values with types /(x:xs)/ to a MultiStateT over /xs/.------ Think "Execute this computation with this additional value as state".-withMultiState :: Monad m-               => x                           -- ^ The value to add-               -> 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, _ :+: s') <- lift $ runStateT (runMultiStateTRaw k) (x :+: s)-  put s'-  return a---- | Adds a heterogenous list of elements to the state, thereby--- transforming a MultiStateT over values with types /xs++ys/ to a MultiStateT--- over /ys/.------ Similar to recursively adding single values with 'withMultiState'.------ Note that /ys/ can be Null; in that case the return value can be--- evaluated further using 'evalMultiStateT'.-withMultiStates :: Monad m-                => HList xs                       -- ^ The list of values to add-                -> MultiStateT (Append xs ys) m a -- ^ The computation using the-                                                  --   enlarged state-                -> MultiStateT ys m a             -- ^ A computation using the-                                                  -- smaller state-withMultiStates HNil = id-withMultiStates (x :+: xs) = withMultiStates xs . withMultiState x--instance (Monad m, ContainsType a c)-      => MonadMultiState a (MultiStateT c m) where-  mSet v = MultiStateT $ get >>= (put . setHListElem v)-  mGet = MultiStateT $ liftM getHListElem get--instance (MonadTrans t, Monad (t m), MonadMultiState a m)-      => MonadMultiState a (t m) where-  mSet = lift . mSet-  mGet = lift $ mGet---- | Evaluate an empty state computation.------ Because the state is empty, no initial state must be provided.------ Currently it is not directly possible to extract the final state of a--- computation (similar to @execStateT@ and @runStateT@ for mtl's StateT),--- but you can use 'mGetRaw' if you need such functionality.------ If you want to evaluate a computation over any non-Null state, either--- use--- --- * 'evalMultiStateTWithInitial'--- * simplify the computation using 'withMultiState' / 'withMultiStates',---   then use 'evalMultiStateT' on the result.-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-                           => HList a           -- ^ The initial state-                           -> MultiStateT a m b -- ^ The computation to evaluate-                           -> m b-evalMultiStateTWithInitial c k = evalStateT (runMultiStateTRaw k) c---- | A raw extractor of the contained HList (i.e. the complete state).------ For a possible usecase, see 'withMultiStates'.-mGetRaw :: Monad m => MultiStateT a m (HList a)-mGetRaw = MultiStateT get---- | Map both the return value and the state of a computation--- using the given function.-mapMultiStateT :: (m (a, HList w) -> m' (a', HList w))-               -> MultiStateT w m  a-               -> MultiStateT w m' a'-mapMultiStateT f = MultiStateT . mapStateT f . runMultiStateTRaw---- foreign lifting instances--instance (MonadState s m) => MonadState s (MultiStateT c m) where-  put   = lift . put-  get   = lift $ get-  state = lift . state--instance (MonadWriter w m) => MonadWriter w (MultiStateT c m) where-  writer = lift . writer-  tell   = lift . tell-  listen = MultiStateT .-    mapStateT (liftM (\((a,w), w') -> ((a, w'), w)) . listen) .-    runMultiStateTRaw-  pass = MultiStateT .-    mapStateT (pass . liftM (\((a, f), w) -> ((a, w), f))) .-    runMultiStateTRaw  +-- just re-export+import Control.Monad.Trans.MultiState.Class+import Control.Monad.Trans.MultiState.Lazy

@@ -2,159 +2,43 @@  -- | The multi-valued version of mtl's Writer / WriterT -- / MonadWriter-module Control.Monad.MultiWriter+module Control.Monad.MultiWriter {-# DEPRECATED "Use Control.Monad.Trans.MultiWriter instead" #-}   ( -- * MultiWriterT     MultiWriterT(..)   , MultiWriterTNull   , MultiWriter   -- * MonadMultiWriter class   , MonadMultiWriter(..)-  -- * functions-  , mGetRaw+  -- * run-functions+  , runMultiWriterT+  , runMultiWriterTAW+  , runMultiWriterTWA+  -- , runMultiWriterTA+  , runMultiWriterTW+  -- , runMultiWriterT_+  , runMultiWriterTNil+  , runMultiWriterTNil_+  -- * with-functions (single Writer)   , withMultiWriter+  , withMultiWriterAW+  , withMultiWriterWA+  , withMultiWriterW+  -- * with-functions (multiple Writers)   , withMultiWriters-  , runMultiWriterT-  , execMultiWriterT+  , withMultiWritersAW+  , withMultiWritersWA+  , withMultiWritersW+  -- * inflate-function (run WriterT in MultiWriterT)+  , inflateWriter+  -- * other functions   , mapMultiWriterT-) where--import Data.HList.HList--import Control.Monad.State.Strict ( StateT(..)-                                  , MonadState(..)-                                  , execStateT-                                  , mapStateT )-import Control.Monad.Trans.Class  ( MonadTrans-                                  , lift )-import Control.Monad.Writer.Class ( MonadWriter-                                  , listen-                                  , tell-                                  , writer-                                  , pass )--import Data.Functor.Identity      ( Identity )--import Control.Applicative        ( Applicative(..) )-import Control.Monad              ( liftM-                                  , ap )--import Data.Monoid+  , mGetRaw+  , mPutRaw+  )+where   --- | A Writer transformer monad patameterized by:---   --- * x - The list of types that can be written (Monoid instances).--- * m - The inner monad.--- --- 'MultiWriterT' corresponds to mtl's 'WriterT', but can contain--- a heterogenous list of types.--- --- This heterogenous list is represented using Types.Data.List, i.e:--- ---   * @'[]@ - The empty list,---   * @a ': b@ - A list where @/a/@ is an arbitrary type---     and @/b/@ is the rest list.--- --- For example,--- --- > MultiWriterT '[Int, Bool] :: (* -> *) -> (* -> *)--- --- is a Writer transformer containing the types [Int, Bool].-newtype MultiWriterT x m a = MultiWriterT {-  runMultiWriterTRaw :: StateT (HList x) m a-}---- | A MultiWriter transformer carrying an empty state.-type MultiWriterTNull = MultiWriterT '[]--type MultiWriter x a = MultiWriterT x Identity a--class ContainsType a c where-  setHListElem :: a -> HList c -> HList c-  getHListElem :: HList c -> a--class (Monad m, Monoid a) => MonadMultiWriter a m where-  mTell :: a -> m ()  --instance ContainsType a (a ': xs) where-  setHListElem a (_ :+: xs) = a :+: xs-  getHListElem (x :+: _) = x--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 (MultiWriterT x f) where-  fmap f = MultiWriterT . fmap f . runMultiWriterTRaw--instance (Applicative m, Monad m) => Applicative (MultiWriterT x m) where-  pure = MultiWriterT . pure-  (<*>) = ap--instance Monad m => Monad (MultiWriterT x m) where-  return = MultiWriterT . return-  k >>= f = MultiWriterT $ runMultiWriterTRaw k >>= (runMultiWriterTRaw.f)--instance MonadTrans (MultiWriterT x) where-  lift = MultiWriterT . lift--withMultiWriter :: Monad m-               => x-               -> MultiWriterT (x ': xs) m a-               -> MultiWriterT xs m a-withMultiWriter x k = MultiWriterT $ do-  s <- get-  (a, _ :+: s') <- lift $ runStateT (runMultiWriterTRaw k) (x :+: s)-  put s'-  return a-withMultiWriters- :: Monad m-                => HList xs-                -> MultiWriterT (Append xs ys) m a-                -> MultiWriterT ys m a-withMultiWriters HNil = id-withMultiWriters (x :+: xs) = withMultiWriters xs . withMultiWriter x--instance (Monad m, ContainsType a c, Monoid a)-      => MonadMultiWriter a (MultiWriterT c m) where-  mTell v = MultiWriterT $ do-    x <- get-    put $ setHListElem (getHListElem x `mappend` v) x--instance (MonadTrans t, Monad (t m), MonadMultiWriter a m)-      => MonadMultiWriter a (t m) where-  mTell = lift . mTell--runMultiWriterT :: (Monad m, Monoid (HList l))-                => MultiWriterT l m a -> m (a, HList l)-runMultiWriterT k = runStateT (runMultiWriterTRaw k) mempty--execMultiWriterT :: (Monad m, Monoid (HList l))-                 => MultiWriterT l m a -> m (HList l)-execMultiWriterT k = execStateT (runMultiWriterTRaw k) mempty--mGetRaw :: Monad m => MultiWriterT a m (HList a)-mGetRaw = MultiWriterT get--mapMultiWriterT :: (m (a, HList w) -> m' (a', HList w))-               -> MultiWriterT w m  a-               -> MultiWriterT w m' a'-mapMultiWriterT f = MultiWriterT . mapStateT f . runMultiWriterTRaw---- foreign lifting instances--instance (MonadState s m) => MonadState s (MultiWriterT c m) where-  put   = lift . put-  get   = lift $ get-  state = lift . state--instance (MonadWriter w m) => MonadWriter w (MultiWriterT c m) where-  writer = lift . writer-  tell   = lift . tell-  listen = MultiWriterT .-    mapStateT (liftM (\((a,w), w') -> ((a, w'), w)) . listen) .-    runMultiWriterTRaw-  pass = MultiWriterT .-    mapStateT (pass . liftM (\((a, f), w) -> ((a, w), f))) .-    runMultiWriterTRaw+-- just re-exports+import Control.Monad.Trans.MultiWriter.Class+import Control.Monad.Trans.MultiWriter.Lazy

@@ -0,0 +1,61 @@+-- | The multi-valued version of mtl's RWS / RWST+module Control.Monad.Trans.MultiRWS+  (+  -- * MultiRWST+    MultiRWST(..)+  , MultiRWSTNull+  , MultiRWS+  -- * run-functions (extracting from RWST)+  , runMultiRWST+  , runMultiRWSTASW+  , runMultiRWSTW+  , runMultiRWSTAW+  , runMultiRWSTSW+  , runMultiRWSTNil+  , runMultiRWSTNil_+  -- * with-functions (extending an RWST)+  , withMultiReader+  , withMultiReader_+  , withMultiReaders+  , withMultiReaders_+  , withMultiWriter+  , withMultiWriterAW+  , withMultiWriterWA+  , withMultiWriterW+  , withMultiWriters+  , withMultiWritersAW+  , withMultiWritersWA+  , withMultiWritersW+  , withMultiState+  , withMultiStateAS+  , withMultiStateSA+  , withMultiStateA+  , withMultiStateS+  , withMultiState_+  , withMultiStates+  , withMultiStatesAS+  , withMultiStatesSA+  , withMultiStatesA+  , withMultiStatesS+  , withMultiStates_+  -- * inflate-functions (run simple transformer in MultiRWST)+  , inflateReader+  , inflateMultiReader+  , inflateWriter+  , inflateMultiWriter+  , inflateState+  , inflateMultiState+  -- * other functions+  , mapMultiRWST+  , mGetRawR+  , mGetRawW+  , mGetRawS+  , mPutRawR+  , mPutRawW+  , mPutRawS+) where++++-- just re-export+import Control.Monad.Trans.MultiRWS.Lazy

@@ -0,0 +1,405 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | The multi-valued version of mtl's RWS / RWST+module Control.Monad.Trans.MultiRWS.Lazy+  (+  -- * MultiRWST+    MultiRWST(..)+  , MultiRWSTNull+  , MultiRWS+  -- * run-functions (extracting from RWST)+  , runMultiRWST+  , runMultiRWSTASW+  , runMultiRWSTW+  , runMultiRWSTAW+  , runMultiRWSTSW+  , runMultiRWSTNil+  , runMultiRWSTNil_+  -- * with-functions (extending an RWST)+  , withMultiReader+  , withMultiReader_+  , withMultiReaders+  , withMultiReaders_+  , withMultiWriter+  , withMultiWriterAW+  , withMultiWriterWA+  , withMultiWriterW+  , withMultiWriters+  , withMultiWritersAW+  , withMultiWritersWA+  , withMultiWritersW+  , withMultiState+  , withMultiStateAS+  , withMultiStateSA+  , withMultiStateA+  , withMultiStateS+  , withMultiState_+  , withMultiStates+  , withMultiStatesAS+  , withMultiStatesSA+  , withMultiStatesA+  , withMultiStatesS+  , withMultiStates_+  -- * inflate-functions (run simple transformer in MultiRWST)+  , inflateReader+  , inflateMultiReader+  , inflateWriter+  , inflateMultiWriter+  , inflateState+  , inflateMultiState+  -- * other functions+  , mapMultiRWST+  , mGetRawR+  , mGetRawW+  , mGetRawS+  , mPutRawR+  , mPutRawW+  , mPutRawS+  )+where++++import Data.HList.HList+import Data.HList.ContainsType++import Control.Monad.Trans.MultiReader.Class ( MonadMultiReader(..) )+import Control.Monad.Trans.MultiWriter.Class ( MonadMultiWriter(..) )+import Control.Monad.Trans.MultiState.Class  ( MonadMultiState(..) )+import Control.Monad.Trans.MultiReader.Lazy  ( MultiReaderT(..)+                                             , runMultiReaderT )+import Control.Monad.Trans.MultiWriter.Lazy  ( MultiWriterT(..)+                                             , runMultiWriterT )+import Control.Monad.Trans.MultiState.Lazy   ( MultiStateT(..)+                                             , runMultiStateT )++import Control.Monad.State.Lazy   ( StateT(..)+                                  , MonadState(..)+                                  , execStateT+                                  , evalStateT+                                  , mapStateT )+import Control.Monad.Reader       ( ReaderT(..) )+import Control.Monad.Writer.Lazy  ( WriterT(..) )+import Control.Monad.Trans.Class  ( MonadTrans+                                  , lift )++import Data.Functor.Identity      ( Identity )++import Control.Applicative        ( Applicative(..) )+import Control.Monad              ( liftM+                                  , ap+                                  , void )++import Data.Monoid++++newtype MultiRWST r w s m a = MultiRWST {+  runMultiRWSTRaw :: StateT (HList r, HList w, HList s) m a+}++type MultiRWSTNull = MultiRWST '[] '[] '[]++type MultiRWS r w s = MultiRWST r w s Identity++instance (Functor f) => Functor (MultiRWST r w s f) where+  fmap f = MultiRWST . fmap f . runMultiRWSTRaw++instance (Applicative m, Monad m) => Applicative (MultiRWST r w s m) where+  pure = MultiRWST . pure+  (<*>) = ap++instance (Monad m) => Monad (MultiRWST r w s m) where+  return = MultiRWST . return+  k >>= f = MultiRWST $ runMultiRWSTRaw k >>= runMultiRWSTRaw . f++instance MonadTrans (MultiRWST r w s) where+  lift = MultiRWST . lift++instance (Monad m, ContainsType a r)+      => MonadMultiReader a (MultiRWST r w s m) where+  mAsk = MultiRWST $ liftM (\(r,_,_) -> getHListElem r) get++instance (Monad m, ContainsType a w, Monoid a)+      => MonadMultiWriter a (MultiRWST r w s m) where+  mTell v = MultiRWST $ do+    ~(r,w,s) <- get+    put $ (r, setHListElem (getHListElem w `mappend` v) w, s)++instance (Monad m, ContainsType a s)+      => MonadMultiState a (MultiRWST r w s m) where+  mSet v = MultiRWST $ do+    ~(r,w,s) <- get+    put (r, w, setHListElem v s)+  mGet = MultiRWST $ do+    ~(_,_,s) <- get+    return $ getHListElem s++-- methods++runMultiRWST    :: ( Monad m+                   , Monoid (HList w)+                   )+                => HList r+                -> HList s+                -> MultiRWST r w s m a+                -> m (a, HList s, HList w)+runMultiRWSTASW :: ( Monad m+                   , Monoid (HList w)+                   )+                => HList r+                -> HList s+                -> MultiRWST r w s m a+                -> m (a, HList s, HList w)+runMultiRWSTW   :: ( Monad m+                   , Monoid (HList w)+                   )+                => HList r+                -> HList s+                -> MultiRWST r w s m a+                -> m (HList w)+runMultiRWSTAW  :: ( Monad m+                    , Monoid (HList w)+                    )+                 => HList r+                 -> HList s+                 -> MultiRWST r w s m a+                 -> m (a, HList w)+runMultiRWSTSW  :: ( Monad m+                    , Monoid (HList w)+                    )+                 => HList r+                 -> HList s+                 -> MultiRWST r w s m a+                 -> m (HList s, HList w)++runMultiRWSTNil :: ( Monad m )+                => MultiRWST '[] '[] '[] m a+                -> m a+runMultiRWSTNil_ :: ( Monad m, Functor m )+                 => MultiRWST '[] '[] '[] m a+                 -> m ()+runMultiRWST = runMultiRWSTASW+runMultiRWSTASW r s k = do+  ~(x, ~(_, w, s')) <- runStateT (runMultiRWSTRaw k) (r, mempty, s)+  return $ (x, s', w)+runMultiRWSTW r s k = do+  ~(_, w, _) <- execStateT (runMultiRWSTRaw k) (r, mempty, s)+  return $ w+runMultiRWSTAW r s k = do+  ~(x, ~(_, w, _)) <- runStateT (runMultiRWSTRaw k) (r, mempty, s)+  return $ (x, w)+runMultiRWSTSW r s k = do+  ~(_, w, s') <- execStateT (runMultiRWSTRaw k) (r, mempty, s)+  return $ (s', w)+runMultiRWSTNil  k = evalStateT (runMultiRWSTRaw k) (HNil, HNil, HNil)+runMultiRWSTNil_ k = void $ runStateT (runMultiRWSTRaw k) (HNil, HNil, HNil)++withMultiReader  :: Monad m => r -> MultiRWST (r ': rs) w s m a -> MultiRWST rs w s m a+withMultiReader_ :: (Functor m, Monad m) => r -> MultiRWST (r ': rs) w s m a -> MultiRWST rs w s m ()+withMultiReaders  :: Monad m => HList r1 -> MultiRWST (Append r1 r2) w s m a -> MultiRWST r2 w s m a+withMultiReaders_ :: (Functor m, Monad m) => HList r1 -> MultiRWST (Append r1 r2) w s m a -> MultiRWST r2 w s m ()+withMultiReader x k = MultiRWST $ do+  (r, w, s) <- get+  ~(a, ~(_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (x :+: r, w, s)+  put (r, w', s')+  return a+withMultiReader_ x k = MultiRWST $ do+  (r, w, s) <- get+  ~(_, w', s') <- lift $ execStateT (runMultiRWSTRaw k) (x :+: r, w, s)+  put (r, w', s')+withMultiReaders HNil       = id+withMultiReaders (x :+: xs) = withMultiReaders xs . withMultiReader x+withMultiReaders_ HNil       = void+withMultiReaders_ (x :+: xs) = withMultiReaders_ xs . withMultiReader x++withMultiWriter   :: (Monoid w, Monad m) => MultiRWST r (w ': ws) s m a -> MultiRWST r ws s m (a, w)+withMultiWriterAW :: (Monoid w, Monad m) => MultiRWST r (w ': ws) s m a -> MultiRWST r ws s m (a, w)+withMultiWriterWA :: (Monoid w, Monad m) => MultiRWST r (w ': ws) s m a -> MultiRWST r ws s m (w, a)+withMultiWriterW  :: (Monoid w, Monad m) => MultiRWST r (w ': ws) s m a -> MultiRWST r ws s m w+withMultiWriters   :: forall r w1 w2 s m a+                    . (Monoid (HList w1), Monad m, HInit w1)+                   => MultiRWST r (Append w1 w2) s m a+                   -> MultiRWST r w2 s m (a, HList w1)+withMultiWritersAW :: forall r w1 w2 s m a+                    . (Monoid (HList w1), Monad m, HInit w1)+                   => MultiRWST r (Append w1 w2) s m a+                   -> MultiRWST r w2 s m (a, HList w1)+withMultiWritersWA :: forall r w1 w2 s m a+                    . (Monoid (HList w1), Monad m, HInit w1)+                   => MultiRWST r (Append w1 w2) s m a+                   -> MultiRWST r w2 s m (HList w1, a)+withMultiWritersW  :: forall r w1 w2 s m a+                    . (Monoid (HList w1), Monad m, HInit w1)+                   => MultiRWST r (Append w1 w2) s m a+                   -> MultiRWST r w2 s m (HList w1)+withMultiWriter = withMultiWriterAW+withMultiWriterAW k = MultiRWST $ do+  (r, w, s) <- get+  ~(a, ~(_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (r, mempty :+: w, s)+  case w' of+    x' :+: wr' -> do+      put (r, wr', s')+      return (a, x')+withMultiWriterWA k = MultiRWST $ do+  (r, w, s) <- get+  ~(a, ~(_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (r, mempty :+: w, s)+  case w' of+    x' :+: wr' -> do+      put (r, wr', s')+      return (x', a)+withMultiWriterW k = MultiRWST $ do+  (r, w, s) <- get+  ~(_, w', s') <- lift $ execStateT (runMultiRWSTRaw k) (r, mempty :+: w, s)+  case w' of+    x' :+: wr' -> do+      put (r, wr', s')+      return x'+withMultiWriters = withMultiWritersAW+withMultiWritersAW k = MultiRWST $ do+  (r, w, s) <- get+  ~(a, ~(_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (r, hAppend (mempty :: HList w1) w, s)+  let (o, wr') = hSplit w'+  put (r, wr', s')+  return (a, o)+withMultiWritersWA k = MultiRWST $ do+  (r, w, s) <- get+  ~(a, ~(_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (r, hAppend (mempty :: HList w1) w, s)+  let (o, wr') = hSplit w'+  put (r, wr', s')+  return (o, a)+withMultiWritersW k = MultiRWST $ do+  (r, w, s) <- get+  ~(_, w', s') <- lift $ execStateT (runMultiRWSTRaw k) (r, hAppend (mempty :: HList w1) w, s)+  let (o, wr') = hSplit w'+  put (r, wr', s')+  return o++withMultiState   :: Monad m => s -> MultiRWST r w (s ': ss) m a -> MultiRWST r w ss m (a, s)+withMultiStateAS :: Monad m => s -> MultiRWST r w (s ': ss) m a -> MultiRWST r w ss m (a, s)+withMultiStateSA :: Monad m => s -> MultiRWST r w (s ': ss) m a -> MultiRWST r w ss m (s, a)+withMultiStateA  :: Monad m => s -> MultiRWST r w (s ': ss) m a -> MultiRWST r w ss m a+withMultiStateS  :: Monad m => s -> MultiRWST r w (s ': ss) m a -> MultiRWST r w ss m s+withMultiState_  :: (Functor m, Monad m) => s -> MultiRWST r w (s ': ss) m a -> MultiRWST r w ss m ()+withMultiStates   :: Monad m => HList s1 -> MultiRWST r w (Append s1 s2) m a -> MultiRWST r w s2 m (a, HList s1)+withMultiStatesAS :: Monad m => HList s1 -> MultiRWST r w (Append s1 s2) m a -> MultiRWST r w s2 m (a, HList s1)+withMultiStatesSA :: Monad m => HList s1 -> MultiRWST r w (Append s1 s2) m a -> MultiRWST r w s2 m (HList s1, a)+withMultiStatesA  :: Monad m => HList s1 -> MultiRWST r w (Append s1 s2) m a -> MultiRWST r w s2 m a+withMultiStatesS  :: Monad m => HList s1 -> MultiRWST r w (Append s1 s2) m a -> MultiRWST r w s2 m (HList s1)+withMultiStates_  :: (Functor m, Monad m) => HList s1 -> MultiRWST r w (Append s1 s2) m a -> MultiRWST r w s2 m ()+withMultiState = withMultiStateAS+withMultiStateAS x k = MultiRWST $ do+  ~(r, w, s) <- get+  ~(a, ~(_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (r, w, (x :+: s))+  case s' of+    x' :+: sr' -> do+      put (r, w', sr')+      return (a, x')+withMultiStateSA x k = MultiRWST $ do+  ~(r, w, s) <- get+  ~(a, ~(_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (r, w, (x :+: s))+  case s' of+    x' :+: sr' -> do+      put (r, w', sr')+      return (x', a)+withMultiStateA x k = MultiRWST $ do+  ~(r, w, s) <- get+  ~(a, ~(_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (r, w, (x :+: s))+  case s' of+    _ :+: sr' -> do+      put (r, w', sr')+      return a+withMultiStateS x k = MultiRWST $ do+  ~(r, w, s) <- get+  ~(_, w', s') <- lift $ execStateT (runMultiRWSTRaw k) (r, w, (x :+: s))+  case s' of+    x' :+: sr' -> do+      put (r, w', sr')+      return x'+withMultiState_ x k = MultiRWST $ do+  ~(r, w, s) <- get+  ~(_, w', s') <- lift $ execStateT (runMultiRWSTRaw k) (r, w, (x :+: s))+  case s' of _ :+: sr' -> put (r, w', sr')+withMultiStates                = withMultiStatesAS+withMultiStatesAS HNil       k = do a <- k; return (a, HNil)+withMultiStatesAS (x :+: xs) k = do+  ~(~(a, x'), xs') <- withMultiStates xs $ withMultiState x k+  return (a, x' :+: xs')+withMultiStatesSA HNil       k = do a <- k; return (HNil, a)+withMultiStatesSA (x :+: xs) k = do+  ~(~(a, x'), xs') <- withMultiStates xs $ withMultiState x k+  return (x' :+: xs', a)+withMultiStatesA HNil       = id+withMultiStatesA (x :+: xs) = withMultiStatesA xs . withMultiStateA x+withMultiStatesS HNil       k = k >> return HNil+withMultiStatesS (x :+: xs) k = do+  ~(x', xs') <- withMultiStates xs $ withMultiStateS x k+  return (x' :+: xs')+withMultiStates_ HNil       = void+withMultiStates_ (x :+: xs) = withMultiStates_ xs . withMultiState_ x++inflateReader :: (Monad m, ContainsType r rs)+              => ReaderT r m a+              -> MultiRWST rs w s m a+inflateReader k = mAsk >>= lift . runReaderT k+inflateMultiReader :: Monad m => MultiReaderT r m a -> MultiRWST r w s m a+inflateMultiReader k = do+  r <- mGetRawR+  lift $ runMultiReaderT r k+inflateWriter :: (Monad m, ContainsType w ws, Monoid w)+              => WriterT w m a+              -> MultiRWST r ws s m a+inflateWriter k = do+  ~(x, w) <- lift $ runWriterT k+  mTell w+  return x+inflateMultiWriter :: (Functor m, Monad m, Monoid (HList w))+                   => MultiWriterT w m a+                   -> MultiRWST r w s m a+inflateMultiWriter k = do+  ~(x, w) <- lift $ runMultiWriterT k+  mPutRawW w+  return x+inflateState :: (Monad m, ContainsType s ss)+             => StateT s m a+             -> MultiRWST r w ss m a+inflateState k = do+  s <- mGet+  ~(x, s') <- lift $ runStateT k s+  mSet s'+  return x+inflateMultiState :: (Functor m, Monad m)+                  => MultiStateT s m a+                  -> MultiRWST r w s m a+inflateMultiState k = do+  s <- mGetRawS+  ~(x, s') <- lift $ runMultiStateT s k+  mPutRawS s'+  return x++mGetRawR :: Monad m => MultiRWST r w s m (HList r)+mPutRawR :: Monad m => HList r -> MultiRWST r w s m ()+mGetRawW :: Monad m => MultiRWST r w s m (HList w)+mPutRawW :: Monad m => HList w -> MultiRWST r w s m ()+mGetRawS :: Monad m => MultiRWST r w s m (HList s)+mPutRawS :: Monad m => HList s -> MultiRWST r w s m ()+mGetRawR = (\(r, _, _) -> r) `liftM` MultiRWST get+mPutRawR r = MultiRWST $ do+  ~(_, w, s) <- get+  put (r, w, s)+mGetRawW = (\(_, w, _) -> w) `liftM` MultiRWST get+mPutRawW w = MultiRWST $ do+  ~(r, _, s) <- get+  put (r, w, s)+mGetRawS = (\(_, _, s) -> s) `liftM` MultiRWST get+mPutRawS s = MultiRWST $ do+  ~(r, w, _) <- get+  put (r, w, s)++mapMultiRWST :: (ss ~ (HList r, HList w, HList s))+             => (m (a, ss) -> m' (a', ss))+             -> MultiRWST r w s m a+             -> MultiRWST r w s m' a'+mapMultiRWST f = MultiRWST . mapStateT f . runMultiRWSTRaw

@@ -0,0 +1,405 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | The multi-valued version of mtl's RWS / RWST+module Control.Monad.Trans.MultiRWS.Strict+  (+  -- * MultiRWST+    MultiRWST(..)+  , MultiRWSTNull+  , MultiRWS+  -- * run-functions (extracting from RWST)+  , runMultiRWST+  , runMultiRWSTASW+  , runMultiRWSTW+  , runMultiRWSTAW+  , runMultiRWSTSW+  , runMultiRWSTNil+  , runMultiRWSTNil_+  -- * with-functions (extending an RWST)+  , withMultiReader+  , withMultiReader_+  , withMultiReaders+  , withMultiReaders_+  , withMultiWriter+  , withMultiWriterAW+  , withMultiWriterWA+  , withMultiWriterW+  , withMultiWriters+  , withMultiWritersAW+  , withMultiWritersWA+  , withMultiWritersW+  , withMultiState+  , withMultiStateAS+  , withMultiStateSA+  , withMultiStateA+  , withMultiStateS+  , withMultiState_+  , withMultiStates+  , withMultiStatesAS+  , withMultiStatesSA+  , withMultiStatesA+  , withMultiStatesS+  , withMultiStates_+  -- * inflate-functions (run simple transformer in MultiRWST)+  , inflateReader+  , inflateMultiReader+  , inflateWriter+  , inflateMultiWriter+  , inflateState+  , inflateMultiState+  -- * other functions+  , mapMultiRWST+  , mGetRawR+  , mGetRawW+  , mGetRawS+  , mPutRawR+  , mPutRawW+  , mPutRawS+  )+where++++import Data.HList.HList+import Data.HList.ContainsType++import Control.Monad.Trans.MultiReader.Class  ( MonadMultiReader(..) )+import Control.Monad.Trans.MultiWriter.Class  ( MonadMultiWriter(..) )+import Control.Monad.Trans.MultiState.Class   ( MonadMultiState(..) )+import Control.Monad.Trans.MultiReader.Strict ( MultiReaderT(..)+                                              , runMultiReaderT )+import Control.Monad.Trans.MultiWriter.Strict ( MultiWriterT(..)+                                              , runMultiWriterT )+import Control.Monad.Trans.MultiState.Strict  ( MultiStateT(..)+                                              , runMultiStateT )++import Control.Monad.State.Strict   ( StateT(..)+                                    , MonadState(..)+                                    , execStateT+                                    , evalStateT+                                    , mapStateT )+import Control.Monad.Reader         ( ReaderT(..) )+import Control.Monad.Writer.Strict  ( WriterT(..) )+import Control.Monad.Trans.Class    ( MonadTrans+                                    , lift )++import Data.Functor.Identity        ( Identity )++import Control.Applicative          ( Applicative(..) )+import Control.Monad                ( liftM+                                    , ap+                                    , void )++import Data.Monoid++++newtype MultiRWST r w s m a = MultiRWST {+  runMultiRWSTRaw :: StateT (HList r, HList w, HList s) m a+}++type MultiRWSTNull = MultiRWST '[] '[] '[]++type MultiRWS r w s = MultiRWST r w s Identity++instance (Functor f) => Functor (MultiRWST r w s f) where+  fmap f = MultiRWST . fmap f . runMultiRWSTRaw++instance (Applicative m, Monad m) => Applicative (MultiRWST r w s m) where+  pure = MultiRWST . pure+  (<*>) = ap++instance (Monad m) => Monad (MultiRWST r w s m) where+  return = MultiRWST . return+  k >>= f = MultiRWST $ runMultiRWSTRaw k >>= runMultiRWSTRaw . f++instance MonadTrans (MultiRWST r w s) where+  lift = MultiRWST . lift++instance (Monad m, ContainsType a r)+      => MonadMultiReader a (MultiRWST r w s m) where+  mAsk = MultiRWST $ liftM (\(r,_,_) -> getHListElem r) get++instance (Monad m, ContainsType a w, Monoid a)+      => MonadMultiWriter a (MultiRWST r w s m) where+  mTell v = MultiRWST $ do+    (r,w,s) <- get+    put $ (r, setHListElem (getHListElem w `mappend` v) w, s)++instance (Monad m, ContainsType a s)+      => MonadMultiState a (MultiRWST r w s m) where+  mSet v = MultiRWST $ do+    (r,w,s) <- get+    put (r, w, setHListElem v s)+  mGet = MultiRWST $ do+    (_,_,s) <- get+    return $ getHListElem s++-- methods++runMultiRWST    :: ( Monad m+                   , Monoid (HList w)+                   )+                => HList r+                -> HList s+                -> MultiRWST r w s m a+                -> m (a, HList s, HList w)+runMultiRWSTASW :: ( Monad m+                   , Monoid (HList w)+                   )+                => HList r+                -> HList s+                -> MultiRWST r w s m a+                -> m (a, HList s, HList w)+runMultiRWSTW   :: ( Monad m+                   , Monoid (HList w)+                   )+                => HList r+                -> HList s+                -> MultiRWST r w s m a+                -> m (HList w)+runMultiRWSTAW  :: ( Monad m+                    , Monoid (HList w)+                    )+                 => HList r+                 -> HList s+                 -> MultiRWST r w s m a+                 -> m (a, HList w)+runMultiRWSTSW  :: ( Monad m+                    , Monoid (HList w)+                    )+                 => HList r+                 -> HList s+                 -> MultiRWST r w s m a+                 -> m (HList s, HList w)++runMultiRWSTNil :: ( Monad m )+                => MultiRWST '[] '[] '[] m a+                -> m a+runMultiRWSTNil_ :: ( Monad m, Functor m )+                 => MultiRWST '[] '[] '[] m a+                 -> m ()+runMultiRWST = runMultiRWSTASW+runMultiRWSTASW r s k = do+  (x, (_, w, s')) <- runStateT (runMultiRWSTRaw k) (r, mempty, s)+  return $ (x, s', w)+runMultiRWSTW r s k = do+  (_, w, _) <- execStateT (runMultiRWSTRaw k) (r, mempty, s)+  return $ w+runMultiRWSTAW r s k = do+  (x, (_, w, _)) <- runStateT (runMultiRWSTRaw k) (r, mempty, s)+  return $ (x, w)+runMultiRWSTSW r s k = do+  (_, w, s') <- execStateT (runMultiRWSTRaw k) (r, mempty, s)+  return $ (s', w)+runMultiRWSTNil  k = evalStateT (runMultiRWSTRaw k) (HNil, HNil, HNil)+runMultiRWSTNil_ k = void $ runStateT (runMultiRWSTRaw k) (HNil, HNil, HNil)++withMultiReader  :: Monad m => r -> MultiRWST (r ': rs) w s m a -> MultiRWST rs w s m a+withMultiReader_ :: (Functor m, Monad m) => r -> MultiRWST (r ': rs) w s m a -> MultiRWST rs w s m ()+withMultiReaders  :: Monad m => HList r1 -> MultiRWST (Append r1 r2) w s m a -> MultiRWST r2 w s m a+withMultiReaders_ :: (Functor m, Monad m) => HList r1 -> MultiRWST (Append r1 r2) w s m a -> MultiRWST r2 w s m ()+withMultiReader x k = MultiRWST $ do+  (r, w, s) <- get+  (a, (_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (x :+: r, w, s)+  put (r, w', s')+  return a+withMultiReader_ x k = MultiRWST $ do+  (r, w, s) <- get+  (_, w', s') <- lift $ execStateT (runMultiRWSTRaw k) (x :+: r, w, s)+  put (r, w', s')+withMultiReaders HNil       = id+withMultiReaders (x :+: xs) = withMultiReaders xs . withMultiReader x+withMultiReaders_ HNil       = void+withMultiReaders_ (x :+: xs) = withMultiReaders_ xs . withMultiReader x++withMultiWriter   :: (Monoid w, Monad m) => MultiRWST r (w ': ws) s m a -> MultiRWST r ws s m (a, w)+withMultiWriterAW :: (Monoid w, Monad m) => MultiRWST r (w ': ws) s m a -> MultiRWST r ws s m (a, w)+withMultiWriterWA :: (Monoid w, Monad m) => MultiRWST r (w ': ws) s m a -> MultiRWST r ws s m (w, a)+withMultiWriterW  :: (Monoid w, Monad m) => MultiRWST r (w ': ws) s m a -> MultiRWST r ws s m w+withMultiWriters   :: forall r w1 w2 s m a+                    . (Monoid (HList w1), Monad m, HInit w1)+                   => MultiRWST r (Append w1 w2) s m a+                   -> MultiRWST r w2 s m (a, HList w1)+withMultiWritersAW :: forall r w1 w2 s m a+                    . (Monoid (HList w1), Monad m, HInit w1)+                   => MultiRWST r (Append w1 w2) s m a+                   -> MultiRWST r w2 s m (a, HList w1)+withMultiWritersWA :: forall r w1 w2 s m a+                    . (Monoid (HList w1), Monad m, HInit w1)+                   => MultiRWST r (Append w1 w2) s m a+                   -> MultiRWST r w2 s m (HList w1, a)+withMultiWritersW  :: forall r w1 w2 s m a+                    . (Monoid (HList w1), Monad m, HInit w1)+                   => MultiRWST r (Append w1 w2) s m a+                   -> MultiRWST r w2 s m (HList w1)+withMultiWriter = withMultiWriterAW+withMultiWriterAW k = MultiRWST $ do+  (r, w, s) <- get+  (a, (_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (r, mempty :+: w, s)+  case w' of+    x' :+: wr' -> do+      put (r, wr', s')+      return (a, x')+withMultiWriterWA k = MultiRWST $ do+  (r, w, s) <- get+  (a, (_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (r, mempty :+: w, s)+  case w' of+    x' :+: wr' -> do+      put (r, wr', s')+      return (x', a)+withMultiWriterW k = MultiRWST $ do+  (r, w, s) <- get+  (_, w', s') <- lift $ execStateT (runMultiRWSTRaw k) (r, mempty :+: w, s)+  case w' of+    x' :+: wr' -> do+      put (r, wr', s')+      return x'+withMultiWriters = withMultiWritersAW+withMultiWritersAW k = MultiRWST $ do+  (r, w, s) <- get+  (a, (_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (r, hAppend (mempty :: HList w1) w, s)+  let (o, wr') = hSplit w'+  put (r, wr', s')+  return (a, o)+withMultiWritersWA k = MultiRWST $ do+  (r, w, s) <- get+  (a, (_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (r, hAppend (mempty :: HList w1) w, s)+  let (o, wr') = hSplit w'+  put (r, wr', s')+  return (o, a)+withMultiWritersW k = MultiRWST $ do+  (r, w, s) <- get+  (_, w', s') <- lift $ execStateT (runMultiRWSTRaw k) (r, hAppend (mempty :: HList w1) w, s)+  let (o, wr') = hSplit w'+  put (r, wr', s')+  return o++withMultiState   :: Monad m => s -> MultiRWST r w (s ': ss) m a -> MultiRWST r w ss m (a, s)+withMultiStateAS :: Monad m => s -> MultiRWST r w (s ': ss) m a -> MultiRWST r w ss m (a, s)+withMultiStateSA :: Monad m => s -> MultiRWST r w (s ': ss) m a -> MultiRWST r w ss m (s, a)+withMultiStateA  :: Monad m => s -> MultiRWST r w (s ': ss) m a -> MultiRWST r w ss m a+withMultiStateS  :: Monad m => s -> MultiRWST r w (s ': ss) m a -> MultiRWST r w ss m s+withMultiState_  :: (Functor m, Monad m) => s -> MultiRWST r w (s ': ss) m a -> MultiRWST r w ss m ()+withMultiStates   :: Monad m => HList s1 -> MultiRWST r w (Append s1 s2) m a -> MultiRWST r w s2 m (a, HList s1)+withMultiStatesAS :: Monad m => HList s1 -> MultiRWST r w (Append s1 s2) m a -> MultiRWST r w s2 m (a, HList s1)+withMultiStatesSA :: Monad m => HList s1 -> MultiRWST r w (Append s1 s2) m a -> MultiRWST r w s2 m (HList s1, a)+withMultiStatesA  :: Monad m => HList s1 -> MultiRWST r w (Append s1 s2) m a -> MultiRWST r w s2 m a+withMultiStatesS  :: Monad m => HList s1 -> MultiRWST r w (Append s1 s2) m a -> MultiRWST r w s2 m (HList s1)+withMultiStates_  :: (Functor m, Monad m) => HList s1 -> MultiRWST r w (Append s1 s2) m a -> MultiRWST r w s2 m ()+withMultiState = withMultiStateAS+withMultiStateAS x k = MultiRWST $ do+  (r, w, s) <- get+  (a, (_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (r, w, (x :+: s))+  case s' of+    x' :+: sr' -> do+      put (r, w', sr')+      return (a, x')+withMultiStateSA x k = MultiRWST $ do+  (r, w, s) <- get+  (a, (_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (r, w, (x :+: s))+  case s' of+    x' :+: sr' -> do+      put (r, w', sr')+      return (x', a)+withMultiStateA x k = MultiRWST $ do+  (r, w, s) <- get+  (a, (_, w', s')) <- lift $ runStateT (runMultiRWSTRaw k) (r, w, (x :+: s))+  case s' of+    _ :+: sr' -> do+      put (r, w', sr')+      return a+withMultiStateS x k = MultiRWST $ do+  (r, w, s) <- get+  (_, w', s') <- lift $ execStateT (runMultiRWSTRaw k) (r, w, (x :+: s))+  case s' of+    x' :+: sr' -> do+      put (r, w', sr')+      return x'+withMultiState_ x k = MultiRWST $ do+  (r, w, s) <- get+  (_, w', s') <- lift $ execStateT (runMultiRWSTRaw k) (r, w, (x :+: s))+  case s' of _ :+: sr' -> put (r, w', sr')+withMultiStates                = withMultiStatesAS+withMultiStatesAS HNil       k = do a <- k; return (a, HNil)+withMultiStatesAS (x :+: xs) k = do+  ((a, x'), xs') <- withMultiStates xs $ withMultiState x k+  return (a, x' :+: xs')+withMultiStatesSA HNil       k = do a <- k; return (HNil, a)+withMultiStatesSA (x :+: xs) k = do+  ((a, x'), xs') <- withMultiStates xs $ withMultiState x k+  return (x' :+: xs', a)+withMultiStatesA HNil       = id+withMultiStatesA (x :+: xs) = withMultiStatesA xs . withMultiStateA x+withMultiStatesS HNil       k = k >> return HNil+withMultiStatesS (x :+: xs) k = do+  (x', xs') <- withMultiStates xs $ withMultiStateS x k+  return (x' :+: xs')+withMultiStates_ HNil       = void+withMultiStates_ (x :+: xs) = withMultiStates_ xs . withMultiState_ x++inflateReader :: (Monad m, ContainsType r rs)+              => ReaderT r m a+              -> MultiRWST rs w s m a+inflateReader k = mAsk >>= lift . runReaderT k+inflateMultiReader :: Monad m => MultiReaderT r m a -> MultiRWST r w s m a+inflateMultiReader k = do+  r <- mGetRawR+  lift $ runMultiReaderT r k+inflateWriter :: (Monad m, ContainsType w ws, Monoid w)+              => WriterT w m a+              -> MultiRWST r ws s m a+inflateWriter k = do+  (x, w) <- lift $ runWriterT k+  mTell w+  return x+inflateMultiWriter :: (Functor m, Monad m, Monoid (HList w))+                   => MultiWriterT w m a+                   -> MultiRWST r w s m a+inflateMultiWriter k = do+  (x, w) <- lift $ runMultiWriterT k+  mPutRawW w+  return x+inflateState :: (Monad m, ContainsType s ss)+             => StateT s m a+             -> MultiRWST r w ss m a+inflateState k = do+  s <- mGet+  (x, s') <- lift $ runStateT k s+  mSet s'+  return x+inflateMultiState :: (Functor m, Monad m)+                  => MultiStateT s m a+                  -> MultiRWST r w s m a+inflateMultiState k = do+  s <- mGetRawS+  (x, s') <- lift $ runMultiStateT s k+  mPutRawS s'+  return x++mGetRawR :: Monad m => MultiRWST r w s m (HList r)+mPutRawR :: Monad m => HList r -> MultiRWST r w s m ()+mGetRawW :: Monad m => MultiRWST r w s m (HList w)+mPutRawW :: Monad m => HList w -> MultiRWST r w s m ()+mGetRawS :: Monad m => MultiRWST r w s m (HList s)+mPutRawS :: Monad m => HList s -> MultiRWST r w s m ()+mGetRawR = (\(r, _, _) -> r) `liftM` MultiRWST get+mPutRawR r = MultiRWST $ do+  ~(_, w, s) <- get+  put (r, w, s)+mGetRawW = (\(_, w, _) -> w) `liftM` MultiRWST get+mPutRawW w = MultiRWST $ do+  ~(r, _, s) <- get+  put (r, w, s)+mGetRawS = (\(_, _, s) -> s) `liftM` MultiRWST get+mPutRawS s = MultiRWST $ do+  ~(r, w, _) <- get+  put (r, w, s)++mapMultiRWST :: (ss ~ (HList r, HList w, HList s))+             => (m (a, ss) -> m' (a', ss))+             -> MultiRWST r w s m a+             -> MultiRWST r w s m' a'+mapMultiRWST f = MultiRWST . mapStateT f . runMultiRWSTRaw

@@ -0,0 +1,33 @@+-- | The multi-valued version of mtl's Reader / ReaderT+-- / MonadReader+module Control.Monad.Trans.MultiReader+  ( -- * MultiReaderT+    MultiReaderT(..)+  , MultiReaderTNull+  , MultiReader+  -- * MonadMultiReader class+  , MonadMultiReader(..)+  -- * run-functions+  , runMultiReaderT+  , runMultiReaderT_+  , runMultiReaderTNil+  , runMultiReaderTNil_+  -- * with-functions (single Reader)+  , withMultiReader+  , withMultiReader_+  -- * with-functions (multiple Readers)+  , withMultiReaders+  , withMultiReaders_+  -- * inflate-function (run ReaderT in MultiReaderT)+  , inflateReader+  -- * other functions+  , mapMultiReaderT+  , mGetRaw+  , mPutRaw+) where++++-- just re-export+import Control.Monad.Trans.MultiReader.Class+import Control.Monad.Trans.MultiReader.Lazy

@@ -0,0 +1,53 @@+-- | The multi-valued version of mtl's MonadReader+module Control.Monad.Trans.MultiReader.Class+  (+  -- * MonadMultiReader class+    MonadMultiReader(..)+  )+where++++import Control.Monad.Trans.Class  ( MonadTrans+                                  , lift )++++-- | All methods must be defined.+--+-- The idea is: Any monad stack is instance of @MonadMultiReader a@, iff+-- the stack contains a @MultiReaderT x@ with /a/ element of /x/.+class (Monad m) => MonadMultiReader a m where+  mAsk :: m a -- ^ Access to a specific type in the environment.++instance (MonadTrans t, Monad (t m), MonadMultiReader a m)+      => MonadMultiReader a (t m) where+  mAsk = lift $ mAsk++{-+it might make seem straightforward to define the following class that+corresponds to other transformer classes. But while we can define the the+class and its instances, there is a problem we try to use it, assuming that we+do not want to annotate the full type signature of the config:+  the type of the config can not be inferred properly. we would need a feature+  like "infer, as return type for this function, the only type for+  which there exists a valid chain of instance definitions that is needed to+  by this function".+  In other words, it is impossible to use the mAskRaw function without+  binding a concrete type for c, because otherwise the inference runs into+  some overlapping instances.+For this reason, I removed this type class and created a non-class function+mAskRaw, for which the type inference works because it involves no+type classes.+  lennart spitzner+-}++--class (Monad m) => MonadMultiReaderRaw c m where+--  mAskRaw :: m (HList c)++--instance (MonadTrans t, Monad (t m), MonadMultiReaderRaw c m)+--      => MonadMultiReaderRaw c (t m) where+--  mAskRaw = lift $ mAskRaw++--instance (Monad m) => MonadMultiReaderRaw a (MultiReaderT a m) where+--  mAskRaw = MultiReaderT $ get

@@ -0,0 +1,175 @@+-- | The multi-valued version of mtl's Reader / ReaderT+module Control.Monad.Trans.MultiReader.Lazy+  (+  -- * MultiReaderT+    MultiReaderT(..)+  , MultiReaderTNull+  , MultiReader+  -- * run-functions+  , runMultiReaderT+  , runMultiReaderT_+  , runMultiReaderTNil+  , runMultiReaderTNil_+  -- * with-functions (single Reader)+  , withMultiReader+  , withMultiReader_+  -- * with-functions (multiple Readers)+  , withMultiReaders+  , withMultiReaders_+  -- * inflate-function (run ReaderT in MultiReaderT)+  , inflateReader+  -- * other functions+  , mapMultiReaderT+  , mGetRaw+  , mPutRaw+) where++++import Data.HList.HList+import Data.HList.ContainsType++import Control.Monad.Trans.MultiReader.Class ( MonadMultiReader(..) )++import Control.Monad.State.Lazy   ( StateT(..)+                                  , MonadState(..)+                                  , evalStateT+                                  , mapStateT )+import Control.Monad.Reader       ( ReaderT(..) )+import Control.Monad.Trans.Class  ( MonadTrans+                                  , lift )+import Control.Monad.Writer.Class ( MonadWriter+                                  , listen+                                  , tell+                                  , writer+                                  , pass )++import Data.Functor.Identity      ( Identity )++import Control.Applicative        ( Applicative(..) )+import Control.Monad              ( liftM+                                  , ap+                                  , void )++++-- | A Reader transformer monad patameterized by:+--   +-- * x - The list of types constituting the environment / input (to be read),+-- * m - The inner monad.+-- +-- 'MultiReaderT' corresponds to mtl's 'ReaderT', but can contain+-- a heterogenous list of types.+-- +-- This heterogenous list is represented using Types.Data.List, i.e:+-- +--   * @'[]@ - The empty list,+--   * @a ': b@ - A list where @/a/@ is an arbitrary type+--     and @/b/@ is the rest list.+-- +-- For example,+-- +-- > MultiReaderT '[Int, Bool] :: (* -> *) -> (* -> *)+-- +-- is a Reader transformer containing the types [Int, Bool].+newtype MultiReaderT x m a = MultiReaderT {+  runMultiReaderTRaw :: StateT (HList x) m a+}++-- | A MultiReader transformer carrying an empty state.+type MultiReaderTNull = MultiReaderT '[]++-- | A reader monad parameterized by the list of types x of the environment+-- / input to carry.+--+-- Similar to @Reader r = ReaderT r Identity@+type MultiReader x = MultiReaderT x Identity++instance (Functor f) => Functor (MultiReaderT x f) where+  fmap f = MultiReaderT . fmap f . runMultiReaderTRaw++instance (Applicative m, Monad m) => Applicative (MultiReaderT x m) where+  pure = MultiReaderT . pure+  (<*>) = ap++instance Monad m => Monad (MultiReaderT x m) where+  return = MultiReaderT . return+  k >>= f = MultiReaderT $ runMultiReaderTRaw k >>= runMultiReaderTRaw . f++instance MonadTrans (MultiReaderT x) where+  lift = MultiReaderT . lift++instance (Monad m, ContainsType a c)+      => MonadMultiReader a (MultiReaderT c m) where+  mAsk = MultiReaderT $ liftM getHListElem get++-- methods++-- | A raw extractor of the contained HList (i.e. the complete Reader).+mGetRaw :: Monad m => MultiReaderT a m (HList a)+mGetRaw = MultiReaderT get++mPutRaw :: Monad m => HList s -> MultiReaderT s m ()+mPutRaw = MultiReaderT . put++-- | Map both the return value and the environment of a computation+-- using the given function.+--+-- Note that there is a difference to mtl's ReaderT,+-- where it is /not/ possible to modify the environment.+mapMultiReaderT :: (m (a, HList w) -> m' (a', HList w))+               -> MultiReaderT w m  a+               -> MultiReaderT w m' a'+mapMultiReaderT f = MultiReaderT . mapStateT f . runMultiReaderTRaw++runMultiReaderT  ::   Monad m => HList r -> MultiReaderT r m a -> m a+runMultiReaderT_ :: Functor m => HList r -> MultiReaderT r m a -> m ()+-- ghc too dumb for this shortcut, unfortunately+-- runMultiReaderT   s k = runMultiReaderTNil $ withMultiReaders s k+-- runMultiReaderT_  s k = runMultiReaderTNil $ withMultiReaders_ s k+runMultiReaderT  s k = evalStateT (runMultiReaderTRaw k) s+runMultiReaderT_ s k = void $ runStateT (runMultiReaderTRaw k) s++runMultiReaderTNil  ::   Monad m => MultiReaderT '[] m a -> m a+runMultiReaderTNil_ :: Functor m => MultiReaderT '[] m a -> m ()+runMultiReaderTNil  k = evalStateT (runMultiReaderTRaw k) HNil+runMultiReaderTNil_ k = void $ runStateT (runMultiReaderTRaw k) HNil++withMultiReader  :: Monad m => r -> MultiReaderT (r ': rs) m a -> MultiReaderT rs m a+withMultiReader_ :: (Functor m, Monad m) => r -> MultiReaderT (r ': rs) m a -> MultiReaderT rs m ()+withMultiReader  x k = MultiReaderT $+  get >>= lift . evalStateT (runMultiReaderTRaw k) . (x :+:)+withMultiReader_ x k = void $ withMultiReader x k++withMultiReaders  :: Monad m => HList r1 -> MultiReaderT (Append r1 r2) m a -> MultiReaderT r2 m a+withMultiReaders_ :: (Functor m, Monad m) => HList r1 -> MultiReaderT (Append r1 r2) m a -> MultiReaderT r2 m ()+withMultiReaders  HNil       = id+withMultiReaders  (x :+: xs) = withMultiReaders xs . withMultiReader x+withMultiReaders_ HNil       = liftM (const ())+withMultiReaders_ (x :+: xs) = withMultiReaders_ xs . withMultiReader_ x++inflateReader :: (Monad m, ContainsType r rs)+              => ReaderT r m a+              -> MultiReaderT rs m a+inflateReader k = mAsk >>= lift . runReaderT k++-- foreign lifting instances++instance (MonadState s m) => MonadState s (MultiReaderT c m) where+  put   = lift . put+  get   = lift $ get+  state = lift . state++instance (MonadWriter w m) => MonadWriter w (MultiReaderT c m) where+  writer = lift . writer+  tell   = lift . tell+  listen = MultiReaderT .+    mapStateT (liftM (\(~(~(a,w), w')) -> ((a, w'), w)) . listen) .+    runMultiReaderTRaw+  pass = MultiReaderT .+    mapStateT (pass . liftM (\(~(~(a, f), w)) -> ((a, w), f))) .+    runMultiReaderTRaw  ++++

@@ -0,0 +1,175 @@+-- | The multi-valued version of mtl's Reader / ReaderT+module Control.Monad.Trans.MultiReader.Strict+  (+  -- * MultiReaderT+    MultiReaderT(..)+  , MultiReaderTNull+  , MultiReader+  -- * run-functions+  , runMultiReaderT+  , runMultiReaderT_+  , runMultiReaderTNil+  , runMultiReaderTNil_+  -- * with-functions (single Reader)+  , withMultiReader+  , withMultiReader_+  -- * with-functions (multiple Readers)+  , withMultiReaders+  , withMultiReaders_+  -- * inflate-function (run ReaderT in MultiReaderT)+  , inflateReader+  -- * other functions+  , mapMultiReaderT+  , mGetRaw+  , mPutRaw+) where++++import Data.HList.HList+import Data.HList.ContainsType++import Control.Monad.Trans.MultiReader.Class ( MonadMultiReader(..) )++import Control.Monad.State.Strict ( StateT(..)+                                  , MonadState(..)+                                  , evalStateT+                                  , mapStateT )+import Control.Monad.Reader       ( ReaderT(..) )+import Control.Monad.Trans.Class  ( MonadTrans+                                  , lift )+import Control.Monad.Writer.Class ( MonadWriter+                                  , listen+                                  , tell+                                  , writer+                                  , pass )++import Data.Functor.Identity      ( Identity )++import Control.Applicative        ( Applicative(..) )+import Control.Monad              ( liftM+                                  , ap+                                  , void )++++-- | A Reader transformer monad patameterized by:+--   +-- * x - The list of types constituting the environment / input (to be read),+-- * m - The inner monad.+-- +-- 'MultiReaderT' corresponds to mtl's 'ReaderT', but can contain+-- a heterogenous list of types.+-- +-- This heterogenous list is represented using Types.Data.List, i.e:+-- +--   * @'[]@ - The empty list,+--   * @a ': b@ - A list where @/a/@ is an arbitrary type+--     and @/b/@ is the rest list.+-- +-- For example,+-- +-- > MultiReaderT '[Int, Bool] :: (* -> *) -> (* -> *)+-- +-- is a Reader transformer containing the types [Int, Bool].+newtype MultiReaderT x m a = MultiReaderT {+  runMultiReaderTRaw :: StateT (HList x) m a+}++-- | A MultiReader transformer carrying an empty state.+type MultiReaderTNull = MultiReaderT '[]++-- | A reader monad parameterized by the list of types x of the environment+-- / input to carry.+--+-- Similar to @Reader r = ReaderT r Identity@+type MultiReader x = MultiReaderT x Identity++instance (Functor f) => Functor (MultiReaderT x f) where+  fmap f = MultiReaderT . fmap f . runMultiReaderTRaw++instance (Applicative m, Monad m) => Applicative (MultiReaderT x m) where+  pure = MultiReaderT . pure+  (<*>) = ap++instance Monad m => Monad (MultiReaderT x m) where+  return = MultiReaderT . return+  k >>= f = MultiReaderT $ runMultiReaderTRaw k >>= (runMultiReaderTRaw . f)++instance MonadTrans (MultiReaderT x) where+  lift = MultiReaderT . lift++instance (Monad m, ContainsType a c)+      => MonadMultiReader a (MultiReaderT c m) where+  mAsk = MultiReaderT $ liftM getHListElem get++-- methods++-- | A raw extractor of the contained HList (i.e. the complete Reader).+mGetRaw :: Monad m => MultiReaderT a m (HList a)+mGetRaw = MultiReaderT get++mPutRaw :: Monad m => HList s -> MultiReaderT s m ()+mPutRaw = MultiReaderT . put++-- | Map both the return value and the environment of a computation+-- using the given function.+--+-- Note that there is a difference to mtl's ReaderT,+-- where it is /not/ possible to modify the environment.+mapMultiReaderT :: (m (a, HList w) -> m' (a', HList w))+               -> MultiReaderT w m  a+               -> MultiReaderT w m' a'+mapMultiReaderT f = MultiReaderT . mapStateT f . runMultiReaderTRaw++runMultiReaderT   ::   Monad m => HList r -> MultiReaderT r m a -> m a+runMultiReaderT_  :: Functor m => HList r -> MultiReaderT r m a -> m ()+-- ghc too dumb for this shortcut, unfortunately+-- runMultiReaderT   s k = runMultiReaderTNil $ withMultiReaders s k+-- runMultiReaderT_  s k = runMultiReaderTNil $ withMultiReaders_ s k+runMultiReaderT  s k = evalStateT (runMultiReaderTRaw k) s+runMultiReaderT_ s k = void $ runStateT (runMultiReaderTRaw k) s++runMultiReaderTNil  ::   Monad m => MultiReaderT '[] m a -> m a+runMultiReaderTNil_ :: Functor m => MultiReaderT '[] m a -> m ()+runMultiReaderTNil  k = evalStateT (runMultiReaderTRaw k) HNil+runMultiReaderTNil_ k = void $ runStateT (runMultiReaderTRaw k) HNil++withMultiReader   :: Monad m => r -> MultiReaderT (r ': rs) m a -> MultiReaderT rs m a+withMultiReader_  :: (Functor m, Monad m) => r -> MultiReaderT (r ': rs) m a -> MultiReaderT rs m ()+withMultiReader  x k = MultiReaderT $+  get >>= lift . evalStateT (runMultiReaderTRaw k) . (x :+:)+withMultiReader_ x k = void $ withMultiReader x k++withMultiReaders  :: Monad m => HList r1 -> MultiReaderT (Append r1 r2) m a -> MultiReaderT r2 m a+withMultiReaders_ :: (Functor m, Monad m) => HList r1 -> MultiReaderT (Append r1 r2) m a -> MultiReaderT r2 m ()+withMultiReaders  HNil       = id+withMultiReaders  (x :+: xs) = withMultiReaders xs . withMultiReader x+withMultiReaders_ HNil       = liftM (const ())+withMultiReaders_ (x :+: xs) = withMultiReaders_ xs . withMultiReader_ x++inflateReader :: (Monad m, ContainsType r rs)+              => ReaderT r m a+              -> MultiReaderT rs m a+inflateReader k = mAsk >>= lift . runReaderT k++-- foreign lifting instances++instance (MonadState s m) => MonadState s (MultiReaderT c m) where+  put   = lift . put+  get   = lift $ get+  state = lift . state++instance (MonadWriter w m) => MonadWriter w (MultiReaderT c m) where+  writer = lift . writer+  tell   = lift . tell+  listen = MultiReaderT .+    mapStateT (liftM (\((a,w), w') -> ((a, w'), w)) . listen) .+    runMultiReaderTRaw+  pass = MultiReaderT .+    mapStateT (pass . liftM (\((a, f), w) -> ((a, w), f))) .+    runMultiReaderTRaw  ++++

@@ -0,0 +1,48 @@+-- | The multi-valued version of mtl's State / StateT+-- / MonadState+module Control.Monad.Trans.MultiState+  (+  -- * MultiStateT+    MultiStateT(..)+  , MultiStateTNull+  , MultiState+  -- * MonadMultiState class+  , MonadMultiState(..)+  -- * run-functions+  , runMultiStateT+  , runMultiStateTAS+  , runMultiStateTSA+  , runMultiStateTA+  , runMultiStateTS+  , runMultiStateT_+  , runMultiStateTNil+  , runMultiStateTNil_+  -- * with-functions (single state)+  , withMultiState+  , withMultiStateAS+  , withMultiStateSA+  , withMultiStateA+  , withMultiStateS+  , withMultiState_+  -- * with-functions (multiple states)+  , withMultiStates+  , withMultiStatesAS+  , withMultiStatesSA+  , withMultiStatesA+  , withMultiStatesS+  , withMultiStates_+  -- * inflate-functions (run single state in multiple states)+  , inflateState+  , inflateReader+  , inflateWriter+  -- * other functions+  , mapMultiStateT+  , mGetRaw+  , mPutRaw+) where++++-- just re-export+import Control.Monad.Trans.MultiState.Class+import Control.Monad.Trans.MultiState.Lazy

@@ -0,0 +1,29 @@+-- | The multi-valued version of mtl's MonadState+module Control.Monad.Trans.MultiState.Class+  (+  -- * MonadMultiState class+    MonadMultiState(..)+  )+where++++import Control.Monad.Trans.Class  ( MonadTrans+                                  , lift )++++-- | All methods must be defined.+--+-- The idea is: Any monad stack is instance of @MonadMultiState a@, iff+-- the stack contains a @MultiStateT x@ with /a/ element of /x/.+class (Monad m) => MonadMultiState a m where+  -- | state set function for values of type @a@.+  mSet :: a -> m ()+  -- | state get function for values of type @a@.+  mGet :: m a++instance (MonadTrans t, Monad (t m), MonadMultiState a m)+      => MonadMultiState a (t m) where+  mSet = lift . mSet+  mGet = lift $ mGet

@@ -0,0 +1,245 @@+-- | The multi-valued version of mtl's State / StateT+module Control.Monad.Trans.MultiState.Lazy+  (+  -- * MultiStateT+    MultiStateT(..)+  , MultiStateTNull+  , MultiState+  -- * MonadMultiState class+  , MonadMultiState(..)+  -- * run-functions+  , runMultiStateT+  , runMultiStateTAS+  , runMultiStateTSA+  , runMultiStateTA+  , runMultiStateTS+  , runMultiStateT_+  , runMultiStateTNil+  , runMultiStateTNil_+  -- * with-functions (single state)+  , withMultiState+  , withMultiStateAS+  , withMultiStateSA+  , withMultiStateA+  , withMultiStateS+  , withMultiState_+  -- * with-functions (multiple states)+  , withMultiStates+  , withMultiStatesAS+  , withMultiStatesSA+  , withMultiStatesA+  , withMultiStatesS+  , withMultiStates_+  -- * inflate-functions (run single state in multiple states)+  , inflateState+  , inflateReader+  , inflateWriter+  -- * other functions+  , mapMultiStateT+  , mGetRaw+  , mPutRaw+) where++++import Data.HList.HList+import Data.HList.ContainsType++import Control.Monad.Trans.MultiState.Class++import Control.Monad.State.Lazy   ( StateT(..)+                                  , MonadState(..)+                                  , evalStateT+                                  , execStateT+                                  , mapStateT )+import Control.Monad.Reader       ( ReaderT(..) )+import Control.Monad.Writer.Lazy  ( WriterT(..) )+import Control.Monad.Trans.Class  ( MonadTrans+                                  , lift )+import Control.Monad.Writer.Class ( MonadWriter+                                  , listen+                                  , tell+                                  , writer+                                  , pass )++import Data.Functor.Identity      ( Identity )++import Control.Applicative        ( Applicative(..) )+import Control.Monad              ( liftM+                                  , ap+                                  , void )+import Data.Monoid                ( Monoid )++++-- | A State transformer monad patameterized by:+--   +-- * x - The list of types constituting the state,+-- * m - The inner monad.+-- +-- 'MultiStateT' corresponds to mtl's 'StateT', but can contain+-- a heterogenous list of types.+-- +-- This heterogenous list is represented using Types.Data.List, i.e:+-- +--   * @'[]@ - The empty list,+--   * @a ': b@ - A list where @/a/@ is an arbitrary type+--     and @/b/@ is the rest list.+-- +-- For example,+-- +-- > MultiStateT '[Int, Bool] :: (* -> *) -> (* -> *)+-- +-- is a State wrapper containing the types [Int, Bool].+newtype MultiStateT x m a = MultiStateT {+  runMultiStateTRaw :: StateT (HList x) m a+}++-- | A MultiState transformer carrying an empty state.+type MultiStateTNull = MultiStateT '[]++-- | A state monad parameterized by the list of types x of the state to carry.+--+-- Similar to @State s = StateT s Identity@+type MultiState x = MultiStateT x Identity++-- some instances++instance (Functor f) => Functor (MultiStateT x f) where+  fmap f = MultiStateT . fmap f . runMultiStateTRaw++instance (Applicative m, Monad m) => Applicative (MultiStateT x m) where+  pure = MultiStateT . pure+  (<*>) = ap++instance Monad m => Monad (MultiStateT x m) where+  return = MultiStateT . return+  k >>= f = MultiStateT $ runMultiStateTRaw k >>= (runMultiStateTRaw.f)++instance MonadTrans (MultiStateT x) where+  lift = MultiStateT . lift++instance (Monad m, ContainsType a c)+      => MonadMultiState a (MultiStateT c m) where+  mSet v = MultiStateT $ get >>= put . setHListElem v+  mGet = MultiStateT $ liftM getHListElem get++-- methods++-- | A raw extractor of the contained HList (i.e. the complete state).+mGetRaw :: Monad m => MultiStateT a m (HList a)+mGetRaw = MultiStateT get++mPutRaw :: Monad m => HList s -> MultiStateT s m ()+mPutRaw = MultiStateT . put++-- | Map both the return value and the state of a computation+-- using the given function.+mapMultiStateT :: (m (a, HList w) -> m' (a', HList w))+               -> MultiStateT w m  a+               -> MultiStateT w m' a'+mapMultiStateT f = MultiStateT . mapStateT f . runMultiStateTRaw++runMultiStateT   :: Functor m => HList s -> MultiStateT s m a -> m (a, HList s)+runMultiStateTAS :: Functor m => HList s -> MultiStateT s m a -> m (a, HList s)+runMultiStateTSA :: Monad m   => HList s -> MultiStateT s m a -> m (HList s, a)+runMultiStateTA  :: Monad m   => HList s -> MultiStateT s m a -> m a+runMultiStateTS  :: Monad m   => HList s -> MultiStateT s m a -> m (HList s)+runMultiStateT_  :: Functor m => HList s -> MultiStateT s m a -> m ()+-- ghc too dumb for this shortcut, unfortunately+-- runMultiStateT   s k = runMultiStateTNil $ withMultiStates s k+-- runMultiStateTAS s k = runMultiStateTNil $ withMultiStatesAS s k+-- runMultiStateTSA s k = runMultiStateTNil $ withMultiStatesSA s k+-- runMultiStateTA  s k = runMultiStateTNil $ withMultiStatesA s k+-- runMultiStateTS  s k = runMultiStateTNil $ withMultiStatesS s k+-- runMultiStateT_  s k = runMultiStateTNil $ withMultiStates_ s k+runMultiStateT   s k = runMultiStateTAS s k+runMultiStateTAS s k = runStateT (runMultiStateTRaw k) s+runMultiStateTSA s k = (\(~(a,b)) -> (b,a)) `liftM` runStateT (runMultiStateTRaw k) s+runMultiStateTA  s k = evalStateT (runMultiStateTRaw k) s+runMultiStateTS  s k = execStateT (runMultiStateTRaw k) s+runMultiStateT_  s k = void $ runStateT (runMultiStateTRaw k) s++runMultiStateTNil  ::   Monad m => MultiStateT '[] m a -> m a+runMultiStateTNil_ :: Functor m => MultiStateT '[] m a -> m ()+runMultiStateTNil  k = evalStateT (runMultiStateTRaw k) HNil+runMultiStateTNil_ k = void $ runStateT (runMultiStateTRaw k) HNil++withMultiState   :: Monad m => s -> MultiStateT (s ': ss) m a -> MultiStateT ss m (a, s)+withMultiStateAS :: Monad m => s -> MultiStateT (s ': ss) m a -> MultiStateT ss m (a, s)+withMultiStateSA :: Monad m => s -> MultiStateT (s ': ss) m a -> MultiStateT ss m (s, a)+withMultiStateA  :: Monad m => s -> MultiStateT (s ': ss) m a -> MultiStateT ss m a+withMultiStateS  :: Monad m => s -> MultiStateT (s ': ss) m a -> MultiStateT ss m s+withMultiState_  :: (Functor m, Monad m) => s -> MultiStateT (s ': ss) m a -> MultiStateT ss m ()+withMultiState = withMultiStateAS+withMultiStateAS x k = MultiStateT $ do+  s <- get+  ~(a, s') <- lift $ runStateT (runMultiStateTRaw k) (x :+: s)+  case s' of x' :+: sr' -> do put sr'; return (a, x')+withMultiStateSA s k = (\(~(a,b)) -> (b,a)) `liftM` withMultiStateAS s k+withMultiStateA  s k = fst `liftM` withMultiStateAS s k+withMultiStateS  s k = snd `liftM` withMultiStateAS s k+withMultiState_  s k = void $ withMultiStateAS s k++withMultiStates   :: Monad m => HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m (a, HList s1)+withMultiStatesAS :: Monad m => HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m (a, HList s1)+withMultiStatesSA :: Monad m => HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m (HList s1, a)+withMultiStatesA  :: Monad m => HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m a+withMultiStatesS  :: Monad m => HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m (HList s1)+withMultiStates_  :: (Functor m, Monad m) => HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m ()+withMultiStates = withMultiStatesAS+withMultiStatesAS HNil       = liftM (\r -> (r, HNil))+withMultiStatesAS (x :+: xs) = liftM (\(~(~(a, x'), xs')) -> (a, x' :+: xs'))+                        . withMultiStatesAS xs +                        . withMultiStateAS x+withMultiStatesSA HNil       = liftM (\r -> (HNil, r))+withMultiStatesSA (x :+: xs) = liftM (\(~(~(a, x'), xs')) -> (x' :+: xs', a))+                        . withMultiStatesAS xs +                        . withMultiStateAS x+withMultiStatesA  HNil       = id+withMultiStatesA  (x :+: xs) = withMultiStatesA xs . withMultiStateA x+withMultiStatesS  HNil       = liftM (const HNil)+withMultiStatesS (x :+: xs)  = liftM (\(~(x', xs')) -> x' :+: xs')+                        . withMultiStatesAS xs+                        . withMultiStateS x+withMultiStates_  HNil       = liftM (const ())+withMultiStates_ (x :+: xs)  = withMultiStates_ xs . withMultiState_ x++inflateState :: (Monad m, ContainsType s ss)+             => StateT s m a+             -> MultiStateT ss m a+inflateState k = do+  s <- mGet+  ~(x, s') <- lift $ runStateT k s+  mSet s'+  return x++inflateReader :: (Monad m, ContainsType r ss)+              => ReaderT r m a+              -> MultiStateT ss m a+inflateReader k = mGet >>= lift . runReaderT k++inflateWriter :: (Monad m, ContainsType w ss, Monoid w)+              => WriterT w m a+              -> MultiStateT ss m a+inflateWriter k = do+  ~(x, w) <- lift $ runWriterT k+  mSet w+  return x++-- foreign lifting instances++instance (MonadState s m) => MonadState s (MultiStateT c m) where+  put   = lift . put+  get   = lift $ get+  state = lift . state++instance (MonadWriter w m) => MonadWriter w (MultiStateT c m) where+  writer = lift . writer+  tell   = lift . tell+  listen = MultiStateT .+    mapStateT (liftM (\(~(~(a,w), w')) -> ((a, w'), w)) . listen) .+    runMultiStateTRaw+  pass = MultiStateT .+    mapStateT (pass . liftM (\(~(~(a, f), w)) -> ((a, w), f))) .+    runMultiStateTRaw  

@@ -0,0 +1,243 @@+-- | The multi-valued version of mtl's State / StateT+module Control.Monad.Trans.MultiState.Strict+  (+  -- * MultiStateT+    MultiStateT(..)+  , MultiStateTNull+  , MultiState+  -- * MonadMultiState class+  , MonadMultiState(..)+  -- * run-functions+  , runMultiStateT+  , runMultiStateTAS+  , runMultiStateTSA+  , runMultiStateTA+  , runMultiStateTS+  , runMultiStateT_+  , runMultiStateTNil+  , runMultiStateTNil_+  -- * with-functions (single state)+  , withMultiState+  , withMultiStateAS+  , withMultiStateSA+  , withMultiStateA+  , withMultiStateS+  , withMultiState_+  -- * with-functions (multiple states)+  , withMultiStates+  , withMultiStatesAS+  , withMultiStatesSA+  , withMultiStatesA+  , withMultiStatesS+  , withMultiStates_+  -- * inflate-functions (run single state in multiple states)+  , inflateState+  , inflateReader+  , inflateWriter+  -- * other functions+  , mapMultiStateT+  , mGetRaw+  , mPutRaw+) where++++import Data.HList.HList+import Data.HList.ContainsType++import Control.Monad.Trans.MultiState.Class++import Control.Monad.State.Strict  ( StateT(..)+                                   , MonadState(..)+                                   , evalStateT+                                   , execStateT+                                   , mapStateT )+import Control.Monad.Reader        ( ReaderT(..) )+import Control.Monad.Writer.Strict ( WriterT(..) )+import Control.Monad.Trans.Class   ( MonadTrans+                                   , lift )+import Control.Monad.Writer.Class  ( MonadWriter+                                   , listen+                                   , tell+                                   , writer+                                   , pass )++import Data.Functor.Identity       ( Identity )++import Control.Applicative         ( Applicative(..) )+import Control.Monad               ( liftM+                                   , ap+                                   , void )+import Data.Monoid                 ( Monoid )++++-- | A State transformer monad patameterized by:+--   +-- * x - The list of types constituting the state,+-- * m - The inner monad.+-- +-- 'MultiStateT' corresponds to mtl's 'StateT', but can contain+-- a heterogenous list of types.+-- +-- This heterogenous list is represented using Types.Data.List, i.e:+-- +--   * @'[]@ - The empty list,+--   * @a ': b@ - A list where @/a/@ is an arbitrary type+--     and @/b/@ is the rest list.+-- +-- For example,+-- +-- > MultiStateT '[Int, Bool] :: (* -> *) -> (* -> *)+-- +-- is a State wrapper containing the types [Int, Bool].+newtype MultiStateT x m a = MultiStateT {+  runMultiStateTRaw :: StateT (HList x) m a+}++-- | A MultiState transformer carrying an empty state.+type MultiStateTNull = MultiStateT '[]++-- | A state monad parameterized by the list of types x of the state to carry.+--+-- Similar to @State s = StateT s Identity@+type MultiState x = MultiStateT x Identity++instance (Functor f) => Functor (MultiStateT x f) where+  fmap f = MultiStateT . fmap f . runMultiStateTRaw++instance (Applicative m, Monad m) => Applicative (MultiStateT x m) where+  pure = MultiStateT . pure+  (<*>) = ap++instance Monad m => Monad (MultiStateT x m) where+  return = MultiStateT . return+  k >>= f = MultiStateT $ runMultiStateTRaw k >>= (runMultiStateTRaw.f)++instance MonadTrans (MultiStateT x) where+  lift = MultiStateT . lift++instance (Monad m, ContainsType a c)+      => MonadMultiState a (MultiStateT c m) where+  mSet v = MultiStateT $ get >>= put . setHListElem v+  mGet = MultiStateT $ liftM getHListElem get++-- methods++-- | A raw extractor of the contained HList (i.e. the complete state).+mGetRaw :: Monad m => MultiStateT a m (HList a)+mGetRaw = MultiStateT get++mPutRaw :: Monad m => HList s -> MultiStateT s m ()+mPutRaw = MultiStateT . put++-- | Map both the return value and the state of a computation+-- using the given function.+mapMultiStateT :: (m (a, HList w) -> m' (a', HList w))+               -> MultiStateT w m  a+               -> MultiStateT w m' a'+mapMultiStateT f = MultiStateT . mapStateT f . runMultiStateTRaw++runMultiStateT   :: Functor m => HList s -> MultiStateT s m a -> m (a, HList s)+runMultiStateTAS :: Functor m => HList s -> MultiStateT s m a -> m (a, HList s)+runMultiStateTSA :: Monad m   => HList s -> MultiStateT s m a -> m (HList s, a)+runMultiStateTA  :: Monad m   => HList s -> MultiStateT s m a -> m a+runMultiStateTS  :: Monad m   => HList s -> MultiStateT s m a -> m (HList s)+runMultiStateT_  :: Functor m => HList s -> MultiStateT s m a -> m ()+-- ghc too dumb for this shortcut, unfortunately+-- runMultiStateT   s k = runMultiStateTNil $ withMultiStates s k+-- runMultiStateTAS s k = runMultiStateTNil $ withMultiStatesAS s k+-- runMultiStateTSA s k = runMultiStateTNil $ withMultiStatesSA s k+-- runMultiStateTA  s k = runMultiStateTNil $ withMultiStatesA s k+-- runMultiStateTS  s k = runMultiStateTNil $ withMultiStatesS s k+-- runMultiStateT_  s k = runMultiStateTNil $ withMultiStates_ s k+runMultiStateT   s k = runMultiStateTAS s k+runMultiStateTAS s k = runStateT (runMultiStateTRaw k) s+runMultiStateTSA s k = (\(a,b) -> (b,a)) `liftM` runStateT (runMultiStateTRaw k) s+runMultiStateTA  s k = evalStateT (runMultiStateTRaw k) s+runMultiStateTS  s k = execStateT (runMultiStateTRaw k) s+runMultiStateT_  s k = void $ runStateT (runMultiStateTRaw k) s++runMultiStateTNil  ::   Monad m => MultiStateT '[] m a -> m a+runMultiStateTNil_ :: Functor m => MultiStateT '[] m a -> m ()+runMultiStateTNil  k = evalStateT (runMultiStateTRaw k) HNil+runMultiStateTNil_ k = void $ runStateT (runMultiStateTRaw k) HNil++withMultiState   :: Monad m => s -> MultiStateT (s ': ss) m a -> MultiStateT ss m (a, s)+withMultiStateAS :: Monad m => s -> MultiStateT (s ': ss) m a -> MultiStateT ss m (a, s)+withMultiStateSA :: Monad m => s -> MultiStateT (s ': ss) m a -> MultiStateT ss m (s, a)+withMultiStateA  :: Monad m => s -> MultiStateT (s ': ss) m a -> MultiStateT ss m a+withMultiStateS  :: Monad m => s -> MultiStateT (s ': ss) m a -> MultiStateT ss m s+withMultiState_  :: (Functor m, Monad m) => s -> MultiStateT (s ': ss) m a -> MultiStateT ss m ()+withMultiState = withMultiStateAS+withMultiStateAS x k = MultiStateT $ do+  s <- get+  ~(a, s') <- lift $ runStateT (runMultiStateTRaw k) (x :+: s)+  case s' of x' :+: sr' -> do put sr'; return (a, x')+withMultiStateSA s k = (\(a,b) -> (b,a)) `liftM` withMultiStateAS s k+withMultiStateA  s k = fst `liftM` withMultiStateAS s k+withMultiStateS  s k = snd `liftM` withMultiStateAS s k+withMultiState_  s k = void $ withMultiStateAS s k++withMultiStates   :: Monad m => HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m (a, HList s1)+withMultiStatesAS :: Monad m => HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m (a, HList s1)+withMultiStatesSA :: Monad m => HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m (HList s1, a)+withMultiStatesA  :: Monad m => HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m a+withMultiStatesS  :: Monad m => HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m (HList s1)+withMultiStates_  :: (Functor m, Monad m) => HList s1 -> MultiStateT (Append s1 s2) m a -> MultiStateT s2 m ()+withMultiStates = withMultiStatesAS+withMultiStatesAS HNil       = liftM (\r -> (r, HNil))+withMultiStatesAS (x :+: xs) = liftM (\((a, x'), xs') -> (a, x' :+: xs'))+                        . withMultiStatesAS xs +                        . withMultiStateAS x+withMultiStatesSA HNil       = liftM (\r -> (HNil, r))+withMultiStatesSA (x :+: xs) = liftM (\((a, x'), xs') -> (x' :+: xs', a))+                        . withMultiStatesAS xs +                        . withMultiStateAS x+withMultiStatesA  HNil       = id+withMultiStatesA  (x :+: xs) = withMultiStatesA xs . withMultiStateA x+withMultiStatesS  HNil       = liftM (const HNil)+withMultiStatesS (x :+: xs)  = liftM (\(x', xs') -> x' :+: xs')+                        . withMultiStatesAS xs+                        . withMultiStateS x+withMultiStates_  HNil       = liftM (const ())+withMultiStates_ (x :+: xs)  = withMultiStates_ xs . withMultiState_ x++inflateState :: (Monad m, ContainsType s ss)+             => StateT s m a+             -> MultiStateT ss m a+inflateState k = do+  s <- mGet+  (x, s') <- lift $ runStateT k s+  mSet s'+  return x++inflateReader :: (Monad m, ContainsType r ss)+              => ReaderT r m a+              -> MultiStateT ss m a+inflateReader k = mGet >>= lift . runReaderT k++inflateWriter :: (Monad m, ContainsType w ss, Monoid w)+              => WriterT w m a+              -> MultiStateT ss m a+inflateWriter k = do+  (x, w) <- lift $ runWriterT k+  mSet w+  return x++-- foreign lifting instances++instance (MonadState s m) => MonadState s (MultiStateT c m) where+  put   = lift . put+  get   = lift $ get+  state = lift . state++instance (MonadWriter w m) => MonadWriter w (MultiStateT c m) where+  writer = lift . writer+  tell   = lift . tell+  listen = MultiStateT .+    mapStateT (liftM (\((a,w), w') -> ((a, w'), w)) . listen) .+    runMultiStateTRaw+  pass = MultiStateT .+    mapStateT (pass . liftM (\((a, f), w) -> ((a, w), f))) .+    runMultiStateTRaw  

@@ -0,0 +1,40 @@+{-# LANGUAGE FlexibleContexts #-}++-- | The multi-valued version of mtl's Writer / WriterT+-- / MonadWriter+module Control.Monad.Trans.MultiWriter+  ( -- * MultiWriterT+    MultiWriterT(..)+  , MultiWriterTNull+  , MultiWriter+  -- * MonadMultiWriter class+  , MonadMultiWriter(..)+  -- * run-functions+  , runMultiWriterT+  , runMultiWriterTAW+  , runMultiWriterTWA+  , runMultiWriterTW+  , runMultiWriterTNil+  , runMultiWriterTNil_+  -- * with-functions (single Writer)+  , withMultiWriter+  , withMultiWriterAW+  , withMultiWriterWA+  , withMultiWriterW+  -- * with-functions (multiple Writers)+  , withMultiWriters+  , withMultiWritersAW+  , withMultiWritersWA+  , withMultiWritersW+  -- * other functions+  , mapMultiWriterT+  , mGetRaw+  , mPutRaw+  )+where++++-- just re-exports+import Control.Monad.Trans.MultiWriter.Class+import Control.Monad.Trans.MultiWriter.Lazy

@@ -0,0 +1,24 @@+-- | The multi-valued version of mtl's MonadWriter+module Control.Monad.Trans.MultiWriter.Class+  (+  -- * MonadMultiWriter class+    MonadMultiWriter(..)+  )+where++++import Control.Monad.Trans.Class  ( MonadTrans+                                  , lift )++import Data.Monoid++++-- TODO: some haddock+class (Monad m, Monoid a) => MonadMultiWriter a m where+  mTell :: a -> m ()  ++instance (MonadTrans t, Monad (t m), MonadMultiWriter a m)+      => MonadMultiWriter a (t m) where+  mTell = lift . mTell

@@ -0,0 +1,222 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | The multi-valued version of mtl's Writer / WriterT+module Control.Monad.Trans.MultiWriter.Lazy+  (+  -- * MultiWriterT+    MultiWriterT(..)+  , MultiWriterTNull+  , MultiWriter+  -- * run-functions+  , runMultiWriterT+  , runMultiWriterTAW+  , runMultiWriterTWA+  , runMultiWriterTW+  , runMultiWriterTNil+  , runMultiWriterTNil_+  -- * with-functions (single Writer)+  , withMultiWriter+  , withMultiWriterAW+  , withMultiWriterWA+  , withMultiWriterW+  -- * with-functions (multiple Writers)+  , withMultiWriters+  , withMultiWritersAW+  , withMultiWritersWA+  , withMultiWritersW+  -- * inflate-function (run WriterT in MultiWriterT)+  , inflateWriter+  -- * other functions+  , mapMultiWriterT+  , mGetRaw+  , mPutRaw+  )+where++++import Data.HList.HList+import Data.HList.ContainsType++import Control.Monad.Trans.MultiWriter.Class ( MonadMultiWriter(..) )++import Control.Monad.State.Lazy   ( StateT(..)+                                  , MonadState(..)+                                  , execStateT+                                  , evalStateT+                                  , mapStateT )+import Control.Monad.Writer.Lazy  ( WriterT(..) ) +import Control.Monad.Trans.Class  ( MonadTrans+                                  , lift )+import Control.Monad.Writer.Class ( MonadWriter+                                  , listen+                                  , tell+                                  , writer+                                  , pass )++import Data.Functor.Identity      ( Identity )++import Control.Applicative        ( Applicative(..) )+import Control.Monad              ( liftM+                                  , ap+                                  , void )++import Data.Monoid++++-- | A Writer transformer monad patameterized by:+--   +-- * x - The list of types that can be written (Monoid instances).+-- * m - The inner monad.+-- +-- 'MultiWriterT' corresponds to mtl's 'WriterT', but can contain+-- a heterogenous list of types.+-- +-- This heterogenous list is represented using Types.Data.List, i.e:+-- +--   * @'[]@ - The empty list,+--   * @a ': b@ - A list where @/a/@ is an arbitrary type+--     and @/b/@ is the rest list.+-- +-- For example,+-- +-- > MultiWriterT '[Int, Bool] :: (* -> *) -> (* -> *)+-- +-- is a Writer transformer containing the types [Int, Bool].+newtype MultiWriterT x m a = MultiWriterT {+  runMultiWriterTRaw :: StateT (HList x) m a+}++-- | A MultiWriter transformer carrying an empty state.+type MultiWriterTNull = MultiWriterT '[]++type MultiWriter x a = MultiWriterT x Identity a++instance (Functor f) => Functor (MultiWriterT x f) where+  fmap f = MultiWriterT . fmap f . runMultiWriterTRaw++instance (Applicative m, Monad m) => Applicative (MultiWriterT x m) where+  pure = MultiWriterT . pure+  (<*>) = ap++instance Monad m => Monad (MultiWriterT x m) where+  return = MultiWriterT . return+  k >>= f = MultiWriterT $ runMultiWriterTRaw k >>= (runMultiWriterTRaw . f)++instance MonadTrans (MultiWriterT x) where+  lift = MultiWriterT . lift++instance (Monad m, ContainsType a c, Monoid a)+      => MonadMultiWriter a (MultiWriterT c m) where+  mTell v = MultiWriterT $ do+    x <- get+    put $ setHListElem (getHListElem x `mappend` v) x++-- methods++-- | A raw extractor of the contained HList (i.e. the complete state).+mGetRaw :: Monad m => MultiWriterT a m (HList a)+mGetRaw = MultiWriterT get++mPutRaw :: Monad m => HList s -> MultiWriterT s m ()+mPutRaw = MultiWriterT . put++-- | Map both the return value and the state of a computation+-- using the given function.+mapMultiWriterT :: (m (a, HList w) -> m' (a', HList w))+               -> MultiWriterT w m  a+               -> MultiWriterT w m' a'+mapMultiWriterT f = MultiWriterT . mapStateT f . runMultiWriterTRaw++runMultiWriterT   :: (Monoid (HList w), Functor m) => MultiWriterT w m a -> m (a, HList w)+runMultiWriterTAW :: (Monoid (HList w), Functor m) => MultiWriterT w m a -> m (a, HList w)+runMultiWriterTWA :: (Monoid (HList w),   Monad m) => MultiWriterT w m a -> m (HList w, a)+runMultiWriterTW  :: (Monoid (HList w),   Monad m) => MultiWriterT w m a -> m (HList w)+runMultiWriterT     = runMultiWriterTAW+runMultiWriterTAW k = runStateT (runMultiWriterTRaw k) mempty+runMultiWriterTWA k = (\(~(a,b)) -> (b,a)) `liftM` runStateT (runMultiWriterTRaw k) mempty+runMultiWriterTW  k = execStateT (runMultiWriterTRaw k) mempty++runMultiWriterTNil  ::   Monad m => MultiWriterT '[] m a -> m a+runMultiWriterTNil_ :: Functor m => MultiWriterT '[] m a -> m ()+runMultiWriterTNil  k = evalStateT (runMultiWriterTRaw k) HNil+runMultiWriterTNil_ k = void $ runStateT (runMultiWriterTRaw k) HNil++withMultiWriter   :: (Monoid w, Monad m) => MultiWriterT (w ': ws) m a -> MultiWriterT ws m (a, w)+withMultiWriterAW :: (Monoid w, Monad m) => MultiWriterT (w ': ws) m a -> MultiWriterT ws m (a, w)+withMultiWriterWA :: (Monoid w, Monad m) => MultiWriterT (w ': ws) m a -> MultiWriterT ws m (w, a)+withMultiWriterW  :: (Monoid w, Monad m) => MultiWriterT (w ': ws) m a -> MultiWriterT ws m w+withMultiWriter = withMultiWriterAW+withMultiWriterAW k = MultiWriterT $ do+  w <- get+  ~(a, w') <- lift $ runStateT (runMultiWriterTRaw k) (mempty :+: w)+  case w' of x' :+: wr' -> do put wr'; return (a, x')+withMultiWriterWA k = (\(~(a,b)) -> (b,a)) `liftM` withMultiWriterAW k+withMultiWriterW  k = snd `liftM` withMultiWriterAW k++withMultiWriters   :: forall w1 w2 m a+               . (Monoid (HList w1), Monad m, HInit w1)+              => MultiWriterT (Append w1 w2) m a+              -> MultiWriterT w2 m (a, HList w1)+withMultiWritersAW :: forall w1 w2 m a+               . (Monoid (HList w1), Monad m, HInit w1)+              => MultiWriterT (Append w1 w2) m a+              -> MultiWriterT w2 m (a, HList w1)+withMultiWritersWA :: forall w1 w2 m a+               . (Monoid (HList w1), Monad m, HInit w1)+              => MultiWriterT (Append w1 w2) m a+              -> MultiWriterT w2 m (HList w1, a)+-- withMultiWritersA would have too much ambiguity for what the ws are+-- (one could use a Proxy, but that does not seem to be worth the effort)+-- same reasoning for withMultiWriters_+withMultiWritersW  :: forall w1 w2 m a+               . (Monoid (HList w1), Monad m, HInit w1)+              => MultiWriterT (Append w1 w2) m a+              -> MultiWriterT w2 m (HList w1)+withMultiWriters = withMultiWritersAW+withMultiWritersAW k = MultiWriterT $ do+  w <- get+  ~(a, ws') <- lift $ runStateT (runMultiWriterTRaw k) (hAppend (mempty :: HList w1) w)+  let (o, w') = hSplit ws'+  put w'+  return $ (a, o)+withMultiWritersWA k = MultiWriterT $ do+  w <- get+  ~(a, ws') <- lift $ runStateT (runMultiWriterTRaw k) (hAppend (mempty :: HList w1) w)+  let (o, w') = hSplit ws'+  put w'+  return $ (o, a)+withMultiWritersW k  = MultiWriterT $ do+  w <- get+  ws' <- lift $ execStateT (runMultiWriterTRaw k) (hAppend (mempty :: HList w1) w)+  let (o, w') = hSplit ws'+  put w'+  return $ o++inflateWriter :: (Monad m, Monoid w, ContainsType w ws)+              => WriterT w m a+              -> MultiWriterT ws m a+inflateWriter k = do+  (x, w) <- lift $ runWriterT k+  mTell w+  return x++-- foreign lifting instances++instance (MonadState s m) => MonadState s (MultiWriterT c m) where+  put   = lift . put+  get   = lift $ get+  state = lift . state++instance (MonadWriter w m) => MonadWriter w (MultiWriterT c m) where+  writer = lift . writer+  tell   = lift . tell+  listen = MultiWriterT .+    mapStateT (liftM (\(~(~(a,w), w')) -> ((a, w'), w)) . listen) .+    runMultiWriterTRaw+  pass = MultiWriterT .+    mapStateT (pass . liftM (\(~(~(a, f), w)) -> ((a, w), f))) .+    runMultiWriterTRaw

@@ -0,0 +1,222 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- | The multi-valued version of mtl's Writer / WriterT+module Control.Monad.Trans.MultiWriter.Strict+  (+  -- * MultiWriterT+    MultiWriterT(..)+  , MultiWriterTNull+  , MultiWriter+  -- * run-functions+  , runMultiWriterT+  , runMultiWriterTAW+  , runMultiWriterTWA+  , runMultiWriterTW+  , runMultiWriterTNil+  , runMultiWriterTNil_+  -- * with-functions (single Writer)+  , withMultiWriter+  , withMultiWriterAW+  , withMultiWriterWA+  , withMultiWriterW+  -- * with-functions (multiple Writers)+  , withMultiWriters+  , withMultiWritersAW+  , withMultiWritersWA+  , withMultiWritersW+  -- * inflate-function (run WriterT in MultiWriterT)+  , inflateWriter+  -- * other functions+  , mapMultiWriterT+  , mGetRaw+  , mPutRaw+  )+where++++import Data.HList.HList+import Data.HList.ContainsType++import Control.Monad.Trans.MultiWriter.Class ( MonadMultiWriter(..) )++import Control.Monad.State.Strict  ( StateT(..)+                                   , MonadState(..)+                                   , execStateT+                                   , evalStateT+                                   , mapStateT )+import Control.Monad.Writer.Strict ( WriterT(..) )+import Control.Monad.Trans.Class   ( MonadTrans+                                   , lift )+import Control.Monad.Writer.Class  ( MonadWriter+                                   , listen+                                   , tell+                                   , writer+                                   , pass )++import Data.Functor.Identity       ( Identity )++import Control.Applicative         ( Applicative(..) )+import Control.Monad               ( liftM+                                   , ap+                                   , void )++import Data.Monoid++++-- | A Writer transformer monad patameterized by:+--   +-- * x - The list of types that can be written (Monoid instances).+-- * m - The inner monad.+-- +-- 'MultiWriterT' corresponds to mtl's 'WriterT', but can contain+-- a heterogenous list of types.+-- +-- This heterogenous list is represented using Types.Data.List, i.e:+-- +--   * @'[]@ - The empty list,+--   * @a ': b@ - A list where @/a/@ is an arbitrary type+--     and @/b/@ is the rest list.+-- +-- For example,+-- +-- > MultiWriterT '[Int, Bool] :: (* -> *) -> (* -> *)+-- +-- is a Writer transformer containing the types [Int, Bool].+newtype MultiWriterT x m a = MultiWriterT {+  runMultiWriterTRaw :: StateT (HList x) m a+}++-- | A MultiWriter transformer carrying an empty state.+type MultiWriterTNull = MultiWriterT '[]++type MultiWriter x a = MultiWriterT x Identity a++instance (Functor f) => Functor (MultiWriterT x f) where+  fmap f = MultiWriterT . fmap f . runMultiWriterTRaw++instance (Applicative m, Monad m) => Applicative (MultiWriterT x m) where+  pure = MultiWriterT . pure+  (<*>) = ap++instance Monad m => Monad (MultiWriterT x m) where+  return = MultiWriterT . return+  k >>= f = MultiWriterT $ runMultiWriterTRaw k >>= (runMultiWriterTRaw.f)++instance MonadTrans (MultiWriterT x) where+  lift = MultiWriterT . lift++instance (Monad m, ContainsType a c, Monoid a)+      => MonadMultiWriter a (MultiWriterT c m) where+  mTell v = MultiWriterT $ do+    x <- get+    put $ setHListElem (getHListElem x `mappend` v) x++-- methods++-- | A raw extractor of the contained HList (i.e. the complete state).+mGetRaw :: Monad m => MultiWriterT a m (HList a)+mGetRaw = MultiWriterT get++mPutRaw :: Monad m => HList s -> MultiWriterT s m ()+mPutRaw = MultiWriterT . put++-- | Map both the return value and the state of a computation+-- using the given function.+mapMultiWriterT :: (m (a, HList w) -> m' (a', HList w))+               -> MultiWriterT w m  a+               -> MultiWriterT w m' a'+mapMultiWriterT f = MultiWriterT . mapStateT f . runMultiWriterTRaw++runMultiWriterT   :: (Monoid (HList w), Functor m) => MultiWriterT w m a -> m (a, HList w)+runMultiWriterTAW :: (Monoid (HList w), Functor m) => MultiWriterT w m a -> m (a, HList w)+runMultiWriterTWA :: (Monoid (HList w),   Monad m) => MultiWriterT w m a -> m (HList w, a)+runMultiWriterTW  :: (Monoid (HList w),   Monad m) => MultiWriterT w m a -> m (HList w)+runMultiWriterT     = runMultiWriterTAW+runMultiWriterTAW k = runStateT (runMultiWriterTRaw k) mempty+runMultiWriterTWA k = (\(a,b) -> (b,a)) `liftM` runStateT (runMultiWriterTRaw k) mempty+runMultiWriterTW  k = execStateT (runMultiWriterTRaw k) mempty++runMultiWriterTNil  ::   Monad m => MultiWriterT '[] m a -> m a+runMultiWriterTNil_ :: Functor m => MultiWriterT '[] m a -> m ()+runMultiWriterTNil  k = evalStateT (runMultiWriterTRaw k) HNil+runMultiWriterTNil_ k = void $ runStateT (runMultiWriterTRaw k) HNil++withMultiWriter   :: (Monoid w, Monad m) => MultiWriterT (w ': ws) m a -> MultiWriterT ws m (a, w)+withMultiWriterAW :: (Monoid w, Monad m) => MultiWriterT (w ': ws) m a -> MultiWriterT ws m (a, w)+withMultiWriterWA :: (Monoid w, Monad m) => MultiWriterT (w ': ws) m a -> MultiWriterT ws m (w, a)+withMultiWriterW  :: (Monoid w, Monad m) => MultiWriterT (w ': ws) m a -> MultiWriterT ws m w+withMultiWriter = withMultiWriterAW+withMultiWriterAW k = MultiWriterT $ do+  w <- get+  (a, w') <- lift $ runStateT (runMultiWriterTRaw k) (mempty :+: w)+  case w' of x' :+: wr' -> do put wr'; return (a, x')+withMultiWriterWA k = (\(a,b) -> (b,a)) `liftM` withMultiWriterAW k+withMultiWriterW  k = snd `liftM` withMultiWriterAW k++withMultiWriters   :: forall w1 w2 m a+               . (Monoid (HList w1), Monad m, HInit w1)+              => MultiWriterT (Append w1 w2) m a+              -> MultiWriterT w2 m (a, HList w1)+withMultiWritersAW :: forall w1 w2 m a+               . (Monoid (HList w1), Monad m, HInit w1)+              => MultiWriterT (Append w1 w2) m a+              -> MultiWriterT w2 m (a, HList w1)+withMultiWritersWA :: forall w1 w2 m a+               . (Monoid (HList w1), Monad m, HInit w1)+              => MultiWriterT (Append w1 w2) m a+              -> MultiWriterT w2 m (HList w1, a)+-- withMultiWritersA would have too much ambiguity for what the ws are+-- (one could use a Proxy, but that does not seem to be worth the effort)+-- same reasoning for withMultiWriters_+withMultiWritersW  :: forall w1 w2 m a+               . (Monoid (HList w1), Monad m, HInit w1)+              => MultiWriterT (Append w1 w2) m a+              -> MultiWriterT w2 m (HList w1)+withMultiWriters = withMultiWritersAW+withMultiWritersAW k = MultiWriterT $ do+  w <- get+  (a, ws') <- lift $ runStateT (runMultiWriterTRaw k) (hAppend (mempty :: HList w1) w)+  let (o, w') = hSplit ws'+  put w'+  return $ (a, o)+withMultiWritersWA k = MultiWriterT $ do+  w <- get+  (a, ws') <- lift $ runStateT (runMultiWriterTRaw k) (hAppend (mempty :: HList w1) w)+  let (o, w') = hSplit ws'+  put w'+  return $ (o, a)+withMultiWritersW k  = MultiWriterT $ do+  w <- get+  ws' <- lift $ execStateT (runMultiWriterTRaw k) (hAppend (mempty :: HList w1) w)+  let (o, w') = hSplit ws'+  put w'+  return $ o++inflateWriter :: (Monad m, Monoid w, ContainsType w ws)+              => WriterT w m a+              -> MultiWriterT ws m a+inflateWriter k = do+  (x, w) <- lift $ runWriterT k+  mTell w+  return x++-- foreign lifting instances++instance (MonadState s m) => MonadState s (MultiWriterT c m) where+  put   = lift . put+  get   = lift $ get+  state = lift . state++instance (MonadWriter w m) => MonadWriter w (MultiWriterT c m) where+  writer = lift . writer+  tell   = lift . tell+  listen = MultiWriterT .+    mapStateT (liftM (\((a,w), w') -> ((a, w'), w)) . listen) .+    runMultiWriterTRaw+  pass = MultiWriterT .+    mapStateT (pass . liftM (\((a, f), w) -> ((a, w), f))) .+    runMultiWriterTRaw

@@ -0,0 +1,23 @@+-- | Class to provide type-driven access to elements of a HList+module Data.HList.ContainsType+  ( ContainsType(..)+  )+where++++import Data.HList.HList++++class ContainsType a c where+  setHListElem :: a -> HList c -> HList c+  getHListElem :: HList c -> a++instance ContainsType a (a ': xs) where+  setHListElem a xs = a :+: case xs of (_ :+: xr) -> xr+  getHListElem (x :+: _) = x++instance (ContainsType a xs) => ContainsType a (x ': xs) where+  setHListElem a (x :+: xr) = x :+: setHListElem a xr+  getHListElem (_ :+: xr) = getHListElem xr

@@ -2,6 +2,9 @@ {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE DataKinds #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE FlexibleContexts #-}  -- | A GADT HList implementation --@@ -10,6 +13,8 @@ module Data.HList.HList   ( HList(..)   , Append+  , hAppend+  , HInit(..) ) where  @@ -18,8 +23,10 @@  import Data.Monoid +import Data.Proxy  + data HList :: [*] -> * where   HNil :: HList '[]   (:+:) :: x -> HList xs -> HList (x ': xs)@@ -29,10 +36,10 @@ infixr 5 :+:  instance Show (HList '[]) where-  show _ = "()"+  show _ = "HNil"  instance (Show a, Show (HList b)) => Show (HList (a ': b)) where-  show (x :+: y) = "(" ++ show x ++ "," ++ show y ++ ")"+  show (x :+: y) = "(" ++ show x ++ ":+:" ++ show y ++ ")"  instance Monoid (HList '[]) where   mempty = HNil@@ -58,3 +65,21 @@ type family Append (l1::[*]) (l2::[*]) :: [*] type instance Append '[] l2 = l2 type instance Append (car1 ': cdr2) l2 = car1 ': Append cdr2 l2++hAppend :: HList ts1 -> HList ts2 -> HList (Append ts1 ts2)+hAppend HNil l = l+hAppend (x:+:xs) l = x :+: hAppend xs l++class HInit (l1 :: [*]) where+  hInit :: forall l2 . Proxy l2 -> HList (Append l1 l2) -> HList l1+  hSplit :: forall l2 . HList (Append l1 l2) -> (HList l1, HList l2)++instance HInit '[] where+  hInit _ _ = HNil+  hSplit l = (HNil, l)+instance HInit l1 => HInit (x ': l1) where+  hInit p (x :+: xs)  = x :+: hInit p xs+  hInit _ _           = error "cannot happen" -- see ghc trac #3927+  hSplit (x :+: xs) = let (l1, l2) = hSplit xs+                       in (x :+: l1, l2)+  hSplit _          = error "cannot happen"

@@ -10,25 +10,27 @@ import Data.Functor.Identity import Data.HList.HList import Data.Monoid-import qualified Control.Monad.MultiState as MS-import qualified Control.Monad.MultiReader as MR-import qualified Control.Monad.MultiWriter as MW+import qualified Control.Monad.Trans.MultiState as MS+import qualified Control.Monad.Trans.MultiReader as MR+import qualified Control.Monad.Trans.MultiWriter as MW  import Control.Applicative ( Applicative, (<$>), (<*>) ) +import Test.Hspec  + type Tests = [(Bool, String)]  runEvalMS :: MS.MultiStateT '[] Identity a -> a-runEvalMS = runIdentity . MS.evalMultiStateT+runEvalMS = runIdentity . MS.runMultiStateTNil runEvalMR :: MR.MultiReaderT '[] Identity a -> a-runEvalMR = runIdentity . MR.evalMultiReaderT+runEvalMR = runIdentity . MR.runMultiReaderTNil runExecMW :: Monoid (HList x) => MW.MultiWriterT x Identity a -> HList x-runExecMW = runIdentity . MW.execMultiWriterT+runExecMW = runIdentity . MW.runMultiWriterTW  runnerMS :: a -> MS.MultiStateT '[a] Identity a -> a-runnerMS x m = runEvalMS $ MS.withMultiState x m+runnerMS x m = runEvalMS $ MS.withMultiStateA x m runnerMR :: a -> MR.MultiReaderT '[a] Identity a -> a runnerMR x m = runEvalMR $ MR.withMultiReader x m runnerMW :: Monoid a => MW.MultiWriterT '[a] Identity b -> a@@ -38,11 +40,11 @@  runnerMS_ :: a -> MS.MultiStateT '[a] Identity b -> a runnerMS_ x m = runIdentity-              $ MS.evalMultiStateT-              $ MS.withMultiState x (m >> MS.mGet)+              $ MS.runMultiStateTNil+              $ MS.withMultiStateA x (m >> MS.mGet) runnerMR_ :: a -> MR.MultiReaderT '[a] Identity b -> a runnerMR_ x m = runIdentity-              $ MR.evalMultiReaderT+              $ MR.runMultiReaderTNil               $ MR.withMultiReader x (m >> MR.mAsk)  intRunnerMS :: Int -> MS.MultiStateT '[Int] Identity Int -> Int@@ -67,102 +69,108 @@            => m (a,b) msGetTuple = (,) <$> MS.mGet <*> MS.mGet -testsMultiState :: Tests-testsMultiState =-  [-    (1 == runIdentity (Identity (1::Int))-    , "identity"),-    (2 == intRunnerMS_ 2 (return ())-    , "multistate getConfig"),-    (3 == intRunnerMS_ 100 (MS.mSet (3::Int))-    , "multistate setConfig"),-    (4 == intRunnerMS_ 4 (MS.mGet >>= \x -> MS.mSet (x::Int))-    , "multistate setConfig"),-    (5 == intRunnerMS (4::Int) (MS.withMultiState (5::Int) MS.mGet)-    , "multistate nesting"),-    (6 == intRunnerMS (4::Int) (   MS.mSet (100::Int)-                                >> MS.withMultiState (6::Int) MS.mGet)-    , "multistate nesting"),-    (7 == intRunnerMS (4::Int) (   MS.withMultiState (100::Int)-                                     $ MS.mSet (7::Int)-                                >> MS.mGet)-    , "multistate nesting"),-    ((True, 'a') == ( runEvalMS-                    $ MS.withMultiState True-                    $ MS.withMultiState 'a'-                    $ msGetTuple )-    , "multistate multiple types"),-    ((True, 'b') == ( runEvalMS-                    $ MS.withMultiState True-                    $ MS.withMultiState 'a'-                    $ MS.withMultiState 'b'-                    $ msGetTuple )-    , "multistate multiple types"),-    ((False, 'a') == ( runEvalMS-                     $ MS.withMultiState True-                     $ MS.withMultiState 'a'-                     $ MS.withMultiState False-                     $ msGetTuple )-    , "multistate multiple types"),-    (test13MS-    , "askRaw")-  ]+testsMultiState :: Spec+testsMultiState = do+  it "identity" $ 1 `shouldBe` runIdentity (Identity (1::Int))+  it "getConfig"+    $ intRunnerMS_ 2 (return ())+    `shouldBe` 2+  it "setConfig"+    $ intRunnerMS_ 100 (MS.mSet (3::Int))+    `shouldBe` 3+  it "setConfig"+    $ intRunnerMS_ 4 (MS.mGet >>= \x -> MS.mSet (x::Int))+    `shouldBe` 4+  it "nesting 1"+    $ intRunnerMS (4::Int) (MS.withMultiStateA (5::Int) MS.mGet)+    `shouldBe` 5+  it "nesting 2"+    $ intRunnerMS (4::Int) (   MS.mSet (100::Int)+                                >> MS.withMultiStateA (6::Int) MS.mGet)+    `shouldBe` 6+  it "nesting 3"+    $ intRunnerMS (4::Int) (MS.withMultiStateA (100::Int)+                                        $ MS.mSet (7::Int) >> MS.mGet)+    `shouldBe` 7+  it "multiple types 1"+    $ ( runEvalMS+      $ MS.withMultiStateA True+      $ MS.withMultiStateA 'a'+      $ msGetTuple )+    `shouldBe` (True, 'a')+  it "multiple types 2"+    $ ( runEvalMS+      $ MS.withMultiStateA True+      $ MS.withMultiStateA 'a'+      $ MS.withMultiStateA 'b'+      $ msGetTuple )+    `shouldBe` (True, 'b')+  it "askRaw" test13MS -testsMultiReader :: Tests-testsMultiReader =-  [-    (1 == runIdentity (Identity (1::Int))-    , "identity"),-    (2 == intRunnerMR_ 2 (return ())-    , "multistate getConfig"),-    (5 == intRunnerMR (4::Int) (MR.withMultiReader (5::Int) MR.mAsk)-    , "multistate nesting"),-    ((True, 'a') == ( runEvalMR-                    $ MR.withMultiReader True-                    $ MR.withMultiReader 'a'-                    $ mrAskTuple )-    , "multistate multiple types"),-    ((True, 'b') == ( runEvalMR-                    $ MR.withMultiReader True-                    $ MR.withMultiReader 'a'-                    $ MR.withMultiReader 'b'-                    $ mrAskTuple )-    , "multistate multiple types"),-    ((False, 'a') == ( runEvalMR-                     $ MR.withMultiReader True-                     $ MR.withMultiReader 'a'-                     $ MR.withMultiReader False-                     $ mrAskTuple )-    , "multistate multiple types"),-    (test13MR-    , "getRaw")-  ]+testsMultiReader :: Spec+testsMultiReader = do+  it "identity"+    $ runIdentity (Identity (1::Int))+    `shouldBe` 1+  it "getConfig"+    $ intRunnerMR_ 2 (return ())+    `shouldBe` 2+  it "nesting"+    $ intRunnerMR (4::Int) (MR.withMultiReader (5::Int) MR.mAsk)+    `shouldBe` 5+  it "multiple types 1"+    $ ( runEvalMR+      $ MR.withMultiReader True+      $ MR.withMultiReader 'a'+      $ mrAskTuple )+    `shouldBe` (True, 'a')+  it "multiple types 2"+    $ ( runEvalMR+      $ MR.withMultiReader True+      $ MR.withMultiReader 'a'+      $ MR.withMultiReader 'b'+      $ mrAskTuple )+    `shouldBe` (True, 'b')+  it "multiple types 3"+    $ ( runEvalMR+      $ MR.withMultiReader True+      $ MR.withMultiReader 'a'+      $ MR.withMultiReader False+      $ mrAskTuple )+    `shouldBe` (False, 'a')+  it "getRaw" test13MR -testsMultiWriter :: Tests-testsMultiWriter =-  [ ("" == stringRunnerMW (return ())-    , "multiwriter 1-0")-  , ("a" == stringRunnerMW (MW.mTell "a") -- this type annotation is kinda-                                            -- annoying..-    , "multiwriter 1-1")-  , ("ab" == stringRunnerMW (MW.mTell "a" >> MW.mTell "b")-    , "multiwriter 1-2")-  , (("ab" :+: [True] :+: HNil) == runExecMW (MW.mTell "a" >> MW.mTell [True] >> MW.mTell "b")-    , "multiwriter 2")-  ]+testsMultiWriter :: Spec+testsMultiWriter = do+  it "1-0"+    $ stringRunnerMW (return ())+    `shouldBe` ""+  it "1-1"+    $ stringRunnerMW (MW.mTell "a")+    `shouldBe` "a"+  it "1-2"+    $ stringRunnerMW (MW.mTell "a" >> MW.mTell "b")+    `shouldBe` "ab"+  it "2"+    $ runExecMW (MW.mTell "a" >> MW.mTell [True] >> MW.mTell "b")+    `shouldBe` ("ab" :+: [True] :+: HNil) -tests :: Tests-tests = testsMultiState ++ testsMultiReader ++ testsMultiWriter+tests :: Spec+tests = do+  describe "MultiState" $ testsMultiState+  describe "MultiReader" $ testsMultiReader+  describe "MultiWriter" $ testsMultiWriter+  lazyStateTest  test13MR :: Bool test13MR = runIdentity-         $ MR.evalMultiReaderT+         $ MR.runMultiReaderTNil          $ MR.withMultiReader True          $ MR.withMultiReader 'a'          $ do-  c <- MR.mAskRaw+  c <- MR.mGetRaw   return $ runIdentity-         $ MR.evalMultiReaderT+         $ MR.runMultiReaderTNil          $ MR.withMultiReaders c          $ do     b <- MR.mAsk@@ -170,31 +178,46 @@  test13MS :: Bool test13MS = runIdentity-         $ MS.evalMultiStateT-         $ MS.withMultiState True-         $ MS.withMultiState 'a'+         $ MS.runMultiStateTNil+         $ MS.withMultiStateA True+         $ MS.withMultiStateA 'a'          $ do   c <- MS.mGetRaw   return $ runIdentity-         $ MS.evalMultiStateT-         $ MS.withMultiStates c+         $ MS.runMultiStateTNil+         $ MS.withMultiStatesA c          $ do     b <- MS.mGet     return (b::Bool) +lazyStateTest :: Spec+lazyStateTest = it "lazyStateTest" $ (33, True) `shouldBe` l+  where+    l :: (Int, Bool)+    l = case runIdentity $ MS.runMultiStateTS ([] :+: [] :+: HNil) action of+      (x :+: y :+: _) -> (head x, head y)+    action :: MS.MultiStateT '[[Int], [Bool]] Identity ()+    action = do+      action+      x <- MS.mGet+      MS.mSet $ (33::Int):x+      y <- MS.mGet+      MS.mSet $ True:y++ main :: IO ()-main = do-  mapM_ (putStrLn . ("error: "++) . snd) $ filter (\(b, _) -> not b) tests-  putStrLn $    "ran "-             ++ show (length tests)-             ++ " tests (no further output = good)"-  return ()+main = hspec $ tests+  -- mapM_ (putStrLn . ("error: "++) . snd) $ filter (\(b, _) -> not b) tests+  -- putStrLn $    "ran "+  --            ++ show (length tests)+  --            ++ " tests (no further output = good)"+  -- return ()  {-  main = do   evalStateT-    (evalMultiReaderT $ withConfig 'a' $ do+    (runMultiReaderT $ withConfig 'a' $ do         x <- withConfig 'b' getConfig         lift $ lift $ print (x::Char)         y <- get@@ -202,7 +225,7 @@         return ()     )     (1::Int)-  evalMultiReaderT $ withConfig 'a' $ evalStateT+  runMultiReaderT $ withConfig 'a' $ evalStateT     ( do         x <- getConfig         lift $ lift $ print (x::Char)