fast-logger 2.4.3 → 2.4.4

raw patch · 6 files changed

+231/−9 lines, 6 filesdep +easy-filedep +old-localedep +timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: easy-file, old-locale, time, unix, unix-time

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• System/Log/FastLogger.hs +138/−3
• System/Log/FastLogger/Date.hs +75/−0
• System/Log/FastLogger/File.hs +2/−3
• System/Log/FastLogger/IORef.hs +1/−0
• fast-logger.cabal +10/−3

@@ -1,3 +1,8 @@+## 2.4.4++* New API: newFastLogger and ewTimedFastLogger.+* LogType and date cache are transferred from wai-logger.+ ## 2.4.3  * Opening files in the append mode on Windows.

@@ -1,7 +1,7 @@ -- | This module provides a fast logging system which --   scales on multicore environments (i.e. +RTS -N\<x\>). {-# LANGUAGE CPP #-}-{-# LANGUAGE Safe #-}+{-# LANGUAGE OverloadedStrings #-}  module System.Log.FastLogger (   -- * Creating a logger set@@ -26,6 +26,16 @@   , pushLogStrLn   -- * Flushing buffered log messages   , flushLogStr+  -- * FastLogger+  , FastLogger+  , TimedFastLogger+  , LogType(..)+  , newFastLogger+  , withFastLogger+  , newTimedFastLogger+  , withTimedFastLogger+  -- * Date cache+  , module System.Log.FastLogger.Date   -- * File rotation   , module System.Log.FastLogger.File   ) where@@ -34,16 +44,19 @@ import Control.Applicative ((<$>)) #endif import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceAction)-import Control.Concurrent (getNumCapabilities, myThreadId, threadCapability, takeMVar)+import Control.Concurrent (getNumCapabilities, myThreadId, threadCapability, takeMVar, MVar, newMVar, tryTakeMVar, putMVar)+import Control.Exception (handle, SomeException(..), bracket) import Control.Monad (when, replicateM) import Data.Array (Array, listArray, (!), bounds) import Data.Maybe (isJust)+import System.EasyFile (getFileSize) import System.Log.FastLogger.File import System.Log.FastLogger.IO import System.Log.FastLogger.FileIO import System.Log.FastLogger.IORef import System.Log.FastLogger.LogStr import System.Log.FastLogger.Logger+import System.Log.FastLogger.Date  ---------------------------------------------------------------- @@ -104,7 +117,7 @@  -- | Same as 'pushLogStr' but also appends a newline. pushLogStrLn :: LoggerSet -> LogStr -> IO ()-pushLogStrLn loggerSet logStr = pushLogStr loggerSet (logStr <> toLogStr "\n")+pushLogStrLn loggerSet logStr = pushLogStr loggerSet (logStr <> "\n")  -- | Flushing log messages in buffers. --   This function must be called explicitly when the program is@@ -150,3 +163,125 @@     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.+-- this can be used to customize how to log timestamp.+type TimedFastLogger = (FormattedTime -> LogStr) -> IO ()++-- | Logger Type.+data LogType+    = LogNone                     -- ^ No logging.+    | LogStdout BufSize           -- ^ Logging to stdout.+                                  --   'BufSize' is a buffer size+    | LogStderr BufSize           -- ^ Logging to stdout.+                                  --   'BufSize' is a buffer size+                                  --   for each capability.+    | LogFile FilePath BufSize    -- ^ Logging to a file.+                                  --   'BufSize' is a buffer size+                                  --   for each capability.+    | LogFileAutoRotate FileLogSpec BufSize -- ^ Logging to a file.+                                  --   'BufSize' is a buffer size+                                  --   for each capability.+                                  --   File rotation is done on-demand.+    | LogCallback (LogStr -> IO ()) (IO ()) -- ^ Logging with a log and flush action.+                                               -- run flush after log each message.++-- | Initialize a 'FastLogger' without attaching timestamp+-- a tuple of logger and clean up action are returned.+newFastLogger :: LogType -> IO (FastLogger, IO ())+newFastLogger typ = case typ of+    LogNone         -> return (const noOp, noOp)+    LogStdout bsize -> newStdoutLoggerSet bsize >>= stdLoggerInit+    LogStderr bsize -> newStderrLoggerSet bsize >>= stdLoggerInit+    LogFile fp bsize ->  newFileLoggerSet bsize fp >>= stdLoggerInit+    LogFileAutoRotate fspec bsize -> rotateLoggerInit fspec bsize+    LogCallback cb flush -> return (\ str -> cb str >> flush, noOp )+  where+    stdLoggerInit lgrset = return (pushLogStr lgrset, noOp)+    rotateLoggerInit fspec bsize = do+        lgrset <- newFileLoggerSet bsize $ log_file fspec+        ref <- newIORef (0 :: Int)+        mvar <- newMVar ()+        let logger str = do+                cnt <- decrease ref+                pushLogStr lgrset str+                when (cnt <= 0) $ tryRotate lgrset fspec ref mvar+        return (logger, rmLoggerSet lgrset)++-- | 'bracket' version of 'newFastLogger'+withFastLogger :: LogType -> (FastLogger -> IO a) -> IO ()+withFastLogger typ log' = bracket (newFastLogger typ) (log' . fst) snd++-- | Initialize a 'FastLogger' with timestamp attached to each message.+-- a tuple of logger and clean up action are returned.+newTimedFastLogger ::+    (IO FormattedTime)    -- ^ How do we get 'FormattedTime'?+                          -- "System.Log.FastLogger.Date" provide cached formatted time.+    -> LogType -> IO (TimedFastLogger, IO ())+newTimedFastLogger tgetter typ = case typ of+    LogNone -> return (const noOp, noOp)+    LogStdout bsize -> newStdoutLoggerSet bsize >>= stdLoggerInit+    LogStderr bsize -> newStderrLoggerSet bsize >>= stdLoggerInit+    LogFile fp bsize ->  newFileLoggerSet bsize fp >>= stdLoggerInit+    LogFileAutoRotate fspec bsize -> rotateLoggerInit fspec bsize+    LogCallback cb flush -> return (\ f -> tgetter >>= cb . f >> flush, noOp )+  where+    stdLoggerInit lgrset = return ( \f -> tgetter >>= pushLogStr lgrset . f, noOp)+    rotateLoggerInit fspec bsize = do+        lgrset <- newFileLoggerSet bsize $ log_file fspec+        ref <- newIORef (0 :: Int)+        mvar <- newMVar ()+        let logger f = do+                cnt <- decrease ref+                t <- tgetter+                pushLogStr lgrset (f t)+                when (cnt <= 0) $ tryRotate lgrset fspec ref mvar+        return (logger, rmLoggerSet lgrset)++-- | 'bracket' version of 'newTimeFastLogger'+withTimedFastLogger :: (IO FormattedTime) -> LogType -> (TimedFastLogger -> IO a) -> IO ()+withTimedFastLogger tgetter typ log' = bracket (newTimedFastLogger tgetter typ) (log' . fst) snd++----------------------------------------------------------------++noOp :: IO ()+noOp = return ()++decrease :: IORef Int -> IO Int+decrease ref = atomicModifyIORef' ref (\x -> (x - 1, x - 1))++tryRotate :: LoggerSet -> FileLogSpec -> IORef Int -> MVar () -> IO ()+tryRotate lgrset spec ref mvar = bracket lock unlock rotateFiles+  where+    lock           = tryTakeMVar mvar+    unlock Nothing = return ()+    unlock _       = putMVar mvar ()+    rotateFiles Nothing = return ()+    rotateFiles _       = do+        msiz <- getSize+        case msiz of+            -- A file is not available.+            -- So, let's set a big value to the counter so that+            -- this function is not called frequently.+            Nothing -> writeIORef ref 1000000+            Just siz+                | siz > limit -> do+                    rotate spec+                    renewLoggerSet lgrset+                    writeIORef ref $ estimate limit+                | otherwise -> do+                    writeIORef ref $ estimate (limit - siz)+    file = log_file spec+    limit = log_file_size spec+    getSize = handle (\(SomeException _) -> return Nothing) $ do+        -- The log file is locked by GHC.+        -- We need to get its file size by the way not using locks.+        Just . fromIntegral <$> getFileSize file+    -- 200 is an ad-hoc value for the length of log line.+    estimate x = fromInteger (x `div` 200)++

@@ -0,0 +1,75 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Formatting time is slow.+-- This package provides mechanisms to cache formatted date.+module System.Log.FastLogger.Date (+  -- * Types+    TimeFormat+  , FormattedTime+  -- * Date cacher+  , newTimeCache+  , simpleTimeFormat+  , simpleTimeFormat'+  ) where++import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction)+import Data.ByteString (ByteString)+#if WINDOWS+import qualified Data.ByteString.Char8 as BS+import Data.Time (UTCTime, formatTime, getCurrentTime, utcToLocalZonedTime)+# if MIN_VERSION_time(1,5,0)+import Data.Time (defaultTimeLocale)+# else+import System.Locale (defaultTimeLocale)+# endif+#else+import Data.UnixTime (formatUnixTime, fromEpochTime)+import System.Posix (EpochTime, epochTime)+#endif++----------------------------------------------------------------++-- | Type aliaes for date format and formatted date.+type FormattedTime = ByteString+type TimeFormat = ByteString++----------------------------------------------------------------++#if WINDOWS+-- | Get date using UTC.+getTime :: IO UTCTime+getTime = getCurrentTime+-- | Format UTC date.+formatDate :: TimeFormat -> UTCTime -> IO FormattedTime+formatDate fmt ut = do+  zt <- utcToLocalZonedTime ut+  return $ BS.pack $ formatTime defaultTimeLocale (BS.unpack fmt) zt+#else+-- | Get date using UnixTime.+getTime :: IO EpochTime+getTime = epochTime+-- | Format unix EpochTime date.+formatDate :: TimeFormat -> EpochTime -> IO FormattedTime+formatDate fmt = formatUnixTime fmt . fromEpochTime+#endif++----------------------------------------------------------------++-- |  Make 'IO' action which get cached formatted local time.+-- Use this to avoid the cost of frequently time formatting by caching an+-- auto updating formatted time, this cache update every 1 second.+-- more detail in "Control.AutoUpdate"+newTimeCache :: TimeFormat -> IO (IO FormattedTime)+newTimeCache fmt = mkAutoUpdate defaultUpdateSettings{+        updateAction = getTime >>= formatDate fmt+    }++-- | A simple time cache using format @"%d/%b/%Y:%T %z"@+simpleTimeFormat :: TimeFormat+simpleTimeFormat = "%d/%b/%Y:%T %z"++-- | A simple time cache using format @"%d-%b-%Y %T"@+simpleTimeFormat' :: TimeFormat+simpleTimeFormat' = "%d-%b-%Y %T"

@@ -14,8 +14,8 @@   }  -- | Checking if a log file can be written.-check :: FileLogSpec -> IO ()-check spec = do+check :: FilePath -> IO ()+check file = do     dirExist <- doesDirectoryExist dir     unless dirExist $ fail $ dir ++ " does not exist or is not a directory."     dirPerm <- getPermissions dir@@ -25,7 +25,6 @@         perm <- getPermissions file         unless (writable perm) $ fail $ file ++ " is not writable."   where-    file = log_file spec     dir = takeDirectory file  -- | Rotating log files.

@@ -6,6 +6,7 @@      , newIORef      , readIORef      , atomicModifyIORef'+     , writeIORef      ) where  import Data.IORef

@@ -1,5 +1,5 @@ Name:                   fast-logger-Version:                2.4.3+Version:                2.4.4 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> License:                BSD3@@ -15,6 +15,7 @@   GHC-Options:          -Wall   Exposed-Modules:      System.Log.FastLogger                         System.Log.FastLogger.File+                        System.Log.FastLogger.Date   Other-Modules:        System.Log.FastLogger.IO                         System.Log.FastLogger.FileIO                         System.Log.FastLogger.IORef@@ -23,14 +24,20 @@   Build-Depends:        base >= 4.5 && < 5                       , array                       , auto-update >= 0.1.2+                      , easy-file >= 0.2                       , bytestring                       , bytestring-builder                       , directory                       , filepath                       , text   if os(windows)-    Build-Depends:-                      Win32+      Cpp-Options:      -DWINDOWS+      Build-Depends:    time+                      , Win32+                      , old-locale+  else+      Build-Depends:    unix+                      , unix-time >= 0.2.2  Test-Suite spec     Main-Is:         Spec.hs