Consider this toy exercise on Writer and WriterT: We need to filter a list of packets based on a predefined set of rules. We also need to log some packets based on another set of rules. Now consider two enhancements:

1. In case of duplicate consecutive packets (that meet the logging criteria), we should only make 1 log entry, along with printing the duplication count. (The goal is to teach the so called 'delayed logging' trick.)
2. We need to attach timestamp to every log entry. (i.e. Use WriterT w IO)

I have implemented 1, but am stuck in extending it to 2. Firstly, below is the code for 1. The merge function processes the current packet, but passes on the potential log entry to the next step which will decide whether to print it or merge it:

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

For 2, initially I thought of making our pending log entry the part of Writer's computation. Something like WriterT [Log] IO ([Packet],[Log]). However I don't like it because the two enhancements are in principle unrelated, and if logs are to mix with computation, why use the monad at all?

Then I (naively) tried to wrap the whole (WriterP, [Log]) with IO. Things seemed to resolve themselves as I went on fixing type errors (haha), but then I hit this No instance for (MonadWriter [Log] IO) roadblock. (See the code below.) What is that? Can some custom instantiation help, or is this path a dead end?

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

Admittedly it's ugly, more so because I am nesting WriterT within IO.

So.. what are some neat ways to add the timestamp feature,

• with little changes to my first code snippet?
• otherwise?

Other remarks are also welcome :)

CodePudding user response：

Looking at the types can be of great help: in your second code snippet, in the function merge, newWriter should have type WriterT [Log] IO [Packet].

The problem lies in the lift $ when shouldTell $ tell prevLog line: the behaviour you want to achieve is to log the previous log iff shouldTell is true. If you try to write this without any helper function you may end up with code that looks like this:

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

Now let's look at how when is implemented and if it can be used to rewrite this piece of code in a nicer way:

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

It is exactly what we were trying to do, it automatically defaults to a default action in case the condition is false. So we can change the code to:

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

No need to use lift as the types are already correct, the error about the missing instance is gone now.

To debug this kind of error it can be really useful to let the type checker help you by using typed holes:

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

However, the action you want to perform (that is tell prevLog) is not an IO action. At least this is what helped me understand that lift was not necessary and you could simply use when. I hope this can help!