{-# 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.Prelude
import Logging.Types.Class
import Logging.Types.Filter
import Logging.Types.Level
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 handler@RotatingFileHandler{..} rcd = do
let msg = format1 formatter rcd
stream' <- readIORef stream
hPutStrLn stream' msg
hFlush stream'
when (backupCount > 0) $ do
pos <- hTell stream'
when (fromEnum pos >= maxBytes) $ do
hClose stream'
rotate $ backupCount - 1
tryRenameFile file $ appendBaseName file ".1"
open handler
where
rotate :: Int -> IO ()
rotate n = when (n > 0) $ do
let src = appendBaseName file $ '.' : (show n)
dest = appendBaseName file $ '.' : (show (n + 1))
tryRenameFile src dest
rotate (n - 1)
close RotatingFileHandler{..} = hClose =<< readIORef stream