7
\$\begingroup\$

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?

\$\endgroup\$
  • \$\begingroup\$ soo .. I'm running this on my laptop. My haskell baseline is at 1:12,04 (according to zsh). By changing one thing, I got down to 1:03,34. Calculating this up to your baseline this should get your code down to the CPython execution time. \$\endgroup\$ – Vogel612 Mar 7 '17 at 9:57
  • 1
    \$\begingroup\$ What is this one simple trick that Intel hates you for? By the way I'd replace all those slog*s with slog flag f = buildMessage flag >=> hPutStrLn f, and flip _repeat is replicateM_, and what's that \_ -> doing there? \$\endgroup\$ – Gurkenglas Mar 7 '17 at 11:26
  • 1
    \$\begingroup\$ @Jules I'm using the included bench, but my zsh is providing the timing. Interestingly the vast majority of time is spent in userspace which is surprising, if not only because compiling through ghc -perf -fperf-auto -rtsopts and then running ./Main -p +RTS shows that the time-cost lies within the log-call itself. Well to be exact it lies in the impure creation of the logentry (interestingly it doesn't seem relevant whether the non-timestamp part of the entry is assigned inside the "loop" or outside of it) :/ \$\endgroup\$ – Vogel612 Mar 7 '17 at 14:25
  • 1
    \$\begingroup\$ Your code does not compile at the moment. For example, repeat_ is missing n. Please make sure that you provide your actual working code. \$\endgroup\$ – Zeta Mar 7 '17 at 16:21
  • 1
    \$\begingroup\$ If the 2nd snippet means to replace the first one, please remove the old one and avoid "EDIT:" headings/notes in the post itself - people that want to see the revision history can look at it here. \$\endgroup\$ – Mathieu Guindon Mar 8 '17 at 14:39
2
\$\begingroup\$

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.

\$\endgroup\$
4
\$\begingroup\$

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.

\$\endgroup\$
  • 1
    \$\begingroup\$ Just wanted to say that I spent some time profiling his original code (for fun) and your answer is the real answer. Basically formatting the time is really expensive to do (guessing the python program actually passes that to a c function call). Interestingly enough the fastlogger lib will format the time once every second and then just ask for that formatted time when it needs it and thats why its so much faster. A very fun learning experience indeed. \$\endgroup\$ – sbditto85 Jun 16 '17 at 2:46
  • \$\begingroup\$ I created a version as close to OP as possible but just use the caching of the formatted time string and got good-ish results. Python version on my machine: 2m6.248s, Original haskell version on my machine: 1m39.371s, Cached Time Format: 0m37.914s, Fast-Logger (slightly differnt then original problem) : 0m6.967s \$\endgroup\$ – sbditto85 Jun 16 '17 at 6:06
  • 1
    \$\begingroup\$ in case anyone cares here is a repo with the code i used and a description of what i did. github.com/sbditto85/profilingfunwithhaskell \$\endgroup\$ – sbditto85 Jun 16 '17 at 6:13

Your Answer

By clicking “Post Your Answer”, you agree to our terms of service, privacy policy and cookie policy

Not the answer you're looking for? Browse other questions tagged or ask your own question.