[Haskell-cafe] A faithful strictly-accumulating writer
Li-yao Xia
lysxia at gmail.com
Fri Aug 30 03:42:51 UTC 2019
This looks like an interesting problem, but I'm a little confused about
the objective. In what sense is it "faithful"?
> to prevent the computation from gaining unauthorized access to the state.
Does that property have a formal definition? Are we looking for a
one-to-one correspondence between a "better" WriterT and the naive WriterT?
What about (w -> s -> s) instead of ((w -> w) -> (s -> s))? It seems
that `pass` needs the (w -> w), but if we leave `pass` aside, does that
still look about right?
Li-yao
On 8/29/19 10:56 PM, David Feuer wrote:
> 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
>>
>
>
> _______________________________________________
> Haskell-Cafe mailing list
> To (un)subscribe, modify options or view archives go to:
> http://mail.haskell.org/cgi-bin/mailman/listinfo/haskell-cafe
> Only members subscribed via the mailman list are allowed to post.
>
More information about the Haskell-Cafe
mailing list