{-# LANGUAGE Safe #-}

module System.Log.FastLogger.File
    ( FileLogSpec(..)
    , TimedFileLogSpec (..)
    , check
    , rotate
    , prefixTime
    ) where

import Data.ByteString.Char8 (unpack)
import System.Directory (doesFileExist, doesDirectoryExist, getPermissions, writable, renameFile)
import System.FilePath (takeDirectory, dropFileName, takeFileName, (</>))

import System.Log.FastLogger.Imports
import System.Log.FastLogger.Types (TimeFormat, FormattedTime)

-- | The spec for logging files
data FileLogSpec = FileLogSpec {
    FileLogSpec -> FilePath
log_file :: FilePath
  , FileLogSpec -> Integer
log_file_size :: Integer -- ^ Max log file size (in bytes) before requiring rotation.
  , FileLogSpec -> Int
log_backup_number :: Int -- ^ Max number of rotated log files to keep around before overwriting the oldest one.
  }

-- | The spec for time based rotation. It supports post processing of log files. Does
-- not delete any logs. Example:
--
-- @
-- timeRotate fname = LogFileTimedRotate
--                (TimedFileLogSpec fname timeFormat sametime compressFile)
--                defaultBufSize
--    where
--        timeFormat = "%FT%H%M%S"
--        sametime = (==) `on` C8.takeWhile (/='T')
--        compressFile fp = void . forkIO $
--            callProcess "tar" [ "--remove-files", "-caf", fp <> ".gz", fp ]
-- @
data TimedFileLogSpec = TimedFileLogSpec {
    TimedFileLogSpec -> FilePath
timed_log_file :: FilePath              -- ^ base file path
  , TimedFileLogSpec -> TimeFormat
timed_timefmt  :: TimeFormat            -- ^ time format to prepend
  , TimedFileLogSpec -> TimeFormat -> TimeFormat -> Bool
timed_same_timeframe  :: FormattedTime -> FormattedTime -> Bool
                                            -- ^ function that compares two
                                            --   formatted times as specified by
                                            --   timed_timefmt and decides if a
                                            --   new rotation is supposed to
                                            --   begin
  , TimedFileLogSpec -> FilePath -> IO ()
timed_post_process :: FilePath -> IO () -- ^ processing function called asynchronously after a file is added to the rotation
  }

-- | Checking if a log file can be written.
check :: FilePath -> IO ()
check :: FilePath -> IO ()
check FilePath
file = do
    Bool
dirExist <- FilePath -> IO Bool
doesDirectoryExist FilePath
dir
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
dirExist (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" does not exist or is not a directory."
    Permissions
dirPerm <- FilePath -> IO Permissions
getPermissions FilePath
dir
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Permissions -> Bool
writable Permissions
dirPerm) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
dir FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is not writable."
    Bool
exist <- FilePath -> IO Bool
doesFileExist FilePath
file
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exist (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        Permissions
perm <- FilePath -> IO Permissions
getPermissions FilePath
file
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Permissions -> Bool
writable Permissions
perm) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> IO ()
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath
file FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" is not writable."
  where
    dir :: FilePath
dir = FilePath -> FilePath
takeDirectory FilePath
file

-- | Rotating log files.
rotate :: FileLogSpec -> IO ()
rotate :: FileLogSpec -> IO ()
rotate FileLogSpec
spec = ((FilePath, FilePath) -> IO ()) -> [(FilePath, FilePath)] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath, FilePath) -> IO ()
move [(FilePath, FilePath)]
srcdsts
  where
    path :: FilePath
path = FileLogSpec -> FilePath
log_file FileLogSpec
spec
    n :: Int
n = FileLogSpec -> Int
log_backup_number FileLogSpec
spec
    dsts' :: [FilePath]
dsts' = [FilePath] -> [FilePath]
forall a. [a] -> [a]
reverse ([FilePath] -> [FilePath])
-> ([Int] -> [FilePath]) -> [Int] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FilePath
""FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:) ([FilePath] -> [FilePath])
-> ([Int] -> [FilePath]) -> [Int] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> FilePath) -> [Int] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map ((Char
'.'Char -> FilePath -> FilePath
forall a. a -> [a] -> [a]
:)(FilePath -> FilePath) -> (Int -> FilePath) -> Int -> FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> FilePath
forall a. Show a => a -> FilePath
show) ([Int] -> [FilePath]) -> [Int] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ [Int
0..Int
nInt -> Int -> Int
forall a. Num a => a -> a -> a
-Int
1]
    dsts :: [FilePath]
dsts = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
pathFilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) [FilePath]
dsts'
    srcs :: [FilePath]
srcs = [FilePath] -> [FilePath]
forall a. [a] -> [a]
tail [FilePath]
dsts
    srcdsts :: [(FilePath, FilePath)]
srcdsts = [FilePath] -> [FilePath] -> [(FilePath, FilePath)]
forall a b. [a] -> [b] -> [(a, b)]
zip [FilePath]
srcs [FilePath]
dsts
    move :: (FilePath, FilePath) -> IO ()
move (FilePath
src,FilePath
dst) = do
        Bool
exist <- FilePath -> IO Bool
doesFileExist FilePath
src
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exist (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
renameFile FilePath
src FilePath
dst

-- | Prefix file name with formatted time
prefixTime :: FormattedTime -> FilePath -> FilePath
prefixTime :: TimeFormat -> FilePath -> FilePath
prefixTime TimeFormat
time FilePath
path = FilePath -> FilePath
dropFileName FilePath
path FilePath -> FilePath -> FilePath
</> TimeFormat -> FilePath
unpack TimeFormat
time FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"-" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
takeFileName FilePath
path