packages feed

fast-logger 0.3.3 → 3.2.6

raw patch · 18 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,207 +1,287 @@-{-# LANGUAGE NoImplicitPrelude, RecordWildCards #-}-{-# LANGUAGE FlexibleInstances, BangPatterns #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-} --- | Fast logging system to copy log data directly to Handle buffer.-+-- | This module provides a fast logging system which+--   scales on multicore environments (i.e. +RTS -N\<x\>).+--+--   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 (-  -- * Logger-    Logger-  , mkLogger-  , mkLogger2-  , renewLogger-  , rmLogger-  -- * Logging-  , loggerPutStr-  , loggerPutBuilder-  , loggerFlush-  -- * Strings-  , LogStr(..)-  , ToLogStr(..)-  -- * Date-  , loggerDate-  , module System.Log.FastLogger.Date-  -- * File rotation-  , module System.Log.FastLogger.File-  ) where+    -- * FastLogger+    FastLogger,+    LogType,+    LogType' (..),+    newFastLogger,+    newFastLogger1,+    withFastLogger, -import Blaze.ByteString.Builder-import Blaze.ByteString.Builder.Char8 (fromString)-import Control.Monad-import qualified Data.ByteString as BS-import Data.ByteString.Internal (ByteString(..), c2w)-import Data.List-import Data.Maybe-import Data.Monoid-import Data.Typeable-import Foreign hiding (void)-import GHC.Base-import GHC.IO.Buffer-import qualified GHC.IO.BufferedIO as Buffered-import qualified GHC.IO.Device as RawIO-import GHC.IO.FD-import GHC.IO.Handle.Internals-import GHC.IO.Handle.Text-import GHC.IO.Handle.Types-import GHC.IORef-import GHC.Num-import GHC.Real-import System.Date.Cache-import System.IO-import System.Log.FastLogger.Date-import System.Log.FastLogger.File+    -- * Timed FastLogger+    TimedFastLogger,+    newTimedFastLogger,+    withTimedFastLogger, -import qualified Data.Text as TS-import qualified Data.Text.Encoding as TE-import qualified Data.Text.Lazy as TL-import qualified Data.ByteString as S-import qualified Data.ByteString.Lazy as L+    -- * Log messages+    LogStr,+    ToLogStr (..),+    fromLogStr,+    logStrLength, --- | Abstract data type for logger.-data Logger = Logger {-    loggerAutoFlush  :: Bool-  , loggerHandle     :: Handle-  , loggerDateGetter :: DateCacheGetter-  , loggerDateCloser :: DateCacheCloser-  }+    -- * Buffer size+    BufSize,+    defaultBufSize, -logBufSize :: Int-logBufSize = 4096+    -- * LoggerSet+    module System.Log.FastLogger.LoggerSet, -initHandle :: Handle -> IO ()-initHandle hdl = hSetBuffering hdl (BlockBuffering (Just logBufSize))+    -- * Date cache+    module System.Log.FastLogger.Date, --- | Creates a 'Logger' from the given handle.--- ('ondemandDateCacher' 'zonedDateCacheConf') is used as a Date getter.-mkLogger :: Bool -- ^ Automatically flush on each loggerPut?-         -> Handle -- ^ If 'Handle' is associated with a file, 'AppendMode' must be used.-         -> IO Logger-mkLogger autoFlush hdl =-    ondemandDateCacher zonedDateCacheConf >>= mkLogger2 autoFlush hdl+    -- * File rotation+    module System.Log.FastLogger.File, --- | Creates a 'Logger' from the given handle.-mkLogger2 :: Bool -- ^ Automatically flush on each loggerPut?-          -> Handle -- ^ If 'Handle' is associated with a file, 'AppendMode' must be used.-          -> (DateCacheGetter, DateCacheCloser) -- ^ Date getter/closer. E.g. ('clockDateCacher' 'zonedDateCacheConf')           -          -> IO Logger-mkLogger2 autoFlush hdl (getter,closer) = do-    initHandle hdl-    return $ Logger autoFlush hdl getter closer+    -- * Types+    module System.Log.FastLogger.Types,+) where --- | Creates a new 'Logger' from old one by replacing 'Handle'.--- The new 'Handle' automatically inherits the file mode of--- the old one.--- The old 'Handle' is automatically closed.-renewLogger :: Logger -> Handle -> IO Logger-renewLogger logger newhdl = do-    let oldhdl = loggerHandle logger-    hFlush oldhdl-    hClose oldhdl-    initHandle newhdl-    return $ logger { loggerHandle = newhdl }+import Control.Concurrent (MVar, newMVar, putMVar, tryTakeMVar)+import Control.Exception (SomeException (..), bracket, handle)+import System.EasyFile (getFileSize) --- | Destroy a 'Logger' by closing internal 'Handle'.-rmLogger :: Logger -> IO ()-rmLogger lgr = hClose (loggerHandle lgr) >> loggerDateCloser lgr+import System.Log.FastLogger.Date+import System.Log.FastLogger.File+import System.Log.FastLogger.IO+import System.Log.FastLogger.Imports+import System.Log.FastLogger.LogStr+import System.Log.FastLogger.LoggerSet+import System.Log.FastLogger.Types --- | A date type to contain 'String' and 'ByteString'.--- This data is exported so that format can be defined.--- This would be replaced with 'Builder' someday when--- it can be written directly to 'Handle' buffer.-data LogStr = LS !String | LB !ByteString+---------------------------------------------------------------- -class ToLogStr a where toLogStr :: a -> LogStr-instance ToLogStr [Char] where toLogStr = LS-instance ToLogStr ByteString where toLogStr = LB-instance ToLogStr L.ByteString where toLogStr = LB . S.concat . L.toChunks-instance ToLogStr TS.Text where toLogStr = LB . TE.encodeUtf8-instance ToLogStr TL.Text where toLogStr = LB . TE.encodeUtf8 . TL.toStrict+-- | 'FastLogger' simply log 'logStr'.+type FastLogger = LogStr -> IO () -hPutLogStr :: Handle -> [LogStr] -> IO ()-hPutLogStr handle bss =-  wantWritableHandle "hPutLogStr" handle $ \h_ -> bufsWrite h_ bss+-- | '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 () --- based on GHC.IO.Handle.Text+type LogType = LogType' LogStr -bufsWrite :: Handle__ -> [LogStr] -> IO ()-bufsWrite h_@Handle__{..} bss = do-    old_buf@Buffer{-        bufRaw = old_raw-      , bufR = w-      , bufSize = size-      } <- readIORef haByteBuffer-    if size - w > len then do-        withRawBuffer old_raw $ \ptr ->-            go (ptr `plusPtr` w)  bss-        writeIORef haByteBuffer old_buf{ bufR = w + len }-     else do-        old_buf' <- Buffered.flushWriteBuffer haDevice old_buf-        writeIORef haByteBuffer old_buf'-        if size > len then-            bufsWrite h_ bss-          else do-            let Just fd = cast haDevice :: Maybe FD-            writeWithBuilder fd bss+-- | 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.++-- | 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++-- | 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++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-    len = foldl' (\ !x !y -> x + getLength y) 0 bss-    getLength (LB s) = BS.length s-    getLength (LS s) = length s-    go :: Ptr Word8 -> [LogStr] -> IO ()-    go _ [] = return ()-    go dst (LB b:bs) = do-      dst' <- copy dst b-      go dst' bs-    go dst (LS s:ss) = do-      dst' <- copy' dst s-      go dst' ss+    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) -writeWithBuilder :: FD -> [LogStr] -> IO ()-writeWithBuilder fd bss = toByteStringIOWith 4096 write builder+-- | 'bracket' version of 'newFastLogger'+withFastLogger :: LogType -> (FastLogger -> IO a) -> IO a+withFastLogger typ log' = bracket (newFastLogger typ) snd (log' . fst)++-- | 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-    write !(PS fp o l) = withForeignPtr fp $ \p -> do-        void $ RawIO.writeNonBlocking fd (p `plusPtr` o) l-    builder = foldr mappend mempty $ map toBuilder bss-    toBuilder (LB s) = fromByteString s-    toBuilder (LS s) = fromString s+    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) -copy :: Ptr Word8 -> ByteString -> IO (Ptr Word8)-copy dst (PS ptr off len) = withForeignPtr ptr $ \s -> do-    let !src = s `plusPtr` off-    _ <- memcpy dst src (fromIntegral len)-    let !res = dst `plusPtr` len-    return res+-- | 'bracket' version of 'newTimeFastLogger'+withTimedFastLogger+    :: IO FormattedTime -> LogType -> (TimedFastLogger -> IO a) -> IO a+withTimedFastLogger tgetter typ log' = bracket (newTimedFastLogger tgetter typ) snd (log' . fst) -copy' :: Ptr Word8 -> String -> IO (Ptr Word8)-copy' dst [] = return dst-copy' dst (x:xs) = do-    poke dst (c2w x)-    copy' (dst `plusPtr` 1) xs+---------------------------------------------------------------- --- | The 'hPut' function to copy a list of 'LogStr' to the buffer--- of 'Handle' of 'Logger' directly.-loggerPutStr :: Logger -> [LogStr] -> IO ()-loggerPutStr logger strs = do-    hPutLogStr hdl strs-    when autoFlush $ hFlush hdl-  where-    hdl = loggerHandle logger-    autoFlush = loggerAutoFlush logger+noOp :: IO ()+noOp = return () --- | The 'hPut' function directory to copy 'Builder' to the buffer.--- The current implementation is inefficient at this moment.--- This would replace 'loggerPutStr' someday.-loggerPutBuilder :: Logger -> Builder -> IO ()-loggerPutBuilder logger builder = do-    loggerPutStr logger . return . LB . toByteString $ builder-    when autoFlush $ hFlush hdl-  where-    hdl = loggerHandle logger-    autoFlush = loggerAutoFlush logger+decrease :: IORef Int -> IO Int+decrease ref = atomicModifyIORef' ref (\x -> (x - 1, x - 1)) --- | Flushing the buffer of 'Handle' of 'Logger'.-loggerFlush :: Logger -> IO ()-loggerFlush logger = hFlush $ loggerHandle logger+-- 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)) --- | Obtaining date string from 'Logger'.-loggerDate :: Logger -> IO ZonedDate-loggerDate logger = loggerDateGetter logger+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 ->+                    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
@@ -1,36 +1,50 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-} +-- |+-- Formatting time is slow.+-- This package provides mechanisms to cache formatted date. module System.Log.FastLogger.Date (-    ZonedDate-  , zonedDateCacheConf-  ) where+    -- * Date cacher+    newTimeCache,+    simpleTimeFormat,+    simpleTimeFormat',+) where -import Data.ByteString-import System.Date.Cache-#if WINDOWS-import qualified Data.ByteString.Char8 as BS-import Data.Time-import System.Locale-#else-import Data.UnixTime-import System.Posix (EpochTime, epochTime)-#endif+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) --- | A type for zoned date.-type ZonedDate = ByteString+---------------------------------------------------------------- -#if WINDOWS-zonedDateCacheConf :: DateCacheConf UTCTime-zonedDateCacheConf = DateCacheConf {-    getTime = getCurrentTime-  , formatDate = \ut -> do-      zt <- utcToLocalZonedTime ut-      return $ BS.pack $ formatTime defaultTimeLocale "%d/%b/%Y:%T %z" zt-  }-#else-zonedDateCacheConf :: DateCacheConf EpochTime-zonedDateCacheConf = DateCacheConf {-    getTime = epochTime-  , formatDate = formatUnixTime "%d/%b/%Y:%T %z" . fromEpochTime-  }-#endif+-- | 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-import System.Directory-import System.FilePath+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 :: String-  , 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
@@ -0,0 +1,47 @@+{-# LANGUAGE CPP #-}++#if __GLASGOW_HASKELL__ <= 708+{-# LANGUAGE Trustworthy #-}+#else+{-# LANGUAGE Safe #-}+#endif++module System.Log.FastLogger.IO where++import Data.ByteString.Builder.Extra (Next (..))+import qualified Data.ByteString.Builder.Extra as BBE+import Foreign.ForeignPtr (withForeignPtr)+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++-- | The type for buffer size of each core.+type BufSize = Int++-- | The default buffer size (4,096 bytes).+defaultBufSize :: BufSize+defaultBufSize = 4096++getBuffer :: BufSize -> IO Buffer+getBuffer = mallocBytes++freeBuffer :: Buffer -> IO ()+freeBuffer = free++toBufIOWith :: Buffer -> BufSize -> (Buffer -> Int -> IO ()) -> Builder -> IO ()+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' ->+                withForeignPtr fptr $ \ptr -> io (ptr `plusPtr` off) siz >> loop writer'
+ 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
@@ -0,0 +1,186 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE Trustworthy #-}++module System.Log.FastLogger.LogStr (+    Builder,+    LogStr (..),+    logStrLength,+    fromLogStr,+    ToLogStr (..),+    mempty,+    (<>),+) where++import qualified Data.ByteString as BS+import Data.ByteString.Builder (Builder)+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Char8 as S8+import qualified Data.ByteString.Lazy as BL+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 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++----------------------------------------------------------------++toBuilder :: ByteString -> Builder+toBuilder = B.byteString++fromBuilder :: Builder -> ByteString+#if MIN_VERSION_bytestring(0,10,0)+fromBuilder = BL.toStrict . B.toLazyByteString+#else+fromBuilder = BS.concat . BL.toChunks . B.toLazyByteString+#endif++----------------------------------------------------------------++-- | 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+    {-# 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+logStrLength (LogStr n _) = n++-- | Converting 'LogStr' to 'ByteString'.+fromLogStr :: LogStr -> ByteString+fromLogStr (LogStr _ builder) = fromBuilder builder
+ 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,46 +1,80 @@-Name:                   fast-logger-Version:                0.3.3-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-                        System.Log.FastLogger.Date-  Build-Depends:        base >= 4 && < 5-                      , blaze-builder-                      , bytestring-                      , date-cache >= 0.3-                      , directory-                      , filepath-                      , text-  if os(windows)-    Cpp-Options:        -DWINDOWS-    Build-Depends:      old-locale-                      , time-  else-    Build-Depends:      unix-                      , unix-time >= 0.2+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-    Build-Depends:   base >= 4 && < 5-                   , bytestring-                   , 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 <> " "