没有因使用“tell”而产生 (MonadWriter [Log] IO) 的实例

Question

考虑这个关于和 的玩具练习：我们需要根据一组预定义的规则过滤数据包列表。我们还需要根据另一组规则记录一些数据包。现在考虑两个增强功能：WriterWriterT

1. 如果出现重复的连续数据包（满足记录标准），我们应该只创建 1 个日志条目，并打印重复计数。（目标是教授所谓的“延迟记录”技巧。）
2. 我们需要为每个日志条目附加时间戳。（即使用WriterT w IO）

我已经实现了 1，但我坚持将其扩展为 2。首先，下面是 1 的代码。该merge函数处理当前数据包，但将潜在的日志条目传递到下一步，该步骤将决定是否打印它或合并它：

import Control.Monad
import Data.List
import Control.Monad.Writer

type Packet = Int
data Log = Log {
    packet :: Packet,
    acceptance :: Bool,
    bulk :: Int
  } deriving Show

instance Eq Log where
  (==) a b = packet a == packet b

incr :: Log -> Log
incr x = x {bulk = 1 + bulk x}

shouldAccept :: Packet -> Bool
shouldAccept = even

shouldLog :: Packet -> Bool
shouldLog p = p `mod` 4 < 2

type WriterP = Writer [Log] [Packet]

merge ::  (WriterP, [Log]) -> Packet -> (WriterP, [Log])
merge (prevWriter,prevLog) p = (newWriter,curLogFinal) where
  acc = shouldAccept p
  curLog = [Log p acc 1 | shouldLog p]
  curLogFinal = if null prevLog || prevLog /= curLog then curLog else incr <$> prevLog
  shouldTell = not (null prevLog) && prevLog /= curLog
  newWriter = do
            packets <- prevWriter
            when shouldTell $ tell prevLog
            return $ [p | acc] ++ packets

processPackets ::  [Packet] -> WriterP
processPackets packets = fst $ foldl' merge (return [],[]) packets

main :: IO ()
main = do
  let packets = [1,2,3,4,4,4,5,5,6,6] -- Ideally, read from a file
      (result,logged) = runWriter $ processPackets packets
      accepted = reverse result
  putStrLn "ACCEPTED PACKETS"
  forM_ accepted print
  putStrLn "\nFIREWALL LOG"
  forM_ logged print

Writer对于 2，最初我想将待处理的日志条目作为 的计算的一部分。就像是WriterT [Log] IO ([Packet],[Log])。然而我不喜欢它，因为这两个增强原则上是不相关的，如果日志要与计算混合，为什么还要使用 monad？

然后我（天真地）尝试用 包裹(WriterP, [Log])整个IO。当我继续修复类型错误时，事情似乎自行解决了（哈哈），但后来我遇到了这个No instance for (MonadWriter [Log] IO)障碍。（请参阅下面的代码。）那是什么？一些自定义实例化可以提供帮助，还是这条路是死胡同？

data Log = Log {
    -- ...
    timestamp :: UTCTime
  } deriving Show

type WriterPT = WriterT [Log] IO [Packet]

merge ::  IO (WriterPT, [Log]) -> Packet -> IO (WriterPT, [Log])
merge prevWriter_prevLog p = do
  t <- getCurrentTime
  (prevWriter,prevLog) <- prevWriter_prevLog
  let
    acc = shouldAccept p
    curLog = [Log p acc 1 t | shouldLog p]
    curLogFinal = if null prevLog || prevLog /= curLog then curLog else incr <$> prevLog
    shouldTell = not (null prevLog) && prevLog /= curLog
    newWriter = do
            packets <- prevWriter
            lift $ when shouldTell $ tell prevLog -- Error: No instance for (MonadWriter [Log] IO)
            return $ [p | acc] ++ packets
  return (newWriter,curLogFinal)

processPacketsMerged ::  [Packet] -> IO WriterPT
processPacketsMerged packets = fst <$> foldl' merge (return (return [],[])) packets

诚然，它很丑陋，更重要的是因为我嵌套WriterT在IO.

那么..有哪些巧妙的方法来添加时间戳功能，

• 我的第一个代码片段几乎没有变化？
• 否则？

其他的也欢迎留言：）

Answer 1

查看类型可能会有很大帮助：在第二个代码片段中，在 function 中merge，newWriter应该有 type WriterT [Log] IO [Packet]。

问题在于这一lift $ when shouldTell $ tell prevLog行：您想要实现的行为是记录前一个日志当且仅当shouldTell为真。如果您尝试在没有任何辅助函数的情况下编写此代码，您最终可能会得到如下所示的代码：

do ...
   if shouldTell
     then (tell prevLog) -- log the previous log
     else (return ())    -- do nothing   
   ...

现在让我们看看它when是如何实现的，以及是否可以用它以更好的方式重写这段代码：

when :: (Applicative f) => Bool -> f () -> f ()
when p s  = if p then s else pure ()

这正是我们想要做的，如果条件为假，它会自动默认为默认操作。所以我们可以将代码修改为：

do ...
   when shouldTell $ tell oldLog
   ...

无需使用lift，因为类型已经正确，有关丢失实例的错误现已消失。

要调试此类错误，让类型检查器通过使用类型化漏洞来帮助您非常有用：

do ... 
   lift $ when shouldTell $ _ -- Found hole: _ :: IO ()
   ...

但是，您要执行的操作（即tell prevLog）不是IO操作。至少这帮助我理解这lift是不必要的，你可以简单地使用when. 我希望这能有所帮助！