{-# LANGUAGE CPP #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs #-}
module System.Log.FastLogger (
FastLogger
, LogType
, LogType'(..)
, newFastLogger
, newFastLogger1
, withFastLogger
, TimedFastLogger
, newTimedFastLogger
, withTimedFastLogger
, LogStr
, ToLogStr(..)
, fromLogStr
, logStrLength
, BufSize
, defaultBufSize
, module System.Log.FastLogger.LoggerSet
, module System.Log.FastLogger.Date
, module System.Log.FastLogger.File
, module System.Log.FastLogger.Types
) where
import Control.Concurrent (MVar, newMVar, tryTakeMVar, putMVar)
import Control.Exception (handle, SomeException(..), bracket)
import System.EasyFile (getFileSize)
import System.Log.FastLogger.Date
import System.Log.FastLogger.File
import System.Log.FastLogger.IO
import System.Log.FastLogger.Imports
import System.Log.FastLogger.LogStr
import System.Log.FastLogger.LoggerSet
import System.Log.FastLogger.Types
type FastLogger = LogStr -> IO ()
type TimedFastLogger = (FormattedTime -> LogStr) -> IO ()
type LogType = LogType' LogStr
data LogType' a where
LogNone :: LogType' LogStr
LogStdout :: BufSize -> LogType' LogStr
LogStderr :: BufSize -> LogType' LogStr
LogFileNoRotate :: FilePath -> BufSize -> LogType' LogStr
LogFile :: FileLogSpec -> BufSize -> LogType' LogStr
LogFileTimedRotate :: TimedFileLogSpec -> BufSize -> LogType' LogStr
LogCallback :: (v -> IO ()) -> IO () -> LogType' v
newFastLogger :: LogType' v -> IO (v -> IO (), IO ())
newFastLogger :: LogType' v -> IO (v -> IO (), IO ())
newFastLogger LogType' v
typ = Maybe Int -> LogType' v -> IO (v -> IO (), IO ())
forall v. Maybe Int -> LogType' v -> IO (v -> IO (), IO ())
newFastLoggerCore Maybe Int
forall a. Maybe a
Nothing LogType' v
typ
newFastLogger1 :: LogType' v -> IO (v -> IO (), IO ())
newFastLogger1 :: LogType' v -> IO (v -> IO (), IO ())
newFastLogger1 LogType' v
typ = Maybe Int -> LogType' v -> IO (v -> IO (), IO ())
forall v. Maybe Int -> LogType' v -> IO (v -> IO (), IO ())
newFastLoggerCore (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
1) LogType' v
typ
newFastLoggerCore :: Maybe Int -> LogType' v -> IO (v -> IO (), IO ())
newFastLoggerCore :: Maybe Int -> LogType' v -> IO (v -> IO (), IO ())
newFastLoggerCore Maybe Int
mn LogType' v
typ = case LogType' v
typ of
LogType' v
LogNone -> (v -> IO (), IO ()) -> IO (v -> IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> v -> IO ()
forall a b. a -> b -> a
const IO ()
noOp, IO ()
noOp)
LogStdout Int
bsize -> Int -> IO LoggerSet
newStdoutLoggerSet Int
bsize IO LoggerSet
-> (LoggerSet -> IO (LogStr -> IO (), IO ()))
-> IO (LogStr -> IO (), IO ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggerSet -> IO (LogStr -> IO (), IO ())
forall (m :: * -> *).
Monad m =>
LoggerSet -> m (LogStr -> IO (), IO ())
stdLoggerInit
LogStderr Int
bsize -> Int -> IO LoggerSet
newStderrLoggerSet Int
bsize IO LoggerSet
-> (LoggerSet -> IO (LogStr -> IO (), IO ()))
-> IO (LogStr -> IO (), IO ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggerSet -> IO (LogStr -> IO (), IO ())
forall (m :: * -> *).
Monad m =>
LoggerSet -> m (LogStr -> IO (), IO ())
stdLoggerInit
LogFileNoRotate FilePath
fp Int
bsize -> Int -> Maybe Int -> FilePath -> IO LoggerSet
newFileLoggerSetN Int
bsize Maybe Int
mn FilePath
fp IO LoggerSet
-> (LoggerSet -> IO (LogStr -> IO (), IO ()))
-> IO (LogStr -> IO (), IO ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggerSet -> IO (LogStr -> IO (), IO ())
forall (m :: * -> *).
Monad m =>
LoggerSet -> m (LogStr -> IO (), IO ())
fileLoggerInit
LogFile FileLogSpec
fspec Int
bsize -> FileLogSpec -> Int -> IO (LogStr -> IO (), IO ())
rotateLoggerInit FileLogSpec
fspec Int
bsize
LogFileTimedRotate TimedFileLogSpec
fspec Int
bsize -> TimedFileLogSpec -> Int -> IO (LogStr -> IO (), IO ())
timedRotateLoggerInit TimedFileLogSpec
fspec Int
bsize
LogCallback v -> IO ()
cb IO ()
flush -> (v -> IO (), IO ()) -> IO (v -> IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (\v
str -> v -> IO ()
cb v
str IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
flush, IO ()
noOp)
where
stdLoggerInit :: LoggerSet -> m (LogStr -> IO (), IO ())
stdLoggerInit LoggerSet
lgrset = (LogStr -> IO (), IO ()) -> m (LogStr -> IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet
lgrset, LoggerSet -> IO ()
rmLoggerSet LoggerSet
lgrset)
fileLoggerInit :: LoggerSet -> m (LogStr -> IO (), IO ())
fileLoggerInit LoggerSet
lgrset = (LogStr -> IO (), IO ()) -> m (LogStr -> IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet
lgrset, LoggerSet -> IO ()
rmLoggerSet LoggerSet
lgrset)
rotateLoggerInit :: FileLogSpec -> Int -> IO (LogStr -> IO (), IO ())
rotateLoggerInit FileLogSpec
fspec Int
bsize = do
LoggerSet
lgrset <- Int -> Maybe Int -> FilePath -> IO LoggerSet
newFileLoggerSetN Int
bsize Maybe Int
mn (FilePath -> IO LoggerSet) -> FilePath -> IO LoggerSet
forall a b. (a -> b) -> a -> b
$ FileLogSpec -> FilePath
log_file FileLogSpec
fspec
IORef Int
ref <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef (Int
0 :: Int)
MVar ()
mvar <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
let logger :: LogStr -> IO ()
logger LogStr
str = do
Int
cnt <- IORef Int -> IO Int
decrease IORef Int
ref
LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet
lgrset LogStr
str
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ LoggerSet -> FileLogSpec -> IORef Int -> MVar () -> IO ()
tryRotate LoggerSet
lgrset FileLogSpec
fspec IORef Int
ref MVar ()
mvar
(LogStr -> IO (), IO ()) -> IO (LogStr -> IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (LogStr -> IO ()
logger, LoggerSet -> IO ()
rmLoggerSet LoggerSet
lgrset)
timedRotateLoggerInit :: TimedFileLogSpec -> Int -> IO (LogStr -> IO (), IO ())
timedRotateLoggerInit TimedFileLogSpec
fspec Int
bsize = do
IO FormattedTime
cache <- FormattedTime -> IO (IO FormattedTime)
newTimeCache (FormattedTime -> IO (IO FormattedTime))
-> FormattedTime -> IO (IO FormattedTime)
forall a b. (a -> b) -> a -> b
$ TimedFileLogSpec -> FormattedTime
timed_timefmt TimedFileLogSpec
fspec
FormattedTime
now <- IO FormattedTime
cache
LoggerSet
lgrset <- Int -> Maybe Int -> FilePath -> IO LoggerSet
newFileLoggerSetN Int
bsize Maybe Int
mn (FilePath -> IO LoggerSet) -> FilePath -> IO LoggerSet
forall a b. (a -> b) -> a -> b
$ FormattedTime -> FilePath -> FilePath
prefixTime FormattedTime
now (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ TimedFileLogSpec -> FilePath
timed_log_file TimedFileLogSpec
fspec
IORef FormattedTime
ref <- FormattedTime -> IO (IORef FormattedTime)
forall a. a -> IO (IORef a)
newIORef FormattedTime
now
MVar LoggerSet
mvar <- LoggerSet -> IO (MVar LoggerSet)
forall a. a -> IO (MVar a)
newMVar LoggerSet
lgrset
let logger :: LogStr -> IO ()
logger LogStr
str = do
FormattedTime
ct <- IO FormattedTime
cache
Bool
updated <- (FormattedTime -> FormattedTime -> Bool)
-> IORef FormattedTime -> FormattedTime -> IO Bool
updateTime (TimedFileLogSpec -> FormattedTime -> FormattedTime -> Bool
timed_same_timeframe TimedFileLogSpec
fspec) IORef FormattedTime
ref FormattedTime
ct
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
updated (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TimedFileLogSpec -> FormattedTime -> MVar LoggerSet -> IO ()
tryTimedRotate TimedFileLogSpec
fspec FormattedTime
ct MVar LoggerSet
mvar
LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet
lgrset LogStr
str
(LogStr -> IO (), IO ()) -> IO (LogStr -> IO (), IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (LogStr -> IO ()
logger, LoggerSet -> IO ()
rmLoggerSet LoggerSet
lgrset)
withFastLogger :: LogType -> (FastLogger -> IO a) -> IO a
withFastLogger :: LogType -> ((LogStr -> IO ()) -> IO a) -> IO a
withFastLogger LogType
typ (LogStr -> IO ()) -> IO a
log' = IO (LogStr -> IO (), IO ())
-> ((LogStr -> IO (), IO ()) -> IO ())
-> ((LogStr -> IO (), IO ()) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (LogType -> IO (LogStr -> IO (), IO ())
forall v. LogType' v -> IO (v -> IO (), IO ())
newFastLogger LogType
typ) (LogStr -> IO (), IO ()) -> IO ()
forall a b. (a, b) -> b
snd ((LogStr -> IO ()) -> IO a
log' ((LogStr -> IO ()) -> IO a)
-> ((LogStr -> IO (), IO ()) -> LogStr -> IO ())
-> (LogStr -> IO (), IO ())
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LogStr -> IO (), IO ()) -> LogStr -> IO ()
forall a b. (a, b) -> a
fst)
newTimedFastLogger ::
IO FormattedTime
-> LogType -> IO (TimedFastLogger, IO ())
newTimedFastLogger :: IO FormattedTime -> LogType -> IO (TimedFastLogger, IO ())
newTimedFastLogger IO FormattedTime
tgetter LogType
typ = case LogType
typ of
LogType
LogNone -> (TimedFastLogger, IO ()) -> IO (TimedFastLogger, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (IO () -> TimedFastLogger
forall a b. a -> b -> a
const IO ()
noOp, IO ()
noOp)
LogStdout Int
bsize -> Int -> IO LoggerSet
newStdoutLoggerSet Int
bsize IO LoggerSet
-> (LoggerSet -> IO (TimedFastLogger, IO ()))
-> IO (TimedFastLogger, IO ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggerSet -> IO (TimedFastLogger, IO ())
stdLoggerInit
LogStderr Int
bsize -> Int -> IO LoggerSet
newStderrLoggerSet Int
bsize IO LoggerSet
-> (LoggerSet -> IO (TimedFastLogger, IO ()))
-> IO (TimedFastLogger, IO ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggerSet -> IO (TimedFastLogger, IO ())
stdLoggerInit
LogFileNoRotate FilePath
fp Int
bsize -> Int -> FilePath -> IO LoggerSet
newFileLoggerSet Int
bsize FilePath
fp IO LoggerSet
-> (LoggerSet -> IO (TimedFastLogger, IO ()))
-> IO (TimedFastLogger, IO ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggerSet -> IO (TimedFastLogger, IO ())
fileLoggerInit
LogFile FileLogSpec
fspec Int
bsize -> FileLogSpec -> Int -> IO (TimedFastLogger, IO ())
rotateLoggerInit FileLogSpec
fspec Int
bsize
LogFileTimedRotate TimedFileLogSpec
fspec Int
bsize -> TimedFileLogSpec -> Int -> IO (TimedFastLogger, IO ())
timedRotateLoggerInit TimedFileLogSpec
fspec Int
bsize
LogCallback LogStr -> IO ()
cb IO ()
flush -> (TimedFastLogger, IO ()) -> IO (TimedFastLogger, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (\FormattedTime -> LogStr
f -> IO FormattedTime
tgetter IO FormattedTime -> (FormattedTime -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LogStr -> IO ()
cb (LogStr -> IO ())
-> (FormattedTime -> LogStr) -> FormattedTime -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormattedTime -> LogStr
f IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IO ()
flush, IO ()
noOp)
where
stdLoggerInit :: LoggerSet -> IO (TimedFastLogger, IO ())
stdLoggerInit LoggerSet
lgrset = (TimedFastLogger, IO ()) -> IO (TimedFastLogger, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return ( \FormattedTime -> LogStr
f -> IO FormattedTime
tgetter IO FormattedTime -> (FormattedTime -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet
lgrset (LogStr -> IO ())
-> (FormattedTime -> LogStr) -> FormattedTime -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormattedTime -> LogStr
f, LoggerSet -> IO ()
rmLoggerSet LoggerSet
lgrset)
fileLoggerInit :: LoggerSet -> IO (TimedFastLogger, IO ())
fileLoggerInit LoggerSet
lgrset = (TimedFastLogger, IO ()) -> IO (TimedFastLogger, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (\FormattedTime -> LogStr
f -> IO FormattedTime
tgetter IO FormattedTime -> (FormattedTime -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet
lgrset (LogStr -> IO ())
-> (FormattedTime -> LogStr) -> FormattedTime -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormattedTime -> LogStr
f, LoggerSet -> IO ()
rmLoggerSet LoggerSet
lgrset)
rotateLoggerInit :: FileLogSpec -> Int -> IO (TimedFastLogger, IO ())
rotateLoggerInit FileLogSpec
fspec Int
bsize = do
LoggerSet
lgrset <- Int -> FilePath -> IO LoggerSet
newFileLoggerSet Int
bsize (FilePath -> IO LoggerSet) -> FilePath -> IO LoggerSet
forall a b. (a -> b) -> a -> b
$ FileLogSpec -> FilePath
log_file FileLogSpec
fspec
IORef Int
ref <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
newIORef (Int
0 :: Int)
MVar ()
mvar <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
newMVar ()
let logger :: TimedFastLogger
logger FormattedTime -> LogStr
f = do
Int
cnt <- IORef Int -> IO Int
decrease IORef Int
ref
FormattedTime
t <- IO FormattedTime
tgetter
LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet
lgrset (FormattedTime -> LogStr
f FormattedTime
t)
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
cnt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ LoggerSet -> FileLogSpec -> IORef Int -> MVar () -> IO ()
tryRotate LoggerSet
lgrset FileLogSpec
fspec IORef Int
ref MVar ()
mvar
(TimedFastLogger, IO ()) -> IO (TimedFastLogger, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (TimedFastLogger
logger, LoggerSet -> IO ()
rmLoggerSet LoggerSet
lgrset)
timedRotateLoggerInit :: TimedFileLogSpec -> Int -> IO (TimedFastLogger, IO ())
timedRotateLoggerInit TimedFileLogSpec
fspec Int
bsize = do
IO FormattedTime
cache <- FormattedTime -> IO (IO FormattedTime)
newTimeCache (FormattedTime -> IO (IO FormattedTime))
-> FormattedTime -> IO (IO FormattedTime)
forall a b. (a -> b) -> a -> b
$ TimedFileLogSpec -> FormattedTime
timed_timefmt TimedFileLogSpec
fspec
FormattedTime
now <- IO FormattedTime
cache
LoggerSet
lgrset <- Int -> FilePath -> IO LoggerSet
newFileLoggerSet Int
bsize (FilePath -> IO LoggerSet) -> FilePath -> IO LoggerSet
forall a b. (a -> b) -> a -> b
$ FormattedTime -> FilePath -> FilePath
prefixTime FormattedTime
now (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ TimedFileLogSpec -> FilePath
timed_log_file TimedFileLogSpec
fspec
IORef FormattedTime
ref <- FormattedTime -> IO (IORef FormattedTime)
forall a. a -> IO (IORef a)
newIORef FormattedTime
now
MVar LoggerSet
mvar <- LoggerSet -> IO (MVar LoggerSet)
forall a. a -> IO (MVar a)
newMVar LoggerSet
lgrset
let logger :: TimedFastLogger
logger FormattedTime -> LogStr
f = do
FormattedTime
ct <- IO FormattedTime
cache
Bool
updated <- (FormattedTime -> FormattedTime -> Bool)
-> IORef FormattedTime -> FormattedTime -> IO Bool
updateTime (TimedFileLogSpec -> FormattedTime -> FormattedTime -> Bool
timed_same_timeframe TimedFileLogSpec
fspec) IORef FormattedTime
ref FormattedTime
ct
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
updated (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TimedFileLogSpec -> FormattedTime -> MVar LoggerSet -> IO ()
tryTimedRotate TimedFileLogSpec
fspec FormattedTime
ct MVar LoggerSet
mvar
FormattedTime
t <- IO FormattedTime
tgetter
LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet
lgrset (FormattedTime -> LogStr
f FormattedTime
t)
(TimedFastLogger, IO ()) -> IO (TimedFastLogger, IO ())
forall (m :: * -> *) a. Monad m => a -> m a
return (TimedFastLogger
logger, LoggerSet -> IO ()
rmLoggerSet LoggerSet
lgrset)
withTimedFastLogger :: IO FormattedTime -> LogType -> (TimedFastLogger -> IO a) -> IO a
withTimedFastLogger :: IO FormattedTime -> LogType -> (TimedFastLogger -> IO a) -> IO a
withTimedFastLogger IO FormattedTime
tgetter LogType
typ TimedFastLogger -> IO a
log' = IO (TimedFastLogger, IO ())
-> ((TimedFastLogger, IO ()) -> IO ())
-> ((TimedFastLogger, IO ()) -> IO a)
-> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (IO FormattedTime -> LogType -> IO (TimedFastLogger, IO ())
newTimedFastLogger IO FormattedTime
tgetter LogType
typ) (TimedFastLogger, IO ()) -> IO ()
forall a b. (a, b) -> b
snd (TimedFastLogger -> IO a
log' (TimedFastLogger -> IO a)
-> ((TimedFastLogger, IO ()) -> TimedFastLogger)
-> (TimedFastLogger, IO ())
-> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimedFastLogger, IO ()) -> TimedFastLogger
forall a b. (a, b) -> a
fst)
noOp :: IO ()
noOp :: IO ()
noOp = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
decrease :: IORef Int -> IO Int
decrease :: IORef Int -> IO Int
decrease IORef Int
ref = IORef Int -> (Int -> (Int, Int)) -> IO Int
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Int
ref (\Int
x -> (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))
updateTime :: (FormattedTime -> FormattedTime -> Bool) -> IORef FormattedTime -> FormattedTime -> IO Bool
updateTime :: (FormattedTime -> FormattedTime -> Bool)
-> IORef FormattedTime -> FormattedTime -> IO Bool
updateTime FormattedTime -> FormattedTime -> Bool
cmp IORef FormattedTime
ref FormattedTime
newTime = IORef FormattedTime
-> (FormattedTime -> (FormattedTime, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef FormattedTime
ref (\FormattedTime
x -> (FormattedTime
newTime, Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ FormattedTime -> FormattedTime -> Bool
cmp FormattedTime
x FormattedTime
newTime))
tryRotate :: LoggerSet -> FileLogSpec -> IORef Int -> MVar () -> IO ()
tryRotate :: LoggerSet -> FileLogSpec -> IORef Int -> MVar () -> IO ()
tryRotate LoggerSet
lgrset FileLogSpec
spec IORef Int
ref MVar ()
mvar = IO (Maybe ())
-> (Maybe () -> IO ()) -> (Maybe () -> IO ()) -> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Maybe ())
lock Maybe () -> IO ()
unlock Maybe () -> IO ()
rotateFiles
where
lock :: IO (Maybe ())
lock = MVar () -> IO (Maybe ())
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar ()
mvar
unlock :: Maybe () -> IO ()
unlock Maybe ()
Nothing = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
unlock Maybe ()
_ = MVar () -> () -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar ()
mvar ()
rotateFiles :: Maybe () -> IO ()
rotateFiles Maybe ()
Nothing = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
rotateFiles Maybe ()
_ = do
Maybe Integer
msiz <- IO (Maybe Integer)
getSize
case Maybe Integer
msiz of
Maybe Integer
Nothing -> IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
ref Int
1000000
Just Integer
siz
| Integer
siz Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
limit -> do
FileLogSpec -> IO ()
rotate FileLogSpec
spec
LoggerSet -> IO ()
renewLoggerSet LoggerSet
lgrset
IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
ref (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
estimate Integer
limit
| Bool
otherwise ->
IORef Int -> Int -> IO ()
forall a. IORef a -> a -> IO ()
writeIORef IORef Int
ref (Int -> IO ()) -> Int -> IO ()
forall a b. (a -> b) -> a -> b
$ Integer -> Int
forall a. Num a => Integer -> a
estimate (Integer
limit Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
siz)
file :: FilePath
file = FileLogSpec -> FilePath
log_file FileLogSpec
spec
limit :: Integer
limit = FileLogSpec -> Integer
log_file_size FileLogSpec
spec
getSize :: IO (Maybe Integer)
getSize = (SomeException -> IO (Maybe Integer))
-> IO (Maybe Integer) -> IO (Maybe Integer)
forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(SomeException e
_) -> Maybe Integer -> IO (Maybe Integer)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Integer
forall a. Maybe a
Nothing) (IO (Maybe Integer) -> IO (Maybe Integer))
-> IO (Maybe Integer) -> IO (Maybe Integer)
forall a b. (a -> b) -> a -> b
$
Integer -> Maybe Integer
forall a. a -> Maybe a
Just (Integer -> Maybe Integer)
-> (Word64 -> Integer) -> Word64 -> Maybe Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Maybe Integer) -> IO Word64 -> IO (Maybe Integer)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Word64
getFileSize FilePath
file
estimate :: Integer -> a
estimate Integer
x = Integer -> a
forall a. Num a => Integer -> a
fromInteger (Integer
x Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`div` Integer
200)
tryTimedRotate :: TimedFileLogSpec -> FormattedTime -> MVar LoggerSet -> IO ()
tryTimedRotate :: TimedFileLogSpec -> FormattedTime -> MVar LoggerSet -> IO ()
tryTimedRotate TimedFileLogSpec
spec FormattedTime
now MVar LoggerSet
mvar = IO (Maybe LoggerSet)
-> (Maybe LoggerSet -> IO ())
-> (Maybe LoggerSet -> IO ())
-> IO ()
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Maybe LoggerSet)
lock Maybe LoggerSet -> IO ()
unlock Maybe LoggerSet -> IO ()
rotateFiles
where
lock :: IO (Maybe LoggerSet)
lock = MVar LoggerSet -> IO (Maybe LoggerSet)
forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar LoggerSet
mvar
unlock :: Maybe LoggerSet -> IO ()
unlock Maybe LoggerSet
Nothing = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
unlock (Just LoggerSet
lgrset) = do
let (LoggerSet
newlgrset, Maybe FilePath
current_path) = LoggerSet -> FilePath -> (LoggerSet, Maybe FilePath)
replaceLoggerSet LoggerSet
lgrset FilePath
new_file_path
MVar LoggerSet -> LoggerSet -> IO ()
forall a. MVar a -> a -> IO ()
putMVar MVar LoggerSet
mvar LoggerSet
newlgrset
case Maybe FilePath
current_path of
Maybe FilePath
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just FilePath
path -> TimedFileLogSpec -> FilePath -> IO ()
timed_post_process TimedFileLogSpec
spec FilePath
path
rotateFiles :: Maybe LoggerSet -> IO ()
rotateFiles Maybe LoggerSet
Nothing = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
rotateFiles (Just LoggerSet
lgrset) = do
let (LoggerSet
newlgrset, Maybe FilePath
_) = LoggerSet -> FilePath -> (LoggerSet, Maybe FilePath)
replaceLoggerSet LoggerSet
lgrset FilePath
new_file_path
LoggerSet -> IO ()
renewLoggerSet LoggerSet
newlgrset
new_file_path :: FilePath
new_file_path = FormattedTime -> FilePath -> FilePath
prefixTime FormattedTime
now (FilePath -> FilePath) -> FilePath -> FilePath
forall a b. (a -> b) -> a -> b
$ TimedFileLogSpec -> FilePath
timed_log_file TimedFileLogSpec
spec