[Haskell-cafe] generalizing the writer monad
Petr P
petr.mvd at gmail.com
Wed Oct 17 19:59:48 CEST 2012
Hi,
(this is a literate Haskell post.)
lately I was playing with the Writer monad and it seems to me that it
is too tightly coupled with monoids. Currently, MonadWriter makes the
following assumptions:
(1) The written value can be read again later.
(2) For that to be possible it has to be monoid so that multiple (or
zero) values can be combined.
I fell say that this is a bit restricting. Sometimes, the written
value can be lost - either used to compute something else or for
example sent out using some IO action to a file, network etc. For
example, I'd like to create an IO-based writer monad whose `tell` logs
its argument somewhere - prints it, stores to a file etc.
So what I'm suggesting is to have another type class between Monad and
MonadWriter, let's say MonadTell, which only allows to write values,
not to retrieve them later:
> {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies #-}
> import Control.Monad
> import Control.Monad.Trans
> import qualified Control.Monad.Writer as W
> import qualified Control.Monad.Reader as R
> import Data.Monoid
>
> class Monad m => MonadTell w m where
> tell :: w -> m ()
> tell w = writer ((), w)
> writer :: (a, w) -> m a
> writer ~(a, w) = tell w >> return a
(We don't need fun.deps. here, they're needed in MonadWriter because
of `listen`. IDK if it'd be still better to add fun.dep. just to
eliminate typing problems?)
And MonadWriter would be defined by inheriting from MonadTell:
> class (MonadTell w m, Monoid w) => MonadWriter' w m | m -> w where
> listen :: m a -> m (a, w)
> pass :: m (a, w -> w) -> m a
Now we could use MonadWriter as before, but we could also make more
generic writers like:
> newtype Log = Log String deriving Show
> -- Prints logs to stdout.
> instance MonadTell Log IO where
> tell (Log s) = putStrLn s
>
> -- Collects the length of written logs.
> instance Monad m => MonadTell Log (W.WriterT (Sum Int) m) where
> tell (Log s) = W.tell (Sum $ length s)
>
>
> main = do
> let l = Log "Hello world"
> tell l
> print . getSum . W.execWriter $ (tell l :: W.Writer (Sum Int) ())
The same applies to MonadReader. We could make another type class
between Monad and MonadReader just with `ask`:
> class Monad m => MonadAsk r m | m -> r where
> ask :: m r
This would allow us to write instances like
> instance MonadAsk Log IO where
> ask = liftM Log getLine
Does it make sense?
Best regards,
Petr Pudlak
More information about the Haskell-Cafe
mailing list