Question

Problem:

I need to compose writer monads of different types in the same Haskell monad transformer stack. Besides using tell to write debug messages I’d also like to use it to write some other data type, e.g. data packets to be transmitted in some other context.

I’ve checked Hackage for a channelized writer monad. What I was hoping to find was a writer-like monad that supports multiple data types, each representing a distinct “logical” channel in the runWriter result. My searches didn’t turn up anything.

Solution Attempt 1:

My first approach at solving the problem was to stack WriterT twice along these lines:

type Packet = B.ByteString

newtype MStack a = MStack { unMStack :: WriterT [Packet] (WriterT [String] Identity) a }
  deriving (Monad)

However, I ran into problems when declaring MStack as an instance of both MonadWriter [Packet] and MonadWriter [String]:

instance MonadWriter [String] MStack where
  tell = Control.Monad.Writer.tell
  listen = Control.Monad.Writer.listen
  pass = Control.Monad.Writer.pass

instance MonadWriter [Packet] MStack where
  tell = lift . Control.Monad.Writer.tell
  listen = lift . Control.Monad.Writer.listen
  pass = lift . Control.Monad.Writer.pass

Subsequent complaints from ghci:

/Users/djoyner/working/channelized-writer/Try1.hs:12:10:
    Functional dependencies conflict between instance declarations:
      instance MonadWriter [String] MStack
        -- Defined at /Users/djoyner/working/channelized-writer/Try1.hs:12:10-36
      instance MonadWriter [Packet] MStack
        -- Defined at /Users/djoyner/working/channelized-writer/Try1.hs:17:10-36
Failed, modules loaded: none.

I understand why this approach is not valid as shown here but I couldn’t figure out a way around the fundamental issues so I abandoned it altogether.

Solution Attempt 2:

Since it appears there can only be a single WriterT in the stack, I’m using a wrapper type over Packet and String and hiding the fact in the utility functions (runMStack, tellPacket, and tellDebug below). Here’s the complete solution that does work:

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

import Control.Monad.Identity
import Control.Monad.Writer
import qualified Data.ByteString as B

type Packet = B.ByteString

data MStackWriterWrapper = MSWPacket Packet
                         | MSWDebug String

newtype MStack a = MStack { unMStack :: WriterT [MStackWriterWrapper] Identity a }
  deriving (Monad, MonadWriter [MStackWriterWrapper])

runMStack :: MStack a -> (a, [Packet], [String])
runMStack act = (a, concatMap unwrapPacket ws, concatMap unwrapDebug ws)
  where (a, ws) = runIdentity $ runWriterT $ unMStack act
        unwrapPacket w = case w of
          MSWPacket p -> [p]
          _ -> []
        unwrapDebug w = case w of
          MSWDebug d -> [d]
          _ -> []

tellPacket = tell . map MSWPacket
tellDebug = tell . map MSWDebug

myFunc = do
  tellDebug ["Entered myFunc"]
  tellPacket [B.pack [0..255]]
  tellDebug ["Exited myFunc"]

main = do
  let (_, ps, ds) = runMStack myFunc
  putStrLn $ "Will be sending " ++ (show $ length ps) ++ " packets."
  putStrLn "Debug log:"
  mapM_ putStrLn ds

Yay, compiles and works!

Solution Non-Attempt 3:

It also occurred to me that this might be a time when I’d roll my own, also including error, reader, and state monad functionality that needs be present in my actual application’s transformer stack type. I didn’t attempt this.

Question:

Although solution 2 works, is there a better way?

Also, could a channelized writer monad with a variable number of channels be generically implemented as a package? It would seem like that would be a useful thing and I’m wondering why it doesn’t already exist.

Answer 1

The output of the Writer monad needs to be a Monoid, but luckily tuples of monoids are monoids too! So this works:

import Control.Monad.Writer
import qualified Data.ByteString as B
import Data.Monoid

type Packet = B.ByteString

tellPacket xs = tell (xs, mempty)
tellDebug  xs = tell (mempty, xs)

myFunc :: Writer ([Packet], [String]) ()
myFunc = do
  tellDebug ["Entered myFunc"]
  tellPacket [B.pack [0..255]]
  tellDebug ["Exited myFunc"]

main = do
  let (_, (ps, ds)) = runWriter myFunc
  putStrLn $ "Will be sending " ++ (show $ length ps) ++ " packets."
  putStrLn "Debug log:"
  mapM_ putStrLn ds