Initial commit
This commit is contained in:
commit
75c02e57c4
4 changed files with 135 additions and 0 deletions
4
.gitignore
vendored
Normal file
4
.gitignore
vendored
Normal file
|
@ -0,0 +1,4 @@
|
|||
dist
|
||||
*.swp
|
||||
*.hi
|
||||
*.o
|
38
rotating-log.cabal
Normal file
38
rotating-log.cabal
Normal file
|
@ -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
|
67
src/System/RotatingLog.hs
Normal file
67
src/System/RotatingLog.hs
Normal file
|
@ -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
|
||||
|
26
test/TestRotate.hs
Normal file
26
test/TestRotate.hs
Normal file
|
@ -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"
|
Loading…
Reference in a new issue