A port of a simple logger

Question

I'm looking at porting a simple logger I wrote a while back in Python to a language which would result in less runtime overhead from logging.

As an informal benchmark, I try to log a message, including the current time, 10,000,000 times to a given file, and to record the time.

The original Python version, under CPython 3.6.0 clocks in at about 2m06s on an Intel Core i7-3615QM CPU @ 2.30GHz, with logging to a file as well as STDOUT, but with STDOUT redirected to /dev/null (constant refreshing of my terminal emulator window with new output causes noticeable overhead).

Run under PyPy 2.7.12, that time is nearly halved to 1m10s.

A trivial C port does the same thing in about half a second with -O3 and a near-identical algorithm (which IMO is a pretty spectacular improvement, and realistically, not the type of performance I can aim for in most other languages AFAIK)

What I'm concerned about is a Haskell port I've been trying to get to run faster than Python:

module Main where

import Control.Monad.Writer
import Data.List hiding (repeat)
import Data.Time (getCurrentTime)
import Data.Time.Format (formatTime)
import System.IO hiding (putStrLn)
import System.Locale (defaultTimeLocale)

data Color = GREEN | BLUE | YELLOW | RED | PURPLE | RESET
instance Show Color where
    show GREEN  = "\x1b[32m"
    show BLUE   = "\x1b[34m"
    show YELLOW = "\x1b[33m"
    show RED    = "\x1b[31m"
    show PURPLE = "\x1b[35m"
    show RESET  = "\x1b[0m"

data MessageLevel = OK | INFO | WARN | FAIL | CRIT
instance Show MessageLevel where
    show OK     = "  OK  "
    show INFO   = " INFO "
    show WARN   = " WARN "
    show FAIL   = " FAIL "
    show CRIT   = " CRIT "

splotch :: MessageLevel -> String
splotch OK   = (show GREEN)  ++ "  ⬢  " ++ (show RESET)
splotch INFO = (show BLUE)   ++ "  ⬢  " ++ (show RESET)
splotch WARN = (show YELLOW) ++ "  ⬢  " ++ (show RESET)
splotch FAIL = (show RED)    ++ "  ⬢  " ++ (show RESET)
splotch CRIT = (show PURPLE) ++ "  ⬢  " ++ (show RESET)

buildMessage :: MessageLevel -> String -> IO String
buildMessage lvl msg = do
    now <- getCurrentTime
    return $ (show now) ++ " || [" ++ (show lvl) ++ "]" ++ (splotch lvl) ++ msg

slog :: MessageLevel -> String -> Handle -> IO ()
slog lvl msg f = (buildMessage lvl msg) >>= (hPutStrLn f)

bench1 = do
    f <- openFile "log.txt" AppendMode
    replicateM_ 10000000 $ slog OK "Hello, world!" f
    hClose f

main = bench1

Long story, short, this generates output which includes:

• Picosecond-precise time (which isn't a requirement; second-precise is enough);
• The log level;
• A colored icon making it easier to recognize the log level at a glance; and
• The log message.

After implementing some revision suggestions from the comments, this code can match Python's performance, but doesn't surpass it.

My primary concerns with my code are:

• That picosecond-precise time is reducing how often memoization is performed

  • I've tried using second-resolution time, which would make this a true port of the basic Python functionality, but Haskell's datetime facilities seem fairly contrived to me

• That I'm using a non-optimal way of sharing the file Handle between functions

• That the benchmarking function itself could be inducing overhead

• That I'm missing some places where pure and impure computations can be separated

I'm trying to avoid using the Writer monad because in the use cases for this logger, the output of computations inducing a logger call wouldn't need to be passed down the pipeline.

What changes can I introduce into this code to improve its performance in the benchmark I described?

Answer 1

The culprit really is getCurrentTime (without it the code runs almost instantly), and I wasn't able to find any standard function that fulfils your requirements. That's why I wrote a tiny library in C that formats the current time as per requirements; and a wrapper around it.

This is the tiny library that gets the current time and formats it:

#include <time.h>

int formatCurrentTime(char * buffer) {
    time_t timer;
    struct tm * tm_info;
    time(&timer);
    tm_info = localtime(&timer);
    strftime(buffer, 26, "%Y-%m-%d %H:%M:%S", tm_info);
    return 0; // TODO: check for errors
}

This is the haskell wrapper around it:

module FormatCurrentTime(mkTimeStamp) where

import Control.Monad(guard)
import Foreign.C
import Foreign.ForeignPtr(withForeignPtr, mallocForeignPtrBytes)
import Foreign.Ptr(Ptr)

foreign import ccall unsafe "formatCurrentTime"
    c_formatCurrentTime :: CString -> IO CInt

mkTimeStamp :: IO String
mkTimeStamp = mallocForeignPtrBytes 26 >>= flip withForeignPtr fun
  where fun :: Ptr CChar -> IO String
        fun ptr = do res <- c_formatCurrentTime ptr
                    guard (res == 0)
                    peekCAString ptr

Finally, these are the parts of the main module that I've changed.

Part 1:

module Main where

import Control.Monad(replicateM_)
import System.IO hiding (putStrLn)

import FormatCurrentTime(mkTimeStamp)

Part 2:

buildMessage :: MessageLevel -> String -> String
buildMessage lvl msg = " || [" ++ show lvl ++ "]" ++ splotch lvl ++ msg

slog :: MessageLevel -> String -> Handle -> IO ()
slog lvl msg h = mkTimeStamp >>= \timestmp ->
                 hPutStrLn h $ timestmp ++ buildMessage lvl msg

bench1 :: IO ()
bench1 = do
    h <- openFile "log.txt" AppendMode
    replicateM_ (10^6) $ slog OK "Hello, world!" h
    hClose h

main :: IO ()
main = bench1

This change reduces the runtime by approximately 72%.

To make it more portable, you could eliminate the middleman and use the FFI to call libtime directly.

Answer 2

So, you were right about the "picosecond precision": the overly precise time is causing problems (GHC doesn't memoize but you can read more about what it does do here).

Basically, the solution is to use a library. I used the fast-logger library.

module Lib
    ( main
    , toBench
    , MessageLevel(..)
    ) where
import Control.Monad
import Data.Monoid
import System.Log.FastLogger.Date
import System.Log.FastLogger

main = toBench 10000000 OK "Hello, World!"

data MessageLevel = OK | INFO | WARN | FAIL | CRIT

instance Show MessageLevel where
    show OK     = "  OK  "
    show INFO   = " INFO "
    show WARN   = " WARN "
    show FAIL   = " FAIL "
    show CRIT   = " CRIT "

toBench :: Int -> MessageLevel -> String -> IO ()
toBench n lvl msg = do
    logFunction <- fst <$> fastLogger
    let toString msg t = toLogStr t <> toLogStr (mconcat msg)
    replicateM_ n $ (logFunction . toString) ([" || [", (show lvl), "] ", msg, "\n"])

fastLogger :: IO (TimedFastLogger, IO ())
fastLogger = do
    timeCache <- newTimeCache "%Y-%m-%d %H:%M:%S"
    let logType = LogFileNoRotate "test.log" 4096
    newTimedFastLogger timeCache logType

You can view the full code here.

I did modify the code, but for good reason: loggers writing to file shouldn't include color. So I think this is a more apt benchmark.

With all that said and done, the Haskell version took around 3.6s on my computer and the python version took 2m35s to accomplish the same thing. This is pure Haskell code - no C whatsoever. I did use one of the suggestions from hlint - use the tools available to you!

As a parting shot: get comfortable using other people's code when writing Haskell. Your code is pretty good - you separate pure and impure code nicely, but on this front it is lacking. One of functional programming's strengths is that it enables easy code reuse. I suggest you take advantage of this - Haskell is not easy.