diff --git a/System/Log/FastLogger.hs b/System/Log/FastLogger.hs --- a/System/Log/FastLogger.hs +++ b/System/Log/FastLogger.hs @@ -1,20 +1,29 @@ -{-# LANGUAGE DoAndIfThenElse, NoImplicitPrelude, RecordWildCards #-} +{-# LANGUAGE NoImplicitPrelude, RecordWildCards #-} +{-# LANGUAGE FlexibleInstances #-} -- | Fast logging system to copy log data directly to Handle buffer. module System.Log.FastLogger ( - -- * Initialization - initHandle + -- * Logger + Logger + , mkLogger + , renewLogger -- * Logging + , loggerPutStr + , loggerPutBuilder + , loggerFlush + -- * Strings , LogStr(..) - , hPutLogStr - -- * Builder - , hPutBuilder + , ToLogStr(..) + -- * Misc functions + , loggerDate -- * File rotation , module System.Log.FastLogger.File ) where import Blaze.ByteString.Builder +import Control.Applicative +import Control.Monad import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString(..), c2w) import Data.List @@ -33,24 +42,61 @@ import GHC.Num import GHC.Real import System.IO +import System.Log.FastLogger.Date import System.Log.FastLogger.File -{-| Setting a proper buffering to 'Handle'. --} +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 + , loggerDateRef :: DateRef + } + +logBufSize :: Int +logBufSize = 4096 + initHandle :: Handle -> IO () -initHandle hdl = hSetBuffering hdl (BlockBuffering (Just 4096)) +initHandle hdl = hSetBuffering hdl (BlockBuffering (Just logBufSize)) -{-| 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. --} +-- | Creates a 'Logger' from the given handle. +mkLogger :: Bool -- ^ Automatically flush on each loggerPut? + -> Handle -- ^ If 'Handle' is associated with a file, 'AppendMode' must be used. + -> IO Logger +mkLogger autoFlush hdl = do + initHandle hdl + Logger autoFlush hdl <$> dateInit + +-- | 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 } + +-- | 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 -{-| The 'hPut' function to copy a list of 'LogStr' to the buffer - of 'Handle' directly. - If 'Handle' is associated with a file, 'AppendMode' must be used. --} +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 @@ -68,15 +114,15 @@ withRawBuffer old_raw $ \ptr -> go (ptr `plusPtr` w) bss writeIORef haByteBuffer old_buf{ bufR = w + len } - else do + else do old_buf' <- Buffered.flushWriteBuffer haDevice old_buf writeIORef haByteBuffer old_buf' if size > len then bufsWrite h_ bss - else allocaBytes size $ \ptr -> do + else allocaBytes size $ \ptr -> do go ptr bss let Just fd = cast haDevice :: Maybe FD - RawIO.writeNonBlocking fd ptr size + _ <- RawIO.writeNonBlocking fd ptr size return () where len = foldl' (\x y -> x + getLength y) 0 bss @@ -94,7 +140,7 @@ 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) + _ <- memcpy dst src (fromIntegral len) return (dst `plusPtr` len) copy' :: Ptr Word8 -> String -> IO (Ptr Word8) @@ -103,11 +149,31 @@ poke dst (c2w x) copy' (dst `plusPtr` 1) xs -{-| The 'hPut' function directory to copy 'Builder' to the buffer. - If 'Handle' is associated with a file, 'AppendMode' must be used. - The current implementation is inefficient at this moment. - 'initHandle' must be called once beforehand if this function is used. - This would replace 'hPutLogStr' someday. --} -hPutBuilder :: Handle -> Builder -> IO () -hPutBuilder hdl = BS.hPut hdl . toByteString +-- | 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 = getDate $ loggerDateRef logger diff --git a/System/Log/FastLogger/Date.hs b/System/Log/FastLogger/Date.hs new file mode 100644 --- /dev/null +++ b/System/Log/FastLogger/Date.hs @@ -0,0 +1,63 @@ +{-# LANGUAGE CPP #-} + +module System.Log.FastLogger.Date ( + ZonedDate + , DateRef + , dateInit + , getDate + ) where + +import Control.Applicative +import Data.ByteString (ByteString) +import qualified Data.ByteString.Char8 as BS +import Data.IORef +import Data.Time +import System.Locale +#if WINDOWS +#define TIME UTCTime +#define GETTIME getCurrentTime +#else +import System.Posix (EpochTime, epochTime) +import Data.Time.Clock.POSIX +#define TIME EpochTime +#define GETTIME epochTime +#endif + +-- | A type for zoned date. +type ZonedDate = ByteString + +data DateCache = DateCache { + unixTime :: !TIME + , zonedDate :: !ZonedDate + } + +-- | Reference to the 'ZonedDate' cache. +newtype DateRef = DateRef (IORef DateCache) + +-- | Getting 'ZonedDate' from the 'ZonedDate' cache. +getDate :: DateRef -> IO ZonedDate +getDate (DateRef ref) = do + newEt <- GETTIME + cache <- readIORef ref + let oldEt = unixTime cache + if oldEt == newEt then + return $ zonedDate cache + else do + newCache <- newDate newEt + writeIORef ref newCache + return $ zonedDate newCache + +newDate :: TIME -> IO DateCache +newDate et = DateCache et . format <$> toZonedTime et + where + toZonedTime = utcToLocalZonedTime . toUTC +#if WINDOWS + toUTC = id +#else + toUTC = posixSecondsToUTCTime . realToFrac +#endif + format = BS.pack . formatTime defaultTimeLocale "%d/%b/%Y:%T %z" + +-- | Initializing the 'ZonedDate' cache. +dateInit :: IO DateRef +dateInit = DateRef <$> (GETTIME >>= newDate >>= newIORef) diff --git a/fast-logger.cabal b/fast-logger.cabal --- a/fast-logger.cabal +++ b/fast-logger.cabal @@ -1,5 +1,5 @@ Name: fast-logger -Version: 0.0.2 +Version: 0.2.0 Author: Kazu Yamamoto Maintainer: Kazu Yamamoto License: BSD3 @@ -10,11 +10,22 @@ Cabal-Version: >= 1.6 Build-Type: Simple library - GHC-Options: -Wall -fno-warn-unused-do-bind + GHC-Options: -Wall Exposed-Modules: System.Log.FastLogger System.Log.FastLogger.File - Build-Depends: base >= 4 && < 5, - filepath, directory, bytestring, blaze-builder + System.Log.FastLogger.Date + Build-Depends: base >= 4 && < 5 + , blaze-builder + , bytestring + , directory + , filepath + , old-locale + , text + , time + if os(windows) + cpp-options: -DWINDOWS + else + build-depends: unix Source-Repository head Type: git Location: git://github.com/kazu-yamamoto/logger.git