有没有更好的方法在 Haskell 中实现多通道 Writer monad？

Question

问题：

我需要在同一个 Haskell monad 转换器堆栈中编写不同类型的 writer monad。除了使用tell 来编写调试消息之外，我还想用它来编写一些其他数据类型，例如在其他上下文中传输的数据包。

我检查了 Hackage 中的通道化 writer monad。我希望找到的是一个支持多种数据类型的类似 writer 的 monad，每个数据类型在 runWriter 结果中代表一个不同的“逻辑”通道。我的搜索没有发现任何东西。

解决方案尝试 1：

我解决问题的第一种方法是按照以下方式将WriterT 堆叠两次：

type Packet = B.ByteString

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

但是，当我将MStack 声明为MonadWriter [Packet] 和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

来自 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.

我理解为什么这种方法无效，但我无法找到解决基本问题的方法，所以我完全放弃了它。

解决方案尝试 2：

由于堆栈中似乎只能有一个 WriterT，因此我在 Packet 和 String 上使用了包装器类型，并将事实隐藏在实用程序函数中（runMStack、tellPacket , 和下面的tellDebug)。以下是完整的解决方案：

{-# 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

是的，编译和工作！

解决方案非尝试 3：

我还想到，这可能是我自己动手的时候，还包括错误、读取器和状态单子功能，这些功能需要存在于我的实际应用程序的转换器堆栈类型中。我没有尝试过。

问题：

虽然解决方案 2 有效，但有没有更好的方法？

另外，具有可变数量通道的通道化 writer monad 是否可以作为包来实现？看起来这将是一个有用的东西，我想知道为什么它不存在。

Answer 1

Writer monad 的输出必须是 Monoid，但幸运的是，幺半群的元组也是幺半群！所以这行得通：

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

Answer 2

为了记录，可以将两个WriterT 堆叠在一起：

{-# LANGUAGE GeneralizedNewtypeDeriving #-}

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

type Packet = B.ByteString

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

tellDebug = MStack . lift . Control.Monad.Writer.tell
tellPacket = MStack . Control.Monad.Writer.tell

runMStack m =
  let ((a, ps), ds) = (runIdentity . runWriterT . runWriterT . unMStack) m
  in (a, ps, ds)

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