[Haskell-cafe] A faithful strictly-accumulating writer
David Feuer
david.feuer at gmail.com
Fri Aug 30 02:11:43 UTC 2019
It's widely known that the classic WriterT tends to leak space, and that in
some cases this leak can be resolved by using StateT instead. The
implementations I've seen of this idea both use the module system to
prevent the computation from gaining unauthorized access to the state. I
believe I've found a way to avoid this. Does this look right?
{-# language RankNTypes, FlexibleInstances, MultiParamTypeClasses #-}
import qualified Control.Monad.Writer.Class as W
import Control.Monad.State.Strict
import Control.Monad.Reader
import Control.Applicative
-- The key idea is that the computation
-- can't inspect the state because it doesn't know the type
newtype WriterT w m a = WriterT
{ unWriterT :: forall s. ReaderT ((w -> w) -> s -> s) (StateT s m) a }
runWriterT :: Monoid w => WriterT w m a -> m (a, w)
runWriterT m = runStateT (runReaderT (unWriterT m) id) mempty
instance Functor m => Functor (WriterT w m) where
fmap f m = WriterT $ fmap f (unWriterT m)
instance Monad m => Applicative (WriterT w m) where
pure a = WriterT (pure a)
liftA2 f m n = WriterT $ liftA2 f (unWriterT m) (unWriterT n)
instance Monad m => Monad (WriterT w m) where
m >>= f = WriterT $ unWriterT m >>= unWriterT . f
instance MonadTrans (WriterT w) where
lift m = WriterT $ lift . lift $ m
tell :: (Monad m, Semigroup w) => w -> WriterT w m ()
tell w = WriterT $ do
p <- ask
modify' $ p (<> w)
pass :: Monad m => WriterT w m (a, w -> w) -> WriterT w m a
pass m = WriterT $ do
p <- ask
(a, ww) <- unWriterT m
modify' (p ww)
pure a
instance (Monoid w, Monad m) => W.MonadWriter w (WriterT w m) where
tell = tell
listen m = do
aw@(_a, w) <- lift $ runWriterT m
tell w
pure aw
pass = pass
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <http://mail.haskell.org/pipermail/haskell-cafe/attachments/20190829/f9ff2714/attachment.html>
More information about the Haskell-Cafe
mailing list