module Control.Monad.Writer
(
Writer
, execWriter
, tell
) where
newtype Identity a = Identity { runIdentity :: a }
instance Functor Identity where
fmap f m = Identity (f (runIdentity m))
instance Applicative Identity where
pure a = Identity a
Identity f <*> Identity x = Identity (f x)
instance Monad Identity where
return a = Identity a
m >>= k = k (runIdentity m)
type Writer w = WriterT w Identity
runWriter :: Monoid w => Writer w a -> (a, w)
runWriter = runIdentity . runWriterT
execWriter :: Monoid w => Writer w a -> w
execWriter m = snd (runWriter m)
newtype WriterT w m a = WriterT { unWriterT :: w -> m (a, w) }
instance Functor m => Functor (WriterT w m) where
fmap f m = WriterT $ \ w ->
fmap (\(a, w') -> (f a, w')) $ unWriterT m w
instance (Functor m, Monad m) => Applicative (WriterT w m) where
pure a = WriterT $ \w -> return (a,w)
WriterT mf <*> WriterT mx = WriterT $ \w -> do
(f, w') <- mf w
(x, w'') <- mx w'
return (f x, w'')
{-# INLINE (<*>) #-}
instance (Monad m, Monoid w) => Monad (WriterT w m) where
return a = WriterT $ \w -> return (a, w)
m >>= f = WriterT $ \w -> do
(a, w') <- unWriterT m w
unWriterT (f a) w'
runWriterT :: (Monoid w) => WriterT w m a -> m (a, w)
runWriterT m = unWriterT m mempty
tell :: (Monad m, Monoid w) => w -> WriterT w m ()
tell w = WriterT $ \w' ->
let wt = w' `mappend` w
in wt `seq` return ((), w' `mappend` w)