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@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