fast-logger 3.1.2 → 3.2.0

raw patch · 11 files changed

+403/−165 lines, 11 filesdep +asyncdep +stmPVP ok

version bump matches the API change (PVP)

Dependencies added: async, stm

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• System/Log/FastLogger.hs +3/−2
• System/Log/FastLogger/Internal.hs +6/−2
• System/Log/FastLogger/LogStr.hs +4/−2
• System/Log/FastLogger/Logger.hs +0/−85
• System/Log/FastLogger/LoggerSet.hs +55/−48
• System/Log/FastLogger/MultiLogger.hs +120/−0
• System/Log/FastLogger/SingleLogger.hs +104/−0
• System/Log/FastLogger/Write.hs +45/−0
• fast-logger.cabal +8/−4
• test/FastLoggerSpec.hs +53/−22

@@ -1,3 +1,8 @@+## 3.2.0++* newFastLogger1 ensures the ordering of logs+  [#207](https://github.com/kazu-yamamoto/logger/pull/207)+ ## 3.1.2  * Require unix-compat >= 0.2

@@ -109,8 +109,9 @@ newFastLogger typ = newFastLoggerCore Nothing typ  -- | Like `newFastLogger`, but creating a logger that uses only 1--- capability. This scales less well on multi-core machines,--- but provides time-ordered output.+-- internal builder. This scales less on multi-core machines and+-- consumes more memory because of an internal queue but provides+-- time-ordered output. newFastLogger1 :: LogType' v -> IO (v -> IO (), IO ()) newFastLogger1 typ = newFastLoggerCore (Just 1) typ 

@@ -4,12 +4,16 @@   ( module System.Log.FastLogger.IO   , module System.Log.FastLogger.FileIO   , module System.Log.FastLogger.LogStr-  , module System.Log.FastLogger.Logger+  , module System.Log.FastLogger.SingleLogger+  , module System.Log.FastLogger.MultiLogger+  , module System.Log.FastLogger.Write   , module System.Log.FastLogger.LoggerSet   ) where  import System.Log.FastLogger.IO import System.Log.FastLogger.FileIO import System.Log.FastLogger.LogStr-import System.Log.FastLogger.Logger+import System.Log.FastLogger.SingleLogger+import System.Log.FastLogger.MultiLogger+import System.Log.FastLogger.Write import System.Log.FastLogger.LoggerSet

@@ -50,12 +50,14 @@ instance Semi.Semigroup LogStr where     {-# INLINE (<>) #-}     LogStr s1 b1 <> LogStr s2 b2 = LogStr (s1 + s2) (b1 <> b2)-#endif- instance Monoid LogStr where     mempty = LogStr 0 (toBuilder BS.empty)+#else+instance Monoid LogStr where+    mempty = LogStr 0 (toBuilder BS.empty)     {-# INLINE mappend #-}     LogStr s1 b1 `mappend` LogStr s2 b2 = LogStr (s1 + s2) (b1 <> b2)+#endif  instance IsString LogStr where     {-# INLINE fromString #-}

@@ -1,85 +0,0 @@-{-# LANGUAGE CPP #-}-{-# LANGUAGE Safe #-}--module System.Log.FastLogger.Logger (-    Logger(..)-  , newLogger-  , pushLog-  , flushLog-  ) where---import Control.Concurrent (MVar, withMVar)-import Foreign.Marshal.Alloc (allocaBytes)-import Foreign.Ptr (plusPtr)--import System.Log.FastLogger.FileIO-import System.Log.FastLogger.IO-import System.Log.FastLogger.Imports-import System.Log.FastLogger.LogStr--------------------------------------------------------------------newtype Logger = Logger (IORef LogStr)--------------------------------------------------------------------newLogger :: IO Logger-newLogger = Logger <$> newIORef mempty--------------------------------------------------------------------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 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-      -- of write not writing the entire buffer at once.-      allocaBytes nlen $ \buf -> withMVar mbuf $ \_ ->-        toBufIOWith buf nlen (write fdref) nbuilder-  | otherwise = do-    mmsg <- atomicModifyIORef' ref checkBuf-    case mmsg of-        Nothing  -> return ()-        Just msg -> withMVar mbuf $ \buf -> writeLogStr fdref buf size msg-  where-    checkBuf ologmsg@(LogStr olen _)-      | size < olen + nlen = (nlogmsg, Just ologmsg)-      | otherwise          = (ologmsg <> nlogmsg, Nothing)--------------------------------------------------------------------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-    -- according to experiment. And even with the special buffer,-    -- there is no grantee that this function is exclusively called-    -- for a buffer. So, we use MVar here.-    -- This is safe and speed penalty can be ignored.-    withMVar mbuf $ \buf -> writeLogStr fdref buf size logmsg---------------------------------------------------------------------- | Writting 'LogStr' using a buffer in blocking mode.---   The size of 'LogStr' must be smaller or equal to---   the size of buffer.-writeLogStr :: IORef FD-            -> Buffer-            -> BufSize-            -> LogStr-            -> IO ()-writeLogStr fdref buf size (LogStr len builder)-  | size < len = error "writeLogStr"-  | otherwise  = toBufIOWith buf size (write fdref) builder--write :: IORef FD -> Buffer -> Int -> IO ()-write fdref buf len' = loop buf (fromIntegral len')-  where-    loop bf len = do-        written <- writeRawBufferPtr2FD fdref bf len-        when (0 <= written && written < len) $-            loop (bf `plusPtr` fromIntegral written) (len - written)

@@ -1,4 +1,5 @@ {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}  module System.Log.FastLogger.LoggerSet (   -- * Creating a logger set@@ -23,26 +24,35 @@   , replaceLoggerSet   ) where -import Control.Concurrent (MVar, getNumCapabilities, myThreadId, threadCapability, takeMVar, newMVar)+import Control.Concurrent (getNumCapabilities) import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceAction)-import Data.Array (Array, listArray, (!), bounds)  import System.Log.FastLogger.FileIO import System.Log.FastLogger.IO import System.Log.FastLogger.Imports import System.Log.FastLogger.LogStr-import System.Log.FastLogger.Logger+import System.Log.FastLogger.MultiLogger (MultiLogger)+import qualified System.Log.FastLogger.MultiLogger as M+import System.Log.FastLogger.SingleLogger (SingleLogger)+import qualified System.Log.FastLogger.SingleLogger as S+import System.Log.FastLogger.Write  ---------------------------------------------------------------- +data Logger = SL SingleLogger | ML MultiLogger++----------------------------------------------------------------+ -- | A set of loggers. --   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)-                           BufSize (MVar Buffer)-                           (Array Int Logger)-                           (IO ())+data LoggerSet = LoggerSet {+    lgrsetFilePath :: Maybe FilePath+  , lgrsetFdRef    :: IORef FD+  , lgrsetLogger   :: Logger+  , lgrsetDebounce :: IO ()+  }  -- | Creating a new 'LoggerSet' using a file. --@@ -90,31 +100,33 @@     n <- case mn of       Just n' -> return n'       Nothing -> getNumCapabilities-    loggers <- replicateM n newLogger-    let arr = listArray (0,n-1) loggers-    fref <- newIORef fd+    fdref <- newIORef fd     let bufsiz = max 1 size-    mbuf <- getBuffer bufsiz >>= newMVar+    logger <- if n == 1 && mn == Just 1 then+                  SL <$> S.newSingleLogger bufsiz fdref+                else do+                  ML <$> M.newMultiLogger n bufsiz fdref     flush <- mkDebounce defaultDebounceSettings-        { debounceAction = flushLogStrRaw fref bufsiz mbuf arr+        { debounceAction = flushLogStrRaw logger         }-    return $ LoggerSet mfile fref bufsiz mbuf arr flush+    return $ LoggerSet {+        lgrsetFilePath = mfile+      , lgrsetFdRef    = fdref+      , lgrsetLogger   = logger+      , lgrsetDebounce = 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 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.-    let u = snd $ bounds arr-        lim = u + 1-        j | i < lim   = i-          | otherwise = i `mod` lim-    let logger = arr ! j-    pushLog fdref size mbuf logger logmsg-    flush+pushLogStr LoggerSet{..} logmsg = case lgrsetLogger of+  SL sl -> do+      pushLog sl logmsg+      lgrsetDebounce+  ML ml -> do+      pushLog ml logmsg+      lgrsetDebounce  -- | Same as 'pushLogStr' but also appends a newline. pushLogStrLn :: LoggerSet -> LogStr -> IO ()@@ -130,41 +142,36 @@ --   function can be used to force flushing outside of the debounced --   flush calls. flushLogStr :: LoggerSet -> IO ()-flushLogStr (LoggerSet _ fref size mbuf arr _) = flushLogStrRaw fref size mbuf arr+flushLogStr LoggerSet{..} = flushLogStrRaw lgrsetLogger -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 size mbuf (arr ! i)+flushLogStrRaw :: Logger -> IO ()+flushLogStrRaw (SL sl) = flushAllLog sl+flushLogStrRaw (ML ml) = flushAllLog ml  -- | 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-    newfd <- openFileFD file-    oldfd <- atomicModifyIORef' fref (\fd -> (newfd, fd))-    closeFD oldfd+renewLoggerSet LoggerSet{..} = case lgrsetFilePath of+  Nothing -> return ()+  Just file -> do+      newfd <- openFileFD file+      oldfd <- atomicModifyIORef' lgrsetFdRef (\fd -> (newfd, fd))+      closeFD oldfd  -- | Flushing the buffers, closing the internal file information --   and freeing the buffers. rmLoggerSet :: LoggerSet -> IO ()-rmLoggerSet (LoggerSet mfile fdref size mbuf arr _) = do-    fd <- readIORef fdref+rmLoggerSet LoggerSet{..} = do+    fd <- readIORef lgrsetFdRef     when (isFDValid fd) $ do-        let (l,u) = bounds arr-        let nums = [l .. u]-        mapM_ flushIt nums-        takeMVar mbuf >>= freeBuffer-        when (isJust mfile) $ closeFD fd-        writeIORef fdref invalidFD-  where-    flushIt i = flushLog fdref size mbuf(arr ! i)+        case lgrsetLogger of+          SL sl -> stopLoggers sl+          ML ml -> stopLoggers ml+        when (isJust lgrsetFilePath) $ closeFD fd+        writeIORef lgrsetFdRef invalidFD  -- | 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 d e) new_file_path =-    (LoggerSet (Just new_file_path) a b c d e, current_path)+replaceLoggerSet lgrset@LoggerSet{..} new_file_path =+    (lgrset { lgrsetFilePath = Just new_file_path }, lgrsetFilePath)

@@ -0,0 +1,120 @@+{-# LANGUAGE RecordWildCards #-}++module System.Log.FastLogger.MultiLogger (+    MultiLogger+  , newMultiLogger+  ) where+++import Control.Concurrent (myThreadId, threadCapability, MVar, newMVar, withMVar, takeMVar)+import Data.Array (Array, listArray, (!), bounds)++import System.Log.FastLogger.FileIO+import System.Log.FastLogger.IO+import System.Log.FastLogger.Imports+import System.Log.FastLogger.LogStr+import System.Log.FastLogger.Write++----------------------------------------------------------------++newtype MLogger = MLogger {+    lgrRef :: IORef LogStr+  }++-- | A scale but non-time-ordered logger.+data MultiLogger = MultiLogger {+    mlgrArray   :: Array Int MLogger+  , mlgrMBuffer :: MVar Buffer+  , mlgrBufSize :: BufSize+  , mlgrFdRef   :: IORef FD+  }++instance Loggers MultiLogger where+    stopLoggers = System.Log.FastLogger.MultiLogger.stopLoggers+    pushLog     = System.Log.FastLogger.MultiLogger.pushLog+    flushAllLog = System.Log.FastLogger.MultiLogger.flushAllLog++----------------------------------------------------------------++newMLogger :: IO MLogger+newMLogger = MLogger <$> newIORef mempty++-- | Creating `MultiLogger`.+--   The first argument is the number of the internal builders.+newMultiLogger :: Int -> BufSize -> IORef FD -> IO MultiLogger+newMultiLogger n bufsize fdref= do+    mbuf <- getBuffer bufsize >>= newMVar+    arr <- listArray (0,n-1) <$> replicateM n newMLogger+    return $ MultiLogger {+        mlgrArray   = arr+      , mlgrMBuffer = mbuf+      , mlgrBufSize = bufsize+      , mlgrFdRef   = fdref+      }++----------------------------------------------------------------++pushLog :: MultiLogger -> LogStr -> IO ()+pushLog ml@MultiLogger{..} logmsg = do+    (i, _) <- myThreadId >>= threadCapability+    -- The number of capability could be dynamically changed.+    -- So, let's check the upper boundary of the array.+    let u = snd $ bounds mlgrArray+        lim = u + 1+        j | i < lim   = i+          | otherwise = i `mod` lim+    let logger = mlgrArray ! j+    pushLog' logger logmsg+  where+    pushLog' logger@MLogger{..} nlogmsg@(LogStr nlen _)+      | nlen > mlgrBufSize = do+          flushLog ml 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+          -- of write not writing the entire buffer at once.+          writeBigLogStr' ml nlogmsg+      | otherwise = do+        action <- atomicModifyIORef' lgrRef checkBuf+        action+      where+        checkBuf ologmsg@(LogStr olen _)+          | mlgrBufSize < olen + nlen = (nlogmsg, writeLogStr' ml ologmsg)+          | otherwise                 = (ologmsg <> nlogmsg, return ())++----------------------------------------------------------------++flushAllLog :: MultiLogger -> IO ()+flushAllLog ml@MultiLogger{..} = do+    let flushIt i = flushLog ml (mlgrArray ! i)+        (l,u) = bounds mlgrArray+        nums = [l .. u]+    mapM_ flushIt nums++flushLog :: MultiLogger -> MLogger -> IO ()+flushLog ml MLogger{..} = do+    -- If a special buffer is prepared for flusher, this MVar could+    -- be removed. But such a code does not contribute logging speed+    -- according to experiment. And even with the special buffer,+    -- there is no grantee that this function is exclusively called+    -- for a buffer. So, we use MVar here.+    -- This is safe and speed penalty can be ignored.+    old <- atomicModifyIORef' lgrRef (\old -> (mempty, old))+    writeLogStr' ml old++----------------------------------------------------------------++stopLoggers :: MultiLogger -> IO ()+stopLoggers ml@MultiLogger{..} = do+  System.Log.FastLogger.MultiLogger.flushAllLog ml+  takeMVar mlgrMBuffer >>= freeBuffer++----------------------------------------------------------------++writeLogStr' :: MultiLogger -> LogStr -> IO ()+writeLogStr' MultiLogger{..} logstr =+    withMVar mlgrMBuffer $ \buf -> writeLogStr buf mlgrFdRef logstr++writeBigLogStr' :: MultiLogger -> LogStr -> IO ()+writeBigLogStr' MultiLogger{..} logstr =+    withMVar mlgrMBuffer $ \_ -> writeBigLogStr mlgrFdRef logstr

@@ -0,0 +1,104 @@+{-# LANGUAGE RecordWildCards #-}++module System.Log.FastLogger.SingleLogger (+    SingleLogger+  , newSingleLogger+  ) where++import Control.Concurrent (forkIO, newEmptyMVar, MVar, takeMVar, putMVar)+import Control.Concurrent.STM++import System.Log.FastLogger.FileIO+import System.Log.FastLogger.IO+import System.Log.FastLogger.Imports+import System.Log.FastLogger.LogStr+import System.Log.FastLogger.Write++----------------------------------------------------------------++-- | A non-scale but time-ordered logger.+data SingleLogger = SingleLogger {+    slgrRef     :: IORef (LogStr+                         ,[LogStr])-- writer queue+  , slgrKill    :: IO ()+  , slgrWakeup  :: IO ()+  , slgrBuffer  :: Buffer+  , slgrBufSize :: BufSize+  , slgrFdRef   :: IORef FD+  }++instance Loggers SingleLogger where+    stopLoggers = System.Log.FastLogger.SingleLogger.stopLoggers+    pushLog     = System.Log.FastLogger.SingleLogger.pushLog+    flushAllLog = System.Log.FastLogger.SingleLogger.flushAllLog++----------------------------------------------------------------++writer :: BufSize -> Buffer -> IORef FD -> TVar Int -> IORef (LogStr, [LogStr]) -> MVar () -> IO ()+writer bufsize buf fdref tvar ref mvar = loop (0 :: Int)+  where+    loop cnt = do+        cnt' <- atomically $ do+            n <- readTVar tvar+            check (n /= cnt)+            return n+        msgs <- reverse <$> atomicModifyIORef' ref (\(msg,q) -> ((msg,[]),q))+        cont <- go msgs+        if cont then+            loop cnt'+          else+            putMVar mvar ()+    go [] = return True+    go (msg@(LogStr len _):msgs)+      | len <  0       = return False+      | len <= bufsize = writeLogStr buf fdref msg >> go msgs+      | otherwise      = writeBigLogStr  fdref msg >> go msgs++----------------------------------------------------------------++-- | Creating `SingleLogger`.+newSingleLogger :: BufSize -> IORef FD -> IO SingleLogger+newSingleLogger bufsize fdref = do+    tvar <- newTVarIO 0+    ref <- newIORef (mempty,[])+    mvar <- newEmptyMVar+    buf <- getBuffer bufsize+    _ <- forkIO $ writer bufsize buf fdref tvar ref mvar+    let kill = do+            let fin = LogStr (-1) mempty+            atomicModifyIORef' ref (\(old,q) -> ((mempty,fin:old:q),()))+            takeMVar mvar+        wakeup = atomically $ modifyTVar' tvar (+ 1)+    return $ SingleLogger {+        slgrRef     = ref+      , slgrKill    = kill+      , slgrWakeup  = wakeup+      , slgrBuffer  = buf+      , slgrBufSize = bufsize+      , slgrFdRef   = fdref+      }++----------------------------------------------------------------++pushLog :: SingleLogger -> LogStr -> IO ()+pushLog SingleLogger{..} nlogmsg@(LogStr nlen _)+  | nlen > slgrBufSize = do+        atomicModifyIORef' slgrRef (\(old,q) -> ((mempty,nlogmsg:old:q),()))+        slgrWakeup+  | otherwise = do+        wake <- atomicModifyIORef' slgrRef checkBuf+        when wake slgrWakeup+  where+    checkBuf (ologmsg@(LogStr olen _),q)+      | slgrBufSize < olen + nlen = ((nlogmsg, nlogmsg:q), True)+      | otherwise                 = ((ologmsg <> nlogmsg, q), False)++flushAllLog :: SingleLogger -> IO ()+flushAllLog SingleLogger{..} = do+    atomicModifyIORef' slgrRef (\(old,q) -> ((mempty,old:q),()))+    slgrWakeup++stopLoggers :: SingleLogger -> IO ()+stopLoggers SingleLogger{..} = do+    slgrKill+    freeBuffer slgrBuffer

@@ -0,0 +1,45 @@+{-# LANGUAGE RecordWildCards #-}++module System.Log.FastLogger.Write (+    writeLogStr+  , writeBigLogStr+  , Loggers(..)+  ) where++import Foreign.Marshal.Alloc (allocaBytes)+import Foreign.Ptr (plusPtr)++import System.Log.FastLogger.FileIO+import System.Log.FastLogger.IO+import System.Log.FastLogger.Imports+import System.Log.FastLogger.LogStr++----------------------------------------------------------------++-- | Writting 'LogStr' using a buffer in blocking mode.+--   The size of 'LogStr' must be smaller or equal to+--   the size of buffer.+writeLogStr :: Buffer -> IORef FD -> LogStr -> IO ()+writeLogStr buf fdref (LogStr len builder) =+    toBufIOWith buf len (write fdref) builder++-- | Writting 'LogStr' using a temporary buffer.+writeBigLogStr :: IORef FD -> LogStr -> IO ()+writeBigLogStr fdref (LogStr len builder) =  allocaBytes len $ \buf ->+    toBufIOWith buf len (write fdref) builder++write :: IORef FD -> Buffer -> Int -> IO ()+write fdref buf len' = loop buf (fromIntegral len')+  where+    loop bf len = do+        written <- writeRawBufferPtr2FD fdref bf len+        when (0 <= written && written < len) $+            loop (bf `plusPtr` fromIntegral written) (len - written)++----------------------------------------------------------------++-- | A class for internal loggers.+class Loggers a where+    stopLoggers :: a -> IO ()+    pushLog     :: a -> LogStr -> IO ()+    flushAllLog :: a -> IO ()

@@ -1,5 +1,5 @@ Name:                   fast-logger-Version:                3.1.2+Version:                3.2.0 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -23,10 +23,12 @@                         System.Log.FastLogger.LoggerSet                         System.Log.FastLogger.Types   Other-Modules:        System.Log.FastLogger.Imports-                        System.Log.FastLogger.IO                         System.Log.FastLogger.FileIO+                        System.Log.FastLogger.IO                         System.Log.FastLogger.LogStr-                        System.Log.FastLogger.Logger+                        System.Log.FastLogger.MultiLogger+                        System.Log.FastLogger.SingleLogger+                        System.Log.FastLogger.Write   Build-Depends:        base >= 4.9 && < 5                       , array                       , auto-update >= 0.1.2@@ -34,6 +36,7 @@                       , bytestring >= 0.10.4                       , directory                       , filepath+                      , stm                       , text                       , unix-time >= 0.4.4                       , unix-compat >= 0.2@@ -48,10 +51,11 @@   Default-Language: Haskell2010   Type:             exitcode-stdio-1.0 -  Ghc-Options:      -Wall -threaded+  Ghc-Options:      -Wall -threaded -rtsopts -with-rtsopts=-N   Other-Modules:    FastLoggerSpec   Build-Tools:      hspec-discover >= 2.6   Build-Depends:    base >= 4 && < 5+                  , async                   , bytestring >= 0.10.4                   , directory                   , fast-logger

@@ -1,20 +1,29 @@-{-# LANGUAGE OverloadedStrings, BangPatterns, CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} -module FastLoggerSpec where+module FastLoggerSpec (spec) where  #if __GLASGOW_HASKELL__ < 709 import Control.Applicative ((<$>)) #endif import Control.Exception (finally)-import Control.Monad (when)+import Control.Concurrent (getNumCapabilities)+import Control.Concurrent.Async (forConcurrently_)+import Control.Monad (when, forM_) import qualified Data.ByteString.Char8 as BS+import Data.List (sort)+#if !MIN_VERSION_base(4,11,0) import Data.Monoid ((<>))+#endif import Data.String (IsString(fromString)) import System.Directory (doesFileExist, removeFile)-import System.Log.FastLogger+import Text.Printf (printf)+ import Test.Hspec import Test.Hspec.QuickCheck (prop) +import System.Log.FastLogger+ spec :: Spec spec = do   describe "instance Show LogStr" $ do@@ -22,12 +31,14 @@       let logstr :: LogStr           logstr = fromString str       in show logstr == show str+   describe "instance Eq LogStr" $ do     prop "it should be consistent with instance IsString" $ \str1 str2 ->       let logstr1, logstr2 :: LogStr           logstr1 = fromString str1           logstr2 = fromString str2       in (logstr1 == logstr2) == (str1 == str2)+   describe "pushLogMsg" $ do     it "is safe for a large message" $ safeForLarge [         100@@ -38,29 +49,26 @@       ]     it "logs all messages" logAllMsgs -nullLogger :: IO LoggerSet-#ifdef mingw32_HOST_OS-nullLogger = newFileLoggerSet 4096 "nul"-#else-nullLogger = newFileLoggerSet 4096 "/dev/null"-#endif+  describe "fastlogger 1" $ do+    it "maintains the ordering of log messages" logOrdering +tempFile :: FilePath+tempFile = "test/temp.txt"+ safeForLarge :: [Int] -> IO ()-safeForLarge ns = mapM_ safeForLarge' ns+safeForLarge = mapM_ safeForLarge'  safeForLarge' :: Int -> IO ()-safeForLarge' n = flip finally (cleanup tmpfile) $ do-    cleanup tmpfile-    lgrset <- newFileLoggerSet defaultBufSize tmpfile+safeForLarge' n = flip finally (cleanup tempFile) $ do+    cleanup tempFile+    lgrset <- newFileLoggerSet defaultBufSize tempFile     let xs = toLogStr $ BS.pack $ take (abs n) (cycle ['a'..'z'])         lf = "x"     pushLogStr lgrset $ xs <> lf     flushLogStr lgrset     rmLoggerSet lgrset-    bs <- BS.readFile tmpfile+    bs <- BS.readFile tempFile     bs `shouldBe` BS.pack (take (abs n) (cycle ['a'..'z']) <> "x")-    where-        tmpfile = "test/temp"  cleanup :: FilePath -> IO () cleanup file = do@@ -68,16 +76,39 @@     when exist $ removeFile file  logAllMsgs :: IO ()-logAllMsgs = logAll "LICENSE" `finally` cleanup tmpfile+logAllMsgs = logAll "LICENSE" `finally` cleanup tempFile   where-    tmpfile = "test/temp"     logAll file = do-        cleanup tmpfile-        lgrset <- newFileLoggerSet 512 tmpfile+        cleanup tempFile+        lgrset <- newFileLoggerSet 512 tempFile         src <- BS.readFile file         let bs = (<> "\n") . toLogStr <$> BS.lines src         mapM_ (pushLogStr lgrset) bs         flushLogStr lgrset         rmLoggerSet lgrset-        dst <- BS.readFile tmpfile+        dst <- BS.readFile tempFile         dst `shouldBe` src++logOrdering :: IO ()+logOrdering = flip finally (cleanup tempFile) $ do+    cleanup tempFile+    -- 128 is small enough for out-of-ordering+    (pushlog, teardown) <- newFastLogger1 $ LogFileNoRotate tempFile 128+    numCapabilities <- getNumCapabilities+    let concurrency = numCapabilities * 200 :: Int+        logEntriesCount = 100 :: Int+    forConcurrently_ [0 .. concurrency - 1] $ \t ->+      forM_ [0 .. logEntriesCount - 1] $ \i -> do+        let tag = mktag t+            cnt = printf "%02d" i :: String+            logmsg = toLogStr tag <> "log line nr: " <> toLogStr cnt <> "\n"+        pushlog logmsg+    teardown+    xs <- BS.lines <$> BS.readFile tempFile+    forM_ [0 .. concurrency - 1] $ \t -> do+        let tag = BS.pack $ mktag t+            msgs = filter (tag `BS.isPrefixOf`) xs+        sort msgs `shouldBe` msgs+  where+    mktag :: Int -> String+    mktag t = "thread id: " <> show t <> " "