<div dir="ltr"><div>Here's another version that passes the state-modifier implicitly. Is this better or worse?</div><div><br></div><div>{-# language RankNTypes, FlexibleInstances, MultiParamTypeClasses, TypeFamilies #-}<br>module WriterT where<br><br>import qualified Control.Monad.Writer.Class as W<br>import Control.Monad.State.Strict<br>import Control.Applicative<br></div><br><div>class WGS w s where</div><div>  wgs :: (w -> w) -> s -> s<br><br>instance w ~ s => WGS w s where<br>  wgs = id<br><br>newtype WriterT w m a = WriterT<br>  { unWriterT :: forall s. WGS w s => StateT s m a }<br><br>runWriterT :: Monoid w => WriterT w m a -> m (a, w)<br>runWriterT m = runStateT (unWriterT m) mempty<br><br>instance Functor m => Functor (WriterT w m) where<br>  fmap f m = WriterT $ fmap f (unWriterT m)<br><br>instance Monad m => Applicative (WriterT w m) where<br>  pure a = WriterT (pure a)<br>  liftA2 f m n = WriterT $ liftA2 f (unWriterT m) (unWriterT n)<br><br>instance Monad m => Monad (WriterT w m) where<br>  m >>= f = WriterT $ unWriterT m >>= unWriterT . f<br><br>instance MonadTrans (WriterT w) where<br>  lift m = WriterT $ lift $ m<br><br>tell :: (Monad m, Semigroup w) => w -> WriterT w m ()<br>tell w = WriterT $ modify' $ wgs (<> w)<br><br>listen :: (Monad m, Monoid w) => WriterT w m a -> WriterT w m (a, w)<br>listen m = do<br>  aw@(_a, w) <- lift $ runWriterT m<br>  tell w<br>  pure aw<br><br>pass :: Monad m => WriterT w m (a, w -> w) -> WriterT w m a<br>pass m = WriterT $ do<br>  (a, ww) <- unWriterT m<br>  modify' (wgs ww)<br>  pure a</div><div><br></div><div>instance (Monoid w, Monad m) => W.MonadWriter w (WriterT w m) where<br>  tell = tell<br>  listen = listen<br>  pass = pass<br></div></div><br><div class="gmail_quote"><div dir="ltr" class="gmail_attr">On Fri, Aug 30, 2019 at 9:11 AM David Feuer <<a href="mailto:david.feuer@gmail.com">david.feuer@gmail.com</a>> wrote:<br></div><blockquote class="gmail_quote" style="margin:0px 0px 0px 0.8ex;border-left:1px solid rgb(204,204,204);padding-left:1ex"><div dir="auto"><div dir="auto">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?</div><div dir="auto"><br></div><div dir="auto">{-# language RankNTypes, FlexibleInstances, MultiParamTypeClasses #-}</div><div dir="auto"><br></div><div dir="auto">import qualified Control.Monad.Writer.Class as W</div><div dir="auto">import Control.Monad.State.Strict</div><div dir="auto">import Control.Monad.Reader</div><div dir="auto">import Control.Applicative</div><div dir="auto"><br></div><div dir="auto">-- The key idea is that the computation</div><div dir="auto">-- can't inspect the state because it doesn't know the type</div><div dir="auto">newtype WriterT w m a = WriterT</div><div dir="auto">  { unWriterT :: forall s. ReaderT ((w -> w) -> s -> s) (StateT s m) a }</div><div dir="auto"><br></div><div dir="auto">runWriterT :: Monoid w => WriterT w m a -> m (a, w)</div><div dir="auto">runWriterT m = runStateT (runReaderT (unWriterT m) id) mempty</div><div dir="auto"><br></div><div dir="auto">instance Functor m => Functor (WriterT w m) where</div><div dir="auto">  fmap f m = WriterT $ fmap f (unWriterT m)</div><div dir="auto"><br></div><div dir="auto">instance Monad m => Applicative (WriterT w m) where</div><div dir="auto">  pure a = WriterT (pure a)</div><div dir="auto">  liftA2 f m n = WriterT $ liftA2 f (unWriterT m) (unWriterT n)</div><div dir="auto"><br></div><div dir="auto">instance Monad m => Monad (WriterT w m) where</div><div dir="auto">  m >>= f = WriterT $ unWriterT m >>= unWriterT . f</div><div dir="auto"><br></div><div dir="auto">instance MonadTrans (WriterT w) where</div><div dir="auto">  lift m = WriterT $ lift . lift $ m</div><div dir="auto"><br></div><div dir="auto">tell :: (Monad m, Semigroup w) => w -> WriterT w m ()</div><div dir="auto">tell w = WriterT $ do</div><div dir="auto">    p <- ask</div><div dir="auto">    modify' $ p (<> w)</div><div dir="auto"><br></div><div dir="auto"><div dir="auto">pass :: Monad m => WriterT w m (a, w -> w) -> WriterT w m a</div><div dir="auto">pass m = WriterT $ do</div><div dir="auto">  p <- ask</div><div dir="auto">  (a, ww) <- unWriterT m</div><div dir="auto">  modify' (p ww)</div><div dir="auto">  pure a</div></div><div dir="auto"><br></div><div dir="auto">instance (Monoid w, Monad m) => W.MonadWriter w (WriterT w m) where</div><div dir="auto">  tell = tell</div><div dir="auto"><br></div><div dir="auto">  listen m = do</div><div dir="auto">    aw@(_a, w) <- lift $ runWriterT m</div><div dir="auto">    tell w</div><div dir="auto">    pure aw</div><div dir="auto"><br></div><div dir="auto">  pass = pass</div></div>
</blockquote></div>