fast-logger-0.3.3/0000755000000000000000000000000012176201772012122 5ustar0000000000000000fast-logger-0.3.3/fast-logger.cabal0000644000000000000000000000264112176201772015323 0ustar0000000000000000Name: fast-logger Version: 0.3.3 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 License-File: LICENSE Synopsis: A fast logging system Description: A fast logging system Category: System Cabal-Version: >= 1.8 Build-Type: Simple Library GHC-Options: -Wall Exposed-Modules: System.Log.FastLogger System.Log.FastLogger.File System.Log.FastLogger.Date Build-Depends: base >= 4 && < 5 , blaze-builder , bytestring , date-cache >= 0.3 , directory , filepath , text if os(windows) Cpp-Options: -DWINDOWS Build-Depends: old-locale , time else Build-Depends: unix , unix-time >= 0.2 Test-Suite spec Main-Is: Spec.hs Hs-Source-Dirs: test Type: exitcode-stdio-1.0 Ghc-Options: -Wall Build-Depends: base >= 4 && < 5 , bytestring , fast-logger , hspec Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/logger.git fast-logger-0.3.3/LICENSE0000644000000000000000000000276512176201772013141 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-0.3.3/Setup.hs0000644000000000000000000000005612176201772013557 0ustar0000000000000000import Distribution.Simple main = defaultMain fast-logger-0.3.3/System/0000755000000000000000000000000012176201772013406 5ustar0000000000000000fast-logger-0.3.3/System/Log/0000755000000000000000000000000012176201772014127 5ustar0000000000000000fast-logger-0.3.3/System/Log/FastLogger.hs0000644000000000000000000001503712176201772016526 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude, RecordWildCards #-} {-# LANGUAGE FlexibleInstances, BangPatterns #-} {-# LANGUAGE OverloadedStrings #-} -- | Fast logging system to copy log data directly to Handle buffer. module System.Log.FastLogger ( -- * Logger Logger , mkLogger , mkLogger2 , renewLogger , rmLogger -- * Logging , loggerPutStr , loggerPutBuilder , loggerFlush -- * Strings , LogStr(..) , ToLogStr(..) -- * Date , loggerDate , module System.Log.FastLogger.Date -- * File rotation , module System.Log.FastLogger.File ) where import Blaze.ByteString.Builder import Blaze.ByteString.Builder.Char8 (fromString) import Control.Monad import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString(..), c2w) import Data.List import Data.Maybe import Data.Monoid import Data.Typeable import Foreign hiding (void) import GHC.Base import GHC.IO.Buffer import qualified GHC.IO.BufferedIO as Buffered import qualified GHC.IO.Device as RawIO import GHC.IO.FD import GHC.IO.Handle.Internals import GHC.IO.Handle.Text import GHC.IO.Handle.Types import GHC.IORef import GHC.Num import GHC.Real import System.Date.Cache import System.IO import System.Log.FastLogger.Date import System.Log.FastLogger.File import qualified Data.Text as TS import qualified Data.Text.Encoding as TE import qualified Data.Text.Lazy as TL import qualified Data.ByteString as S import qualified Data.ByteString.Lazy as L -- | Abstract data type for logger. data Logger = Logger { loggerAutoFlush :: Bool , loggerHandle :: Handle , loggerDateGetter :: DateCacheGetter , loggerDateCloser :: DateCacheCloser } logBufSize :: Int logBufSize = 4096 initHandle :: Handle -> IO () initHandle hdl = hSetBuffering hdl (BlockBuffering (Just logBufSize)) -- | Creates a 'Logger' from the given handle. -- ('ondemandDateCacher' 'zonedDateCacheConf') is used as a Date getter. mkLogger :: Bool -- ^ Automatically flush on each loggerPut? -> Handle -- ^ If 'Handle' is associated with a file, 'AppendMode' must be used. -> IO Logger mkLogger autoFlush hdl = ondemandDateCacher zonedDateCacheConf >>= mkLogger2 autoFlush hdl -- | Creates a 'Logger' from the given handle. mkLogger2 :: Bool -- ^ Automatically flush on each loggerPut? -> Handle -- ^ If 'Handle' is associated with a file, 'AppendMode' must be used. -> (DateCacheGetter, DateCacheCloser) -- ^ Date getter/closer. E.g. ('clockDateCacher' 'zonedDateCacheConf') -> IO Logger mkLogger2 autoFlush hdl (getter,closer) = do initHandle hdl return $ Logger autoFlush hdl getter closer -- | Creates a new 'Logger' from old one by replacing 'Handle'. -- The new 'Handle' automatically inherits the file mode of -- the old one. -- The old 'Handle' is automatically closed. renewLogger :: Logger -> Handle -> IO Logger renewLogger logger newhdl = do let oldhdl = loggerHandle logger hFlush oldhdl hClose oldhdl initHandle newhdl return $ logger { loggerHandle = newhdl } -- | Destroy a 'Logger' by closing internal 'Handle'. rmLogger :: Logger -> IO () rmLogger lgr = hClose (loggerHandle lgr) >> loggerDateCloser lgr -- | A date type to contain 'String' and 'ByteString'. -- This data is exported so that format can be defined. -- This would be replaced with 'Builder' someday when -- it can be written directly to 'Handle' buffer. data LogStr = LS !String | LB !ByteString class ToLogStr a where toLogStr :: a -> LogStr instance ToLogStr [Char] where toLogStr = LS instance ToLogStr ByteString where toLogStr = LB instance ToLogStr L.ByteString where toLogStr = LB . S.concat . L.toChunks instance ToLogStr TS.Text where toLogStr = LB . TE.encodeUtf8 instance ToLogStr TL.Text where toLogStr = LB . TE.encodeUtf8 . TL.toStrict hPutLogStr :: Handle -> [LogStr] -> IO () hPutLogStr handle bss = wantWritableHandle "hPutLogStr" handle $ \h_ -> bufsWrite h_ bss -- based on GHC.IO.Handle.Text bufsWrite :: Handle__ -> [LogStr] -> IO () bufsWrite h_@Handle__{..} bss = do old_buf@Buffer{ bufRaw = old_raw , bufR = w , bufSize = size } <- readIORef haByteBuffer if size - w > len then do withRawBuffer old_raw $ \ptr -> go (ptr `plusPtr` w) bss writeIORef haByteBuffer old_buf{ bufR = w + len } else do old_buf' <- Buffered.flushWriteBuffer haDevice old_buf writeIORef haByteBuffer old_buf' if size > len then bufsWrite h_ bss else do let Just fd = cast haDevice :: Maybe FD writeWithBuilder fd bss where len = foldl' (\ !x !y -> x + getLength y) 0 bss getLength (LB s) = BS.length s getLength (LS s) = length s go :: Ptr Word8 -> [LogStr] -> IO () go _ [] = return () go dst (LB b:bs) = do dst' <- copy dst b go dst' bs go dst (LS s:ss) = do dst' <- copy' dst s go dst' ss writeWithBuilder :: FD -> [LogStr] -> IO () writeWithBuilder fd bss = toByteStringIOWith 4096 write builder where write !(PS fp o l) = withForeignPtr fp $ \p -> do void $ RawIO.writeNonBlocking fd (p `plusPtr` o) l builder = foldr mappend mempty $ map toBuilder bss toBuilder (LB s) = fromByteString s toBuilder (LS s) = fromString s copy :: Ptr Word8 -> ByteString -> IO (Ptr Word8) copy dst (PS ptr off len) = withForeignPtr ptr $ \s -> do let !src = s `plusPtr` off _ <- memcpy dst src (fromIntegral len) let !res = dst `plusPtr` len return res copy' :: Ptr Word8 -> String -> IO (Ptr Word8) copy' dst [] = return dst copy' dst (x:xs) = do poke dst (c2w x) copy' (dst `plusPtr` 1) xs -- | The 'hPut' function to copy a list of 'LogStr' to the buffer -- of 'Handle' of 'Logger' directly. loggerPutStr :: Logger -> [LogStr] -> IO () loggerPutStr logger strs = do hPutLogStr hdl strs when autoFlush $ hFlush hdl where hdl = loggerHandle logger autoFlush = loggerAutoFlush logger -- | The 'hPut' function directory to copy 'Builder' to the buffer. -- The current implementation is inefficient at this moment. -- This would replace 'loggerPutStr' someday. loggerPutBuilder :: Logger -> Builder -> IO () loggerPutBuilder logger builder = do loggerPutStr logger . return . LB . toByteString $ builder when autoFlush $ hFlush hdl where hdl = loggerHandle logger autoFlush = loggerAutoFlush logger -- | Flushing the buffer of 'Handle' of 'Logger'. loggerFlush :: Logger -> IO () loggerFlush logger = hFlush $ loggerHandle logger -- | Obtaining date string from 'Logger'. loggerDate :: Logger -> IO ZonedDate loggerDate logger = loggerDateGetter logger fast-logger-0.3.3/System/Log/FastLogger/0000755000000000000000000000000012176201772016164 5ustar0000000000000000fast-logger-0.3.3/System/Log/FastLogger/Date.hs0000644000000000000000000000152612176201772017401 0ustar0000000000000000{-# LANGUAGE CPP, OverloadedStrings #-} module System.Log.FastLogger.Date ( ZonedDate , zonedDateCacheConf ) where import Data.ByteString import System.Date.Cache #if WINDOWS import qualified Data.ByteString.Char8 as BS import Data.Time import System.Locale #else import Data.UnixTime import System.Posix (EpochTime, epochTime) #endif -- | A type for zoned date. type ZonedDate = ByteString #if WINDOWS zonedDateCacheConf :: DateCacheConf UTCTime zonedDateCacheConf = DateCacheConf { getTime = getCurrentTime , formatDate = \ut -> do zt <- utcToLocalZonedTime ut return $ BS.pack $ formatTime defaultTimeLocale "%d/%b/%Y:%T %z" zt } #else zonedDateCacheConf :: DateCacheConf EpochTime zonedDateCacheConf = DateCacheConf { getTime = epochTime , formatDate = formatUnixTime "%d/%b/%Y:%T %z" . fromEpochTime } #endif fast-logger-0.3.3/System/Log/FastLogger/File.hs0000644000000000000000000000223212176201772017376 0ustar0000000000000000module System.Log.FastLogger.File where import Control.Monad import System.Directory import System.FilePath -- | The spec for logging files data FileLogSpec = FileLogSpec { log_file :: String , log_file_size :: Integer , log_backup_number :: Int } -- | Checking if a log file can be written. check :: FileLogSpec -> IO () check spec = 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 file = log_file spec 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-0.3.3/test/0000755000000000000000000000000012176201772013101 5ustar0000000000000000fast-logger-0.3.3/test/Spec.hs0000644000000000000000000000005412176201772014326 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-}