[Haskell-cafe] style question: Writer monad or unsafeIOToST?

[Chris Kuklewicz]

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.