packages feed

stateWriter (empty) → 0.2.0

raw patch · 12 files changed

+695/−0 lines, 12 filesdep +QuickCheckdep +basedep +containerssetup-changed

Dependencies added: QuickCheck, base, containers, criterion, deepseq, dlist, free, hspec, lens, mtl, stateWriter, transformers, vector

Files

+ Control/Monad/RSS.hs view
@@ -0,0 +1,13 @@+-----------------------------------------------------------------------------+-- Declaration of the MonadRSS class.+--+-- This is a variant of the classic "Control.Monad.RWS" transformer,+-- where the Writer part rides with the State part.+--+-----------------------------------------------------------------------------++module Control.Monad.RSS (+    module Control.Monad.RSS.Strict+  ) where+ +import Control.Monad.RSS.Strict
+ Control/Monad/RSS/Lazy.hs view
@@ -0,0 +1,41 @@+-----------------------------------------------------------------------------+-- |+-- Lazy RSS monad.+--+-- This is a variant of the classic "Control.Monad..RWS.Lazy" transformer,+-- where the Writer part rides with the State part.+--+-----------------------------------------------------------------------------++module Control.Monad.RSS.Lazy (+    -- * The RSS monad+    RSS,+    rss,+    runRSS,+    evalRSS,+    execRSS,+    withRSS,+    -- * The RSST monad transformer+    RSST,+    evalRSST,+    execRSST,+    withRSST,+    -- * Lazy Reader-writer-state monads+    module Control.Monad.RWS.Class,+    module Control.Monad,+    module Control.Monad.Fix,+    module Control.Monad.Trans,+    module Data.Monoid,+  ) where++import Control.Monad.RWS.Class++import Control.Monad.Trans+import Control.Monad.Trans.RSS.Lazy (+    RSS, rss, runRSS, evalRSS, execRSS, withRSS,+    RSST, evalRSST, execRSST, withRSST)++import Control.Monad+import Control.Monad.Fix+import Data.Monoid+
+ Control/Monad/RSS/Strict.hs view
@@ -0,0 +1,41 @@+-----------------------------------------------------------------------------+-- |+-- Strict RSS monad.+--+-- This is a variant of the classic "Control.Monad..RWS.Strict" transformer,+-- where the Writer part rides with the State part.+--+-----------------------------------------------------------------------------++module Control.Monad.RSS.Strict (+    -- * The RSS monad+    RSS,+    rss,+    runRSS,+    evalRSS,+    execRSS,+    withRSS,+    -- * The RSST monad transformer+    RSST,+    evalRSST,+    execRSST,+    withRSST,+    -- * Strict Reader-writer-state monads+    module Control.Monad.RWS.Class,+    module Control.Monad,+    module Control.Monad.Fix,+    module Control.Monad.Trans,+    module Data.Monoid,+  ) where++import Control.Monad.RWS.Class++import Control.Monad.Trans+import Control.Monad.Trans.RSS.Strict (+    RSS, rss, runRSS, evalRSS, execRSS, withRSS,+    RSST, evalRSST, execRSST, withRSST)++import Control.Monad+import Control.Monad.Fix+import Data.Monoid+
+ Control/Monad/Trans/RSS.hs view
@@ -0,0 +1,14 @@+-----------------------------------------------------------------------------+-- A monad transformer that combines 'ReaderT', 'WriterT' and 'StateT'.+-- This version is strict; for a lazy version, see+-- "Control.Monad.Trans.RSS.Lazy", which has the same interface.+--+-- This is a variant of the classic "Control.Monad.Trans.RWS" transformer,+-- where the Writer part rides with the State part.+-----------------------------------------------------------------------------++module Control.Monad.Trans.RSS (+    module Control.Monad.Trans.RSS.Strict+  ) where++import Control.Monad.Trans.RSS.Strict
+ Control/Monad/Trans/RSS/Lazy.hs view
@@ -0,0 +1,175 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}+module Control.Monad.Trans.RSS.Lazy (+    -- * The RWS monad+    RSS,+    rss,+    runRSS,+    evalRSS,+    execRSS,+    withRSS,+    -- * The RSST monad transformer+    RSST,+    runRSST,+    evalRSST,+    execRSST,+    withRSST,+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Data.Functor.Identity++import Control.Monad.State+import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.RWS++-- | A monad containing an environment of type @r@, output of type @w@+-- and an updatable state of type @s@.+type RSS r w s = RSST r w s Identity++-- | Construct an RSS computation from a function.+-- (The inverse of 'runRSS'.)+rss :: Monoid w => (r -> s -> (a, s, w)) -> RSS r w s a+rss f = RSST $ \r (s,w) -> let (a,s',w') = f r s+                           in  Identity (a, (s', w <> w'))++-- | Unwrap an RSS computation as a function.+-- (The inverse of 'rws'.)+runRSS :: Monoid w => RSS r w s a -> r -> s -> (a,s,w)+runRSS m r s = runIdentity (runRSST m r s)++-- | Evaluate a computation with the given initial state and environment,+-- returning the final value and output, discarding the final state.+evalRSS :: Monoid w+        => RSS r w s a  -- ^RWS computation to execute+        -> r            -- ^initial environment+        -> s            -- ^initial value+        -> (a, w)       -- ^final value and output+evalRSS m r s = let+    (a, _, w) = runRSS m r s+    in (a, w)++-- | Evaluate a computation with the given initial state and environment,+-- returning the final state and output, discarding the final value.+execRSS :: Monoid w+        => RSS r w s a  -- ^RWS computation to execute+        -> r            -- ^initial environment+        -> s            -- ^initial value+        -> (s, w)       -- ^final state and output+execRSS m r s = let+    (_, s', w) = runRSS m r s+    in (s', w)++-- and state modified by applying @f@.+--+-- * @'runRSS' ('withRSS' f m) r s = 'uncurry' ('runRSS' m) (f r s)@+withRSS :: (r' -> s -> (r, s)) -> RSS r w s a -> RSS r' w s a+withRSS = withRSST++---------------------------------------------------------------------------+-- | A monad transformer adding reading an environment of type @r@,+-- collecting an output of type @w@ and updating a state of type @s@+-- to an inner monad @m@.+newtype RSST r w s m a = RSST { runRSST' :: r -> (s,w) -> m (a, (s, w)) }++runRSST :: (Monoid w, Monad m) => RSST r w s m a -> r -> s -> m (a, s, w)+runRSST m r s = do+    ~(a,(s',w)) <- runRSST' m r (s,mempty)+    return (a,s',w)++-- | Evaluate a computation with the given initial state and environment,+-- returning the final value and output, discarding the final state.+evalRSST :: (Monad m, Monoid w)+            => RSST r w s m a     -- ^computation to execute+            -> r                  -- ^initial environment+            -> s                  -- ^initial value+            -> m (a,w)          -- ^computation yielding final value and output+evalRSST m r s = do+    ~(a, (_, w)) <- runRSST' m r (s,mempty)+    return (a, w)++-- | Evaluate a computation with the given initial state and environment,+-- returning the final state and output, discarding the final value.+execRSST :: (Monad m, Monoid w)+            => RSST r w s m a      -- ^computation to execute+            -> r                   -- ^initial environment+            -> s                   -- ^initial value+            -> m (s, w)          -- ^computation yielding final state and output+execRSST m r s = do+        ~(_, (s', w)) <- runRSST' m r (s,mempty)+        return (s', w)++-- | @'withRSST' f m@ executes action @m@ with an initial environment+-- and state modified by applying @f@.+--+-- * @'runRSST' ('withRSST' f m) r s = 'uncurry' ('runRSST' m) (f r s)@+withRSST :: (r' -> s -> (r, s)) -> RSST r w s m a -> RSST r' w s m a+withRSST f m = RSST $ \r (s,w) ->+    let (r',s') = f r s+    in  runRSST' m r' (s',w)++instance (Functor m) => Functor (RSST r w s m) where+    fmap f m = RSST $ \r s ->+        fmap (\ ~(a, (s', w)) -> (f a, (s', w))) $ runRSST' m r s++instance (Monad m) => Monad (RSST r w s m) where+    return a = RSST $ \_ s -> return (a, s)+    m >>= k  = RSST $ \r s -> do+        ~(a, (s', w))  <- runRSST' m r s+        runRSST' (k a) r (s',w)+    fail msg = RSST $ \_ _ -> fail msg++instance (MonadPlus m) => MonadPlus (RSST r w s m) where+    mzero       = RSST $ \_ _ -> mzero+    m `mplus` n = RSST $ \r s -> runRSST' m r s `mplus` runRSST' n r s++instance (Functor m, Monad m) => Applicative (RSST r w s m) where+    pure = return+    (<*>) = ap++instance (Functor m, MonadPlus m) => Alternative (RSST r w s m) where+    empty = mzero+    (<|>) = mplus++instance (MonadFix m) => MonadFix (RSST r w s m) where+    mfix f = RSST $ \r s -> mfix $ \ ~(a, _) -> runRSST' (f a) r s++instance MonadTrans (RSST r w s) where+    lift m = RSST $ \_ s -> do+        a <- m+        return (a, s)++instance (MonadIO m) => MonadIO (RSST r w s m) where+    liftIO = lift . liftIO++instance Monad m => MonadState s (RSST r w s m) where+    get = RSST $ \_ (s,w) -> return (s,(s,w))+    put ns = RSST $ \_ (_,w) -> return ((),(ns,w))+    state f = RSST $ \_ (s,w) -> case f s of+                                      (a,s') -> return (a, (s', w))++++instance Monad m => MonadReader r (RSST r w s m) where+    ask = RSST $ \r s -> return (r, s)+    local f rw = RSST $ \r s -> runRSST' rw (f r) s+    reader f = RSST $ \r s -> return (f r, s)++instance (Monoid w, Monad m) => MonadWriter w (RSST r w s m) where+    writer (a,w) = tell w >> return a+    tell w = RSST $ \_ (s, ow) ->+        let nw = ow <> w+        in  return ((), (s, nw))+    listen rw = RSST $ \r s -> do+        (a, (ns, nw)) <- runRSST' rw r s+        return ((a, nw), (ns, nw))+    pass rw = RSST $ \r s -> do+        ( (a, fw), (s', w) ) <- runRSST' rw r s+        return (a, (s', fw w))++instance (Monoid w, Monad m) => MonadRWS r w s (RSST r w s m)+
+ Control/Monad/Trans/RSS/Strict.hs view
@@ -0,0 +1,173 @@+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FlexibleContexts #-}+module Control.Monad.Trans.RSS.Strict (+    -- * The RWS monad+    RSS,+    rss,+    runRSS,+    evalRSS,+    execRSS,+    withRSS,+    -- * The RSST monad transformer+    RSST,+    runRSST,+    evalRSST,+    execRSST,+    withRSST,+  ) where++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import Control.Monad.IO.Class+import Control.Monad.Trans.Class+import Data.Functor.Identity++import Control.Monad.State+import Control.Monad.Reader+import Control.Monad.Writer+import Control.Monad.RWS++-- | A monad containing an environment of type @r@, output of type @w@+-- and an updatable state of type @s@.+type RSS r w s = RSST r w s Identity++-- | Construct an RSS computation from a function.+-- (The inverse of 'runRSS'.)+rss :: Monoid w => (r -> s -> (a, s, w)) -> RSS r w s a+rss f = RSST $ \r (s,w) -> let (a,s',w') = f r s+                           in  Identity (a, (s', w <> w'))++-- | Unwrap an RSS computation as a function.+-- (The inverse of 'rss'.)+runRSS :: Monoid w => RSS r w s a -> r -> s -> (a,s,w)+runRSS m r s = runIdentity (runRSST m r s)++-- | Evaluate a computation with the given initial state and environment,+-- returning the final value and output, discarding the final state.+evalRSS :: Monoid w+        => RSS r w s a  -- ^RWS computation to execute+        -> r            -- ^initial environment+        -> s            -- ^initial value+        -> (a, w)       -- ^final value and output+evalRSS m r s = let+    (a, _, w) = runRSS m r s+    in (a, w)++-- | Evaluate a computation with the given initial state and environment,+-- returning the final state and output, discarding the final value.+execRSS :: Monoid w+        => RSS r w s a  -- ^RWS computation to execute+        -> r            -- ^initial environment+        -> s            -- ^initial value+        -> (s, w)       -- ^final state and output+execRSS m r s = let+    (_, s', w) = runRSS m r s+    in (s', w)++-- and state modified by applying @f@.+--+-- * @'runRSS' ('withRSS' f m) r s = 'uncurry' ('runRSS' m) (f r s)@+withRSS :: (r' -> s -> (r, s)) -> RSS r w s a -> RSS r' w s a+withRSS = withRSST++---------------------------------------------------------------------------+-- | A monad transformer adding reading an environment of type @r@,+-- collecting an output of type @w@ and updating a state of type @s@+-- to an inner monad @m@.+newtype RSST r w s m a = RSST { runRSST' :: r -> (s,w) -> m (a, (s, w)) }++runRSST :: (Monoid w, Monad m) => RSST r w s m a -> r -> s -> m (a, s, w)+runRSST m r s = do+    (a,(s',w)) <- runRSST' m r (s,mempty)+    return (a,s',w)++-- | Evaluate a computation with the given initial state and environment,+-- returning the final value and output, discarding the final state.+evalRSST :: (Monoid w, Monad m)+            => RSST r w s m a     -- ^computation to execute+            -> r                  -- ^initial environment+            -> s                  -- ^initial value+            -> m (a,w)          -- ^computation yielding final value and output+evalRSST m r s = do+    (a, _, w) <- runRSST m r s+    return (a, w)++-- | Evaluate a computation with the given initial state and environment,+-- returning the final state and output, discarding the final value.+execRSST :: (Monoid w, Monad m)+            => RSST r w s m a      -- ^computation to execute+            -> r                   -- ^initial environment+            -> s                   -- ^initial value+            -> m (s, w)          -- ^computation yielding final state and output+execRSST m r s = do+        (_, s', w) <- runRSST m r s+        return (s', w)++-- | @'withRSST' f m@ executes action @m@ with an initial environment+-- and state modified by applying @f@.+--+-- * @'runRSST' ('withRSST' f m) r s = 'uncurry' ('runRSST' m) (f r s)@+withRSST :: (r' -> s -> (r, s)) -> RSST r w s m a -> RSST r' w s m a+withRSST f m = RSST $ \r (s,w) ->+    let (r',s') = f r s+    in  runRSST' m r' (s',w)++instance (Functor m) => Functor (RSST r w s m) where+    fmap f m = RSST $ \r s ->+        fmap (\ (a, (s', w)) -> (f a, (s', w))) $ runRSST' m r s++instance (Monad m) => Monad (RSST r w s m) where+    return a = RSST $ \_ s -> return (a, s)+    m >>= k  = RSST $ \r s -> do+        (a, (s', w))  <- runRSST' m r s+        runRSST' (k a) r (s',w)+    fail msg = RSST $ \_ _ -> fail msg++instance (MonadPlus m) => MonadPlus (RSST r w s m) where+    mzero       = RSST $ \_ _ -> mzero+    m `mplus` n = RSST $ \r s -> runRSST' m r s `mplus` runRSST' n r s++instance (Functor m, Monad m) => Applicative (RSST r w s m) where+    pure = return+    (<*>) = ap++instance (Functor m, MonadPlus m) => Alternative (RSST r w s m) where+    empty = mzero+    (<|>) = mplus++instance (MonadFix m) => MonadFix (RSST r w s m) where+    mfix f = RSST $ \r s -> mfix $ \ (a, _) -> runRSST' (f a) r s++instance MonadTrans (RSST r w s) where+    lift m = RSST $ \_ s -> do+        a <- m+        return (a, s)++instance (MonadIO m) => MonadIO (RSST r w s m) where+    liftIO = lift . liftIO++instance Monad m => MonadState s (RSST r w s m) where+    get = RSST $ \_ (s,w) -> return (s,(s,w))+    put ns = RSST $ \_ (_,w) -> return ((),(ns,w))+    state f = RSST $ \_ (s,w) -> case f s of+                                      (a,s') -> return (a, (s', w))++instance Monad m => MonadReader r (RSST r w s m) where+    ask = RSST $ \r s -> return (r, s)+    local f rw = RSST $ \r s -> runRSST' rw (f r) s+    reader f = RSST $ \r s -> return (f r, s)++instance (Monoid w, Monad m) => MonadWriter w (RSST r w s m) where+    writer (a,w) = tell w >> return a+    tell w = RSST $ \_ (s, ow) ->+        let nw = ow `mappend` w+        in  nw `seq` return ((), (s, ow `mappend` w))+    listen rw = RSST $ \r s -> do+        (a, (ns, nw)) <- runRSST' rw r s+        return ((a, nw), (ns, nw))+    pass rw = RSST $ \r s -> do+        ( (a, fw), (s', w) ) <- runRSST' rw r s+        return (a, (s', fw w))++instance (Monoid w, Monad m) => MonadRWS r w s (RSST r w s m)+
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Simon Marechal++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Simon Marechal nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ bench/bench.hs view
@@ -0,0 +1,57 @@+{-# LANGUAGE FlexibleContexts #-}+module Main where++import qualified Control.Monad.Trans.RSS.Lazy as RSSL+import qualified Control.Monad.Trans.RSS.Strict as RSSS+import qualified Control.Monad.Trans.RWS.Lazy as RWSL+import qualified Control.Monad.Trans.RWS.Strict as RWSS++import Criterion+import Criterion.Main++import qualified Data.Sequence as Seq+import qualified Data.Vector.Primitive as VP+import qualified Data.IntSet as IS+import qualified Data.Set as S+import qualified Data.DList as D++import Control.DeepSeq++import Control.Monad.RWS++testActions :: (Monoid w, Monad m, MonadRWS () w Int m) => (Int -> m ()) -> m ()+testActions tellaction = do+    v <- get+    unless (v == 0) $ do+        put $! v - 1+        when (v `mod` 11 == 0) $ tellaction v+        testActions tellaction++benchlen :: Int+benchlen = 10000++actions :: (Monoid w) => (Int -> w) -> [(String, Int -> ((), Int, w))]+actions cnv = [ ("RSS.Lazy"  , RSSL.runRSS (testActions (tell . cnv)) ())+              , ("RSS.Strict", RSSS.runRSS (testActions (tell . cnv)) ())+              , ("RWS.Lazy"  , RWSL.runRWS (testActions (tell . cnv)) ())+              , ("RWS.Strict", RWSS.runRWS (testActions (tell . cnv)) ())+              ]++instance NFData a => NFData (D.DList a) where+    rnf d = rnf $ D.toList d++main :: IO ()+main = defaultMain $ [ bench "Snoc list"    (nf (RSSS.runRSS (testActions (RSSS.tellElement :: Int -> RSSS.RSS () [Int] Int () )) ()) benchlen)+                     , bench "Snoc seq"     (nf (RSSS.runRSS (testActions (RSSS.tellElement :: Int -> RSSS.RSS () (Seq.Seq Int) Int () )) ()) benchlen)+                     ]+                  ++ mkBench "Seq" Seq.singleton+                  ++ mkBench "List" (:[])+                  ++ mkBench "Vector Primitive" VP.singleton+                  ++ mkBench "IntSet" IS.singleton+                  ++ mkBench "Set" S.singleton+                  ++ mkBench "DList" D.singleton+    where+        mkBench n = map toBench . actions+            where+                toBench (n', a) = bench (n' ++ " [" ++ n ++ "]") $ nf a benchlen+
+ stateWriter.cabal view
@@ -0,0 +1,56 @@+-- Initial stateWriter.cabal generated by cabal init.  For further +-- documentation, see http://haskell.org/cabal/users-guide/++name:                stateWriter+version:             0.2.0+synopsis:            A faster variant of the RWS monad transformers.+description:         This is a version of the RWS monad transformers that should be much faster than what's found in transformers. The writer in the strict version does not leak memory.+license:             BSD3+license-file:        LICENSE+author:              Simon Marechal+maintainer:          bartavelle@gmail.com+-- copyright:           +category:            Control+build-type:          Simple+-- extra-source-files:  +cabal-version:       >=1.10++source-repository head+  type: git+  location: git://github.com/bartavelle/stateWriter.git++library+  exposed-modules:     Control.Monad.Trans.RSS.Lazy, Control.Monad.Trans.RSS.Strict, Control.Monad.RSS.Lazy, Control.Monad.RSS.Strict, Control.Monad.RSS, Control.Monad.Trans.RSS+  ghc-options:         -Wall+  ghc-prof-options:    -caf-all -auto-all+  -- other-modules:       +  other-extensions:    FlexibleInstances, MultiParamTypeClasses+  build-depends:       base >=4.6 && <4.7, transformers >=0.3 && <0.4, mtl >=2.1 && <2.2+  -- hs-source-dirs:      +  default-language:    Haskell2010++test-suite spaceleak+    hs-source-dirs: tests+    type:           exitcode-stdio-1.0+    ghc-options:    -Wall -rtsopts+    build-depends:  stateWriter,base,mtl+    main-is:        spaceleak.hs+    default-language:    Haskell2010++test-suite rwscompare+    hs-source-dirs: tests+    type:           exitcode-stdio-1.0+    ghc-options:    -Wall -rtsopts+    build-depends:  stateWriter,base,hspec,QuickCheck,mtl,free+    main-is:        rwscompare.hs+    default-language:    Haskell2010++benchmark bench+    hs-source-dirs: bench+    type:           exitcode-stdio-1.0+    ghc-options:    -Wall -rtsopts -O2 -fllvm+    build-depends:  stateWriter,base,criterion,containers,mtl,transformers,lens,vector,dlist,deepseq+    main-is:        bench.hs+    default-language:    Haskell2010++
+ tests/rwscompare.hs view
@@ -0,0 +1,77 @@+{-# LANGUAGE GADTs, FlexibleContexts, FlexibleInstances #-}+module Main where++import Control.Monad.Trans.RSS.Strict+import Control.Monad.RWS+import Test.Hspec+import Test.QuickCheck+import Control.Applicative+import Control.Monad.Free++data ActionF next = Tell        [Int]         next+                  | SetState    Int           next+                  | AskAndStore IModification next+                  | Modify      SModification next+                  | GetAndStore IModification next++type Action = Free ActionF++data SModification = SId+                   | Double+                   deriving (Enum, Show, Bounded)++data IModification = IReturn+                   | ReplicateThrice+                   deriving (Enum, Show, Bounded)++instance Arbitrary SModification where+    arbitrary = arbitraryBoundedEnum+instance Arbitrary IModification where+    arbitrary = arbitraryBoundedEnum++instance Arbitrary next => Arbitrary (ActionF next) where+    arbitrary = frequency [ (5,  Tell        <$> arbitrary <*> arbitrary)+                          , (5,  SetState    <$> arbitrary <*> arbitrary)+                          , (20, AskAndStore <$> arbitrary <*> arbitrary)+                          , (20, GetAndStore <$> arbitrary <*> arbitrary)+                          , (20, Modify      <$> arbitrary <*> arbitrary)+                          ]++instance Arbitrary (Action Int) where+    arbitrary = frequency [ (1, Pure <$> arbitrary)+                          , (9, Free <$> arbitrary) +                          ]++evaluateIM :: IModification -> (Int -> [Int])+evaluateIM IReturn x = [x]+evaluateIM ReplicateThrice x = [x,x,x]++evaluateSM :: SModification -> (Int -> Int)+evaluateSM SId = id+evaluateSM Double = (*) 2++instance Show next => Show (ActionF next) where+    show (Tell x n) = "Tell " ++ show x ++ " / " ++ show n+    show (SetState s n) = "Set " ++ show s ++ " / " ++ show n+    show (AskAndStore i n) = "AskAndStore " ++ show i ++ " / " ++ show n+    show (GetAndStore i n) = "GetAndStore " ++ show i ++ " / " ++ show n+    show (Modify s n) = "Modify " ++ show s ++ " / " ++ show n++evaluateActions :: (MonadRWS Int [Int] Int m) => Action x -> m x+evaluateActions (Free (Tell x next))        = tell x >>  evaluateActions next+evaluateActions (Free (SetState s next))    = put s  >>  evaluateActions next+evaluateActions (Free (AskAndStore f next)) = ask >>= tell . evaluateIM f >> evaluateActions next+evaluateActions (Free (GetAndStore f next)) = get >>= tell . evaluateIM f >> evaluateActions next+evaluateActions (Free (Modify f next)) = modify (evaluateSM f) >> evaluateActions next+evaluateActions (Pure x) = return x++main :: IO ()+main = hspec $ do+    describe "Writer part" $ do+        it "logs stuff in the right order, with tell" $+            property $ \listOfLists -> runRSS (mapM_ tell (listOfLists :: [[Int]])) () () == runRWS (mapM_ tell listOfLists) () ()+        it "logs stuff in the right order, with tellElement" $+            property $ \list -> runRSS (mapM_ tellElement (list :: [Int])) () () == ((), (), list)+        it "interprets actions the same" $+            property $ \actions -> runRSS (evaluateActions (actions :: Action Int)) 42 12 == runRWS (evaluateActions actions) 42 12+
+ tests/spaceleak.hs view
@@ -0,0 +1,16 @@++module Main where++import qualified Control.Monad.Trans.RSS.Lazy as RSSL+import qualified Control.Monad.Trans.RSS.Strict as RSSS+import Control.Monad.Writer++n :: Int+n = 10000000++main :: IO ()+main = do+    print $ RSSS.runRSS (replicateM_ n $ tell $ Sum (1 :: Int)) () ()+    putStrLn "Strict version ok, the next test should explode the stack."+    print $ RSSL.runRSS (replicateM_ n $ tell $ Sum (1 :: Int)) () ()+    putStrLn "Lazy version should have exploded !"