module System.Log.FastLogger (
BufSize
, defaultBufSize
, logOpen
, LoggerSet
, newLoggerSet
, renewLoggerSet
, rmLoggerSet
, LogStr
, ToLogStr(..)
, pushLogStr
, flushLogStr
, module System.Log.FastLogger.File
) where
import Control.Applicative ((<$>))
import Control.Concurrent (getNumCapabilities, myThreadId, threadCapability, takeMVar)
import Control.Monad (when, replicateM)
import Data.Array (Array, listArray, (!))
import GHC.IO.Device (close)
import GHC.IO.FD (FD(..), openFile)
import GHC.IO.IOMode (IOMode(..))
import System.Log.FastLogger.File
import System.Log.FastLogger.IO
import System.Log.FastLogger.IORef
import System.Log.FastLogger.LogStr
import System.Log.FastLogger.Logger
logOpen :: FilePath -> IO FD
logOpen file = fst <$> openFile file AppendMode False
data LoggerSet = LoggerSet (IORef FD) (Array Int Logger)
newLoggerSet :: BufSize -> FD -> IO LoggerSet
newLoggerSet size fd = do
n <- getNumCapabilities
loggers <- replicateM n $ newLogger size
let arr = listArray (0,n1) loggers
fref <- newIORef fd
return $ LoggerSet fref arr
pushLogStr :: LoggerSet -> LogStr -> IO ()
pushLogStr (LoggerSet fref arr) logmsg = do
(i, _) <- myThreadId >>= threadCapability
let logger = arr ! i
fd <- readIORef fref
pushLog fd logger logmsg
flushLogStr :: LoggerSet -> IO ()
flushLogStr (LoggerSet fref arr) = do
n <- getNumCapabilities
fd <- readIORef fref
mapM_ (flushIt fd) [0..n1]
where
flushIt fd i = flushLog fd (arr ! i)
renewLoggerSet :: LoggerSet -> FD -> IO ()
renewLoggerSet (LoggerSet fref _) newfd = do
oldfd <- atomicModifyIORef' fref (\fd -> (newfd, fd))
close oldfd
rmLoggerSet :: LoggerSet -> IO ()
rmLoggerSet (LoggerSet fref arr) = do
n <- getNumCapabilities
fd <- readIORef fref
let nums = [0..n1]
mapM_ (flushIt fd) nums
mapM_ freeIt nums
when (fdFD fd /= 1) $ close fd
where
flushIt fd i = flushLog fd (arr ! i)
freeIt i = do
let (Logger mbuf _ _) = arr ! i
takeMVar mbuf >>= freeBuffer