{-# LANGUAGE CPP               #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GADTs             #-}

-- | This module provides a fast logging system which
--   scales on multicore environments (i.e. +RTS -N\<x\>).
--
--   Note: This library does not guarantee correct ordering of log messages
--   when program is run on more than one core thus users
--   should rely more on message timestamps than on their order in the
--   log.
module System.Log.FastLogger (
  -- * FastLogger
    FastLogger
  , LogType
  , LogType'(..)
  , newFastLogger
  , newFastLogger1
  , withFastLogger
  -- * Timed FastLogger
  , TimedFastLogger
  , newTimedFastLogger
  , withTimedFastLogger
  -- * Log messages
  , LogStr
  , ToLogStr(..)
  , fromLogStr
  , logStrLength
  -- * Buffer size
  , BufSize
  , defaultBufSize
  -- * LoggerSet
  , module System.Log.FastLogger.LoggerSet
  -- * Date cache
  , module System.Log.FastLogger.Date
  -- * File rotation
  , module System.Log.FastLogger.File
  -- * Types
  , 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

----------------------------------------------------------------

-- | 'FastLogger' simply log 'logStr'.
type FastLogger = LogStr -> IO ()
-- | 'TimedFastLogger' pass 'FormattedTime' to callback and simply log its result.
-- this can be used to customize how to log timestamp.
--
-- Usually, one would write a wrapper on top of 'TimedFastLogger', for example:
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- >
-- > log :: TimedFastLogger -> LogStr -> IO ()
-- > log logger msg = logger (\time -> toLogStr (show time) <> " " <> msg <> "\n")
type TimedFastLogger = (FormattedTime -> LogStr) -> IO ()

type LogType = LogType' LogStr

-- | Logger Type.
data LogType' a where
    LogNone :: LogType' LogStr    -- ^ No logging.
    LogStdout :: BufSize -> LogType' LogStr
                                  -- ^ Logging to stdout.
                                  --   'BufSize' is a buffer size
                                  --   for each capability.
    LogStderr :: BufSize -> LogType' LogStr
                                  -- ^ Logging to stderr.
                                  --   'BufSize' is a buffer size
                                  --   for each capability.
    LogFileNoRotate :: FilePath -> BufSize -> LogType' LogStr
                                  -- ^ Logging to a file.
                                  --   'BufSize' is a buffer size
                                  --   for each capability.
    LogFile :: FileLogSpec -> BufSize -> LogType' LogStr
                                  -- ^ Logging to a file.
                                  --   'BufSize' is a buffer size
                                  --   for each capability.
                                  --   File rotation is done on-demand.
    LogFileTimedRotate :: TimedFileLogSpec -> BufSize -> LogType' LogStr -- ^ Logging to a file.
                                  --   'BufSize' is a buffer size
                                  --   for each capability.
                                  --   Rotation happens based on check specified
                                  --   in 'TimedFileLogSpec'.
    LogCallback :: (v -> IO ()) -> IO () -> LogType' v  -- ^ Logging with a log and flush action.
                                                          -- run flush after log each message.

-- | Initialize a 'FastLogger' without attaching timestamp
-- a tuple of logger and clean up action are returned.
-- This type signature should be read as:
--
-- > newFastLogger :: LogType -> IO (FastLogger, IO ())
--
-- This logger uses `numCapabilities` many buffers, and thus
-- does not provide time-ordered output.
-- For time-ordered output, use `newFastLogger1`.
newFastLogger :: LogType' v -> IO (v -> IO (), IO ())
newFastLogger :: forall v. LogType' v -> IO (v -> IO (), IO ())
newFastLogger LogType' v
typ = forall v. Maybe Int -> LogType' v -> IO (v -> IO (), IO ())
newFastLoggerCore forall a. Maybe a
Nothing LogType' v
typ

-- | Like `newFastLogger`, but creating a logger that uses only 1
-- internal builder. This scales less on multi-core machines and
-- consumes more memory because of an internal queue but provides
-- time-ordered output.
newFastLogger1 :: LogType' v -> IO (v -> IO (), IO ())
newFastLogger1 :: forall v. LogType' v -> IO (v -> IO (), IO ())
newFastLogger1 LogType' v
typ = forall v. Maybe Int -> LogType' v -> IO (v -> IO (), IO ())
newFastLoggerCore (forall a. a -> Maybe a
Just Int
1) LogType' v
typ

newFastLoggerCore :: Maybe Int -> LogType' v -> IO (v -> IO (), IO ())
newFastLoggerCore :: forall v. Maybe Int -> LogType' v -> IO (v -> IO (), IO ())
newFastLoggerCore Maybe Int
mn LogType' v
typ = case LogType' v
typ of
    LogType' v
LogNone                        -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> a
const IO ()
noOp, IO ()
noOp)
    LogStdout Int
bsize                -> Int -> Maybe Int -> IO LoggerSet
newStdoutLoggerSetN Int
bsize Maybe Int
mn forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall {m :: * -> *}.
Monad m =>
LoggerSet -> m (LogStr -> IO (), IO ())
stdLoggerInit
    LogStderr Int
bsize                -> Int -> Maybe Int -> IO LoggerSet
newStderrLoggerSetN Int
bsize Maybe Int
mn forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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 forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= 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           -> forall (m :: * -> *) a. Monad m => a -> m a
return (\v
str -> v -> IO ()
cb v
str 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 = 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 = 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 forall a b. (a -> b) -> a -> b
$ FileLogSpec -> FilePath
log_file FileLogSpec
fspec
        IORef Int
ref <- forall a. a -> IO (IORef a)
newIORef (Int
0 :: Int)
        MVar ()
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
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
cnt forall a. Ord a => a -> a -> Bool
<= Int
0) forall a b. (a -> b) -> a -> b
$ LoggerSet -> FileLogSpec -> IORef Int -> MVar () -> IO ()
tryRotate LoggerSet
lgrset FileLogSpec
fspec IORef Int
ref MVar ()
mvar
        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 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 forall a b. (a -> b) -> a -> b
$ FormattedTime -> FilePath -> FilePath
prefixTime FormattedTime
now forall a b. (a -> b) -> a -> b
$ TimedFileLogSpec -> FilePath
timed_log_file TimedFileLogSpec
fspec
        IORef FormattedTime
ref <- forall a. a -> IO (IORef a)
newIORef FormattedTime
now
        MVar LoggerSet
mvar <- 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
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
updated 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
        forall (m :: * -> *) a. Monad m => a -> m a
return (LogStr -> IO ()
logger, LoggerSet -> IO ()
rmLoggerSet LoggerSet
lgrset)

-- | 'bracket' version of 'newFastLogger'
withFastLogger :: LogType -> (FastLogger -> IO a) -> IO a
withFastLogger :: forall a. LogType -> ((LogStr -> IO ()) -> IO a) -> IO a
withFastLogger LogType
typ (LogStr -> IO ()) -> IO a
log' = forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (forall v. LogType' v -> IO (v -> IO (), IO ())
newFastLogger LogType
typ) forall a b. (a, b) -> b
snd ((LogStr -> IO ()) -> IO a
log' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

-- | Initialize a 'FastLogger' with timestamp attached to each message.
-- a tuple of logger and clean up action are returned.
newTimedFastLogger ::
    IO FormattedTime    -- ^ How do we get 'FormattedTime'?
                        -- "System.Log.FastLogger.Date" provide cached formatted time.
    -> LogType -> IO (TimedFastLogger, IO ())
newTimedFastLogger :: IO FormattedTime -> LogType -> IO (TimedFastLogger, IO ())
newTimedFastLogger IO FormattedTime
tgetter LogType
typ = case LogType
typ of
    LogType
LogNone                        -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> b -> a
const IO ()
noOp, IO ()
noOp)
    LogStdout Int
bsize                -> Int -> IO LoggerSet
newStdoutLoggerSet Int
bsize 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 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 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           -> forall (m :: * -> *) a. Monad m => a -> m a
return (\FormattedTime -> LogStr
f -> IO FormattedTime
tgetter forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LogStr -> IO ()
cb forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormattedTime -> LogStr
f 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 = forall (m :: * -> *) a. Monad m => a -> m a
return ( \FormattedTime -> LogStr
f -> IO FormattedTime
tgetter forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet
lgrset 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 = forall (m :: * -> *) a. Monad m => a -> m a
return (\FormattedTime -> LogStr
f -> IO FormattedTime
tgetter forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= LoggerSet -> LogStr -> IO ()
pushLogStr LoggerSet
lgrset 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 forall a b. (a -> b) -> a -> b
$ FileLogSpec -> FilePath
log_file FileLogSpec
fspec
        IORef Int
ref <- forall a. a -> IO (IORef a)
newIORef (Int
0 :: Int)
        MVar ()
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)
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
cnt forall a. Ord a => a -> a -> Bool
<= Int
0) forall a b. (a -> b) -> a -> b
$ LoggerSet -> FileLogSpec -> IORef Int -> MVar () -> IO ()
tryRotate LoggerSet
lgrset FileLogSpec
fspec IORef Int
ref MVar ()
mvar
        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 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 forall a b. (a -> b) -> a -> b
$ FormattedTime -> FilePath -> FilePath
prefixTime FormattedTime
now forall a b. (a -> b) -> a -> b
$ TimedFileLogSpec -> FilePath
timed_log_file TimedFileLogSpec
fspec
        IORef FormattedTime
ref <- forall a. a -> IO (IORef a)
newIORef FormattedTime
now
        MVar LoggerSet
mvar <- 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
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
updated 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)
        forall (m :: * -> *) a. Monad m => a -> m a
return (TimedFastLogger
logger, LoggerSet -> IO ()
rmLoggerSet LoggerSet
lgrset)

-- | 'bracket' version of 'newTimeFastLogger'
withTimedFastLogger :: IO FormattedTime -> LogType -> (TimedFastLogger -> IO a) -> IO a
withTimedFastLogger :: forall a.
IO FormattedTime -> LogType -> (TimedFastLogger -> IO a) -> IO a
withTimedFastLogger IO FormattedTime
tgetter LogType
typ TimedFastLogger -> IO a
log' = 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) forall a b. (a, b) -> b
snd (TimedFastLogger -> IO a
log' forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst)

----------------------------------------------------------------

noOp :: IO ()
noOp :: IO ()
noOp = forall (m :: * -> *) a. Monad m => a -> m a
return ()

decrease :: IORef Int -> IO Int
decrease :: IORef Int -> IO Int
decrease IORef Int
ref = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef Int
ref (\Int
x -> (Int
x forall a. Num a => a -> a -> a
- Int
1, Int
x forall a. Num a => a -> a -> a
- Int
1))

-- updateTime returns whether the timeframe has changed
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 = forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef FormattedTime
ref (\FormattedTime
x -> (FormattedTime
newTime, Bool -> Bool
not 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 = 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           = forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar ()
mvar
    unlock :: Maybe () -> IO ()
unlock Maybe ()
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    unlock Maybe ()
_       = forall a. MVar a -> a -> IO ()
putMVar MVar ()
mvar ()
    rotateFiles :: Maybe () -> IO ()
rotateFiles Maybe ()
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    rotateFiles Maybe ()
_       = do
        Maybe Integer
msiz <- IO (Maybe Integer)
getSize
        case Maybe Integer
msiz of
            -- A file is not available.
            -- So, let's set a big value to the counter so that
            -- this function is not called frequently.
            Maybe Integer
Nothing -> forall a. IORef a -> a -> IO ()
writeIORef IORef Int
ref Int
1000000
            Just Integer
siz
                | Integer
siz forall a. Ord a => a -> a -> Bool
> Integer
limit -> do
                    FileLogSpec -> IO ()
rotate FileLogSpec
spec
                    LoggerSet -> IO ()
renewLoggerSet LoggerSet
lgrset
                    forall a. IORef a -> a -> IO ()
writeIORef IORef Int
ref forall a b. (a -> b) -> a -> b
$ forall {a}. Num a => Integer -> a
estimate Integer
limit
                | Bool
otherwise ->
                    forall a. IORef a -> a -> IO ()
writeIORef IORef Int
ref forall a b. (a -> b) -> a -> b
$ forall {a}. Num a => Integer -> a
estimate (Integer
limit 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 = forall e a. Exception e => (e -> IO a) -> IO a -> IO a
handle (\(SomeException e
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) forall a b. (a -> b) -> a -> b
$
        -- The log file is locked by GHC.
        -- We need to get its file size by the way not using locks.
        forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO Word64
getFileSize FilePath
file
    -- 200 is an ad-hoc value for the length of log line.
    estimate :: Integer -> a
estimate Integer
x = forall {a}. Num a => Integer -> a
fromInteger (Integer
x 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 = 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           = forall a. MVar a -> IO (Maybe a)
tryTakeMVar MVar LoggerSet
mvar
    unlock :: Maybe LoggerSet -> IO ()
unlock Maybe LoggerSet
Nothing = 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
        forall a. MVar a -> a -> IO ()
putMVar MVar LoggerSet
mvar LoggerSet
newlgrset
        case Maybe FilePath
current_path of
          Maybe FilePath
Nothing   -> 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  = 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 forall a b. (a -> b) -> a -> b
$ TimedFileLogSpec -> FilePath
timed_log_file TimedFileLogSpec
spec