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

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

12 голосов
/ 20 сентября 2011

Проблема:

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

Ууу, компилирует и работает!

Решение без попытки 3:

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

Вопрос:

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

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

Ответы [ 2 ]

23 голосов
/ 20 сентября 2011

Выход монады 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
8 голосов
/ 21 сентября 2011

Для записи можно сложить два 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
...