fast-logger 3.0.5 → 3.1.0

raw patch · 5 files changed

+40/−36 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• System/Log/FastLogger/IO.hs +1/−2
• System/Log/FastLogger/Logger.hs +10/−12
• System/Log/FastLogger/LoggerSet.hs +23/−21
• fast-logger.cabal +1/−1

@@ -1,3 +1,8 @@+## 3.1.0++* Having a single Buffer in LoggerSet for locking [#197](https://github.com/kazu-yamamoto/logger/pull/197.+  This would have performance penalty. So, the major version bumps up. If you see performance regression, please register an issue on github.+ ## 3.0.5  * recovering backward compatibility for newFileLoggerSet.

@@ -1,4 +1,3 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-}  #if __GLASGOW_HASKELL__ <= 708@@ -34,7 +33,7 @@ freeBuffer = free  toBufIOWith :: Buffer -> BufSize -> (Buffer -> Int -> IO ()) -> Builder -> IO ()-toBufIOWith buf !size io builder = loop $ BBE.runBuilder builder+toBufIOWith buf size io builder = loop $ BBE.runBuilder builder   where     loop writer = do         (len, next) <- writer buf size

@@ -1,4 +1,3 @@-{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} @@ -10,7 +9,7 @@   ) where  -import Control.Concurrent (MVar, newMVar, withMVar)+import Control.Concurrent (MVar, withMVar) import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Ptr (plusPtr) @@ -21,20 +20,19 @@  ---------------------------------------------------------------- -data Logger = Logger !BufSize (MVar Buffer) (IORef LogStr)+newtype Logger = Logger (IORef LogStr)  ---------------------------------------------------------------- -newLogger :: BufSize -> IO Logger-newLogger size = Logger size <$> (getBuffer size >>= newMVar)-                             <*> newIORef mempty+newLogger :: IO Logger+newLogger = Logger <$> newIORef mempty  ---------------------------------------------------------------- -pushLog :: IORef FD -> Logger -> LogStr -> IO ()-pushLog fdref logger@(Logger size mbuf ref) nlogmsg@(LogStr nlen nbuilder)+pushLog :: IORef FD -> BufSize -> MVar Buffer -> Logger -> LogStr -> IO ()+pushLog fdref size mbuf logger@(Logger ref) nlogmsg@(LogStr nlen nbuilder)   | nlen > size = do-      flushLog fdref logger+      flushLog fdref size mbuf logger       -- Make sure we have a large enough buffer to hold the entire       -- contents, thereby allowing for a single write system call and       -- avoiding interleaving. This does not address the possibility@@ -53,8 +51,8 @@  ---------------------------------------------------------------- -flushLog :: IORef FD -> Logger -> IO ()-flushLog fdref (Logger size mbuf lref) = do+flushLog :: IORef FD -> BufSize -> MVar Buffer -> Logger -> IO ()+flushLog fdref size mbuf (Logger lref) = do     logmsg <- atomicModifyIORef' lref (\old -> (mempty, old))     -- If a special buffer is prepared for flusher, this MVar could     -- be removed. But such a code does not contribute logging speed@@ -81,7 +79,7 @@ write :: IORef FD -> Buffer -> Int -> IO () write fdref buf len' = loop buf (fromIntegral len')   where-    loop bf !len = do+    loop bf len = do         written <- writeRawBufferPtr2FD fdref bf len         when (0 <= written && written < len) $             loop (bf `plusPtr` fromIntegral written) (len - written)

@@ -20,8 +20,8 @@   , replaceLoggerSet   ) where +import Control.Concurrent (MVar, getNumCapabilities, myThreadId, threadCapability, takeMVar, newMVar) import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceAction)-import Control.Concurrent (getNumCapabilities, myThreadId, threadCapability, takeMVar) import Data.Array (Array, listArray, (!), bounds)  import System.Log.FastLogger.FileIO@@ -36,7 +36,10 @@ --   The number of loggers is the capabilities of GHC RTS. --   You can specify it with \"+RTS -N\<x\>\". --   A buffer is prepared for each capability.-data LoggerSet = LoggerSet (Maybe FilePath) (IORef FD) (Array Int Logger) (IO ())+data LoggerSet = LoggerSet (Maybe FilePath) (IORef FD)+                           BufSize (MVar Buffer)+                           (Array Int Logger)+                           (IO ())  -- | Creating a new 'LoggerSet' using a file. newFileLoggerSet :: BufSize -> FilePath -> IO LoggerSet@@ -68,19 +71,21 @@     n <- case mn of       Just n' -> return n'       Nothing -> getNumCapabilities-    loggers <- replicateM n $ newLogger (max 1 size)+    loggers <- replicateM n newLogger     let arr = listArray (0,n-1) loggers     fref <- newIORef fd+    let bufsiz = max 1 size+    mbuf <- getBuffer bufsiz >>= newMVar     flush <- mkDebounce defaultDebounceSettings-        { debounceAction = flushLogStrRaw fref arr+        { debounceAction = flushLogStrRaw fref bufsiz mbuf arr         }-    return $ LoggerSet mfile fref arr flush+    return $ LoggerSet mfile fref bufsiz mbuf arr flush  -- | Writing a log message to the corresponding buffer. --   If the buffer becomes full, the log messages in the buffer --   are written to its corresponding file, stdout, or stderr. pushLogStr :: LoggerSet -> LogStr -> IO ()-pushLogStr (LoggerSet _ fdref arr flush) logmsg = do+pushLogStr (LoggerSet _ fdref size mbuf arr flush) logmsg = do     (i, _) <- myThreadId >>= threadCapability     -- The number of capability could be dynamically changed.     -- So, let's check the upper boundary of the array.@@ -89,7 +94,7 @@         j | i < lim   = i           | otherwise = i `mod` lim     let logger = arr ! j-    pushLog fdref logger logmsg+    pushLog fdref size mbuf logger logmsg     flush  -- | Same as 'pushLogStr' but also appends a newline.@@ -106,20 +111,20 @@ --   function can be used to force flushing outside of the debounced --   flush calls. flushLogStr :: LoggerSet -> IO ()-flushLogStr (LoggerSet _ fref arr _) = flushLogStrRaw fref arr+flushLogStr (LoggerSet _ fref size mbuf arr _) = flushLogStrRaw fref size mbuf arr -flushLogStrRaw :: IORef FD -> Array Int Logger -> IO ()-flushLogStrRaw fdref arr = do+flushLogStrRaw :: IORef FD -> BufSize -> MVar Buffer -> Array Int Logger -> IO ()+flushLogStrRaw fdref size mbuf arr = do     let (l,u) = bounds arr     mapM_ flushIt [l .. u]   where-    flushIt i = flushLog fdref (arr ! i)+    flushIt i = flushLog fdref size mbuf (arr ! i)  -- | Renewing the internal file information in 'LoggerSet'. --   This does nothing for stdout and stderr. renewLoggerSet :: LoggerSet -> IO ()-renewLoggerSet (LoggerSet Nothing     _    _ _) = return ()-renewLoggerSet (LoggerSet (Just file) fref _ _) = do+renewLoggerSet (LoggerSet Nothing     _    _ _ _ _) = return ()+renewLoggerSet (LoggerSet (Just file) fref _ _ _ _) = do     newfd <- openFileFD file     oldfd <- atomicModifyIORef' fref (\fd -> (newfd, fd))     closeFD oldfd@@ -127,23 +132,20 @@ -- | Flushing the buffers, closing the internal file information --   and freeing the buffers. rmLoggerSet :: LoggerSet -> IO ()-rmLoggerSet (LoggerSet mfile fdref arr _) = do+rmLoggerSet (LoggerSet mfile fdref size mbuf arr _) = do     fd <- readIORef fdref     when (isFDValid fd) $ do         let (l,u) = bounds arr         let nums = [l .. u]         mapM_ flushIt nums-        mapM_ freeIt nums+        takeMVar mbuf >>= freeBuffer         when (isJust mfile) $ closeFD fd         writeIORef fdref invalidFD   where-    flushIt i = flushLog fdref (arr ! i)-    freeIt i = do-        let (Logger _ mbuf _) = arr ! i-        takeMVar mbuf >>= freeBuffer+    flushIt i = flushLog fdref size mbuf(arr ! i)  -- | Replacing the file path in 'LoggerSet' and returning a new --   'LoggerSet' and the old file path. replaceLoggerSet :: LoggerSet -> FilePath -> (LoggerSet, Maybe FilePath)-replaceLoggerSet (LoggerSet current_path a b c) new_file_path =-    (LoggerSet (Just new_file_path) a b c, current_path)+replaceLoggerSet (LoggerSet current_path a b c d e) new_file_path =+    (LoggerSet (Just new_file_path) a b c d e, current_path)

@@ -1,5 +1,5 @@ Name:                   fast-logger-Version:                3.0.5+Version:                3.1.0 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3