Есть ли лучший способ реализовать многоканальную монаду Writer в Haskell?

Question

Проблема:

Мне нужно собрать монады писателя разных типов в одном стеке монад Хаскелла. Помимо использования tell для написания отладочных сообщений я также хотел бы использовать его для записи какого-либо другого типа данных, например, пакетов данных для передачи в каком-либо другом контексте.

Я проверил Hackage на предмет канадской писательской монады. Я надеялся найти похожую на писателя монаду, которая поддерживает несколько типов данных, каждый из которых представляет отдельный "логический" канал в 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 работает, есть ли лучший способ?

Кроме того, может ли монада канального писателя с переменным числом каналов быть реализована в виде пакета? Казалось бы, это было бы полезно, и мне интересно, почему его еще не существует.

Answer 1

Выход из Writer Монада должна быть 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 (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