fast-logger-2.4.7/0000755000000000000000000000000012773072710012132 5ustar0000000000000000fast-logger-2.4.7/ChangeLog.md0000644000000000000000000000207112773072710014303 0ustar0000000000000000## 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 ewTimedFastLogger. * 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-2.4.7/fast-logger.cabal0000644000000000000000000000365612773072710015342 0ustar0000000000000000Name: fast-logger Version: 2.4.7 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE Synopsis: A fast logging system Description: A fast logging system Homepage: https://github.com/kazu-yamamoto/logger Category: System Cabal-Version: >= 1.8 Build-Type: Simple extra-source-files: README.md ChangeLog.md Library GHC-Options: -Wall Exposed-Modules: System.Log.FastLogger System.Log.FastLogger.File System.Log.FastLogger.Date Other-Modules: System.Log.FastLogger.IO System.Log.FastLogger.FileIO System.Log.FastLogger.IORef System.Log.FastLogger.LogStr System.Log.FastLogger.Logger Build-Depends: base >= 4.5 && < 5 , array , auto-update >= 0.1.2 , easy-file >= 0.2 , bytestring , bytestring-builder , directory , filepath , text if os(windows) Cpp-Options: -DWINDOWS Build-Depends: time , Win32 , old-locale else Build-Depends: unix , unix-time >= 0.2.2 Test-Suite spec Main-Is: Spec.hs Hs-Source-Dirs: test Type: exitcode-stdio-1.0 Ghc-Options: -Wall -threaded Build-Depends: base >= 4 && < 5 , bytestring , directory , fast-logger , hspec Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/logger.git fast-logger-2.4.7/LICENSE0000644000000000000000000000276512773072710013151 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-2.4.7/README.md0000644000000000000000000000004612773072710013411 0ustar0000000000000000## fast-logger A fast logging system fast-logger-2.4.7/Setup.hs0000644000000000000000000000005612773072710013567 0ustar0000000000000000import Distribution.Simple main = defaultMain fast-logger-2.4.7/System/0000755000000000000000000000000012773072710013416 5ustar0000000000000000fast-logger-2.4.7/System/Log/0000755000000000000000000000000012773072710014137 5ustar0000000000000000fast-logger-2.4.7/System/Log/FastLogger.hs0000644000000000000000000002626612773072710016544 0ustar0000000000000000-- | This module provides a fast logging system which -- scales on multicore environments (i.e. +RTS -N\). {-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module System.Log.FastLogger ( -- * Creating a logger set LoggerSet , newFileLoggerSet , newStdoutLoggerSet , newStderrLoggerSet , newLoggerSet -- * Buffer size , BufSize , defaultBufSize -- * Renewing and removing a logger set , renewLoggerSet , rmLoggerSet -- * Log messages , LogStr , ToLogStr(..) , fromLogStr , logStrLength -- * Writing a log message , pushLogStr , pushLogStrLn -- * Flushing buffered log messages , flushLogStr -- * FastLogger , FastLogger , TimedFastLogger , LogType(..) , newFastLogger , withFastLogger , newTimedFastLogger , withTimedFastLogger -- * Date cache , module System.Log.FastLogger.Date -- * File rotation , module System.Log.FastLogger.File ) where #if __GLASGOW_HASKELL__ < 709 import Control.Applicative ((<$>)) #endif import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceAction) import Control.Concurrent (getNumCapabilities, myThreadId, threadCapability, takeMVar, MVar, newMVar, tryTakeMVar, putMVar) import Control.Exception (handle, SomeException(..), bracket) import Control.Monad (when, replicateM) import Data.Array (Array, listArray, (!), bounds) import Data.Maybe (isJust) import System.EasyFile (getFileSize) import System.Log.FastLogger.File import System.Log.FastLogger.IO import System.Log.FastLogger.FileIO import System.Log.FastLogger.IORef import System.Log.FastLogger.LogStr import System.Log.FastLogger.Logger import System.Log.FastLogger.Date ---------------------------------------------------------------- -- | 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) (Array Int Logger) (IO ()) -- | Creating a new 'LoggerSet' using a file. newFileLoggerSet :: BufSize -> FilePath -> IO LoggerSet newFileLoggerSet size file = openFileFD file >>= newFDLoggerSet size (Just file) -- | Creating a new 'LoggerSet' using stdout. newStdoutLoggerSet :: BufSize -> IO LoggerSet newStdoutLoggerSet size = getStdoutFD >>= newFDLoggerSet size Nothing -- | Creating a new 'LoggerSet' using stderr. newStderrLoggerSet :: BufSize -> IO LoggerSet newStderrLoggerSet size = getStderrFD >>= newFDLoggerSet size 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 FilePath -> IO LoggerSet newLoggerSet size = maybe (newStdoutLoggerSet size) (newFileLoggerSet size) -- | Creating a new 'LoggerSet' using a FD. newFDLoggerSet :: BufSize -> Maybe FilePath -> FD -> IO LoggerSet newFDLoggerSet size mfile fd = do n <- getNumCapabilities loggers <- replicateM n $ newLogger (max 1 size) let arr = listArray (0,n-1) loggers fref <- newIORef fd flush <- mkDebounce defaultDebounceSettings { debounceAction = flushLogStrRaw fref arr } return $ LoggerSet mfile fref 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 _ fref arr flush) logmsg = do (i, _) <- myThreadId >>= threadCapability -- The number of capability could be dynamically changed. -- So, let's check the upper boundary of the array. let u = snd $ bounds arr lim = u + 1 j | i < lim = i | otherwise = i `mod` lim let logger = arr ! j fd <- readIORef fref pushLog fd logger logmsg flush -- | 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 arr _) = flushLogStrRaw fref arr flushLogStrRaw :: IORef FD -> Array Int Logger -> IO () flushLogStrRaw fref arr = do let (l,u) = bounds arr fd <- readIORef fref mapM_ (flushIt fd) [l .. u] where flushIt fd i = flushLog fd (arr ! i) -- | Renewing the internal file information in 'LoggerSet'. -- This does nothing for stdout and stderr. renewLoggerSet :: LoggerSet -> IO () renewLoggerSet (LoggerSet Nothing _ _ _) = return () renewLoggerSet (LoggerSet (Just file) fref _ _) = do newfd <- 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 fref arr _) = do let (l,u) = bounds arr fd <- readIORef fref let nums = [l .. u] mapM_ (flushIt fd) nums mapM_ freeIt nums when (isJust mfile) $ closeFD fd where flushIt fd i = flushLog fd (arr ! i) freeIt i = do let (Logger mbuf _ _) = arr ! i takeMVar mbuf >>= freeBuffer ---------------------------------------------------------------- -- | 'FastLogger' simply log 'logStr'. type FastLogger = LogStr -> IO () -- | 'TimedFastLogger' pass 'FormattedTime' to callback and simply log its result. -- this can be used to customize how to log timestamp. type TimedFastLogger = (FormattedTime -> LogStr) -> IO () -- | Logger Type. data LogType = LogNone -- ^ No logging. | LogStdout BufSize -- ^ Logging to stdout. -- 'BufSize' is a buffer size | LogStderr BufSize -- ^ Logging to stdout. -- 'BufSize' is a buffer size -- for each capability. | LogFileNoRotate FilePath BufSize -- ^ Logging to a file. -- 'BufSize' is a buffer size -- for each capability. | LogFile FileLogSpec BufSize -- ^ Logging to a file. -- 'BufSize' is a buffer size -- for each capability. -- File rotation is done on-demand. | LogCallback (LogStr -> IO ()) (IO ()) -- ^ Logging with a log and flush action. -- run flush after log each message. -- | Initialize a 'FastLogger' without attaching timestamp -- a tuple of logger and clean up action are returned. newFastLogger :: LogType -> IO (FastLogger, IO ()) newFastLogger typ = case typ of LogNone -> return (const noOp, noOp) LogStdout bsize -> newStdoutLoggerSet bsize >>= stdLoggerInit LogStderr bsize -> newStderrLoggerSet bsize >>= stdLoggerInit LogFileNoRotate fp bsize -> newFileLoggerSet bsize fp >>= fileLoggerInit LogFile fspec bsize -> rotateLoggerInit 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 <- newFileLoggerSet bsize $ log_file fspec ref <- newIORef (0 :: Int) mvar <- newMVar () let logger str = do cnt <- decrease ref pushLogStr lgrset str when (cnt <= 0) $ tryRotate lgrset fspec ref mvar return (logger, rmLoggerSet lgrset) -- | 'bracket' version of 'newFastLogger' withFastLogger :: LogType -> (FastLogger -> IO a) -> IO 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 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) -- | '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)) 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) fast-logger-2.4.7/System/Log/FastLogger/0000755000000000000000000000000012773072710016174 5ustar0000000000000000fast-logger-2.4.7/System/Log/FastLogger/Date.hs0000644000000000000000000000435212773072710017411 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} -- | -- Formatting time is slow. -- This package provides mechanisms to cache formatted date. module System.Log.FastLogger.Date ( -- * Types TimeFormat , FormattedTime -- * Date cacher , newTimeCache , simpleTimeFormat , simpleTimeFormat' ) where import Control.AutoUpdate (mkAutoUpdate, defaultUpdateSettings, updateAction) import Data.ByteString (ByteString) #if WINDOWS import qualified Data.ByteString.Char8 as BS import Data.Time (UTCTime, formatTime, getCurrentTime, utcToLocalZonedTime) # if MIN_VERSION_time(1,5,0) import Data.Time (defaultTimeLocale) # else import System.Locale (defaultTimeLocale) # endif #else import Data.UnixTime (formatUnixTime, fromEpochTime) import System.Posix (EpochTime, epochTime) #endif ---------------------------------------------------------------- -- | Type aliaes for date format and formatted date. type FormattedTime = ByteString type TimeFormat = ByteString ---------------------------------------------------------------- #if WINDOWS -- | Get date using UTC. getTime :: IO UTCTime getTime = getCurrentTime -- | Format UTC date. formatDate :: TimeFormat -> UTCTime -> IO FormattedTime formatDate fmt ut = do zt <- utcToLocalZonedTime ut return $ BS.pack $ formatTime defaultTimeLocale (BS.unpack fmt) zt #else -- | Get date using UnixTime. getTime :: IO EpochTime getTime = epochTime -- | Format unix EpochTime date. formatDate :: TimeFormat -> EpochTime -> IO FormattedTime formatDate fmt = formatUnixTime fmt . fromEpochTime #endif ---------------------------------------------------------------- -- | Make 'IO' action which get cached formatted local time. -- Use this to avoid the cost of frequently time formatting by caching an -- auto updating formatted time, this cache update every 1 second. -- more detail in "Control.AutoUpdate" newTimeCache :: TimeFormat -> IO (IO FormattedTime) newTimeCache fmt = mkAutoUpdate defaultUpdateSettings{ updateAction = getTime >>= formatDate fmt } -- | A simple time cache using format @"%d/%b/%Y:%T %z"@ simpleTimeFormat :: TimeFormat simpleTimeFormat = "%d/%b/%Y:%T %z" -- | A simple time cache using format @"%d-%b-%Y %T"@ simpleTimeFormat' :: TimeFormat simpleTimeFormat' = "%d-%b-%Y %T" fast-logger-2.4.7/System/Log/FastLogger/File.hs0000644000000000000000000000262312773072710017412 0ustar0000000000000000{-# LANGUAGE Safe #-} module System.Log.FastLogger.File where import Control.Monad (unless, when) import System.Directory (doesFileExist, doesDirectoryExist, getPermissions, writable, renameFile) import System.FilePath (takeDirectory) -- | 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. } -- | 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 fast-logger-2.4.7/System/Log/FastLogger/FileIO.hs0000644000000000000000000000322212773072710017636 0ustar0000000000000000{-# LANGUAGE CPP #-} module System.Log.FastLogger.FileIO where import Foreign.Ptr (Ptr) import Data.Word (Word8) #ifdef mingw32_HOST_OS import System.Win32.Types (HANDLE, UINT) import System.Win32.File import Graphics.Win32.Misc (getStdHandle, sTD_OUTPUT_HANDLE, sTD_ERROR_HANDLE) import Data.Bits ((.|.)) type FD = HANDLE -- This flag is not defined in System.Win32.File fILE_APPEND_DATA :: UINT fILE_APPEND_DATA = 0x0004 closeFD :: FD -> IO () closeFD = closeHandle openFileFD :: FilePath -> IO FD openFileFD f = createFile f fILE_APPEND_DATA (fILE_SHARE_READ .|. fILE_SHARE_DELETE) Nothing oPEN_ALWAYS fILE_ATTRIBUTE_NORMAL Nothing getStderrFD :: IO FD getStderrFD = getStdHandle sTD_ERROR_HANDLE getStdoutFD :: IO FD getStdoutFD = getStdHandle sTD_OUTPUT_HANDLE writeRawBufferPtr2FD :: FD -> Ptr Word8 -> Int -> IO Int writeRawBufferPtr2FD h bf len = fromIntegral `fmap` win32_WriteFile h bf (fromIntegral len) Nothing #else import GHC.IO.Device (close) import qualified GHC.IO.FD as POSIX (FD(..)) import GHC.IO.FD (openFile, stderr, stdout, writeRawBufferPtr) import GHC.IO.IOMode (IOMode(..)) type FD = POSIX.FD closeFD :: FD -> IO () closeFD = close openFileFD :: FilePath -> IO FD openFileFD f = fst `fmap` openFile f AppendMode False getStderrFD :: IO FD getStderrFD = return stderr getStdoutFD :: IO FD getStdoutFD = return stdout writeRawBufferPtr2FD :: FD -> Ptr Word8 -> Int -> IO Int writeRawBufferPtr2FD fd bf len = fromIntegral `fmap` writeRawBufferPtr "write" fd bf 0 (fromIntegral len) #endif fast-logger-2.4.7/System/Log/FastLogger/IO.hs0000644000000000000000000000242512773072710017042 0ustar0000000000000000{-# LANGUAGE BangPatterns #-} {-# LANGUAGE Trustworthy #-} module System.Log.FastLogger.IO where import Data.ByteString.Builder.Extra (Next(..)) import qualified Data.ByteString.Builder.Extra as BBE import Data.ByteString.Internal (ByteString(..)) import Data.Word (Word8) import Foreign.ForeignPtr (withForeignPtr) import Foreign.Marshal.Alloc (mallocBytes, free) import Foreign.Ptr (Ptr, plusPtr) 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-2.4.7/System/Log/FastLogger/IORef.hs0000644000000000000000000000070512773072710017476 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE Safe #-} module System.Log.FastLogger.IORef ( IORef , newIORef , readIORef , atomicModifyIORef' , writeIORef ) where import Data.IORef #if !MIN_VERSION_base(4, 6, 0) atomicModifyIORef' :: IORef a -> (a -> (a,b)) -> IO b atomicModifyIORef' ref f = do b <- atomicModifyIORef ref (\x -> let (a, b) = f x in (a, a `seq` b)) b `seq` return b #endif fast-logger-2.4.7/System/Log/FastLogger/Logger.hs0000644000000000000000000000603012773072710017746 0ustar0000000000000000{-# LANGUAGE BangPatterns, CPP #-} {-# LANGUAGE Safe #-} module System.Log.FastLogger.Logger ( Logger(..) , newLogger , pushLog , flushLog ) where import Control.Concurrent (MVar, newMVar, withMVar) import Control.Monad (when) import Foreign.Marshal.Alloc (allocaBytes) import Foreign.Ptr (plusPtr) import System.Log.FastLogger.FileIO import System.Log.FastLogger.IO import System.Log.FastLogger.LogStr import System.Log.FastLogger.IORef ---------------------------------------------------------------- data Logger = Logger (MVar Buffer) !BufSize (IORef LogStr) ---------------------------------------------------------------- newLogger :: BufSize -> IO Logger newLogger size = do buf <- getBuffer size mbuf <- newMVar buf lref <- newIORef mempty return $ Logger mbuf size lref ---------------------------------------------------------------- pushLog :: FD -> Logger -> LogStr -> IO () pushLog fd logger@(Logger mbuf size ref) nlogmsg@(LogStr nlen nbuilder) | nlen > size = do flushLog fd logger -- 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 fd) nbuilder | otherwise = do mmsg <- atomicModifyIORef' ref checkBuf case mmsg of Nothing -> return () Just msg -> withMVar mbuf $ \buf -> writeLogStr fd buf size msg where checkBuf ologmsg@(LogStr olen _) | size < olen + nlen = (nlogmsg, Just ologmsg) | otherwise = (ologmsg <> nlogmsg, Nothing) ---------------------------------------------------------------- flushLog :: FD -> Logger -> IO () flushLog fd (Logger mbuf size lref) = do logmsg <- atomicModifyIORef' lref (\old -> (mempty, old)) -- If a special buffer is prepared for flusher, this MVar could -- be removed. But such a code does not contribute logging speed -- according to experiment. And even with the special buffer, -- there is no grantee that this function is exclusively called -- for a buffer. So, we use MVar here. -- This is safe and speed penalty can be ignored. withMVar mbuf $ \buf -> writeLogStr fd buf size logmsg ---------------------------------------------------------------- -- | Writting 'LogStr' using a buffer in blocking mode. -- The size of 'LogStr' must be smaller or equal to -- the size of buffer. writeLogStr :: FD -> Buffer -> BufSize -> LogStr -> IO () writeLogStr fd buf size (LogStr len builder) | size < len = error "writeLogStr" | otherwise = toBufIOWith buf size (write fd) builder write :: FD -> Buffer -> Int -> IO () write fd buf len' = loop buf (fromIntegral len') where loop bf !len = do written <- writeRawBufferPtr2FD fd bf len when (written < len) $ loop (bf `plusPtr` fromIntegral written) (len - written) fast-logger-2.4.7/System/Log/FastLogger/LogStr.hs0000644000000000000000000000441412773072710017745 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE Safe #-} module System.Log.FastLogger.LogStr ( Builder , LogStr(..) , logStrLength , fromLogStr , ToLogStr(..) , mempty , (<>) ) where import Data.ByteString.Builder (Builder) import qualified Data.ByteString.Builder as B import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Char8 as S8 import qualified Data.ByteString.Lazy as BL #if __GLASGOW_HASKELL__ < 709 import Data.Monoid (Monoid, mempty, mappend) #endif #if MIN_VERSION_base(4,5,0) import Data.Monoid ((<>)) #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 ---------------------------------------------------------------- #if !MIN_VERSION_base(4,5,0) (<>) :: Monoid m => m -> m -> m (<>) = mappend #endif 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 instance Monoid LogStr where mempty = LogStr 0 (toBuilder BS.empty) LogStr s1 b1 `mappend` LogStr s2 b2 = LogStr (s1 + s2) (b1 <> b2) instance IsString LogStr where fromString = toLogStr . TL.pack class ToLogStr msg where toLogStr :: msg -> LogStr instance ToLogStr LogStr where toLogStr = id instance ToLogStr S8.ByteString where toLogStr bs = LogStr (BS.length bs) (toBuilder bs) instance ToLogStr BL.ByteString where toLogStr = toLogStr . S8.concat . BL.toChunks instance ToLogStr String where toLogStr = toLogStr . TL.pack instance ToLogStr T.Text where toLogStr = toLogStr . T.encodeUtf8 instance ToLogStr TL.Text where toLogStr = toLogStr . TL.encodeUtf8 -- | 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-2.4.7/test/0000755000000000000000000000000012773072710013111 5ustar0000000000000000fast-logger-2.4.7/test/Spec.hs0000644000000000000000000000005412773072710014336 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-}