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

Question

问题:

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

我已经检查了Hackage的通道化编写器monad.我希望找到的是类似于编写器的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:

我还想到,这可能是我自己滚动的时间,也包括我的实际应用程序的变换器堆栈类型中需要出现的错误,读取器和状态monad功能.我没有尝试这个.

题:

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

另外,具有可变数量通道的通道化写入器monad是否可以作为包一般实现？看起来这将是一件有用的事情,我想知道为什么它还没有存在.

Answer 1

Writermonad 的输出需要是a 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