fast-logger 0.0.2 → 0.2.0

raw patch · 3 files changed

+174/−34 lines, 3 filesdep +old-localedep +textdep +timePVP ok

version bump matches the API change (PVP)

Dependencies added: old-locale, text, time, unix

API changes (from Hackage documentation)

Files

• System/Log/FastLogger.hs +96/−30
• System/Log/FastLogger/Date.hs +63/−0
• fast-logger.cabal +15/−4

@@ -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

@@ -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)

@@ -1,5 +1,5 @@ Name:                   fast-logger-Version:                0.0.2+Version:                0.2.0 Author:                 Kazu Yamamoto <kazu@iij.ad.jp> Maintainer:             Kazu Yamamoto <kazu@iij.ad.jp> 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