{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE RecordWildCards #-}
module Logging.Types.Handlers.RotatingFileHandler
( RotatingFileHandler(..)
) where
import Control.Monad
import Data.IORef
import GHC.Generics
import System.IO
import Text.Format
import Logging.Types.Class
import Logging.Types.Filter
import Logging.Types.Level
import Logging.Utils
import System.IO.Extra
data RotatingFileHandler = RotatingFileHandler { level :: Level
, filterer :: Filterer
, formatter :: Format1
, file :: FilePath
, encoding :: TextEncoding
, maxBytes :: Int
, backupCount :: Int
, stream :: IORef Handle
} deriving (Generic, Eq)
instance Handler RotatingFileHandler where
open RotatingFileHandler{..} =
atomicWriteIORef stream =<< openLogFile file encoding
emit RotatingFileHandler{..} rcd = do
let msg = format1 formatter rcd
rollover $ length msg
stream' <- readIORef stream
hPutStrLn stream' msg
hFlush stream'
where
rollover :: Int -> IO ()
rollover mlen = do
stream' <- readIORef stream
pos <- hTell =<< readIORef stream
when (fromEnum pos + mlen >= maxBytes && backupCount > 0) $ do
hClose stream'
rotateNext $ backupCount - 1
rotateFile file $ modifyBaseName file (++ ".1")
addSuffix :: String -> Int -> String
addSuffix src suffix = src ++ "." ++ (show suffix)
rotateNext :: Int -> IO ()
rotateNext n = when (n > 0) $ do
let src = modifyBaseName file $ flip addSuffix n
dest = modifyBaseName file $ flip addSuffix $ n + 1
rotateFile src dest
close RotatingFileHandler{..} = hClose =<< readIORef stream