12

問題：

同じ Haskell モナド トランスフォーマー スタックで異なる型のライター モナドを構成する必要があります。デバッグ メッセージの書き込みに使用tellする以外に、他のデータ タイプ (たとえば、他のコンテキストで送信されるデータ パケット) の書き込みにも使用したいと考えています。

チャネライズド ライター モナドの Hackage を確認しました。私が見つけたいと思っていたのは、複数のデータ型をサポートするライターのようなモナドで、それぞれがrunWriter結果の個別の「論理」チャネルを表しています。私の検索では何も見つかりませんでした。

解決策の試み 1:

問題を解決するための私の最初のアプローチは、WriterT次の行に沿って 2 回スタックすることでした。

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:

スタックには1 つしか存在しないように見えるのでWriterT、ラッパー タイプを使用して、ユーティリティ関数 ( 、、およびPacket以下) でその事実を隠しています。機能する完全なソリューションは次のとおりです。StringrunMStacktellPackettellDebug

{-# 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 は機能しますが、より良い方法はありますか?

また、可変数のチャネルを持つチャネル化されたライター モナドは、パッケージとして一般的に実装できますか? それは便利なことのように思えますが、なぜまだ存在しないのだろうと思っています。

4

2 に答える 2

24

モナドの出力は である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
于 2011-09-20T18:40:14.047 に答える
8

記録として、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
于 2011-09-21T15:31:08.577 に答える