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

Проблема:

Мне нужно написать монады-писатели разных типов в одном и том же стеке монашеских монашеских монашек. Помимо использования 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

Yay, компилируется и работает!

Решение Не пытайтесь 3:

Мне также пришло в голову, что это может быть время, когда я откажусь от своего собственного, включая функции ошибок, чтения и состояния штата, которые должны присутствовать в моем фактическом стеке приложения. Я не пытался это сделать.

Вопрос:

Хотя решение 2 работает, есть ли лучший способ?

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

Ответ 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

Ответ 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