New monads/LazyWriterT

From HaskellWiki
< New monads
Revision as of 15:58, 7 October 2006 by BrettGiles (talk | contribs) (NewMonads/LazyWriterT moved to New monads/LazyWriterT)
Jump to navigation Jump to search
The printable version is no longer supported and may have rendering errors. Please update your browser bookmarks and please use the default browser print function instead.

This came up on the mailing list: Why is WriterT never lazy? The answer is it does not use lazy patterns with "~". So here is a more useful NewMonads/LazyWriterT that add two "~" to the definition of (>>=) and renames WriterT to LazyWriterT.

This is very very handy when (Control.Monad.ST.Lazy) is the transformed Monad.

{-# OPTIONS_GHC -fglasgow-exts #-}
module Main where

-- LazyWriterT, copied from
import Control.Monad.Writer
import Control.Monad.Reader
import Control.Monad.Fix
import Control.Monad.Trans

newtype LazyWriterT w m a = LazyWriterT { runLazyWriterT :: m (a, w) }

instance (Monad m) => Functor (LazyWriterT w m) where
	fmap f m = LazyWriterT $ do
		(a, w) <- runLazyWriterT m
		return (f a, w)

instance (Monoid w, Monad m) => Monad (LazyWriterT w m) where
	return a = LazyWriterT $ return (a, mempty)
	m >>= k  = LazyWriterT $ do
		~(a,w)  <- runLazyWriterT m
		~(b,w') <- runLazyWriterT (k a)
		return (b, w `mappend` w')
	fail msg = LazyWriterT $ fail msg

instance (Monoid w, MonadPlus m) => MonadPlus (LazyWriterT w m) where
	mzero       = LazyWriterT mzero
	m `mplus` n = LazyWriterT $ runLazyWriterT m `mplus` runLazyWriterT n

instance (Monoid w, MonadFix m) => MonadFix (LazyWriterT w m) where
	mfix m = LazyWriterT $ mfix $ \ ~(a, _) -> runLazyWriterT (m a)

instance (Monoid w, Monad m) => MonadWriter w (LazyWriterT w m) where
	tell   w = LazyWriterT $ return ((), w)
	listen m = LazyWriterT $ do
		(a, w) <- runLazyWriterT m
		return ((a, w), w)
	pass   m = LazyWriterT $ do
		((a, f), w) <- runLazyWriterT m
		return (a, f w)

instance (Monoid w) => MonadTrans (LazyWriterT w) where
	lift m = LazyWriterT $ do
		a <- m
		return (a, mempty)

instance (Monoid w, MonadIO m) => MonadIO (LazyWriterT w m) where
	liftIO = lift . liftIO

instance (Monoid w, MonadReader r m) => MonadReader r (LazyWriterT w m) where
	ask       = lift ask
	local f m = LazyWriterT $ local f (runLazyWriterT m)

execLazyWriterT :: Monad m => LazyWriterT w m a -> m w
execLazyWriterT m = do
	(_, w) <- runLazyWriterT m
	return w

mapLazyWriterT :: (m (a, w) -> n (b, w')) -> LazyWriterT w m a -> LazyWriterT w' n b
mapLazyWriterT f m = LazyWriterT $ f (runLazyWriterT m)