packages feed

fast-logger 2.2.0 → 3.2.6

raw patch · 20 files changed

Files

+ ChangeLog.md view
@@ -0,0 +1,156 @@+## 3.2.6++* Labeling the thread of SingleLogger.++## 3.2.5++* Giving names to threads.++## 3.2.4++* Avoid unnecessary copy for Text values with text-2.0+  [#219](https://github.com/kazu-yamamoto/logger/pull/219)++## 3.2.3++* Ensuring flush for single logger.+  [#214](https://github.com/kazu-yamamoto/logger/pull/214)++## 3.2.2++* Corrected handling of messages at the buffer boundary in the SingleLogger+  [#211](https://github.com/kazu-yamamoto/logger/pull/211)++## 3.2.1++* Fixing a bug where a single logger is not killed++## 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+  [#206](https://github.com/kazu-yamamoto/logger/pull/206)+* Remove Safe if directory >= 1.3.8+  [#199](https://github.com/kazu-yamamoto/logger/pull/199)++## 3.1.1++* More time-ordered logging functions+  [#199](https://github.com/kazu-yamamoto/logger/pull/199)++## 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.++## 3.0.4++* New API: `newFastLogger1` which use only one capability.+* Making `FD` safer with `invalidFD`.++## 3.0.3++* Dropping support of GHC 7.x.+* Add `ToLogStr` instance for `ShortByteString`. Add lower bound on+  `bytestring` dependency to ensure that `bytestring` exports+  `Data.ByteString.Short`.++## 3.0.2++* Fixing documentation.++## 3.0.1++* Creating the `Internal` module.+  [#185](https://github.com/kazu-yamamoto/logger/pull/185)++## 3.0.0++* Allowing the callback logger to be generic. [#182](https://github.com/kazu-yamamoto/logger/pull/180) This is a BREAKING CHANGE. Users should do:+  1. Importing `LogType'` and related constructors because `LogType` is now a type alias.+  2. Using `{-# LANGUAGE GADTs #-}`, even if you aren't using anything new, any time you try and `case` over values of type `LogType'`.++## 2.4.17++* Obtaining a fresh fd from IORef just before writing. [#180](https://github.com/kazu-yamamoto/logger/pull/180)++## 2.4.16++* Using strict language extensions.++## 2.4.15++* Rescuing GHC 7.8.++## 2.4.14++* Add `ToLogStr` instances for the following types: signed integers, unsigned integers, floating-point numbers. These instances all use decimal encodings. [#177](https://github.com/kazu-yamamoto/logger/pull/177)++## 2.4.11++* Give an explicit definition for (<>) in LogStr's Semigroup instance. [#155](https://github.com/kazu-yamamoto/logger/pull/155)++## 2.4.10++* Fix Windows build on GHC 7.8. [#121](https://github.com/kazu-yamamoto/logger/pull/121)++## 2.4.9++* Fixing build on Windows. [#118](https://github.com/kazu-yamamoto/logger/pull/118)++## 2.4.8++* Add Semigroup instance to LogStr [#115](https://github.com/kazu-yamamoto/logger/pull/115)+* Added note on log message ordering [#116](https://github.com/kazu-yamamoto/logger/pull/116)++## 2.4.7++* Fixing interleaved log output when messages are larger than buffer size. [#103](https://github.com/kazu-yamamoto/logger/pull/103)++## 2.4.6++* Ensuring that stdio is flushed. [#92](https://github.com/kazu-yamamoto/logger/pull/92)++## 2.4.5++* Bringing backward compatibility back.++## 2.4.4++* New API: newFastLogger and newTimedFastLogger.+* LogType and date cache are transferred from wai-logger.++## 2.4.3++* Opening files in the append mode on Windows.++## 2.4.2++* Fixing a buf of long log messages [#80](https://github.com/kazu-yamamoto/logger/pull/80)+* Log rotation support for Windows [#79](https://github.com/kazu-yamamoto/logger/pull/79)+* Unsupporting GHC 7.4.++## 2.4.1++* Restore compatibility with bytestring < 0.10+* Mark fast-logger modules as Safe/Trustworth [#68](https://github.com/kazu-yamamoto/logger/pull/68)++## 2.4.0++* Providing pushLogStrLn. [#64](https://github.com/kazu-yamamoto/logger/pull/64)++## 2.3.1++* No changes.++## 2.3.0++* Move from blaze-builder to `Data.ByteString.Builder` [#55](https://github.com/kazu-yamamoto/logger/pull/55)
+ README.md view
@@ -0,0 +1,3 @@+## fast-logger++A fast logging system
Setup.hs view
@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain
System/Log/FastLogger.hs view
@@ -1,150 +1,287 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+ -- | This module provides a fast logging system which --   scales on multicore environments (i.e. +RTS -N\<x\>).-{-# LANGUAGE BangPatterns, CPP #-}-+--+--   Note: This library does not guarantee correct ordering of log messages+--   when program is run on more than one core thus users+--   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-  -- * Flushing buffered log messages-  , flushLogStr-  -- * File rotation-  , module System.Log.FastLogger.File-  ) where+    -- * FastLogger+    FastLogger,+    LogType,+    LogType' (..),+    newFastLogger,+    newFastLogger1,+    withFastLogger, -import Control.Applicative ((<$>))-import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction)-import Control.Concurrent (getNumCapabilities, myThreadId, threadCapability, takeMVar)-import Control.Monad (when, replicateM)-import Data.Array (Array, listArray, (!), bounds)-import Data.Maybe (isJust)-import GHC.IO.Device (close)-import GHC.IO.FD (FD(..), openFile, stderr, stdout)-import GHC.IO.IOMode (IOMode(..))+    -- * 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+    module System.Log.FastLogger.File,++    -- * Types+    module System.Log.FastLogger.Types,+) where++import Control.Concurrent (MVar, newMVar, putMVar, tryTakeMVar)+import Control.Exception (SomeException (..), bracket, handle)+import System.EasyFile (getFileSize)++import System.Log.FastLogger.Date import System.Log.FastLogger.File import System.Log.FastLogger.IO-import System.Log.FastLogger.IORef+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  ---------------------------------------------------------------- --- | Opening a log file.-logOpen :: FilePath -> IO FD-logOpen file = fst <$> openFile file AppendMode False+-- | '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.+--+-- 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")+type TimedFastLogger = (FormattedTime -> LogStr) -> IO () --- | 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 ())+type LogType = LogType' LogStr --- | Creating a new 'LoggerSet' using a file.-newFileLoggerSet :: BufSize -> FilePath -> IO LoggerSet-newFileLoggerSet size file = logOpen file >>= newFDLoggerSet size (Just file)+-- | Logger Type.+data LogType' a where+    LogNone :: LogType' LogStr+        -- ^ No logging.+    LogStdout :: BufSize+        -> LogType' LogStr+        -- ^ Logging to stdout.+        --   'BufSize' is a buffer size+        --   for each capability.+    LogStderr :: BufSize+        -> LogType' LogStr+        -- ^ Logging to stderr.+        --   'BufSize' is a buffer size+        --   for each capability.+    LogFileNoRotate :: FilePath+        -> BufSize+        -> LogType' LogStr+        -- ^ Logging to a file.+        --   'BufSize' is a buffer size+        --   for each capability.+    LogFile :: FileLogSpec+        -> BufSize+        -> LogType' LogStr+        -- ^ Logging to a file.+        --   'BufSize' is a buffer size+        --   for each capability.+        --   File rotation is done on-demand.+    LogFileTimedRotate :: TimedFileLogSpec+        -> BufSize+        -> LogType' LogStr+        -- ^ Logging to a file.+        --   'BufSize' is a buffer size+        --   for each capability.+        --   Rotation happens based on check specified+        --   in 'TimedFileLogSpec'.+    LogCallback :: (v -> IO ())+        -> IO ()+        -> LogType' v+        -- ^ Logging with a log and flush action.+        -- run flush after log each message. --- | Creating a new 'LoggerSet' using stdout.-newStdoutLoggerSet :: BufSize -> IO LoggerSet-newStdoutLoggerSet size = newFDLoggerSet size Nothing stdout+-- | 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 ())+--+-- This logger uses `numCapabilities` many buffers, and thus+-- does not provide time-ordered output.+-- For time-ordered output, use `newFastLogger1`.+newFastLogger :: LogType' v -> IO (v -> IO (), IO ())+newFastLogger typ = newFastLoggerCore Nothing typ --- | Creating a new 'LoggerSet' using stderr.-newStderrLoggerSet :: BufSize -> IO LoggerSet-newStderrLoggerSet size = newFDLoggerSet size Nothing stderr+-- | Like `newFastLogger`, but creating a logger that uses only 1+-- 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 -{-# 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)+newFastLoggerCore :: Maybe Int -> LogType' v -> IO (v -> IO (), IO ())+newFastLoggerCore mn typ = case typ of+    LogNone -> return (const noOp, noOp)+    LogStdout bsize -> newStdoutLoggerSetN bsize mn >>= stdLoggerInit+    LogStderr bsize -> newStderrLoggerSetN bsize mn >>= stdLoggerInit+    LogFileNoRotate fp bsize -> newFileLoggerSetN bsize mn fp >>= fileLoggerInit+    LogFile fspec bsize -> rotateLoggerInit fspec bsize+    LogFileTimedRotate fspec bsize -> timedRotateLoggerInit fspec bsize+    LogCallback cb flush -> return (\str -> cb str >> flush, noOp)+  where+    stdLoggerInit lgrset = return (pushLogStr lgrset, rmLoggerSet lgrset)+    fileLoggerInit lgrset = return (pushLogStr lgrset, rmLoggerSet lgrset)+    rotateLoggerInit fspec bsize = do+        lgrset <- newFileLoggerSetN bsize mn $ 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)+    timedRotateLoggerInit fspec bsize = do+        cache <- newTimeCache $ timed_timefmt fspec+        now <- cache+        lgrset <- newFileLoggerSetN bsize mn $ prefixTime now $ timed_log_file fspec+        ref <- newIORef now+        mvar <- newMVar lgrset+        let logger str = do+                ct <- cache+                updated <- updateTime (timed_same_timeframe fspec) ref ct+                when updated $ tryTimedRotate fspec ct mvar+                pushLogStr lgrset str+        return (logger, rmLoggerSet lgrset) --- | 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 <- mkAutoUpdate defaultUpdateSettings-        { updateAction = flushLogStrRaw fref arr-        }-    return $ LoggerSet mfile fref arr flush+-- | 'bracket' version of 'newFastLogger'+withFastLogger :: LogType -> (FastLogger -> IO a) -> IO a+withFastLogger typ log' = bracket (newFastLogger typ) snd (log' . fst) --- | 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 _ fref 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-    fd <- readIORef fref-    pushLog fd logger logmsg-    flush+-- | 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+    LogFileNoRotate fp bsize -> newFileLoggerSet bsize fp >>= fileLoggerInit+    LogFile fspec bsize -> rotateLoggerInit fspec bsize+    LogFileTimedRotate fspec bsize -> timedRotateLoggerInit fspec bsize+    LogCallback cb flush -> return (\f -> tgetter >>= cb . f >> flush, noOp)+  where+    stdLoggerInit lgrset = return (\f -> tgetter >>= pushLogStr lgrset . f, rmLoggerSet lgrset)+    fileLoggerInit lgrset = return (\f -> tgetter >>= pushLogStr lgrset . f, rmLoggerSet lgrset)+    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)+    timedRotateLoggerInit fspec bsize = do+        cache <- newTimeCache $ timed_timefmt fspec+        now <- cache+        lgrset <- newFileLoggerSet bsize $ prefixTime now $ timed_log_file fspec+        ref <- newIORef now+        mvar <- newMVar lgrset+        let logger f = do+                ct <- cache+                updated <- updateTime (timed_same_timeframe fspec) ref ct+                when updated $ tryTimedRotate fspec ct mvar+                t <- tgetter+                pushLogStr lgrset (f t)+        return (logger, rmLoggerSet lgrset) --- | 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.-flushLogStr :: LoggerSet -> IO ()-flushLogStr (LoggerSet _ _ _ go) = go+-- | 'bracket' version of 'newTimeFastLogger'+withTimedFastLogger+    :: IO FormattedTime -> LogType -> (TimedFastLogger -> IO a) -> IO a+withTimedFastLogger tgetter typ log' = bracket (newTimedFastLogger tgetter typ) snd (log' . fst) -flushLogStrRaw :: IORef FD -> Array Int Logger -> IO ()-flushLogStrRaw fref arr = do-    let (l,u) = bounds arr-    fd <- readIORef fref-    mapM_ (flushIt fd) [l .. u]-  where-    flushIt fd i = flushLog fd (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 <- logOpen file-    oldfd <- atomicModifyIORef' fref (\fd -> (newfd, fd))-    close oldfd+noOp :: IO ()+noOp = return () --- | Flushing the buffers, closing the internal file information---   and freeing the buffers.-rmLoggerSet :: LoggerSet -> IO ()-rmLoggerSet (LoggerSet mfile fref arr _) = do-    let (l,u) = bounds arr-    fd <- readIORef fref-    let nums = [l .. u]-    mapM_ (flushIt fd) nums-    mapM_ freeIt nums-    when (isJust mfile) $ close fd+decrease :: IORef Int -> IO Int+decrease ref = atomicModifyIORef' ref (\x -> (x - 1, x - 1))++-- updateTime returns whether the timeframe has changed+updateTime+    :: (FormattedTime -> FormattedTime -> Bool)+    -> IORef FormattedTime+    -> FormattedTime+    -> IO Bool+updateTime cmp ref newTime = atomicModifyIORef' ref (\x -> (newTime, not $ cmp x newTime))++tryRotate :: LoggerSet -> FileLogSpec -> IORef Int -> MVar () -> IO ()+tryRotate lgrset spec ref mvar = bracket lock unlock rotateFiles   where-    flushIt fd i = flushLog fd (arr ! i)-    freeIt i = do-        let (Logger mbuf _ _) = arr ! i-        takeMVar mbuf >>= freeBuffer+    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 ->+                    writeIORef ref $ estimate (limit - siz)+    file = log_file spec+    limit = log_file_size spec+    getSize =+        handle (\(SomeException _) -> return Nothing) $+            -- 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)++tryTimedRotate :: TimedFileLogSpec -> FormattedTime -> MVar LoggerSet -> IO ()+tryTimedRotate spec now mvar = bracket lock unlock rotateFiles+  where+    lock = tryTakeMVar mvar+    unlock Nothing = return ()+    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 lgrset) = do+        let (newlgrset, _) = replaceLoggerSet lgrset new_file_path+        renewLoggerSet newlgrset+    new_file_path = prefixTime now $ timed_log_file spec
+ System/Log/FastLogger/Date.hs view
@@ -0,0 +1,50 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Formatting time is slow.+-- This package provides mechanisms to cache formatted date.+module System.Log.FastLogger.Date (+    -- * Date cacher+    newTimeCache,+    simpleTimeFormat,+    simpleTimeFormat',+) where++import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction, updateThreadName)+import Data.UnixTime (formatUnixTime, fromEpochTime)+import System.Log.FastLogger.Types (FormattedTime, TimeFormat)+import System.PosixCompat.Time (epochTime)+import System.PosixCompat.Types (EpochTime)++----------------------------------------------------------------++-- | Get date using UnixTime.+getTime :: IO EpochTime+getTime = epochTime++-- | Format unix EpochTime date.+formatDate :: TimeFormat -> EpochTime -> IO FormattedTime+formatDate fmt = formatUnixTime fmt . fromEpochTime++----------------------------------------------------------------++-- |  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+            , updateThreadName = "Date string cacher of FastLogger (AutoUpdate)"+            }++-- | 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"
System/Log/FastLogger/File.hs view
@@ -1,19 +1,69 @@-module System.Log.FastLogger.File where+{-# LANGUAGE CPP #-}+#if !MIN_VERSION_directory(1,3,8)+{-# LANGUAGE Safe #-}+#endif -import Control.Monad (unless, when)-import System.Directory (doesFileExist, doesDirectoryExist, getPermissions, writable, renameFile)-import System.FilePath (takeDirectory)+module System.Log.FastLogger.File (+    FileLogSpec (..),+    TimedFileLogSpec (..),+    check,+    rotate,+    prefixTime,+) where +import Data.ByteString.Char8 (unpack)+import System.Directory (+    doesDirectoryExist,+    doesFileExist,+    getPermissions,+    renameFile,+    writable,+ )+import System.FilePath (dropFileName, takeDirectory, takeFileName, (</>))++import System.Log.FastLogger.Imports+import System.Log.FastLogger.Types (FormattedTime, TimeFormat)+ -- | The spec for logging files-data FileLogSpec = FileLogSpec {-    log_file :: FilePath-  , log_file_size :: Integer-  , log_backup_number :: Int-  }+data FileLogSpec = FileLogSpec+    { log_file :: FilePath+    , log_file_size :: Integer+    -- ^ Max log file size (in bytes) before requiring rotation.+    , log_backup_number :: Int+    -- ^ Max number of rotated log files to keep around before overwriting the oldest one.+    } +-- | The spec for time based rotation. It supports post processing of log files. Does+-- not delete any logs. Example:+--+-- @+-- timeRotate fname = LogFileTimedRotate+--                (TimedFileLogSpec fname timeFormat sametime compressFile)+--                defaultBufSize+--    where+--        timeFormat = "%FT%H%M%S"+--        sametime = (==) `on` C8.takeWhile (/='T')+--        compressFile fp = void . forkIO $+--            callProcess "tar" [ "--remove-files", "-caf", fp <> ".gz", fp ]+-- @+data TimedFileLogSpec = TimedFileLogSpec+    { timed_log_file :: FilePath+    -- ^ base file path+    , timed_timefmt :: TimeFormat+    -- ^ time format to prepend+    , timed_same_timeframe :: FormattedTime -> FormattedTime -> Bool+    -- ^ function that compares two+    --   formatted times as specified by+    --   timed_timefmt and decides if a+    --   new rotation is supposed to+    --   begin+    , timed_post_process :: FilePath -> IO ()+    -- ^ processing function called asynchronously after a file is added to the rotation+    }+ -- | 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@@ -23,7 +73,6 @@         perm <- getPermissions file         unless (writable perm) $ fail $ file ++ " is not writable."   where-    file = log_file spec     dir = takeDirectory file  -- | Rotating log files.@@ -32,11 +81,14 @@   where     path = log_file spec     n = log_backup_number spec-    dsts' = reverse . ("":) . map (('.':). show) $ [0..n-1]-    dsts = map (path++) dsts'-    srcs = tail dsts+    dsts' = reverse . ("" :) . map (('.' :) . show) $ [0 .. n - 1]+    dsts = map (path ++) dsts'+    srcs = drop 1 dsts     srcdsts = zip srcs dsts-    move (src,dst) = do+    move (src, dst) = do         exist <- doesFileExist src         when exist $ renameFile src dst +-- | Prefix file name with formatted time+prefixTime :: FormattedTime -> FilePath -> FilePath+prefixTime time path = dropFileName path </> unpack time ++ "-" ++ takeFileName path
+ System/Log/FastLogger/FileIO.hs view
@@ -0,0 +1,38 @@+module System.Log.FastLogger.FileIO where++import Foreign.Ptr (Ptr)+import GHC.IO.Device (close)+import GHC.IO.FD (openFile, stderr, stdout, writeRawBufferPtr)+import qualified GHC.IO.FD as POSIX (FD (..))+import GHC.IO.IOMode (IOMode (..))++import System.Log.FastLogger.Imports++type FD = POSIX.FD++closeFD :: FD -> IO ()+closeFD = close++openFileFD :: FilePath -> IO FD+openFileFD f = fst <$> openFile f AppendMode False++getStderrFD :: IO FD+getStderrFD = return stderr++getStdoutFD :: IO FD+getStdoutFD = return stdout++writeRawBufferPtr2FD :: IORef FD -> Ptr Word8 -> Int -> IO Int+writeRawBufferPtr2FD fdref bf len = do+    fd <- readIORef fdref+    if isFDValid fd+        then+            fromIntegral <$> writeRawBufferPtr "write" fd bf 0 (fromIntegral len)+        else+            return (-1)++invalidFD :: POSIX.FD+invalidFD = stdout{POSIX.fdFD = -1}++isFDValid :: POSIX.FD -> Bool+isFDValid fd = POSIX.fdFD fd /= -1
System/Log/FastLogger/IO.hs view
@@ -1,19 +1,20 @@-{-# LANGUAGE BangPatterns, CPP #-}+{-# LANGUAGE CPP #-} +#if __GLASGOW_HASKELL__ <= 708+{-# LANGUAGE Trustworthy #-}+#else+{-# LANGUAGE Safe #-}+#endif+ module System.Log.FastLogger.IO where -#if MIN_VERSION_bytestring(0,10,2)-import Data.ByteString.Builder.Extra (Next(..))+import Data.ByteString.Builder.Extra (Next (..)) import qualified Data.ByteString.Builder.Extra as BBE-#else-import Blaze.ByteString.Builder.Internal.Types (Builder(..), BuildSignal(..), BufRange(..), runBuildStep, buildStep)-import Foreign.Ptr (minusPtr)-#endif-import Data.ByteString.Internal (ByteString(..))-import Data.Word (Word8) import Foreign.ForeignPtr (withForeignPtr)-import Foreign.Marshal.Alloc (mallocBytes, free)+import Foreign.Marshal.Alloc (free, mallocBytes) import Foreign.Ptr (Ptr, plusPtr)++import System.Log.FastLogger.Imports import System.Log.FastLogger.LogStr  type Buffer = Ptr Word8@@ -31,40 +32,16 @@ freeBuffer :: Buffer -> IO () freeBuffer = free -#if MIN_VERSION_bytestring(0,10,2) 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         io buf len         case next of-             Done -> return ()-             More minSize writer'-               | size < minSize -> error "toBufIOWith: More: minSize"-               | otherwise      -> loop writer'-             Chunk (PS fptr off siz) writer'-               | len == 0  -> loop writer' -- flushing-               | otherwise -> withForeignPtr fptr $ \ptr -> io (ptr `plusPtr` off) siz-#else-toBufIOWith :: Buffer -> BufSize -> (Buffer -> Int -> IO ()) -> Builder -> IO ()-toBufIOWith buf !size io (Builder build) = loop firstStep-  where-    firstStep = build (buildStep finalStep)-    finalStep (BufRange p _) = return $ Done p ()-    bufRange = BufRange buf (buf `plusPtr` size)-    loop step = do-        signal <- runBuildStep step bufRange-        case signal of-             Done ptr _ -> io buf (ptr `minusPtr` buf)-             BufferFull minSize ptr next-               | size < minSize -> error "toBufIOWith: BufferFull: minSize"-               | otherwise      -> do-                   io buf (ptr `minusPtr` buf)-                   loop next-             InsertByteString ptr (PS fptr off siz) next -> do-                 io buf (ptr `minusPtr` buf)-                 withForeignPtr fptr $ \p -> io (p `plusPtr` off) siz-                 loop next-#endif-+            Done -> return ()+            More minSize writer'+                | size < minSize -> error "toBufIOWith: More: minSize"+                | otherwise -> loop writer'+            Chunk (PS fptr off siz) writer' ->+                withForeignPtr fptr $ \ptr -> io (ptr `plusPtr` off) siz >> loop writer'
− System/Log/FastLogger/IORef.hs 
@@ -1,19 +0,0 @@-{-# LANGUAGE CPP #-}--module System.Log.FastLogger.IORef (-       IORef-     , newIORef-     , readIORef-     , atomicModifyIORef'-     ) where--import Data.IORef--#if !MIN_VERSION_base(4, 6, 0)-atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b-atomicModifyIORef' ref f = do-    b <- atomicModifyIORef ref-            (\x -> let (a, b) = f x-                    in (a, a `seq` b))-    b `seq` return b-#endif
+ System/Log/FastLogger/Imports.hs view
@@ -0,0 +1,27 @@+{-# LANGUAGE Trustworthy #-}++module System.Log.FastLogger.Imports (+    ByteString (..),+    module Control.Applicative,+    module Control.Monad,+    module Data.IORef,+    module Data.List,+    module Data.Int,+    module Data.Monoid,+    module Data.Ord,+    module Data.Word,+    module Data.Maybe,+    module Numeric,+) where++import Control.Applicative+import Control.Monad+import Data.ByteString.Internal (ByteString (..))+import Data.IORef+import Data.Int+import Data.List+import Data.Maybe+import Data.Monoid+import Data.Ord+import Data.Word+import Numeric
+ System/Log/FastLogger/Internal.hs view
@@ -0,0 +1,19 @@+-- |+-- The contents of this module can change at any time without warning.+module System.Log.FastLogger.Internal (+    module System.Log.FastLogger.IO,+    module System.Log.FastLogger.FileIO,+    module System.Log.FastLogger.LogStr,+    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.FileIO+import System.Log.FastLogger.IO+import System.Log.FastLogger.LogStr+import System.Log.FastLogger.LoggerSet+import System.Log.FastLogger.MultiLogger+import System.Log.FastLogger.SingleLogger+import System.Log.FastLogger.Write
System/Log/FastLogger/LogStr.hs view
@@ -1,56 +1,47 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Trustworthy #-}  module System.Log.FastLogger.LogStr (-    Builder-  , LogStr(..)-  , logStrLength-  , fromLogStr-  , ToLogStr(..)-  , mempty-  , (<>)-  ) where+    Builder,+    LogStr (..),+    logStrLength,+    fromLogStr,+    ToLogStr (..),+    mempty,+    (<>),+) where -#if MIN_VERSION_bytestring(0,10,2)+import qualified Data.ByteString as BS import Data.ByteString.Builder (Builder) import qualified Data.ByteString.Builder as B-#else-import qualified Blaze.ByteString.Builder as BB-import Blaze.ByteString.Builder.Internal.Types as BB (Builder(..))-#endif-import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as S8-import Data.ByteString.Internal (ByteString(..)) import qualified Data.ByteString.Lazy as BL-import Data.Monoid (Monoid, mempty, mappend)-#if MIN_VERSION_base(4,5,0)-import Data.Monoid ((<>))+import qualified Data.ByteString.Short as SBS+#if MIN_VERSION_base(4,9,0)+import qualified Data.Semigroup as Semi (Semigroup(..)) #endif-import Data.String (IsString(..))+import Data.String (IsString (..)) import qualified Data.Text as T import qualified Data.Text.Encoding as T+#if MIN_VERSION_text(2,0,0)+import qualified Data.Text.Foreign as T+#endif import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Encoding as TL -----------------------------------------------------------------+import System.Log.FastLogger.Imports -#if !MIN_VERSION_base(4,5,0)-(<>) :: Monoid m => m -> m -> m-(<>) = mappend-#endif+----------------------------------------------------------------  toBuilder :: ByteString -> Builder-#if MIN_VERSION_bytestring(0,10,2) toBuilder = B.byteString-#else-toBuilder = BB.fromByteString-#endif  fromBuilder :: Builder -> ByteString-#if MIN_VERSION_bytestring(0,10,2)+#if MIN_VERSION_bytestring(0,10,0) fromBuilder = BL.toStrict . B.toLazyByteString #else-fromBuilder = BB.toByteString+fromBuilder = BS.concat . BL.toChunks . B.toLazyByteString #endif  ----------------------------------------------------------------@@ -58,28 +49,133 @@ -- | Log message builder. Use ('<>') to append two LogStr in O(1). data LogStr = LogStr !Int Builder +#if MIN_VERSION_base(4,9,0)+instance Semi.Semigroup LogStr where+    {-# INLINE (<>) #-}+    LogStr s1 b1 <> LogStr s2 b2 = LogStr (s1 + s2) (b1 <> b2) 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 #-}     fromString = toLogStr . TL.pack +-- | Types that can be converted to a 'LogStr'. Instances for+-- types from the @text@ library use a UTF-8 encoding. Instances+-- for numerical types use a decimal encoding. class ToLogStr msg where     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-    toLogStr = toLogStr . S8.concat . BL.toChunks+    {-# 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 SBS.ShortByteString where+    {-# INLINE toLogStr #-}+    toLogStr b = LogStr (SBS.length b) (B.shortByteString b) instance ToLogStr String where+    {-# INLINE toLogStr #-}     toLogStr = toLogStr . TL.pack instance ToLogStr T.Text where+    {-# INLINE toLogStr #-}+#if MIN_VERSION_text(2,0,0)+    toLogStr t = LogStr (T.lengthWord8 t) (T.encodeUtf8Builder t)+#else     toLogStr = toLogStr . T.encodeUtf8+#endif instance ToLogStr TL.Text where+    {-# INLINE toLogStr #-}+#if MIN_VERSION_text(2,0,0)+    toLogStr t = LogStr (TL.foldlChunks (\n c -> T.lengthWord8 c + n) 0 t) (TL.encodeUtf8Builder t)+#else     toLogStr = toLogStr . TL.encodeUtf8+#endif+-- | @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+    show = show . T.decodeUtf8 . fromLogStr++instance Eq LogStr where+    a == b = fromLogStr a == fromLogStr b  -- | Obtaining the length of 'LogStr'. logStrLength :: LogStr -> Int
− System/Log/FastLogger/Logger.hs 
@@ -1,81 +0,0 @@-{-# LANGUAGE BangPatterns, CPP #-}--module System.Log.FastLogger.Logger (-    Logger(..)-  , newLogger-  , pushLog-  , flushLog-  ) where--import Control.Concurrent (MVar, newMVar, withMVar)-import Control.Monad (when)-import Foreign.Ptr (plusPtr)-import GHC.IO.FD (FD, writeRawBufferPtr)-import System.Log.FastLogger.IO-import System.Log.FastLogger.LogStr-import System.Log.FastLogger.IORef--------------------------------------------------------------------data Logger = Logger (MVar Buffer) !BufSize (IORef LogStr)--------------------------------------------------------------------newLogger :: BufSize -> IO Logger-newLogger size = do-    buf <- getBuffer size-    mbuf <- newMVar buf-    lref <- newIORef mempty-    return $ Logger mbuf size lref--------------------------------------------------------------------pushLog :: FD -> Logger -> LogStr -> IO ()-pushLog fd logger@(Logger mbuf size ref) nlogmsg@(LogStr nlen nbuilder)-  | nlen > size = do-      flushLog fd logger-      withMVar mbuf $ \buf -> toBufIOWith buf size (write fd) nbuilder-  | otherwise = do-    mmsg <- atomicModifyIORef' ref checkBuf-    case mmsg of-        Nothing  -> return ()-        Just msg -> withMVar mbuf $ \buf -> writeLogStr fd buf size msg-  where-    checkBuf ologmsg@(LogStr olen _)-      | size < olen + nlen = (nlogmsg, Just ologmsg)-      | otherwise          = (ologmsg <> nlogmsg, Nothing)--------------------------------------------------------------------flushLog :: FD -> Logger -> IO ()-flushLog fd (Logger mbuf size 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 fd 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 :: FD-            -> Buffer-            -> BufSize-            -> LogStr-            -> IO ()-writeLogStr fd buf size (LogStr len builder)-  | size < len = error "writeLogStr"-  | otherwise  = toBufIOWith buf size (write fd) builder--write :: FD -> Buffer -> Int -> IO ()-write fd buf len' = loop buf (fromIntegral len')-  where-    loop bf !len = do-        written <- writeRawBufferPtr "write" fd bf 0 (fromIntegral len)-        when (written < len) $-            loop (bf `plusPtr` fromIntegral written) (len - written)
+ System/Log/FastLogger/LoggerSet.hs view
@@ -0,0 +1,188 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE RecordWildCards #-}++module System.Log.FastLogger.LoggerSet (+    -- * Creating a logger set+    LoggerSet,+    newFileLoggerSet,+    newFileLoggerSetN,+    newStdoutLoggerSet,+    newStdoutLoggerSetN,+    newStderrLoggerSet,+    newStderrLoggerSetN,+    newLoggerSet,+    newFDLoggerSet,++    -- * Renewing and removing a logger set+    renewLoggerSet,+    rmLoggerSet,++    -- * Writing a log message+    pushLogStr,+    pushLogStrLn,++    -- * Flushing buffered log messages+    flushLogStr,++    -- * Misc+    replaceLoggerSet,+) where++import Control.Concurrent (getNumCapabilities)+import Control.Debounce (debounceAction, defaultDebounceSettings, mkDebounce, debounceThreadName)++import System.Log.FastLogger.FileIO+import System.Log.FastLogger.IO+import System.Log.FastLogger.Imports+import System.Log.FastLogger.LogStr+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+    { lgrsetFilePath :: Maybe FilePath+    , lgrsetFdRef :: IORef FD+    , lgrsetLogger :: Logger+    , lgrsetDebounce :: IO ()+    }++-- | Creating a new 'LoggerSet' using a file.+--+-- Uses `numCapabilties` many buffers, which will result in log+-- output that is not ordered by time (see `newFileLoggerSetN`).+newFileLoggerSet :: BufSize -> FilePath -> IO LoggerSet+newFileLoggerSet size file = openFileFD file >>= newFDLoggerSet size Nothing (Just file)++-- | Creating a new 'LoggerSet' using a file, using only the given number of capabilites.+--+-- Giving @mn = Just 1@ scales less well on multi-core machines,+-- but provides time-ordered output.+newFileLoggerSetN :: BufSize -> Maybe Int -> FilePath -> IO LoggerSet+newFileLoggerSetN size mn file = openFileFD file >>= newFDLoggerSet size mn (Just file)++-- | Creating a new 'LoggerSet' using stdout.+newStdoutLoggerSet :: BufSize -> IO LoggerSet+newStdoutLoggerSet size = getStdoutFD >>= newFDLoggerSet size Nothing Nothing++-- | Creating a new 'LoggerSet' using stdout, with the given number of buffers+-- (see `newFileLoggerSetN`).+newStdoutLoggerSetN :: BufSize -> Maybe Int -> IO LoggerSet+newStdoutLoggerSetN size mn = getStdoutFD >>= newFDLoggerSet size mn Nothing++-- | Creating a new 'LoggerSet' using stderr.+newStderrLoggerSet :: BufSize -> IO LoggerSet+newStderrLoggerSet size = getStderrFD >>= newFDLoggerSet size Nothing Nothing++-- | Creating a new 'LoggerSet' using stderr, with the given number of buffers+-- (see `newFileLoggerSetN`).+newStderrLoggerSetN :: BufSize -> Maybe Int -> IO LoggerSet+newStderrLoggerSetN size mn = getStderrFD >>= newFDLoggerSet size mn 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 Int -> Maybe FilePath -> IO LoggerSet+newLoggerSet size mn = maybe (newStdoutLoggerSet size) (newFileLoggerSetN size mn)++-- | Creating a new 'LoggerSet' using a FD.+newFDLoggerSet :: BufSize -> Maybe Int -> Maybe FilePath -> FD -> IO LoggerSet+newFDLoggerSet size mn mfile fd = do+    n <- case mn of+        Just n' -> return n'+        Nothing -> getNumCapabilities+    fdref <- newIORef fd+    let bufsiz = max 1 size+    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 logger+                , debounceThreadName = "Loggerset of FastLogger (Debounce)"+                }+    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{..} 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 ()+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{..} = flushLogStrRaw lgrsetLogger++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{..} = 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{..} = do+    fd <- readIORef lgrsetFdRef+    when (isFDValid fd) $ do+        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 lgrset@LoggerSet{..} new_file_path =+    (lgrset{lgrsetFilePath = Just new_file_path}, lgrsetFilePath)
+ System/Log/FastLogger/MultiLogger.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE RecordWildCards #-}++module System.Log.FastLogger.MultiLogger (+    MultiLogger,+    newMultiLogger,+) where++import Control.Concurrent (+    MVar,+    myThreadId,+    newMVar,+    takeMVar,+    threadCapability,+    withMVar,+ )+import Data.Array (Array, bounds, listArray, (!))++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
+ System/Log/FastLogger/SingleLogger.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE RecordWildCards #-}++module System.Log.FastLogger.SingleLogger (+    SingleLogger,+    newSingleLogger,+) where++import Control.Concurrent (MVar, forkIO, newEmptyMVar, putMVar, takeMVar)+import Control.Concurrent.STM+import GHC.Conc.Sync (labelThread)++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++----------------------------------------------------------------++data Ent = F (MVar ()) Bool | L LogStr+type Q = [Ent] -- writer queue++-- | A non-scale but time-ordered logger.+data SingleLogger = SingleLogger+    { slgrRef :: IORef (LogStr, Q)+    , slgrFlush :: Bool -> IO () -- teminate if False+    , 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, Q)+    -> IO ()+writer bufsize buf fdref tvar ref = 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+        when cont $ loop cnt'+    go [] = return True+    go (F mvar cont : msgs) = do+        putMVar mvar ()+        if cont then go msgs else return False+    go (L msg@(LogStr len _) : msgs)+        | 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, [])+    buf <- getBuffer bufsize+    tid <- forkIO $ writer bufsize buf fdref tvar ref+    labelThread tid "FastLogger single logger's writer"+    let wakeup = atomically $ modifyTVar' tvar (+ 1)+        flush cont = do+            mvar <- newEmptyMVar+            let fin = F mvar cont+            atomicModifyIORef' ref (\(old, q) -> ((mempty, fin : L old : q), ()))+            wakeup+            takeMVar mvar+    return $+        SingleLogger+            { slgrRef = ref+            , slgrFlush = flush+            , 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, L nlogmsg : L old : q), ()))+        slgrWakeup+    | otherwise = do+        wake <- atomicModifyIORef' slgrRef checkBuf+        when wake slgrWakeup+  where+    checkBuf (ologmsg@(LogStr olen _), q)+        | slgrBufSize < olen + nlen = ((nlogmsg, L ologmsg : q), True)+        | otherwise = ((ologmsg <> nlogmsg, q), False)++flushAllLog :: SingleLogger -> IO ()+flushAllLog SingleLogger{..} = do+    atomicModifyIORef' slgrRef (\(old, q) -> ((mempty, L old : q), ()))+    slgrFlush True++stopLoggers :: SingleLogger -> IO ()+stopLoggers SingleLogger{..} = do+    slgrFlush False+    freeBuffer slgrBuffer
+ System/Log/FastLogger/Types.hs view
@@ -0,0 +1,14 @@+module System.Log.FastLogger.Types (+    -- * Types+    TimeFormat,+    FormattedTime,+) where++import System.Log.FastLogger.Imports++----------------------------------------------------------------++-- | Type aliaes for date format and formatted date.+type FormattedTime = ByteString++type TimeFormat = ByteString
+ System/Log/FastLogger/Write.hs view
@@ -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 ()
fast-logger.cabal view
@@ -1,45 +1,80 @@-Name:                   fast-logger-Version:                2.2.0-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-Category:               System-Cabal-Version:          >= 1.8-Build-Type:             Simple+cabal-version:      >=1.10+name:               fast-logger+version:            3.2.6+license:            BSD3+license-file:       LICENSE+maintainer:         Kazu Yamamoto <kazu@iij.ad.jp>+author:             Kazu Yamamoto <kazu@iij.ad.jp>+tested-with:+    ghc ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.3 -Library-  GHC-Options:          -Wall-  Exposed-Modules:      System.Log.FastLogger-                        System.Log.FastLogger.File-  Other-Modules:        System.Log.FastLogger.IO-                        System.Log.FastLogger.IORef-                        System.Log.FastLogger.LogStr-                        System.Log.FastLogger.Logger-  Build-Depends:        base >= 4 && < 5-                      , array-                      , auto-update-                      -- FIXME: blaze-builder should be removed someday-                      , blaze-builder-                      , bytestring-                      , directory-                      , filepath-                      , text+homepage:           https://github.com/kazu-yamamoto/logger+synopsis:           A fast logging system+description:        A fast logging system for Haskell+category:           System+build-type:         Simple+extra-source-files:+    README.md+    ChangeLog.md -Test-Suite spec-    Main-Is:         Spec.hs-    Hs-Source-Dirs:  test-    Type:            exitcode-stdio-1.0+source-repository head+    type:     git+    location: https://github.com/kazu-yamamoto/logger.git -    Ghc-Options:     -Wall -threaded-    Build-Depends:   base >= 4 && < 5-                   , bytestring-                   , directory-                   , fast-logger-                   , hspec+library+    exposed-modules:+        System.Log.FastLogger+        System.Log.FastLogger.Date+        System.Log.FastLogger.File+        System.Log.FastLogger.Internal+        System.Log.FastLogger.LoggerSet+        System.Log.FastLogger.Types -Source-Repository head-  Type:                 git-  Location:             git://github.com/kazu-yamamoto/logger.git+    other-modules:+        System.Log.FastLogger.Imports+        System.Log.FastLogger.FileIO+        System.Log.FastLogger.IO+        System.Log.FastLogger.LogStr+        System.Log.FastLogger.MultiLogger+        System.Log.FastLogger.SingleLogger+        System.Log.FastLogger.Write++    default-language: Haskell2010+    ghc-options:      -Wall+    build-depends:+        base >=4.9 && <5,+        array,+        auto-update >=0.2.2,+        easy-file >=0.2,+        bytestring >=0.10.4,+        directory,+        filepath,+        stm,+        text,+        unix-time >=0.4.4,+        unix-compat >=0.2++    if impl(ghc <7.8)+        build-depends: bytestring-builder++    if impl(ghc >=8)+        default-extensions: Strict StrictData++test-suite spec+    type:             exitcode-stdio-1.0+    main-is:          Spec.hs+    build-tools:      hspec-discover >=2.6+    hs-source-dirs:   test+    other-modules:    FastLoggerSpec+    default-language: Haskell2010+    ghc-options:      -Wall -threaded -rtsopts -with-rtsopts=-N+    build-depends:+        base >=4 && <5,+        async,+        bytestring >=0.10.4,+        directory,+        fast-logger,+        hspec++    if impl(ghc >=8)+        default-extensions: Strict StrictData
+ test/FastLoggerSpec.hs view
@@ -0,0 +1,115 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++module FastLoggerSpec (spec) where++#if __GLASGOW_HASKELL__ < 709+import Control.Applicative ((<$>))+#endif+import Control.Concurrent (getNumCapabilities)+import Control.Concurrent.Async (forConcurrently_)+import Control.Exception (finally)+import Control.Monad (forM_, when)+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 Text.Printf (printf)++import Test.Hspec+import Test.Hspec.QuickCheck (prop)++import System.Log.FastLogger++spec :: Spec+spec = do+    describe "instance Show LogStr" $ do+        prop "it should be consistent with instance IsString" $ \str ->+            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+                , 1000+                , 10000+                , 100000+                , 1000000+                ]+        it "logs all messages" logAllMsgs++    describe "fastlogger 1" $ do+        it "maintains the ordering of log messages" logOrdering++tempFile :: FilePath+tempFile = "test/temp.txt"++safeForLarge :: [Int] -> IO ()+safeForLarge = mapM_ safeForLarge'++safeForLarge' :: Int -> IO ()+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 tempFile+    bs `shouldBe` BS.pack (take (abs n) (cycle ['a' .. 'z']) <> "x")++cleanup :: FilePath -> IO ()+cleanup file = do+    exist <- doesFileExist file+    when exist $ removeFile file++logAllMsgs :: IO ()+logAllMsgs = logAll "LICENSE" `finally` cleanup tempFile+  where+    logAll file = do+        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 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 <> " "