fast-logger-3.1.1/0000755000000000000000000000000007346545000012117 5ustar0000000000000000fast-logger-3.1.1/ChangeLog.md0000644000000000000000000000635507346545000014301 0ustar0000000000000000## 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) fast-logger-3.1.1/LICENSE0000644000000000000000000000276507346545000013136 0ustar0000000000000000Copyright (c) 2009, IIJ Innovation Institute Inc. All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of the copyright holders nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. fast-logger-3.1.1/README.md0000644000000000000000000000004607346545000013376 0ustar0000000000000000## fast-logger A fast logging system fast-logger-3.1.1/Setup.hs0000644000000000000000000000005607346545000013554 0ustar0000000000000000import Distribution.Simple main = defaultMain fast-logger-3.1.1/System/Log/0000755000000000000000000000000007346545000014124 5ustar0000000000000000fast-logger-3.1.1/System/Log/FastLogger.hs0000644000000000000000000002546407346545000016530 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE GADTs #-} -- | This module provides a fast logging system which -- scales on multicore environments (i.e. +RTS -N\). -- -- 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 ( -- * 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 import Control.Concurrent (MVar, newMVar, tryTakeMVar, putMVar) import Control.Exception (handle, SomeException(..), bracket) import System.EasyFile (getFileSize) 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 ---------------------------------------------------------------- -- | 'FastLogger' simply log 'logStr'. type FastLogger = LogStr -> IO () -- | 'TimedFastLogger' pass 'FormattedTime' to callback and simply log its result. -- this can be used to customize how to log timestamp. -- -- Usually, one would write a wrapper on top of 'TimedFastLogger', for example: -- -- > {-# LANGUAGE OverloadedStrings #-} -- > -- > log :: TimedFastLogger -> LogStr -> IO () -- > log logger msg = logger (\time -> toLogStr (show time) <> " " <> msg <> "\n") type TimedFastLogger = (FormattedTime -> LogStr) -> IO () type LogType = LogType' LogStr -- | 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 -- capability. This scales less well on multi-core machines, -- 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 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) -- | '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 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) -- | 'bracket' version of 'newTimeFastLogger' withTimedFastLogger :: IO FormattedTime -> LogType -> (TimedFastLogger -> IO a) -> IO a withTimedFastLogger tgetter typ log' = bracket (newTimedFastLogger tgetter typ) snd (log' . fst) ---------------------------------------------------------------- noOp :: IO () noOp = return () decrease :: IORef Int -> IO Int decrease ref = atomicModifyIORef' ref (\x -> (x - 1, x - 1)) -- updateTime returns whether the timeframe has changed updateTime :: (FormattedTime -> FormattedTime -> Bool) -> IORef FormattedTime -> FormattedTime -> IO Bool updateTime cmp ref newTime = atomicModifyIORef' ref (\x -> (newTime, not $ cmp x newTime)) tryRotate :: LoggerSet -> FileLogSpec -> IORef Int -> MVar () -> IO () tryRotate lgrset spec ref mvar = bracket lock unlock rotateFiles where 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 fast-logger-3.1.1/System/Log/FastLogger/0000755000000000000000000000000007346545000016161 5ustar0000000000000000fast-logger-3.1.1/System/Log/FastLogger/Date.hs0000644000000000000000000000303007346545000017366 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- | -- Formatting time is slow. -- This package provides mechanisms to cache formatted date. module System.Log.FastLogger.Date ( -- * Date cacher newTimeCache , simpleTimeFormat , simpleTimeFormat' ) where import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction) import System.Log.FastLogger.Types (TimeFormat, FormattedTime) import Data.UnixTime (formatUnixTime, fromEpochTime) import System.PosixCompat.Types (EpochTime) import System.PosixCompat.Time (epochTime) ---------------------------------------------------------------- -- | Get date using UnixTime. getTime :: IO EpochTime getTime = epochTime -- | Format unix EpochTime date. formatDate :: TimeFormat -> EpochTime -> IO FormattedTime formatDate fmt = formatUnixTime fmt . fromEpochTime ---------------------------------------------------------------- -- | Make 'IO' action which get cached formatted local time. -- Use this to avoid the cost of frequently time formatting by caching an -- auto updating formatted time, this cache update every 1 second. -- more detail in "Control.AutoUpdate" newTimeCache :: TimeFormat -> IO (IO FormattedTime) newTimeCache fmt = mkAutoUpdate defaultUpdateSettings{ updateAction = getTime >>= formatDate fmt } -- | 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" fast-logger-3.1.1/System/Log/FastLogger/File.hs0000644000000000000000000000603007346545000017373 0ustar0000000000000000{-# LANGUAGE Safe #-} 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.Log.FastLogger.Imports import System.Log.FastLogger.Types (TimeFormat, FormattedTime) -- | 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. } -- | 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 :: FilePath -> IO () check file = do dirExist <- doesDirectoryExist dir unless dirExist $ fail $ dir ++ " does not exist or is not a directory." dirPerm <- getPermissions dir unless (writable dirPerm) $ fail $ dir ++ " is not writable." exist <- doesFileExist file when exist $ do perm <- getPermissions file unless (writable perm) $ fail $ file ++ " is not writable." where dir = takeDirectory file -- | Rotating log files. rotate :: FileLogSpec -> IO () rotate spec = mapM_ move srcdsts where path = log_file spec n = log_backup_number spec dsts' = reverse . ("":) . map (('.':). show) $ [0..n-1] dsts = map (path++) dsts' srcs = tail dsts srcdsts = zip srcs dsts 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 fast-logger-3.1.1/System/Log/FastLogger/FileIO.hs0000644000000000000000000000162107346545000017624 0ustar0000000000000000module 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 fast-logger-3.1.1/System/Log/FastLogger/IO.hs0000644000000000000000000000245207346545000017027 0ustar0000000000000000{-# 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 (mallocBytes, free) 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' fast-logger-3.1.1/System/Log/FastLogger/Imports.hs0000644000000000000000000000105407346545000020152 0ustar0000000000000000{-# 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 fast-logger-3.1.1/System/Log/FastLogger/Internal.hs0000644000000000000000000000076707346545000020303 0ustar0000000000000000-- | -- 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.Logger , module System.Log.FastLogger.LoggerSet ) where import System.Log.FastLogger.IO import System.Log.FastLogger.FileIO import System.Log.FastLogger.LogStr import System.Log.FastLogger.Logger import System.Log.FastLogger.LoggerSet fast-logger-3.1.1/System/Log/FastLogger/LogStr.hs0000644000000000000000000001117707346545000017736 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE Safe #-} 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 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) #endif instance Monoid LogStr where mempty = LogStr 0 (toBuilder BS.empty) {-# INLINE mappend #-} LogStr s1 b1 `mappend` LogStr s2 b2 = LogStr (s1 + s2) (b1 <> b2) instance IsString LogStr where {-# INLINE fromString #-} fromString = toLogStr . TL.pack -- | Types that can be converted to a 'LogStr'. Instances for -- 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 #-} toLogStr = toLogStr . T.encodeUtf8 instance ToLogStr TL.Text where {-# INLINE toLogStr #-} toLogStr = toLogStr . TL.encodeUtf8 -- | @since 2.4.14 instance ToLogStr Int where {-# INLINE toLogStr #-} toLogStr = toLogStr . B.intDec -- | @since 2.4.14 instance ToLogStr Int8 where {-# INLINE toLogStr #-} toLogStr = toLogStr . B.int8Dec -- | @since 2.4.14 instance ToLogStr Int16 where {-# INLINE toLogStr #-} toLogStr = toLogStr . B.int16Dec -- | @since 2.4.14 instance ToLogStr Int32 where {-# INLINE toLogStr #-} toLogStr = toLogStr . B.int32Dec -- | @since 2.4.14 instance ToLogStr Int64 where {-# INLINE toLogStr #-} toLogStr = toLogStr . B.int64Dec -- | @since 2.4.14 instance ToLogStr Word where {-# INLINE toLogStr #-} toLogStr = toLogStr . B.wordDec -- | @since 2.4.14 instance ToLogStr Word8 where {-# INLINE toLogStr #-} toLogStr = toLogStr . B.word8Dec -- | @since 2.4.14 instance ToLogStr Word16 where {-# INLINE toLogStr #-} toLogStr = toLogStr . B.word16Dec -- | @since 2.4.14 instance ToLogStr Word32 where {-# INLINE toLogStr #-} toLogStr = toLogStr . B.word32Dec -- | @since 2.4.14 instance ToLogStr Word64 where {-# INLINE toLogStr #-} toLogStr = toLogStr . B.word64Dec -- | @since 2.4.14 instance ToLogStr Integer where {-# INLINE toLogStr #-} toLogStr = toLogStr . B.integerDec -- | @since 2.4.14 instance ToLogStr Float where {-# INLINE toLogStr #-} toLogStr = toLogStr . B.floatDec -- | @since 2.4.14 instance ToLogStr Double where {-# INLINE toLogStr #-} toLogStr = toLogStr . B.doubleDec instance Show LogStr where 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 fast-logger-3.1.1/System/Log/FastLogger/Logger.hs0000644000000000000000000000575607346545000017751 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} module System.Log.FastLogger.Logger ( Logger(..) , newLogger , pushLog , flushLog ) where import Control.Concurrent (MVar, withMVar) 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 ---------------------------------------------------------------- newtype Logger = Logger (IORef LogStr) ---------------------------------------------------------------- newLogger :: IO Logger newLogger = Logger <$> newIORef mempty ---------------------------------------------------------------- pushLog :: IORef FD -> BufSize -> MVar Buffer -> Logger -> LogStr -> IO () pushLog fdref size mbuf logger@(Logger ref) nlogmsg@(LogStr nlen nbuilder) | nlen > size = do flushLog fdref size mbuf 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. allocaBytes nlen $ \buf -> withMVar mbuf $ \_ -> toBufIOWith buf nlen (write fdref) nbuilder | otherwise = do mmsg <- atomicModifyIORef' ref checkBuf case mmsg of Nothing -> return () Just msg -> withMVar mbuf $ \buf -> writeLogStr fdref buf size msg where checkBuf ologmsg@(LogStr olen _) | size < olen + nlen = (nlogmsg, Just ologmsg) | otherwise = (ologmsg <> nlogmsg, Nothing) ---------------------------------------------------------------- flushLog :: IORef FD -> BufSize -> MVar Buffer -> Logger -> IO () flushLog fdref size mbuf (Logger lref) = do logmsg <- atomicModifyIORef' lref (\old -> (mempty, old)) -- If a special buffer is prepared for flusher, this MVar could -- be removed. But such a code does not contribute logging speed -- according to experiment. And even with the special buffer, -- there is no grantee that this function is exclusively called -- for a buffer. So, we use MVar here. -- This is safe and speed penalty can be ignored. withMVar mbuf $ \buf -> writeLogStr fdref buf size logmsg ---------------------------------------------------------------- -- | Writting 'LogStr' using a buffer in blocking mode. -- The size of 'LogStr' must be smaller or equal to -- the size of buffer. writeLogStr :: IORef FD -> Buffer -> BufSize -> LogStr -> IO () writeLogStr fdref buf size (LogStr len builder) | size < len = error "writeLogStr" | otherwise = toBufIOWith buf size (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) fast-logger-3.1.1/System/Log/FastLogger/LoggerSet.hs0000644000000000000000000001473007346545000020415 0ustar0000000000000000{-# LANGUAGE OverloadedStrings #-} 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 (MVar, getNumCapabilities, myThreadId, threadCapability, takeMVar, newMVar) import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceAction) import Data.Array (Array, listArray, (!), bounds) import System.Log.FastLogger.FileIO import System.Log.FastLogger.IO import System.Log.FastLogger.Imports import System.Log.FastLogger.LogStr import System.Log.FastLogger.Logger ---------------------------------------------------------------- -- | A set of loggers. -- The number of loggers is the capabilities of GHC RTS. -- You can specify it with \"+RTS -N\\". -- A buffer is prepared for each capability. data LoggerSet = LoggerSet (Maybe FilePath) (IORef FD) BufSize (MVar Buffer) (Array Int Logger) (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 loggers <- replicateM n newLogger let arr = listArray (0,n-1) loggers fref <- newIORef fd let bufsiz = max 1 size mbuf <- getBuffer bufsiz >>= newMVar flush <- mkDebounce defaultDebounceSettings { debounceAction = flushLogStrRaw fref bufsiz mbuf arr } return $ LoggerSet mfile fref bufsiz mbuf arr flush -- | Writing a log message to the corresponding buffer. -- If the buffer becomes full, the log messages in the buffer -- are written to its corresponding file, stdout, or stderr. pushLogStr :: LoggerSet -> LogStr -> IO () pushLogStr (LoggerSet _ fdref size mbuf arr flush) logmsg = do (i, _) <- myThreadId >>= threadCapability -- The number of capability could be dynamically changed. -- So, let's check the upper boundary of the array. let u = snd $ bounds arr lim = u + 1 j | i < lim = i | otherwise = i `mod` lim let logger = arr ! j pushLog fdref size mbuf logger logmsg flush -- | Same as 'pushLogStr' but also appends a newline. pushLogStrLn :: LoggerSet -> LogStr -> IO () pushLogStrLn loggerSet logStr = pushLogStr loggerSet (logStr <> "\n") -- | Flushing log messages in buffers. -- This function must be called explicitly when the program is -- being terminated. -- -- Note: Since version 2.1.6, this function does not need to be -- explicitly called, as every push includes an auto-debounced flush -- courtesy of the auto-update package. Since version 2.2.2, this -- function can be used to force flushing outside of the debounced -- flush calls. flushLogStr :: LoggerSet -> IO () flushLogStr (LoggerSet _ fref size mbuf arr _) = flushLogStrRaw fref size mbuf arr flushLogStrRaw :: IORef FD -> BufSize -> MVar Buffer -> Array Int Logger -> IO () flushLogStrRaw fdref size mbuf arr = do let (l,u) = bounds arr mapM_ flushIt [l .. u] where flushIt i = flushLog fdref size mbuf (arr ! i) -- | Renewing the internal file information in 'LoggerSet'. -- This does nothing for stdout and stderr. renewLoggerSet :: LoggerSet -> IO () renewLoggerSet (LoggerSet Nothing _ _ _ _ _) = return () renewLoggerSet (LoggerSet (Just file) fref _ _ _ _) = do newfd <- openFileFD file oldfd <- atomicModifyIORef' fref (\fd -> (newfd, fd)) closeFD oldfd -- | Flushing the buffers, closing the internal file information -- and freeing the buffers. rmLoggerSet :: LoggerSet -> IO () rmLoggerSet (LoggerSet mfile fdref size mbuf arr _) = do fd <- readIORef fdref when (isFDValid fd) $ do let (l,u) = bounds arr let nums = [l .. u] mapM_ flushIt nums takeMVar mbuf >>= freeBuffer when (isJust mfile) $ closeFD fd writeIORef fdref invalidFD where flushIt i = flushLog fdref size mbuf(arr ! i) -- | Replacing the file path in 'LoggerSet' and returning a new -- 'LoggerSet' and the old file path. replaceLoggerSet :: LoggerSet -> FilePath -> (LoggerSet, Maybe FilePath) replaceLoggerSet (LoggerSet current_path a b c d e) new_file_path = (LoggerSet (Just new_file_path) a b c d e, current_path) fast-logger-3.1.1/System/Log/FastLogger/Types.hs0000644000000000000000000000047007346545000017622 0ustar0000000000000000module 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 fast-logger-3.1.1/fast-logger.cabal0000644000000000000000000000453607346545000015325 0ustar0000000000000000Name: fast-logger Version: 3.1.1 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE Synopsis: A fast logging system Description: A fast logging system for Haskell Homepage: https://github.com/kazu-yamamoto/logger Category: System Cabal-Version: >= 1.10 Build-Type: Simple Extra-Source-Files: README.md ChangeLog.md Tested-With: GHC ==7.8.4 || ==7.10.3 || ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.3 Library Default-Language: Haskell2010 GHC-Options: -Wall 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 Other-Modules: System.Log.FastLogger.Imports System.Log.FastLogger.IO System.Log.FastLogger.FileIO System.Log.FastLogger.LogStr System.Log.FastLogger.Logger Build-Depends: base >= 4.9 && < 5 , array , auto-update >= 0.1.2 , easy-file >= 0.2 , bytestring >= 0.10.4 , directory , filepath , text , unix-time >= 0.4.4 , unix-compat if impl(ghc < 7.8) Build-Depends: bytestring-builder if impl(ghc >= 8) Default-Extensions: Strict StrictData Test-Suite spec Main-Is: Spec.hs Hs-Source-Dirs: test Default-Language: Haskell2010 Type: exitcode-stdio-1.0 Ghc-Options: -Wall -threaded Other-Modules: FastLoggerSpec Build-Tools: hspec-discover >= 2.6 Build-Depends: base >= 4 && < 5 , bytestring >= 0.10.4 , directory , fast-logger , hspec if impl(ghc >= 8) Default-Extensions: Strict StrictData Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/logger.git fast-logger-3.1.1/test/0000755000000000000000000000000007346545000013076 5ustar0000000000000000fast-logger-3.1.1/test/FastLoggerSpec.hs0000644000000000000000000000453607346545000016312 0ustar0000000000000000{-# LANGUAGE OverloadedStrings, BangPatterns, CPP #-} module FastLoggerSpec where #if __GLASGOW_HASKELL__ < 709 import Control.Applicative ((<$>)) #endif import Control.Exception (finally) import Control.Monad (when) import qualified Data.ByteString.Char8 as BS import Data.Monoid ((<>)) import Data.String (IsString(fromString)) import System.Directory (doesFileExist, removeFile) import System.Log.FastLogger import Test.Hspec import Test.Hspec.QuickCheck (prop) 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 nullLogger :: IO LoggerSet #ifdef mingw32_HOST_OS nullLogger = newFileLoggerSet 4096 "nul" #else nullLogger = newFileLoggerSet 4096 "/dev/null" #endif safeForLarge :: [Int] -> IO () safeForLarge ns = mapM_ safeForLarge' ns safeForLarge' :: Int -> IO () safeForLarge' n = flip finally (cleanup tmpfile) $ do cleanup tmpfile lgrset <- newFileLoggerSet defaultBufSize tmpfile let xs = toLogStr $ BS.pack $ take (abs n) (cycle ['a'..'z']) lf = "x" pushLogStr lgrset $ xs <> lf flushLogStr lgrset rmLoggerSet lgrset bs <- BS.readFile tmpfile bs `shouldBe` BS.pack (take (abs n) (cycle ['a'..'z']) <> "x") where tmpfile = "test/temp" cleanup :: FilePath -> IO () cleanup file = do exist <- doesFileExist file when exist $ removeFile file logAllMsgs :: IO () logAllMsgs = logAll "LICENSE" `finally` cleanup tmpfile where tmpfile = "test/temp" logAll file = do cleanup tmpfile lgrset <- newFileLoggerSet 512 tmpfile src <- BS.readFile file let bs = (<> "\n") . toLogStr <$> BS.lines src mapM_ (pushLogStr lgrset) bs flushLogStr lgrset rmLoggerSet lgrset dst <- BS.readFile tmpfile dst `shouldBe` src fast-logger-3.1.1/test/Spec.hs0000644000000000000000000000005407346545000014323 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-}