module Colog.Rotation
( Limit(..)
, withLogRotation
) where
import Control.Monad (when, (>=>))
import Control.Monad.IO.Class (MonadIO (..))
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
import Data.List.NonEmpty (nonEmpty)
import Data.Maybe (fromMaybe, mapMaybe)
import Numeric.Natural (Natural)
import System.FilePath.Posix ((<.>))
import System.IO (Handle, IOMode (AppendMode), hClose, hFileSize, openFile)
import Text.Read (readMaybe)
import Colog.Core.Action (LogAction (..), (<&))
import qualified Data.List.NonEmpty as NE
import qualified System.Directory as D
import qualified System.FilePath.Posix as POS
data Limit = LimitTo Natural | Unlimited deriving (Eq, Ord)
withLogRotation
:: forall r msg m .
MonadIO m
=> Limit
-> Limit
-> FilePath
-> (FilePath -> IO ())
-> (Handle -> LogAction m msg)
-> (LogAction m msg -> IO r)
-> IO r
withLogRotation sizeLimit filesLimit path cleanup mkAction cont = do
handle <- openFile path AppendMode
handleRef <- newIORef handle
cont $ rotationAction handleRef
where
rotationAction :: IORef Handle -> LogAction m msg
rotationAction refHandle = LogAction $ \msg -> do
handle <- liftIO $ readIORef refHandle
mkAction handle <& msg
isLimitReached <- isFileSizeLimitReached sizeLimit handle
when isLimitReached $ cleanupAndRotate refHandle
cleanupAndRotate :: IORef Handle -> m ()
cleanupAndRotate refHandle = liftIO $ do
readIORef refHandle >>= hClose
maxN <- maxFileIndex path
renameFileToNumber (maxN + 1) path
oldFiles <- getOldFiles filesLimit path
mapM_ cleanup oldFiles
newHandle <- openFile path AppendMode
writeIORef refHandle newHandle
isLimitedBy :: Integer -> Limit -> Bool
isLimitedBy _ Unlimited = False
isLimitedBy size (LimitTo limit)
| size <= 0 = False
| otherwise = toInteger limit > size
isFileSizeLimitReached :: forall m . MonadIO m => Limit -> Handle -> m Bool
isFileSizeLimitReached limit handle = liftIO $ do
fileSize <- hFileSize handle
pure $ isLimitedBy fileSize limit
maxFileIndex :: FilePath -> IO Natural
maxFileIndex path = do
files <- D.listDirectory (POS.takeDirectory path)
let logFiles = filter (== POS.takeBaseName path) files
let maxFile = maximum <$> nonEmpty (mapMaybe logFileIndex logFiles)
pure $ fromMaybe 0 maxFile
renameFileToNumber :: Natural -> FilePath -> IO ()
renameFileToNumber n path = D.renameFile path (path <.> show n)
logFileIndex :: FilePath -> Maybe Natural
logFileIndex path =
nonEmpty (POS.takeExtension path) >>= readMaybe . NE.tail
getOldFiles :: Limit -> FilePath -> IO [FilePath]
getOldFiles limit path = do
currentMaxN <- maxFileIndex path
files <- D.listDirectory (POS.takeDirectory path)
pure $ mapMaybe (takeFileIndex >=> guardFileIndex currentMaxN) files
where
takeFileIndex :: FilePath -> Maybe (FilePath, Natural)
takeFileIndex p = (p,) <$> logFileIndex path
guardFileIndex :: Natural -> (FilePath, Natural) -> Maybe FilePath
guardFileIndex maxN (p, n)
| isOldFile maxN n = Nothing
| otherwise = Just p
isOldFile :: Natural -> Natural -> Bool
isOldFile maxN n = case limit of
Unlimited -> False
LimitTo l -> n < maxN - l