{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module System.Log.FastLogger.LoggerSet (
LoggerSet
, newFileLoggerSet
, newFileLoggerSetN
, newStdoutLoggerSet
, newStdoutLoggerSetN
, newStderrLoggerSet
, newStderrLoggerSetN
, newLoggerSet
, newFDLoggerSet
, renewLoggerSet
, rmLoggerSet
, pushLogStr
, pushLogStrLn
, flushLogStr
, replaceLoggerSet
) where
import Control.Concurrent (getNumCapabilities)
import Control.Debounce (mkDebounce, defaultDebounceSettings, debounceAction)
import System.Log.FastLogger.FileIO
import System.Log.FastLogger.IO
import System.Log.FastLogger.Imports
import System.Log.FastLogger.LogStr
import System.Log.FastLogger.MultiLogger (MultiLogger)
import qualified System.Log.FastLogger.MultiLogger as M
import System.Log.FastLogger.SingleLogger (SingleLogger)
import qualified System.Log.FastLogger.SingleLogger as S
import System.Log.FastLogger.Write
data Logger = SL SingleLogger | ML MultiLogger
data LoggerSet = LoggerSet {
LoggerSet -> Maybe FilePath
lgrsetFilePath :: Maybe FilePath
, LoggerSet -> IORef FD
lgrsetFdRef :: IORef FD
, LoggerSet -> Logger
lgrsetLogger :: Logger
, LoggerSet -> IO ()
lgrsetDebounce :: IO ()
}
newFileLoggerSet :: BufSize -> FilePath -> IO LoggerSet
newFileLoggerSet :: BufSize -> FilePath -> IO LoggerSet
newFileLoggerSet BufSize
size FilePath
file = FilePath -> IO FD
openFileFD FilePath
file IO FD -> (FD -> IO LoggerSet) -> IO LoggerSet
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BufSize -> Maybe BufSize -> Maybe FilePath -> FD -> IO LoggerSet
newFDLoggerSet BufSize
size Maybe BufSize
forall a. Maybe a
Nothing (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
file)
newFileLoggerSetN :: BufSize -> Maybe Int -> FilePath -> IO LoggerSet
newFileLoggerSetN :: BufSize -> Maybe BufSize -> FilePath -> IO LoggerSet
newFileLoggerSetN BufSize
size Maybe BufSize
mn FilePath
file = FilePath -> IO FD
openFileFD FilePath
file IO FD -> (FD -> IO LoggerSet) -> IO LoggerSet
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BufSize -> Maybe BufSize -> Maybe FilePath -> FD -> IO LoggerSet
newFDLoggerSet BufSize
size Maybe BufSize
mn (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
file)
newStdoutLoggerSet :: BufSize -> IO LoggerSet
newStdoutLoggerSet :: BufSize -> IO LoggerSet
newStdoutLoggerSet BufSize
size = IO FD
getStdoutFD IO FD -> (FD -> IO LoggerSet) -> IO LoggerSet
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BufSize -> Maybe BufSize -> Maybe FilePath -> FD -> IO LoggerSet
newFDLoggerSet BufSize
size Maybe BufSize
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing
newStdoutLoggerSetN :: BufSize -> Maybe Int -> IO LoggerSet
newStdoutLoggerSetN :: BufSize -> Maybe BufSize -> IO LoggerSet
newStdoutLoggerSetN BufSize
size Maybe BufSize
mn = IO FD
getStdoutFD IO FD -> (FD -> IO LoggerSet) -> IO LoggerSet
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BufSize -> Maybe BufSize -> Maybe FilePath -> FD -> IO LoggerSet
newFDLoggerSet BufSize
size Maybe BufSize
mn Maybe FilePath
forall a. Maybe a
Nothing
newStderrLoggerSet :: BufSize -> IO LoggerSet
newStderrLoggerSet :: BufSize -> IO LoggerSet
newStderrLoggerSet BufSize
size = IO FD
getStderrFD IO FD -> (FD -> IO LoggerSet) -> IO LoggerSet
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BufSize -> Maybe BufSize -> Maybe FilePath -> FD -> IO LoggerSet
newFDLoggerSet BufSize
size Maybe BufSize
forall a. Maybe a
Nothing Maybe FilePath
forall a. Maybe a
Nothing
newStderrLoggerSetN :: BufSize -> Maybe Int -> IO LoggerSet
newStderrLoggerSetN :: BufSize -> Maybe BufSize -> IO LoggerSet
newStderrLoggerSetN BufSize
size Maybe BufSize
mn = IO FD
getStderrFD IO FD -> (FD -> IO LoggerSet) -> IO LoggerSet
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= BufSize -> Maybe BufSize -> Maybe FilePath -> FD -> IO LoggerSet
newFDLoggerSet BufSize
size Maybe BufSize
mn Maybe FilePath
forall a. Maybe a
Nothing
{-# DEPRECATED newLoggerSet "Use newFileLoggerSet etc instead" #-}
newLoggerSet :: BufSize -> Maybe Int -> Maybe FilePath -> IO LoggerSet
newLoggerSet :: BufSize -> Maybe BufSize -> Maybe FilePath -> IO LoggerSet
newLoggerSet BufSize
size Maybe BufSize
mn = IO LoggerSet
-> (FilePath -> IO LoggerSet) -> Maybe FilePath -> IO LoggerSet
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (BufSize -> IO LoggerSet
newStdoutLoggerSet BufSize
size) (BufSize -> Maybe BufSize -> FilePath -> IO LoggerSet
newFileLoggerSetN BufSize
size Maybe BufSize
mn)
newFDLoggerSet :: BufSize -> Maybe Int -> Maybe FilePath -> FD -> IO LoggerSet
newFDLoggerSet :: BufSize -> Maybe BufSize -> Maybe FilePath -> FD -> IO LoggerSet
newFDLoggerSet BufSize
size Maybe BufSize
mn Maybe FilePath
mfile FD
fd = do
BufSize
n <- case Maybe BufSize
mn of
Just BufSize
n' -> BufSize -> IO BufSize
forall (m :: * -> *) a. Monad m => a -> m a
return BufSize
n'
Maybe BufSize
Nothing -> IO BufSize
getNumCapabilities
IORef FD
fdref <- FD -> IO (IORef FD)
forall a. a -> IO (IORef a)
newIORef FD
fd
let bufsiz :: BufSize
bufsiz = BufSize -> BufSize -> BufSize
forall a. Ord a => a -> a -> a
max BufSize
1 BufSize
size
Logger
logger <- if BufSize
n BufSize -> BufSize -> Bool
forall a. Eq a => a -> a -> Bool
== BufSize
1 Bool -> Bool -> Bool
&& Maybe BufSize
mn Maybe BufSize -> Maybe BufSize -> Bool
forall a. Eq a => a -> a -> Bool
== BufSize -> Maybe BufSize
forall a. a -> Maybe a
Just BufSize
1 then
SingleLogger -> Logger
SL (SingleLogger -> Logger) -> IO SingleLogger -> IO Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufSize -> IORef FD -> IO SingleLogger
S.newSingleLogger BufSize
bufsiz IORef FD
fdref
else do
MultiLogger -> Logger
ML (MultiLogger -> Logger) -> IO MultiLogger -> IO Logger
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> BufSize -> BufSize -> IORef FD -> IO MultiLogger
M.newMultiLogger BufSize
n BufSize
bufsiz IORef FD
fdref
IO ()
flush <- DebounceSettings -> IO (IO ())
mkDebounce DebounceSettings
defaultDebounceSettings
{ debounceAction :: IO ()
debounceAction = Logger -> IO ()
flushLogStrRaw Logger
logger
}
LoggerSet -> IO LoggerSet
forall (m :: * -> *) a. Monad m => a -> m a
return (LoggerSet -> IO LoggerSet) -> LoggerSet -> IO LoggerSet
forall a b. (a -> b) -> a -> b
$ LoggerSet :: Maybe FilePath -> IORef FD -> Logger -> IO () -> LoggerSet
LoggerSet {
lgrsetFilePath :: Maybe FilePath
lgrsetFilePath = Maybe FilePath
mfile
, lgrsetFdRef :: IORef FD
lgrsetFdRef = IORef FD
fdref
, lgrsetLogger :: Logger
lgrsetLogger = Logger
logger
, lgrsetDebounce :: IO ()
lgrsetDebounce = IO ()
flush
}
pushLogStr :: LoggerSet -> LogStr -> IO ()
pushLogStr :: LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet{Maybe FilePath
IO ()
IORef FD
Logger
lgrsetDebounce :: IO ()
lgrsetLogger :: Logger
lgrsetFdRef :: IORef FD
lgrsetFilePath :: Maybe FilePath
lgrsetDebounce :: LoggerSet -> IO ()
lgrsetLogger :: LoggerSet -> Logger
lgrsetFdRef :: LoggerSet -> IORef FD
lgrsetFilePath :: LoggerSet -> Maybe FilePath
..} LogStr
logmsg = case Logger
lgrsetLogger of
SL SingleLogger
sl -> do
SingleLogger -> LogStr -> IO ()
forall a. Loggers a => a -> LogStr -> IO ()
pushLog SingleLogger
sl LogStr
logmsg
IO ()
lgrsetDebounce
ML MultiLogger
ml -> do
MultiLogger -> LogStr -> IO ()
forall a. Loggers a => a -> LogStr -> IO ()
pushLog MultiLogger
ml LogStr
logmsg
IO ()
lgrsetDebounce
pushLogStrLn :: LoggerSet -> LogStr -> IO ()
pushLogStrLn :: LoggerSet -> LogStr -> IO ()
pushLogStrLn LoggerSet
loggerSet LogStr
logStr = LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet
loggerSet (LogStr
logStr LogStr -> LogStr -> LogStr
forall a. Semigroup a => a -> a -> a
<> LogStr
"\n")
flushLogStr :: LoggerSet -> IO ()
flushLogStr :: LoggerSet -> IO ()
flushLogStr LoggerSet{Maybe FilePath
IO ()
IORef FD
Logger
lgrsetDebounce :: IO ()
lgrsetLogger :: Logger
lgrsetFdRef :: IORef FD
lgrsetFilePath :: Maybe FilePath
lgrsetDebounce :: LoggerSet -> IO ()
lgrsetLogger :: LoggerSet -> Logger
lgrsetFdRef :: LoggerSet -> IORef FD
lgrsetFilePath :: LoggerSet -> Maybe FilePath
..} = Logger -> IO ()
flushLogStrRaw Logger
lgrsetLogger
flushLogStrRaw :: Logger -> IO ()
flushLogStrRaw :: Logger -> IO ()
flushLogStrRaw (SL SingleLogger
sl) = SingleLogger -> IO ()
forall a. Loggers a => a -> IO ()
flushAllLog SingleLogger
sl
flushLogStrRaw (ML MultiLogger
ml) = MultiLogger -> IO ()
forall a. Loggers a => a -> IO ()
flushAllLog MultiLogger
ml
renewLoggerSet :: LoggerSet -> IO ()
renewLoggerSet :: LoggerSet -> IO ()
renewLoggerSet LoggerSet{Maybe FilePath
IO ()
IORef FD
Logger
lgrsetDebounce :: IO ()
lgrsetLogger :: Logger
lgrsetFdRef :: IORef FD
lgrsetFilePath :: Maybe FilePath
lgrsetDebounce :: LoggerSet -> IO ()
lgrsetLogger :: LoggerSet -> Logger
lgrsetFdRef :: LoggerSet -> IORef FD
lgrsetFilePath :: LoggerSet -> Maybe FilePath
..} = case Maybe FilePath
lgrsetFilePath of
Maybe FilePath
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just FilePath
file -> do
FD
newfd <- FilePath -> IO FD
openFileFD FilePath
file
FD
oldfd <- IORef FD -> (FD -> (FD, FD)) -> IO FD
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef FD
lgrsetFdRef (\FD
fd -> (FD
newfd, FD
fd))
FD -> IO ()
closeFD FD
oldfd
rmLoggerSet :: LoggerSet -> IO ()
rmLoggerSet :: LoggerSet -> IO ()
rmLoggerSet LoggerSet{Maybe FilePath
IO ()
IORef FD
Logger
lgrsetDebounce :: IO ()
lgrsetLogger :: Logger
lgrsetFdRef :: IORef FD
lgrsetFilePath :: Maybe FilePath
lgrsetDebounce :: LoggerSet -> IO ()
lgrsetLogger :: LoggerSet -> Logger
lgrsetFdRef :: LoggerSet -> IORef FD
lgrsetFilePath :: LoggerSet -> Maybe FilePath
..} = do
FD
fd <- IORef FD -> IO FD
forall a. IORef a -> IO a
readIORef IORef FD
lgrsetFdRef
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FD -> Bool
isFDValid FD
fd) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
case Logger
lgrsetLogger of
SL SingleLogger
sl -> SingleLogger -> IO ()
forall a. Loggers a => a -> IO ()
stopLoggers SingleLogger
sl
ML MultiLogger
ml -> MultiLogger -> IO ()
forall a. Loggers a => a -> IO ()
stopLoggers MultiLogger
ml
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe FilePath -> Bool
forall a. Maybe a -> Bool
isJust Maybe FilePath
lgrsetFilePath) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FD -> IO ()
closeFD FD
fd
IORef FD -> FD -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef FD
lgrsetFdRef FD
invalidFD
replaceLoggerSet :: LoggerSet -> FilePath -> (LoggerSet, Maybe FilePath)
replaceLoggerSet :: LoggerSet -> FilePath -> (LoggerSet, Maybe FilePath)
replaceLoggerSet lgrset :: LoggerSet
lgrset@LoggerSet{Maybe FilePath
IO ()
IORef FD
Logger
lgrsetDebounce :: IO ()
lgrsetLogger :: Logger
lgrsetFdRef :: IORef FD
lgrsetFilePath :: Maybe FilePath
lgrsetDebounce :: LoggerSet -> IO ()
lgrsetLogger :: LoggerSet -> Logger
lgrsetFdRef :: LoggerSet -> IORef FD
lgrsetFilePath :: LoggerSet -> Maybe FilePath
..} FilePath
new_file_path =
(LoggerSet
lgrset { lgrsetFilePath :: Maybe FilePath
lgrsetFilePath = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
new_file_path }, Maybe FilePath
lgrsetFilePath)