fast-logger 3.2.4 → 3.2.5
raw patch · 16 files changed
+406/−323 lines, 16 filesdep ~auto-updatesetup-changedPVP ok
version bump matches the API change (PVP)
Dependency ranges changed: auto-update
API changes (from Hackage documentation)
Files
- ChangeLog.md +4/−0
- Setup.hs +1/−0
- System/Log/FastLogger.hs +116/−87
- System/Log/FastLogger/Date.hs +16/−12
- System/Log/FastLogger/File.hs +40/−29
- System/Log/FastLogger/FileIO.hs +9/−8
- System/Log/FastLogger/IO.hs +8/−8
- System/Log/FastLogger/Imports.hs +13/−13
- System/Log/FastLogger/Internal.hs +12/−12
- System/Log/FastLogger/LogStr.hs +24/−12
- System/Log/FastLogger/LoggerSet.hs +68/−57
- System/Log/FastLogger/MultiLogger.hs +49/−41
- System/Log/FastLogger/Types.hs +5/−4
- System/Log/FastLogger/Write.hs +6/−6
- fast-logger.cabal +2/−2
- test/FastLoggerSpec.hs +33/−32
ChangeLog.md view
@@ -1,3 +1,7 @@+## 3.2.5++* Giving names to threads.+ ## 3.2.4 * Avoid unnecessary copy for Text values with text-2.0
Setup.hs view
@@ -1,2 +1,3 @@ import Distribution.Simple+ main = defaultMain
System/Log/FastLogger.hs view
@@ -1,6 +1,6 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE GADTs #-} {-# LANGUAGE OverloadedStrings #-}-{-# LANGUAGE GADTs #-} -- | This module provides a fast logging system which -- scales on multicore environments (i.e. +RTS -N\<x\>).@@ -10,37 +10,44 @@ -- should rely more on message timestamps than on their order in the -- log. module System.Log.FastLogger (- -- * FastLogger- FastLogger- , LogType- , LogType'(..)- , newFastLogger- , newFastLogger1- , withFastLogger- -- * Timed FastLogger- , TimedFastLogger- , newTimedFastLogger- , withTimedFastLogger- -- * Log messages- , LogStr- , ToLogStr(..)- , fromLogStr- , logStrLength- -- * Buffer size- , BufSize- , defaultBufSize- -- * LoggerSet- , module System.Log.FastLogger.LoggerSet- -- * Date cache- , module System.Log.FastLogger.Date- -- * File rotation- , module System.Log.FastLogger.File- -- * Types- , module System.Log.FastLogger.Types- ) where+ -- * FastLogger+ FastLogger,+ LogType,+ LogType' (..),+ newFastLogger,+ newFastLogger1,+ withFastLogger, -import Control.Concurrent (MVar, newMVar, tryTakeMVar, putMVar)-import Control.Exception (handle, SomeException(..), bracket)+ -- * 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@@ -55,6 +62,7 @@ -- | '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. --@@ -70,31 +78,44 @@ -- | 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.+ 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.@@ -117,13 +138,13 @@ 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+ 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)+ LogCallback cb flush -> return (\str -> cb str >> flush, noOp) where stdLoggerInit lgrset = return (pushLogStr lgrset, rmLoggerSet lgrset) fileLoggerInit lgrset = return (pushLogStr lgrset, rmLoggerSet lgrset)@@ -155,20 +176,22 @@ -- | 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+ :: 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+ 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)+ LogCallback cb flush -> return (\f -> tgetter >>= cb . f >> flush, noOp) where- stdLoggerInit lgrset = return ( \f -> tgetter >>= pushLogStr lgrset . f, rmLoggerSet lgrset)+ 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@@ -195,7 +218,8 @@ return (logger, rmLoggerSet lgrset) -- | 'bracket' version of 'newTimeFastLogger'-withTimedFastLogger :: IO FormattedTime -> LogType -> (TimedFastLogger -> IO a) -> IO a+withTimedFastLogger+ :: IO FormattedTime -> LogType -> (TimedFastLogger -> IO a) -> IO a withTimedFastLogger tgetter typ log' = bracket (newTimedFastLogger tgetter typ) snd (log' . fst) ----------------------------------------------------------------@@ -207,17 +231,21 @@ 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+ :: (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- lock = tryTakeMVar mvar+ lock = tryTakeMVar mvar unlock Nothing = return ()- unlock _ = putMVar mvar ()+ unlock _ = putMVar mvar () rotateFiles Nothing = return ()- rotateFiles _ = do+ rotateFiles _ = do msiz <- getSize case msiz of -- A file is not available.@@ -233,25 +261,26 @@ 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+ 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+ 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 ()+ 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
System/Log/FastLogger/Date.hs view
@@ -4,24 +4,25 @@ -- | -- Formatting time is slow. -- This package provides mechanisms to cache formatted date.-module System.Log.FastLogger.Date- ( -- * Date cacher- newTimeCache- , simpleTimeFormat- , simpleTimeFormat'- ) where+module System.Log.FastLogger.Date (+ -- * Date cacher+ newTimeCache,+ simpleTimeFormat,+ simpleTimeFormat',+) where -import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction)-import System.Log.FastLogger.Types (TimeFormat, FormattedTime)+import Control.AutoUpdate (defaultUpdateSettings, mkAutoUpdate, updateAction, updateThreadName) import Data.UnixTime (formatUnixTime, fromEpochTime)-import System.PosixCompat.Types (EpochTime)+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@@ -33,9 +34,12 @@ -- 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- }+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
System/Log/FastLogger/File.hs view
@@ -3,27 +3,35 @@ {-# LANGUAGE Safe #-} #endif -module System.Log.FastLogger.File- ( FileLogSpec(..)- , TimedFileLogSpec (..)- , check- , rotate- , prefixTime- ) where+module System.Log.FastLogger.File (+ FileLogSpec (..),+ TimedFileLogSpec (..),+ check,+ rotate,+ prefixTime,+) where import Data.ByteString.Char8 (unpack)-import System.Directory (doesFileExist, doesDirectoryExist, getPermissions, writable, renameFile)-import System.FilePath (takeDirectory, dropFileName, takeFileName, (</>))+import System.Directory (+ doesDirectoryExist,+ doesFileExist,+ getPermissions,+ renameFile,+ writable,+ )+import System.FilePath (dropFileName, takeDirectory, takeFileName, (</>)) import System.Log.FastLogger.Imports-import System.Log.FastLogger.Types (TimeFormat, FormattedTime)+import System.Log.FastLogger.Types (FormattedTime, TimeFormat) -- | The spec for logging files-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.- }+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:@@ -38,17 +46,20 @@ -- 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- }+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 :: FilePath -> IO ()@@ -70,11 +81,11 @@ where path = log_file spec n = log_backup_number spec- dsts' = reverse . ("":) . map (('.':). show) $ [0..n-1]- dsts = map (path++) dsts'+ dsts' = reverse . ("" :) . map (('.' :) . show) $ [0 .. n - 1]+ dsts = map (path ++) dsts' srcs = tail dsts srcdsts = zip srcs dsts- move (src,dst) = do+ move (src, dst) = do exist <- doesFileExist src when exist $ renameFile src dst
System/Log/FastLogger/FileIO.hs view
@@ -2,9 +2,9 @@ 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 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 @@ -25,13 +25,14 @@ 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)+ if isFDValid fd+ then+ fromIntegral <$> writeRawBufferPtr "write" fd bf 0 (fromIntegral len)+ else+ return (-1) invalidFD :: POSIX.FD-invalidFD = stdout { POSIX.fdFD = -1 }+invalidFD = stdout{POSIX.fdFD = -1} isFDValid :: POSIX.FD -> Bool isFDValid fd = POSIX.fdFD fd /= -1
System/Log/FastLogger/IO.hs view
@@ -8,10 +8,10 @@ module System.Log.FastLogger.IO where -import Data.ByteString.Builder.Extra (Next(..))+import Data.ByteString.Builder.Extra (Next (..)) import qualified Data.ByteString.Builder.Extra as BBE 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@@ -39,9 +39,9 @@ (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'+ 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
@@ -1,22 +1,22 @@ {-# 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+ 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.ByteString.Internal (ByteString (..)) import Data.IORef import Data.Int import Data.List
System/Log/FastLogger/Internal.hs view
@@ -1,19 +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+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.IO import System.Log.FastLogger.FileIO+import System.Log.FastLogger.IO import System.Log.FastLogger.LogStr-import System.Log.FastLogger.SingleLogger+import System.Log.FastLogger.LoggerSet import System.Log.FastLogger.MultiLogger+import System.Log.FastLogger.SingleLogger import System.Log.FastLogger.Write-import System.Log.FastLogger.LoggerSet
System/Log/FastLogger/LogStr.hs view
@@ -3,14 +3,14 @@ {-# LANGUAGE Trustworthy #-} module System.Log.FastLogger.LogStr (- Builder- , LogStr(..)- , logStrLength- , fromLogStr- , ToLogStr(..)- , mempty- , (<>)- ) where+ Builder,+ LogStr (..),+ logStrLength,+ fromLogStr,+ ToLogStr (..),+ mempty,+ (<>),+) where import qualified Data.ByteString as BS import Data.ByteString.Builder (Builder)@@ -21,7 +21,7 @@ #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)@@ -83,7 +83,9 @@ 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)+ 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)@@ -108,18 +110,22 @@ 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 #-}@@ -129,18 +135,22 @@ 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 #-}@@ -150,20 +160,22 @@ 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+ show = show . T.decodeUtf8 . fromLogStr instance Eq LogStr where- a == b = fromLogStr a == fromLogStr b+ a == b = fromLogStr a == fromLogStr b -- | Obtaining the length of 'LogStr'. logStrLength :: LogStr -> Int
System/Log/FastLogger/LoggerSet.hs view
@@ -2,30 +2,34 @@ {-# 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+ -- * 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 (mkDebounce, defaultDebounceSettings, debounceAction)+import Control.Debounce (debounceAction, defaultDebounceSettings, mkDebounce, debounceThreadName) import System.Log.FastLogger.FileIO import System.Log.FastLogger.IO@@ -47,12 +51,12 @@ -- 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 ()- }+data LoggerSet = LoggerSet+ { lgrsetFilePath :: Maybe FilePath+ , lgrsetFdRef :: IORef FD+ , lgrsetLogger :: Logger+ , lgrsetDebounce :: IO ()+ } -- | Creating a new 'LoggerSet' using a file. --@@ -87,6 +91,7 @@ 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.@@ -98,35 +103,41 @@ 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+ 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- }- return $ LoggerSet {- lgrsetFilePath = mfile- , lgrsetFdRef = fdref- , lgrsetLogger = logger- , lgrsetDebounce = flush- }+ 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+ 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 ()@@ -152,11 +163,11 @@ -- 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+ 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.@@ -165,8 +176,8 @@ fd <- readIORef lgrsetFdRef when (isFDValid fd) $ do case lgrsetLogger of- SL sl -> stopLoggers sl- ML ml -> stopLoggers ml+ SL sl -> stopLoggers sl+ ML ml -> stopLoggers ml when (isJust lgrsetFilePath) $ closeFD fd writeIORef lgrsetFdRef invalidFD @@ -174,4 +185,4 @@ -- '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)+ (lgrset{lgrsetFilePath = Just new_file_path}, lgrsetFilePath)
System/Log/FastLogger/MultiLogger.hs view
@@ -1,13 +1,19 @@ {-# LANGUAGE RecordWildCards #-} module System.Log.FastLogger.MultiLogger (- MultiLogger- , newMultiLogger- ) where-+ MultiLogger,+ newMultiLogger,+) where -import Control.Concurrent (myThreadId, threadCapability, MVar, newMVar, withMVar, takeMVar)-import Data.Array (Array, listArray, (!), bounds)+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@@ -17,21 +23,21 @@ ---------------------------------------------------------------- -newtype MLogger = MLogger {- lgrRef :: IORef LogStr- }+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- }+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+ pushLog = System.Log.FastLogger.MultiLogger.pushLog flushAllLog = System.Log.FastLogger.MultiLogger.flushAllLog ----------------------------------------------------------------@@ -42,15 +48,16 @@ -- | Creating `MultiLogger`. -- The first argument is the number of the internal builders. newMultiLogger :: Int -> BufSize -> IORef FD -> IO MultiLogger-newMultiLogger n bufsize fdref= do+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- }+ arr <- listArray (0, n - 1) <$> replicateM n newMLogger+ return $+ MultiLogger+ { mlgrArray = arr+ , mlgrMBuffer = mbuf+ , mlgrBufSize = bufsize+ , mlgrFdRef = fdref+ } ---------------------------------------------------------------- @@ -61,33 +68,34 @@ -- 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+ 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+ | 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 ())+ | 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+ (l, u) = bounds mlgrArray nums = [l .. u] mapM_ flushIt nums @@ -106,8 +114,8 @@ stopLoggers :: MultiLogger -> IO () stopLoggers ml@MultiLogger{..} = do- System.Log.FastLogger.MultiLogger.flushAllLog ml- takeMVar mlgrMBuffer >>= freeBuffer+ System.Log.FastLogger.MultiLogger.flushAllLog ml+ takeMVar mlgrMBuffer >>= freeBuffer ----------------------------------------------------------------
System/Log/FastLogger/Types.hs view
@@ -1,8 +1,8 @@ module System.Log.FastLogger.Types (- -- * Types- TimeFormat- , FormattedTime- ) where+ -- * Types+ TimeFormat,+ FormattedTime,+) where import System.Log.FastLogger.Imports @@ -10,4 +10,5 @@ -- | Type aliaes for date format and formatted date. type FormattedTime = ByteString+ type TimeFormat = ByteString
System/Log/FastLogger/Write.hs view
@@ -1,10 +1,10 @@ {-# LANGUAGE RecordWildCards #-} module System.Log.FastLogger.Write (- writeLogStr- , writeBigLogStr- , Loggers(..)- ) where+ writeLogStr,+ writeBigLogStr,+ Loggers (..),+) where import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Ptr (plusPtr)@@ -25,7 +25,7 @@ -- | Writting 'LogStr' using a temporary buffer. writeBigLogStr :: IORef FD -> LogStr -> IO ()-writeBigLogStr fdref (LogStr len builder) = allocaBytes len $ \buf ->+writeBigLogStr fdref (LogStr len builder) = allocaBytes len $ \buf -> toBufIOWith buf len (write fdref) builder write :: IORef FD -> Buffer -> Int -> IO ()@@ -41,5 +41,5 @@ -- | A class for internal loggers. class Loggers a where stopLoggers :: a -> IO ()- pushLog :: a -> LogStr -> IO ()+ pushLog :: a -> LogStr -> IO () flushAllLog :: a -> IO ()
fast-logger.cabal view
@@ -1,6 +1,6 @@ cabal-version: >=1.10 name: fast-logger-version: 3.2.4+version: 3.2.5 license: BSD3 license-file: LICENSE maintainer: Kazu Yamamoto <kazu@iij.ad.jp>@@ -44,7 +44,7 @@ build-depends: base >=4.9 && <5, array,- auto-update >=0.1.2,+ auto-update >=0.2.2, easy-file >=0.2, bytestring >=0.10.4, directory,
test/FastLoggerSpec.hs view
@@ -6,16 +6,16 @@ #if __GLASGOW_HASKELL__ < 709 import Control.Applicative ((<$>)) #endif-import Control.Exception (finally) import Control.Concurrent (getNumCapabilities) import Control.Concurrent.Async (forConcurrently_)-import Control.Monad (when, forM_)+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 Data.String (IsString (fromString)) import System.Directory (doesFileExist, removeFile) import Text.Printf (printf) @@ -26,31 +26,32 @@ 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 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 "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 "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+ describe "fastlogger 1" $ do+ it "maintains the ordering of log messages" logOrdering tempFile :: FilePath tempFile = "test/temp.txt"@@ -62,13 +63,13 @@ safeForLarge' n = flip finally (cleanup tempFile) $ do cleanup tempFile lgrset <- newFileLoggerSet defaultBufSize tempFile- let xs = toLogStr $ BS.pack $ take (abs n) (cycle ['a'..'z'])+ 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")+ bs `shouldBe` BS.pack (take (abs n) (cycle ['a' .. 'z']) <> "x") cleanup :: FilePath -> IO () cleanup file = do@@ -98,11 +99,11 @@ 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+ 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