[Haskell-cafe] A faithful strictly-accumulating writer

[David Feuer]

Here's another version that passes the state-modifier implicitly. Is this
better or worse?

{-# language RankNTypes, FlexibleInstances, MultiParamTypeClasses,
TypeFamilies #-}
module WriterT where

import qualified Control.Monad.Writer.Class as W
import Control.Monad.State.Strict
import Control.Applicative

class WGS w s where
  wgs :: (w -> w) -> s -> s

instance w ~ s => WGS w s where
  wgs = id

newtype WriterT w m a = WriterT
  { unWriterT :: forall s. WGS w s => StateT s m a }

runWriterT :: Monoid w => WriterT w m a -> m (a, w)
runWriterT m = runStateT (unWriterT m) 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 $ m

tell :: (Monad m, Semigroup w) => w -> WriterT w m ()
tell w = WriterT $ modify' $ wgs (<> w)

listen :: (Monad m, Monoid w) => WriterT w m a -> WriterT w m (a, w)
listen m = do
  aw@(_a, w) <- lift $ runWriterT m
  tell w
  pure aw

pass :: Monad m => WriterT w m (a, w -> w) -> WriterT w m a
pass m = WriterT $ do
  (a, ww) <- unWriterT m
  modify' (wgs ww)
  pure a

instance (Monoid w, Monad m) => W.MonadWriter w (WriterT w m) where
  tell = tell
  listen = listen
  pass = pass

On Fri, Aug 30, 2019 at 9:11 AM David Feuer <david.feuer at gmail.com> wrote:

> 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/20190830/ea47497a/attachment.html>