1{-# LANGUAGE CPP #-} 2{-# LANGUAGE OverloadedStrings #-} 3{-# LANGUAGE GADTs #-} 4 5-- | This module provides a fast logging system which 6-- scales on multicore environments (i.e. +RTS -N\<x\>). 7-- 8-- Note: This library does not guarantee correct ordering of log messages 9-- when program is run on more than one core thus users 10-- should rely more on message timestamps than on their order in the 11-- log. 12module System.Log.FastLogger ( 13 -- * FastLogger 14 FastLogger 15 , LogType 16 , LogType'(..) 17 , newFastLogger 18 , newFastLogger1 19 , withFastLogger 20 -- * Timed FastLogger 21 , TimedFastLogger 22 , newTimedFastLogger 23 , withTimedFastLogger 24 -- * Log messages 25 , LogStr 26 , ToLogStr(..) 27 , fromLogStr 28 , logStrLength 29 -- * Buffer size 30 , BufSize 31 , defaultBufSize 32 -- * LoggerSet 33 , module System.Log.FastLogger.LoggerSet 34 -- * Date cache 35 , module System.Log.FastLogger.Date 36 -- * File rotation 37 , module System.Log.FastLogger.File 38 -- * Types 39 , module System.Log.FastLogger.Types 40 ) where 41 42import Control.Concurrent (MVar, newMVar, tryTakeMVar, putMVar) 43import Control.Exception (handle, SomeException(..), bracket) 44import System.EasyFile (getFileSize) 45 46import System.Log.FastLogger.Date 47import System.Log.FastLogger.File 48import System.Log.FastLogger.IO 49import System.Log.FastLogger.Imports 50import System.Log.FastLogger.LogStr 51import System.Log.FastLogger.LoggerSet 52import System.Log.FastLogger.Types 53 54---------------------------------------------------------------- 55 56-- | 'FastLogger' simply log 'logStr'. 57type FastLogger = LogStr -> IO () 58-- | 'TimedFastLogger' pass 'FormattedTime' to callback and simply log its result. 59-- this can be used to customize how to log timestamp. 60-- 61-- Usually, one would write a wrapper on top of 'TimedFastLogger', for example: 62-- 63-- > {-# LANGUAGE OverloadedStrings #-} 64-- > 65-- > log :: TimedFastLogger -> LogStr -> IO () 66-- > log logger msg = logger (\time -> toLogStr (show time) <> " " <> msg <> "\n") 67type TimedFastLogger = (FormattedTime -> LogStr) -> IO () 68 69type LogType = LogType' LogStr 70 71-- | Logger Type. 72data LogType' a where 73 LogNone :: LogType' LogStr -- ^ No logging. 74 LogStdout :: BufSize -> LogType' LogStr 75 -- ^ Logging to stdout. 76 -- 'BufSize' is a buffer size 77 -- for each capability. 78 LogStderr :: BufSize -> LogType' LogStr 79 -- ^ Logging to stderr. 80 -- 'BufSize' is a buffer size 81 -- for each capability. 82 LogFileNoRotate :: FilePath -> BufSize -> LogType' LogStr 83 -- ^ Logging to a file. 84 -- 'BufSize' is a buffer size 85 -- for each capability. 86 LogFile :: FileLogSpec -> BufSize -> LogType' LogStr 87 -- ^ Logging to a file. 88 -- 'BufSize' is a buffer size 89 -- for each capability. 90 -- File rotation is done on-demand. 91 LogFileTimedRotate :: TimedFileLogSpec -> BufSize -> LogType' LogStr -- ^ Logging to a file. 92 -- 'BufSize' is a buffer size 93 -- for each capability. 94 -- Rotation happens based on check specified 95 -- in 'TimedFileLogSpec'. 96 LogCallback :: (v -> IO ()) -> IO () -> LogType' v -- ^ Logging with a log and flush action. 97 -- run flush after log each message. 98 99-- | Initialize a 'FastLogger' without attaching timestamp 100-- a tuple of logger and clean up action are returned. 101-- This type signature should be read as: 102-- 103-- > newFastLogger :: LogType -> IO (FastLogger, IO ()) 104newFastLogger :: LogType' v -> IO (v -> IO (), IO ()) 105newFastLogger typ = newFastLoggerCore Nothing typ 106 107newFastLogger1 :: LogType' v -> IO (v -> IO (), IO ()) 108newFastLogger1 typ = newFastLoggerCore (Just 1) typ 109 110newFastLoggerCore :: Maybe Int -> LogType' v -> IO (v -> IO (), IO ()) 111newFastLoggerCore mn typ = case typ of 112 LogNone -> return (const noOp, noOp) 113 LogStdout bsize -> newStdoutLoggerSet bsize >>= stdLoggerInit 114 LogStderr bsize -> newStderrLoggerSet bsize >>= stdLoggerInit 115 LogFileNoRotate fp bsize -> newFileLoggerSetN bsize mn fp >>= fileLoggerInit 116 LogFile fspec bsize -> rotateLoggerInit fspec bsize 117 LogFileTimedRotate fspec bsize -> timedRotateLoggerInit fspec bsize 118 LogCallback cb flush -> return (\str -> cb str >> flush, noOp) 119 where 120 stdLoggerInit lgrset = return (pushLogStr lgrset, rmLoggerSet lgrset) 121 fileLoggerInit lgrset = return (pushLogStr lgrset, rmLoggerSet lgrset) 122 rotateLoggerInit fspec bsize = do 123 lgrset <- newFileLoggerSetN bsize mn $ log_file fspec 124 ref <- newIORef (0 :: Int) 125 mvar <- newMVar () 126 let logger str = do 127 cnt <- decrease ref 128 pushLogStr lgrset str 129 when (cnt <= 0) $ tryRotate lgrset fspec ref mvar 130 return (logger, rmLoggerSet lgrset) 131 timedRotateLoggerInit fspec bsize = do 132 cache <- newTimeCache $ timed_timefmt fspec 133 now <- cache 134 lgrset <- newFileLoggerSetN bsize mn $ prefixTime now $ timed_log_file fspec 135 ref <- newIORef now 136 mvar <- newMVar lgrset 137 let logger str = do 138 ct <- cache 139 updated <- updateTime (timed_same_timeframe fspec) ref ct 140 when updated $ tryTimedRotate fspec ct mvar 141 pushLogStr lgrset str 142 return (logger, rmLoggerSet lgrset) 143 144-- | 'bracket' version of 'newFastLogger' 145withFastLogger :: LogType -> (FastLogger -> IO a) -> IO a 146withFastLogger typ log' = bracket (newFastLogger typ) snd (log' . fst) 147 148-- | Initialize a 'FastLogger' with timestamp attached to each message. 149-- a tuple of logger and clean up action are returned. 150newTimedFastLogger :: 151 IO FormattedTime -- ^ How do we get 'FormattedTime'? 152 -- "System.Log.FastLogger.Date" provide cached formatted time. 153 -> LogType -> IO (TimedFastLogger, IO ()) 154newTimedFastLogger tgetter typ = case typ of 155 LogNone -> return (const noOp, noOp) 156 LogStdout bsize -> newStdoutLoggerSet bsize >>= stdLoggerInit 157 LogStderr bsize -> newStderrLoggerSet bsize >>= stdLoggerInit 158 LogFileNoRotate fp bsize -> newFileLoggerSet bsize fp >>= fileLoggerInit 159 LogFile fspec bsize -> rotateLoggerInit fspec bsize 160 LogFileTimedRotate fspec bsize -> timedRotateLoggerInit fspec bsize 161 LogCallback cb flush -> return (\f -> tgetter >>= cb . f >> flush, noOp) 162 where 163 stdLoggerInit lgrset = return ( \f -> tgetter >>= pushLogStr lgrset . f, rmLoggerSet lgrset) 164 fileLoggerInit lgrset = return (\f -> tgetter >>= pushLogStr lgrset . f, rmLoggerSet lgrset) 165 rotateLoggerInit fspec bsize = do 166 lgrset <- newFileLoggerSet bsize $ log_file fspec 167 ref <- newIORef (0 :: Int) 168 mvar <- newMVar () 169 let logger f = do 170 cnt <- decrease ref 171 t <- tgetter 172 pushLogStr lgrset (f t) 173 when (cnt <= 0) $ tryRotate lgrset fspec ref mvar 174 return (logger, rmLoggerSet lgrset) 175 timedRotateLoggerInit fspec bsize = do 176 cache <- newTimeCache $ timed_timefmt fspec 177 now <- cache 178 lgrset <- newFileLoggerSet bsize $ prefixTime now $ timed_log_file fspec 179 ref <- newIORef now 180 mvar <- newMVar lgrset 181 let logger f = do 182 ct <- cache 183 updated <- updateTime (timed_same_timeframe fspec) ref ct 184 when updated $ tryTimedRotate fspec ct mvar 185 t <- tgetter 186 pushLogStr lgrset (f t) 187 return (logger, rmLoggerSet lgrset) 188 189-- | 'bracket' version of 'newTimeFastLogger' 190withTimedFastLogger :: IO FormattedTime -> LogType -> (TimedFastLogger -> IO a) -> IO a 191withTimedFastLogger tgetter typ log' = bracket (newTimedFastLogger tgetter typ) snd (log' . fst) 192 193---------------------------------------------------------------- 194 195noOp :: IO () 196noOp = return () 197 198decrease :: IORef Int -> IO Int 199decrease ref = atomicModifyIORef' ref (\x -> (x - 1, x - 1)) 200 201-- updateTime returns whether the timeframe has changed 202updateTime :: (FormattedTime -> FormattedTime -> Bool) -> IORef FormattedTime -> FormattedTime -> IO Bool 203updateTime cmp ref newTime = atomicModifyIORef' ref (\x -> (newTime, not $ cmp x newTime)) 204 205tryRotate :: LoggerSet -> FileLogSpec -> IORef Int -> MVar () -> IO () 206tryRotate lgrset spec ref mvar = bracket lock unlock rotateFiles 207 where 208 lock = tryTakeMVar mvar 209 unlock Nothing = return () 210 unlock _ = putMVar mvar () 211 rotateFiles Nothing = return () 212 rotateFiles _ = do 213 msiz <- getSize 214 case msiz of 215 -- A file is not available. 216 -- So, let's set a big value to the counter so that 217 -- this function is not called frequently. 218 Nothing -> writeIORef ref 1000000 219 Just siz 220 | siz > limit -> do 221 rotate spec 222 renewLoggerSet lgrset 223 writeIORef ref $ estimate limit 224 | otherwise -> 225 writeIORef ref $ estimate (limit - siz) 226 file = log_file spec 227 limit = log_file_size spec 228 getSize = handle (\(SomeException _) -> return Nothing) $ 229 -- The log file is locked by GHC. 230 -- We need to get its file size by the way not using locks. 231 Just . fromIntegral <$> getFileSize file 232 -- 200 is an ad-hoc value for the length of log line. 233 estimate x = fromInteger (x `div` 200) 234 235tryTimedRotate :: TimedFileLogSpec -> FormattedTime -> MVar LoggerSet -> IO () 236tryTimedRotate spec now mvar = bracket lock unlock rotateFiles 237 where 238 lock = tryTakeMVar mvar 239 unlock Nothing = return () 240 unlock (Just lgrset) = do 241 let (newlgrset, current_path) = replaceLoggerSet lgrset new_file_path 242 putMVar mvar newlgrset 243 case current_path of 244 Nothing -> return () 245 Just path -> timed_post_process spec path 246 rotateFiles Nothing = return () 247 rotateFiles (Just lgrset) = do 248 let (newlgrset, _) = replaceLoggerSet lgrset new_file_path 249 renewLoggerSet newlgrset 250 new_file_path = prefixTime now $ timed_log_file spec 251