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 (isPrefixOf)
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 stock (Limit -> Limit -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Limit -> Limit -> Bool
$c/= :: Limit -> Limit -> Bool
== :: Limit -> Limit -> Bool
$c== :: Limit -> Limit -> Bool
Eq, Eq Limit
Limit -> Limit -> Bool
Limit -> Limit -> Ordering
Limit -> Limit -> Limit
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Limit -> Limit -> Limit
$cmin :: Limit -> Limit -> Limit
max :: Limit -> Limit -> Limit
$cmax :: Limit -> Limit -> Limit
>= :: Limit -> Limit -> Bool
$c>= :: Limit -> Limit -> Bool
> :: Limit -> Limit -> Bool
$c> :: Limit -> Limit -> Bool
<= :: Limit -> Limit -> Bool
$c<= :: Limit -> Limit -> Bool
< :: Limit -> Limit -> Bool
$c< :: Limit -> Limit -> Bool
compare :: Limit -> Limit -> Ordering
$ccompare :: Limit -> Limit -> Ordering
Ord, Int -> Limit -> ShowS
[Limit] -> ShowS
Limit -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Limit] -> ShowS
$cshowList :: [Limit] -> ShowS
show :: Limit -> String
$cshow :: Limit -> String
showsPrec :: Int -> Limit -> ShowS
$cshowsPrec :: Int -> Limit -> ShowS
Show)
withLogRotation
:: forall r msg m .
MonadIO m
=> Limit
-> Limit
-> FilePath
-> (FilePath -> IO ())
-> (Handle -> LogAction m msg)
-> (LogAction m msg -> IO r)
-> IO r
withLogRotation :: forall r msg (m :: * -> *).
MonadIO m =>
Limit
-> Limit
-> String
-> (String -> IO ())
-> (Handle -> LogAction m msg)
-> (LogAction m msg -> IO r)
-> IO r
withLogRotation Limit
sizeLimit Limit
filesLimit String
path String -> IO ()
cleanup Handle -> LogAction m msg
mkAction LogAction m msg -> IO r
cont = do
Handle
handle <- String -> IOMode -> IO Handle
openFile String
path IOMode
AppendMode
IORef Handle
handleRef <- forall a. a -> IO (IORef a)
newIORef Handle
handle
LogAction m msg -> IO r
cont forall a b. (a -> b) -> a -> b
$ IORef Handle -> LogAction m msg
rotationAction IORef Handle
handleRef
where
rotationAction :: IORef Handle -> LogAction m msg
rotationAction :: IORef Handle -> LogAction m msg
rotationAction IORef Handle
refHandle = forall (m :: * -> *) msg. (msg -> m ()) -> LogAction m msg
LogAction forall a b. (a -> b) -> a -> b
$ \msg
msg -> do
Handle
handle <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ forall a. IORef a -> IO a
readIORef IORef Handle
refHandle
Handle -> LogAction m msg
mkAction Handle
handle forall (m :: * -> *) msg. LogAction m msg -> msg -> m ()
<& msg
msg
Bool
isLimitReached <- forall (m :: * -> *). MonadIO m => Limit -> Handle -> m Bool
isFileSizeLimitReached Limit
sizeLimit Handle
handle
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
isLimitReached forall a b. (a -> b) -> a -> b
$ IORef Handle -> m ()
cleanupAndRotate IORef Handle
refHandle
cleanupAndRotate :: IORef Handle -> m ()
cleanupAndRotate :: IORef Handle -> m ()
cleanupAndRotate IORef Handle
refHandle = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
forall a. IORef a -> IO a
readIORef IORef Handle
refHandle forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Handle -> IO ()
hClose
Natural
maxN <- String -> IO Natural
maxFileIndex String
path
Natural -> String -> IO ()
renameFileToNumber (Natural
maxN forall a. Num a => a -> a -> a
+ Natural
1) String
path
[String]
oldFiles <- Limit -> String -> IO [String]
getOldFiles Limit
filesLimit String
path
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ String -> IO ()
cleanup [String]
oldFiles
Handle
newHandle <- String -> IOMode -> IO Handle
openFile String
path IOMode
AppendMode
forall a. IORef a -> a -> IO ()
writeIORef IORef Handle
refHandle Handle
newHandle
isLimitedBy :: Integer -> Limit -> Bool
isLimitedBy :: Integer -> Limit -> Bool
isLimitedBy Integer
_ Limit
Unlimited = Bool
False
isLimitedBy Integer
size (LimitTo Natural
limit)
| Integer
size forall a. Ord a => a -> a -> Bool
<= Integer
0 = Bool
False
| Bool
otherwise = Integer
size forall a. Ord a => a -> a -> Bool
> forall a. Integral a => a -> Integer
toInteger Natural
limit
isFileSizeLimitReached :: forall m . MonadIO m => Limit -> Handle -> m Bool
isFileSizeLimitReached :: forall (m :: * -> *). MonadIO m => Limit -> Handle -> m Bool
isFileSizeLimitReached Limit
limit Handle
handle = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ do
Integer
fileSize <- Handle -> IO Integer
hFileSize Handle
handle
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Integer -> Limit -> Bool
isLimitedBy Integer
fileSize Limit
limit
maxFileIndex :: FilePath -> IO Natural
maxFileIndex :: String -> IO Natural
maxFileIndex String
path = do
[String]
files <- String -> IO [String]
D.listDirectory (ShowS
POS.takeDirectory String
path)
let logFiles :: [String]
logFiles = String -> [String] -> [String]
getLogFiles String
path [String]
files
let maxFile :: Maybe Natural
maxFile = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe String -> Maybe Natural
logFileIndex [String]
logFiles)
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe Natural
0 Maybe Natural
maxFile
getLogFiles :: FilePath -> [FilePath] -> [FilePath]
getLogFiles :: String -> [String] -> [String]
getLogFiles String
logPath = forall a. (a -> Bool) -> [a] -> [a]
filter (\String
p -> ShowS
POS.takeFileName String
logPath forall a. Eq a => [a] -> [a] -> Bool
`isPrefixOf` ShowS
POS.takeFileName String
p)
renameFileToNumber :: Natural -> FilePath -> IO ()
renameFileToNumber :: Natural -> String -> IO ()
renameFileToNumber Natural
n String
path = String -> String -> IO ()
D.renameFile String
path (String
path String -> ShowS
<.> forall a. Show a => a -> String
show Natural
n)
logFileIndex :: FilePath -> Maybe Natural
logFileIndex :: String -> Maybe Natural
logFileIndex String
path = forall a. [a] -> Maybe (NonEmpty a)
nonEmpty (ShowS
POS.takeExtension String
path) forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.tail
getOldFiles :: Limit -> FilePath -> IO [FilePath]
getOldFiles :: Limit -> String -> IO [String]
getOldFiles Limit
limit String
path = do
Natural
currentMaxN <- String -> IO Natural
maxFileIndex String
path
[String]
files <- String -> IO [String]
D.listDirectory (ShowS
POS.takeDirectory String
path)
let logFiles :: [String]
logFiles = String -> [String] -> [String]
getLogFiles String
path [String]
files
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (String -> Maybe (String, Natural)
takeFileIndex forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> Natural -> (String, Natural) -> Maybe String
guardFileIndex Natural
currentMaxN) [String]
logFiles
where
takeFileIndex :: FilePath -> Maybe (FilePath, Natural)
takeFileIndex :: String -> Maybe (String, Natural)
takeFileIndex String
p = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String
p,) (String -> Maybe Natural
logFileIndex String
p)
guardFileIndex :: Natural -> (FilePath, Natural) -> Maybe FilePath
guardFileIndex :: Natural -> (String, Natural) -> Maybe String
guardFileIndex Natural
maxN (String
p, Natural
n)
| Natural -> Natural -> Bool
isOldFile Natural
maxN Natural
n = forall a. a -> Maybe a
Just String
p
| Bool
otherwise = forall a. Maybe a
Nothing
isOldFile :: Natural -> Natural -> Bool
isOldFile :: Natural -> Natural -> Bool
isOldFile Natural
maxN Natural
n = case Limit
limit of
Limit
Unlimited -> Bool
False
LimitTo Natural
l -> Natural
n forall a. Num a => a -> a -> a
+ Natural
l forall a. Ord a => a -> a -> Bool
< Natural
maxN