Hi Chris, Thank you. That is exactly what I needed to know. It's good to know that I'm not totally crazy and that with the lazier LogT the code can run as it was written. It seems as if a request should be made for a Writer.Lazy as well as the existing Writer.Strict. (The latter could well be the default, just as with the ST monad.) A good idea? Virtual beer to you sir! -Greg On Aug 24, 2006, at 1:05 PM, Chris Kuklewicz wrote:
The problem with WriterT is it is too strict.
See http://www.mail-archive.com/haskell@haskell.org/msg16088.html
The fix is adding ~ to the patterns inside the definition of (>>=):
~(a,w) <- runLogT m ~(b,w') <- runLogT (k a)
A lazy version of WriterT, called LogT:
{-# OPTIONS_GHC -fglasgow-exts #-} module Main where import Control.Monad.ST.Lazy import Data.STRef.Lazy import Control.Monad.Writer import Control.Monad.Identity import Control.Monad.Fix import Control.Monad.Trans import Control.Monad.Reader import Maybe import Debug.Trace type LogMonoid = [String] -> [String] loopLT :: Int -> LogT [String] Identity [Int] loopLT 0 = trace "end of loopLT" (return [0]) loopLT x = do let msg = "loopLT now "++ show x tell [msg] liftM (x:) (loopLT (pred x)) newtype LogT w m a = LogT { runLogT :: m (a, w) } instance (Monad m) => Functor (LogT w m) where fmap f m = LogT $ do (a, w) <- runLogT m return (f a, w) instance (Monoid w, Monad m) => Monad (LogT w m) where return a = LogT $ return (a, mempty) m >>= k = LogT $ do ~(a,w) <- runLogT m ~(b,w') <- runLogT (k a) return (b, w `mappend` w') fail msg = LogT $ fail msg instance (Monoid w, MonadPlus m) => MonadPlus (LogT w m) where mzero = LogT mzero m `mplus` n = LogT $ runLogT m `mplus` runLogT n instance (Monoid w, MonadFix m) => MonadFix (LogT w m) where mfix m = LogT $ mfix $ \ ~(a, _) -> runLogT (m a) instance (Monoid w, Monad m) => MonadWriter w (LogT w m) where tell w = LogT $ return ((), w) listen m = LogT $ do (a, w) <- runLogT m return ((a, w), w) pass m = LogT $ do ((a, f), w) <- runLogT m return (a, f w) instance (Monoid w) => MonadTrans (LogT w) where lift m = LogT $ do a <- m return (a, mempty) instance (Monoid w, MonadIO m) => MonadIO (LogT w m) where liftIO = lift . liftIO -- This instance needs -fallow-undecidable-instances, because -- it does not satisfy the coverage condition instance (Monoid w, MonadReader r m) => MonadReader r (LogT w m) where ask = lift ask local f m = LogT $ local f (runLogT m) execLogT :: Monad m => LogT w m a -> m w execLogT m = do (_, w) <- runLogT m return w mapLogT :: (m (a, w) -> n (b, w')) -> LogT w m a -> LogT w' n b mapLogT f m = LogT $ f (runLogT m) main :: IO () main = do let logLT = runIdentity (execLogT (loopLT 100)) print (head logLT) print (last logLT)
The output is
./maindemo "loopLT now 100" end of loopLT "loopLT now 1"
Just as we want.