module System.Log.FastLogger (
LoggerSet
, newFileLoggerSet
, newStdoutLoggerSet
, newStderrLoggerSet
, newLoggerSet
, BufSize
, defaultBufSize
, renewLoggerSet
, rmLoggerSet
, LogStr
, ToLogStr(..)
, fromLogStr
, logStrLength
, pushLogStr
, pushLogStrLn
, flushLogStr
, module System.Log.FastLogger.File
) where
#if __GLASGOW_HASKELL__ < 709
import Control.Applicative ((<$>))
#endif
import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceAction)
import Control.Concurrent (getNumCapabilities, myThreadId, threadCapability, takeMVar)
import Control.Monad (when, replicateM)
import Data.Array (Array, listArray, (!), bounds)
import Data.Maybe (isJust)
import System.Log.FastLogger.File
import System.Log.FastLogger.IO
import System.Log.FastLogger.FileIO
import System.Log.FastLogger.IORef
import System.Log.FastLogger.LogStr
import System.Log.FastLogger.Logger
data LoggerSet = LoggerSet (Maybe FilePath) (IORef FD) (Array Int Logger) (IO ())
newFileLoggerSet :: BufSize -> FilePath -> IO LoggerSet
newFileLoggerSet size file = openFileFD file >>= newFDLoggerSet size (Just file)
newStdoutLoggerSet :: BufSize -> IO LoggerSet
newStdoutLoggerSet size = getStdoutFD >>= newFDLoggerSet size Nothing
newStderrLoggerSet :: BufSize -> IO LoggerSet
newStderrLoggerSet size = getStderrFD >>= newFDLoggerSet size Nothing
newLoggerSet :: BufSize -> Maybe FilePath -> IO LoggerSet
newLoggerSet size = maybe (newStdoutLoggerSet size) (newFileLoggerSet size)
newFDLoggerSet :: BufSize -> Maybe FilePath -> FD -> IO LoggerSet
newFDLoggerSet size mfile fd = do
n <- getNumCapabilities
loggers <- replicateM n $ newLogger (max 1 size)
let arr = listArray (0,n1) loggers
fref <- newIORef fd
flush <- mkDebounce defaultDebounceSettings
{ debounceAction = flushLogStrRaw fref arr
}
return $ LoggerSet mfile fref arr flush
pushLogStr :: LoggerSet -> LogStr -> IO ()
pushLogStr (LoggerSet _ fref arr flush) logmsg = do
(i, _) <- myThreadId >>= threadCapability
let u = snd $ bounds arr
lim = u + 1
j | i < lim = i
| otherwise = i `mod` lim
let logger = arr ! j
fd <- readIORef fref
pushLog fd logger logmsg
flush
pushLogStrLn :: LoggerSet -> LogStr -> IO ()
pushLogStrLn loggerSet logStr = pushLogStr loggerSet (logStr <> toLogStr "\n")
flushLogStr :: LoggerSet -> IO ()
flushLogStr (LoggerSet _ fref arr _) = flushLogStrRaw fref arr
flushLogStrRaw :: IORef FD -> Array Int Logger -> IO ()
flushLogStrRaw fref arr = do
let (l,u) = bounds arr
fd <- readIORef fref
mapM_ (flushIt fd) [l .. u]
where
flushIt fd i = flushLog fd (arr ! i)
renewLoggerSet :: LoggerSet -> IO ()
renewLoggerSet (LoggerSet Nothing _ _ _) = return ()
renewLoggerSet (LoggerSet (Just file) fref _ _) = do
newfd <- openFileFD file
oldfd <- atomicModifyIORef' fref (\fd -> (newfd, fd))
closeFD oldfd
rmLoggerSet :: LoggerSet -> IO ()
rmLoggerSet (LoggerSet mfile fref arr _) = do
let (l,u) = bounds arr
fd <- readIORef fref
let nums = [l .. u]
mapM_ (flushIt fd) nums
mapM_ freeIt nums
when (isJust mfile) $ closeFD fd
where
flushIt fd i = flushLog fd (arr ! i)
freeIt i = do
let (Logger mbuf _ _) = arr ! i
takeMVar mbuf >>= freeBuffer