Initial commit

.gitignore

@@ -0,0 +1,4 @@
+dist
+*.swp
+*.hi
+*.o

rotating-log.cabal

@@ -0,0 +1,38 @@
+-- Initial restful-snap.cabal generated by cabal init.  For further 
+-- documentation, see http://haskell.org/cabal/users-guide/
+
+name:                rotating-log
+version:             0.1
+-- synopsis:            
+-- description:         
+license:             BSD3
+license-file:        LICENSE
+author:              Doug Beardsley
+maintainer:          doug.beardsley@soostone.com
+-- copyright:           
+category:            Web
+build-type:          Simple
+cabal-version:       >=1.8
+
+library
+  hs-source-dirs: src
+
+  exposed-modules: 
+    System.RotatingLog
+
+  build-depends:       
+    base               >= 4    && < 5,
+    bytestring         >= 0.8  && < 0.11,
+    old-locale         >= 1.0  && < 1.1,
+    time               >= 1.1  && < 1.5
+
+  ghc-options: -Wall -fwarn-tabs
+
+executable test-rotate
+  main-is: TestRotate.hs
+  hs-source-dirs: test, src
+  build-depends:
+    base               >= 4    && < 5,
+    bytestring         >= 0.8  && < 0.11,
+    old-locale         >= 1.0  && < 1.1,
+    time               >= 1.1  && < 1.5

src/System/RotatingLog.hs

@@ -0,0 +1,67 @@
+{-# LANGUAGE RecordWildCards #-}
+
+module System.RotatingLog
+  ( RotatingLog
+  , mkRotatingLog
+  , rotatedWrite
+  ) where
+
+import           Control.Concurrent.MVar
+import           Data.ByteString.Char8 (ByteString)
+import qualified Data.ByteString.Char8 as B
+import           Data.Time
+import           Data.Word
+import           System.IO
+import           System.Locale
+
+------------------------------------------------------------------------------
+-- | A size-limited rotating log.  Log filenames are of the format
+-- prefix_timestamp.log.
+data RotatingLog = RotatingLog
+    { logInfo    :: MVar LogInfo
+    , namePrefix :: String
+    , sizeLimit  :: Word64
+    }
+
+data LogInfo = LogInfo
+    { curHandle    :: Handle
+    , bytesWritten :: !Word64
+    }
+
+logFileName :: String -> UTCTime -> FilePath
+logFileName pre t = concat
+    [pre, "_", formatTime defaultTimeLocale "%F_%T%Q" t, ".log"]
+
+------------------------------------------------------------------------------
+-- | Creates a rotating log given a prefix and size limit in bytes.
+mkRotatingLog :: String -> Word64 -> IO RotatingLog
+mkRotatingLog pre limit = do
+    t <- getCurrentTime
+    h <- openFile (logFileName pre t) AppendMode
+    mvar <- newMVar $ LogInfo h 0
+    return $ RotatingLog mvar pre limit
+
+------------------------------------------------------------------------------
+-- | Like "rotatedWrite'", but doesn't need a UTCTime.
+rotatedWrite :: RotatingLog -> ByteString -> IO ()
+rotatedWrite log bs = do
+    t <- getCurrentTime
+    rotatedWrite log t bs
+
+------------------------------------------------------------------------------
+-- | Writes ByteString to a rotating log file.  If this write would exceed the
+-- size limit, then the file is closed and a new file opened.  This function
+-- takes a UTCTime to allow a cached time to be used to avoid a system call.
+rotatedWrite' :: RotatingLog -> UTCTime -> ByteString -> IO ()
+rotatedWrite' RotatingLog{..} t bs = do
+    modifyMVar_ logInfo $ \LogInfo{..} -> do
+        (h,b) <- if bytesWritten + len > sizeLimit
+                   then do hClose curHandle
+                           h <- openFile (logFileName namePrefix t) AppendMode
+                           return (h,0)
+                   else return (curHandle, bytesWritten)
+        B.hPutStrLn h bs
+        return $ LogInfo h (b+len)
+  where
+    len = fromIntegral $ B.length bs + 1
+

test/TestRotate.hs

@@ -0,0 +1,26 @@
+{-# LANGUAGE OverloadedStrings #-}
+
+module Main where
+
+import           Control.Concurrent
+import qualified Data.ByteString.Char8 as B
+import           Data.Time
+import           System.RotatingLog
+
+thread :: RotatingLog -> B.ByteString -> Int -> IO ()
+thread log pre n = do
+    rotatedWrite log (B.concat [pre, ": ", B.pack $ show n])
+    thread log pre (n+1)
+    
+main = do
+    log <- mkRotatingLog "foo" 1000000
+    a <- forkIO $ thread log "a" 0
+    b <- forkIO $ thread log "b" 0
+    c <- forkIO $ thread log "c" 0
+    d <- forkIO $ thread log "d" 0
+    threadDelay 5000000
+    killThread a
+    killThread b
+    killThread c
+    killThread d
+    putStrLn "done"