fast-logger 3.0.1 → 3.0.2

raw patch · 5 files changed

+200/−150 lines, 5 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• System/Log/FastLogger.hs +30/−145
• System/Log/FastLogger/Internal.hs +2/−1
• System/Log/FastLogger/LogStr.hs +23/−0
• System/Log/FastLogger/LoggerSet.hs +140/−0
• fast-logger.cabal +5/−4

@@ -10,36 +10,26 @@ --   should rely more on message timestamps than on their order in the --   log. module System.Log.FastLogger (-  -- * Creating a logger set-    LoggerSet-  , newFileLoggerSet-  , newStdoutLoggerSet-  , newStderrLoggerSet-  , newLoggerSet-  -- * Buffer size-  , BufSize-  , defaultBufSize-  -- * Renewing and removing a logger set-  , renewLoggerSet-  , rmLoggerSet-  -- * Log messages-  , LogStr-  , ToLogStr(..)-  , fromLogStr-  , logStrLength-  -- * Writing a log message-  , pushLogStr-  , pushLogStrLn-  -- * Flushing buffered log messages-  , flushLogStr   -- * FastLogger-  , FastLogger-  , TimedFastLogger-  , LogType'(..), LogType+    FastLogger+  , LogType+  , LogType'(..)   , newFastLogger   , withFastLogger+  -- * Timed FastLogger+  , TimedFastLogger   , newTimedFastLogger   , withTimedFastLogger+  -- * Log messages+  , LogStr+  , ToLogStr(..)+  , fromLogStr+  , logStrLength+  -- * Buffer size+  , BufSize+  , defaultBufSize+  -- * LoggerSet+  , module System.Log.FastLogger.LoggerSet   -- * Date cache   , module System.Log.FastLogger.Date   -- * File rotation@@ -48,127 +38,20 @@   , module System.Log.FastLogger.Types   ) where -import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceAction)-import Control.Concurrent (getNumCapabilities, myThreadId, threadCapability, takeMVar, MVar, newMVar, tryTakeMVar, putMVar)+import Control.Concurrent (MVar, newMVar, tryTakeMVar, putMVar) import Control.Exception (handle, SomeException(..), bracket)-import Data.Array (Array, listArray, (!), bounds) import System.EasyFile (getFileSize)  import System.Log.FastLogger.Date import System.Log.FastLogger.File-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.LoggerSet import System.Log.FastLogger.Types  ---------------------------------------------------------------- --- | 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) (Array Int Logger) (IO ())---- | Creating a new 'LoggerSet' using a file.-newFileLoggerSet :: BufSize -> FilePath -> IO LoggerSet-newFileLoggerSet size file = openFileFD file >>= newFDLoggerSet size (Just file)---- | Creating a new 'LoggerSet' using stdout.-newStdoutLoggerSet :: BufSize -> IO LoggerSet-newStdoutLoggerSet size = getStdoutFD >>= newFDLoggerSet size Nothing---- | Creating a new 'LoggerSet' using stderr.-newStderrLoggerSet :: BufSize -> IO LoggerSet-newStderrLoggerSet size = getStderrFD >>= newFDLoggerSet size Nothing--{-# DEPRECATED newLoggerSet "Use newFileLoggerSet etc instead" #-}--- | Creating a new 'LoggerSet'.---   If 'Nothing' is specified to the second argument,---   stdout is used.---   Please note that the minimum 'BufSize' is 1.-newLoggerSet :: BufSize -> Maybe FilePath -> IO LoggerSet-newLoggerSet size = maybe (newStdoutLoggerSet size) (newFileLoggerSet size)---- | Creating a new 'LoggerSet' using a FD.-newFDLoggerSet :: BufSize -> Maybe FilePath -> FD -> IO LoggerSet-newFDLoggerSet size mfile fd = do-    n <- getNumCapabilities-    loggers <- replicateM n $ newLogger (max 1 size)-    let arr = listArray (0,n-1) loggers-    fref <- newIORef fd-    flush <- mkDebounce defaultDebounceSettings-        { debounceAction = flushLogStrRaw fref arr-        }-    return $ LoggerSet mfile fref 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-    (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 logger logmsg-    flush---- | Same as 'pushLogStr' but also appends a newline.-pushLogStrLn :: LoggerSet -> LogStr -> IO ()-pushLogStrLn loggerSet logStr = pushLogStr loggerSet (logStr <> "\n")---- | Flushing log messages in buffers.---   This function must be called explicitly when the program is---   being terminated.------   Note: Since version 2.1.6, this function does not need to be---   explicitly called, as every push includes an auto-debounced flush---   courtesy of the auto-update package. Since version 2.2.2, this---   function can be used to force flushing outside of the debounced---   flush calls.-flushLogStr :: LoggerSet -> IO ()-flushLogStr (LoggerSet _ fref arr _) = flushLogStrRaw fref arr--flushLogStrRaw :: IORef FD -> Array Int Logger -> IO ()-flushLogStrRaw fdref arr = do-    let (l,u) = bounds arr-    mapM_ flushIt [l .. u]-  where-    flushIt i = flushLog fdref (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-    newfd <- openFileFD file-    oldfd <- atomicModifyIORef' fref (\fd -> (newfd, fd))-    closeFD oldfd---- | Flushing the buffers, closing the internal file information---   and freeing the buffers.-rmLoggerSet :: LoggerSet -> IO ()-rmLoggerSet (LoggerSet mfile fdref arr _) = do-    let (l,u) = bounds arr-    let nums = [l .. u]-    mapM_ flushIt nums-    mapM_ freeIt nums-    fd <- readIORef fdref-    when (isJust mfile) $ closeFD fd-  where-    flushIt i = flushLog fdref (arr ! i)-    freeIt i = do-        let (Logger _ mbuf _) = arr ! i-        takeMVar mbuf >>= freeBuffer------------------------------------------------------------------- -- | 'FastLogger' simply log 'logStr'. type FastLogger = LogStr -> IO () -- | 'TimedFastLogger' pass 'FormattedTime' to callback and simply log its result.@@ -176,12 +59,10 @@ -- -- Usually, one would write a wrapper on top of 'TimedFastLogger', for example: ----- @--- {-# LANGUAGE OverloadedStrings #-}------ log :: TimedFastLogger -> LogStr -> IO ()--- log logger msg = logger (\time -> toLogStr (show time) <> " " <> msg <> "\n")--- @+-- > {-# LANGUAGE OverloadedStrings #-}+-- >+-- > log :: TimedFastLogger -> LogStr -> IO ()+-- > log logger msg = logger (\time -> toLogStr (show time) <> " " <> msg <> "\n") type TimedFastLogger = (FormattedTime -> LogStr) -> IO ()  type LogType = LogType' LogStr@@ -216,6 +97,9 @@  -- | Initialize a 'FastLogger' without attaching timestamp -- a tuple of logger and clean up action are returned.+-- This type signature should be read as:+--+-- > newFastLogger :: LogType -> IO (FastLogger, IO ()) newFastLogger :: LogType' v -> IO (v -> IO (), IO ()) newFastLogger typ = case typ of     LogNone                        -> return (const noOp, noOp)@@ -341,18 +225,19 @@     -- 200 is an ad-hoc value for the length of log line.     estimate x = fromInteger (x `div` 200) - tryTimedRotate :: TimedFileLogSpec -> FormattedTime -> MVar LoggerSet -> IO () tryTimedRotate spec now mvar = bracket lock unlock rotateFiles   where     lock           = tryTakeMVar mvar     unlock Nothing = return ()-    unlock (Just (LoggerSet current_path a b c)) = do-        putMVar mvar $ LoggerSet (Just new_file_path) a b c+    unlock (Just lgrset) = do+        let (newlgrset, current_path) = replaceLoggerSet lgrset new_file_path+        putMVar mvar newlgrset         case current_path of           Nothing   -> return ()           Just path -> timed_post_process spec path     rotateFiles Nothing  = return ()-    rotateFiles (Just (LoggerSet _ a b c)) = renewLoggerSet $ LoggerSet (Just new_file_path) a b c+    rotateFiles (Just lgrset) = do+        let (newlgrset, _) = replaceLoggerSet lgrset new_file_path+        renewLoggerSet newlgrset     new_file_path = prefixTime now $ timed_log_file spec-

@@ -1,4 +1,3 @@- -- | -- The contents of this module can change at any time without warning. module System.Log.FastLogger.Internal@@ -6,9 +5,11 @@   , module System.Log.FastLogger.FileIO   , module System.Log.FastLogger.LogStr   , module System.Log.FastLogger.Logger+  , 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.LoggerSet

@@ -47,14 +47,17 @@  #if MIN_VERSION_base(4,9,0) 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)+    {-# INLINE mappend #-}     LogStr s1 b1 `mappend` LogStr s2 b2 = LogStr (s1 + s2) (b1 <> b2)  instance IsString LogStr where+    {-# INLINE fromString #-}     fromString = toLogStr . TL.pack  -- | Types that can be converted to a 'LogStr'. Instances for@@ -64,60 +67,80 @@     toLogStr :: msg -> LogStr  instance ToLogStr LogStr where+    {-# INLINE toLogStr #-}     toLogStr = id instance ToLogStr S8.ByteString where+    {-# INLINE toLogStr #-}     toLogStr bs = LogStr (BS.length bs) (toBuilder bs) instance ToLogStr BL.ByteString where+    {-# INLINE toLogStr #-}     toLogStr b = LogStr (fromIntegral (BL.length b)) (B.lazyByteString b) instance ToLogStr Builder where+    {-# INLINE toLogStr #-}     toLogStr x = let b = B.toLazyByteString x in LogStr (fromIntegral (BL.length b)) (B.lazyByteString b) instance ToLogStr String where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . TL.pack instance ToLogStr T.Text where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . T.encodeUtf8 instance ToLogStr TL.Text where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . TL.encodeUtf8  -- | @since 2.4.14 instance ToLogStr Int where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . B.intDec -- | @since 2.4.14 instance ToLogStr Int8 where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . B.int8Dec -- | @since 2.4.14 instance ToLogStr Int16 where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . B.int16Dec -- | @since 2.4.14 instance ToLogStr Int32 where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . B.int32Dec -- | @since 2.4.14 instance ToLogStr Int64 where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . B.int64Dec  -- | @since 2.4.14 instance ToLogStr Word where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . B.wordDec -- | @since 2.4.14 instance ToLogStr Word8 where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . B.word8Dec -- | @since 2.4.14 instance ToLogStr Word16 where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . B.word16Dec -- | @since 2.4.14 instance ToLogStr Word32 where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . B.word32Dec -- | @since 2.4.14 instance ToLogStr Word64 where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . B.word64Dec  -- | @since 2.4.14 instance ToLogStr Integer where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . B.integerDec -- | @since 2.4.14 instance ToLogStr Float where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . B.floatDec -- | @since 2.4.14 instance ToLogStr Double where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . B.doubleDec  instance Show LogStr where

@@ -0,0 +1,140 @@+{-# LANGUAGE OverloadedStrings #-}++module System.Log.FastLogger.LoggerSet (+  -- * Creating a logger set+    LoggerSet+  , newFileLoggerSet+  , newStdoutLoggerSet+  , newStderrLoggerSet+  , newLoggerSet+  -- * Renewing and removing a logger set+  , renewLoggerSet+  , rmLoggerSet+  -- * Writing a log message+  , pushLogStr+  , pushLogStrLn+  -- * Flushing buffered log messages+  , flushLogStr+  -- * Misc+  , replaceLoggerSet+  ) where++import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceAction)+import Control.Concurrent (getNumCapabilities, myThreadId, threadCapability, 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.Logger++----------------------------------------------------------------++-- | 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) (Array Int Logger) (IO ())++-- | Creating a new 'LoggerSet' using a file.+newFileLoggerSet :: BufSize -> FilePath -> IO LoggerSet+newFileLoggerSet size file = openFileFD file >>= newFDLoggerSet size (Just file)++-- | Creating a new 'LoggerSet' using stdout.+newStdoutLoggerSet :: BufSize -> IO LoggerSet+newStdoutLoggerSet size = getStdoutFD >>= newFDLoggerSet size Nothing++-- | Creating a new 'LoggerSet' using stderr.+newStderrLoggerSet :: BufSize -> IO LoggerSet+newStderrLoggerSet size = getStderrFD >>= newFDLoggerSet size Nothing++{-# DEPRECATED newLoggerSet "Use newFileLoggerSet etc instead" #-}+-- | Creating a new 'LoggerSet'.+--   If 'Nothing' is specified to the second argument,+--   stdout is used.+--   Please note that the minimum 'BufSize' is 1.+newLoggerSet :: BufSize -> Maybe FilePath -> IO LoggerSet+newLoggerSet size = maybe (newStdoutLoggerSet size) (newFileLoggerSet size)++-- | Creating a new 'LoggerSet' using a FD.+newFDLoggerSet :: BufSize -> Maybe FilePath -> FD -> IO LoggerSet+newFDLoggerSet size mfile fd = do+    n <- getNumCapabilities+    loggers <- replicateM n $ newLogger (max 1 size)+    let arr = listArray (0,n-1) loggers+    fref <- newIORef fd+    flush <- mkDebounce defaultDebounceSettings+        { debounceAction = flushLogStrRaw fref arr+        }+    return $ LoggerSet mfile fref 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+    (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 logger logmsg+    flush++-- | Same as 'pushLogStr' but also appends a newline.+pushLogStrLn :: LoggerSet -> LogStr -> IO ()+pushLogStrLn loggerSet logStr = pushLogStr loggerSet (logStr <> "\n")++-- | Flushing log messages in buffers.+--   This function must be called explicitly when the program is+--   being terminated.+--+--   Note: Since version 2.1.6, this function does not need to be+--   explicitly called, as every push includes an auto-debounced flush+--   courtesy of the auto-update package. Since version 2.2.2, this+--   function can be used to force flushing outside of the debounced+--   flush calls.+flushLogStr :: LoggerSet -> IO ()+flushLogStr (LoggerSet _ fref arr _) = flushLogStrRaw fref arr++flushLogStrRaw :: IORef FD -> Array Int Logger -> IO ()+flushLogStrRaw fdref arr = do+    let (l,u) = bounds arr+    mapM_ flushIt [l .. u]+  where+    flushIt i = flushLog fdref (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+    newfd <- openFileFD file+    oldfd <- atomicModifyIORef' fref (\fd -> (newfd, fd))+    closeFD oldfd++-- | Flushing the buffers, closing the internal file information+--   and freeing the buffers.+rmLoggerSet :: LoggerSet -> IO ()+rmLoggerSet (LoggerSet mfile fdref arr _) = do+    let (l,u) = bounds arr+    let nums = [l .. u]+    mapM_ flushIt nums+    mapM_ freeIt nums+    fd <- readIORef fdref+    when (isJust mfile) $ closeFD fd+  where+    flushIt i = flushLog fdref (arr ! i)+    freeIt i = do+        let (Logger _ mbuf _) = arr ! i+        takeMVar mbuf >>= freeBuffer++-- | 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)

@@ -1,11 +1,11 @@ Name:                   fast-logger-Version:                3.0.1+Version:                3.0.2 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3 License-File:           LICENSE Synopsis:               A fast logging system-Description:            A fast logging system+Description:            A fast logging system for Haskell Homepage:               https://github.com/kazu-yamamoto/logger Category:               System Cabal-Version:          >= 1.10@@ -17,10 +17,11 @@   Default-Language:     Haskell2010   GHC-Options:          -Wall   Exposed-Modules:      System.Log.FastLogger-                        System.Log.FastLogger.File                         System.Log.FastLogger.Date-                        System.Log.FastLogger.Types+                        System.Log.FastLogger.File                         System.Log.FastLogger.Internal+                        System.Log.FastLogger.LoggerSet+                        System.Log.FastLogger.Types   Other-Modules:        System.Log.FastLogger.Imports                         System.Log.FastLogger.IO                         System.Log.FastLogger.FileIO