» A Simple Asynchronous Handler for hslogger #

Paul R. Brown @ 2008-05-29

The hslogger package provides a few handlers, e.g., for files and for Syslog, but the implementation of the file logger uses an MVar as a lock for writing log events. This isn't a bad thing, per se, since the GHC runtime will do a good job of queuing waiters for that lock, but it had a noticable impact on performance for perpubplat when I added some initial logging.

To decouple the log event dispatch and disk access, I whipped up a quick AsyncLogHandler (source) that does the job. Here is a quick tour in snippets, starting with a base data structure:

type Timestamp = String

type LogMessage = String

data AsyncLogHandler
    = AsyncLogHandler { channel :: Chan (LogRecord, LogMessage, Timestamp)
                      , level :: Priority }

An admittedly imperfect instantiation for the LogHandler type class:

instance LogHandler AsyncLogHandler where
    setLevel alh p = alh { level = p }
    getLevel alh = level alh
    emit alh lr msg = do { n <- now
                         ; writeChan (channel alh) $! (lr,msg,n) }
    close _ = return () -- make this better

This is less than perfect because it doesn't deal with altering the priority level or closing the stream on the fly, but I'm not concerned with either of those things for the moment. (To make that work, I'd need an additional level of encapsulation on the Chan that wraps log messages and control requests.) I'm on the fence with the necessity of making the writeChan strict in the second argument, but I believe it's necessary to ensure that the timestamp is computed when the message is dispatched as opposed to when it's output.

Setup just requires forking a lightweight thread to pull log messages out of the channel:

asyncHandler :: Int -> Handle -> Priority -> IO AsyncLogHandler
asyncHandler n h pri = do { c <- newChan
                          ; forkIO $ append n 0 h c
                          ; return $ AsyncLogHandler { channel = c
                                                     , level = pri } }

And then a tail-recursive function to pull the events, format output, and periodically (every n messages) flush the stream:

append :: Int -> Int -> Handle -> Chan (LogRecord, LogMessage, Timestamp) -> IO ()
append n i h c = do { ((p,m),l,ts) <- readChan c
                    ; (hPutStrLn h $ ts ++ " [" ++ (show p) ++ "] " ++ l ++ " - " ++ m)
                      `CE.catch` (printex h)
                    ; if i == n then
                          do { (hFlush h) `CE.catch` (printex h)
                             ; append n 0 h c }
                      else
                          append n (i+1) h c }

printex :: Handle -> CE.Exception -> IO ()
printex h e = hPutStrLn System.IO.stderr $ "Error writing to log handle "
              ++ (show h) ++ ": " ++ show e

And that's it.

 

← 2008-05-20 — Just cancel, OK?
→ 2008-06-17 — No, Dad, I'm Lowly Worm...