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

Question

问题：

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

我检查过 Hackage 的通道化编写器单子。我希望找到一个类似 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 和 Packet 上使用包装类型code>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：

我还想到，这可能是我推出自己的解决方案的时候，还包括需要出现在我的实际应用程序中的错误、读取器和状态 monad 功能变压器堆型。我没有尝试这样做。

问题：

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

另外，具有可变数量通道的通道化编写器 monad 是否可以普遍实现为一个包？这似乎是一件有用的事情，但我想知道为什么它还不存在。

Answer 1

Writer monad 的输出需要是一个 Monoid，但幸运的是，monoid 的元组也是 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