{-# LANGUAGE CPP #-}
#if !MIN_VERSION_directory(1,3,8)
{-# LANGUAGE Safe #-}
#endif

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

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

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

-- | 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 a. FilePath -> IO a
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 a. FilePath -> IO a
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 a. FilePath -> IO a
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
n Int -> 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
path FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) [FilePath]
dsts'
    srcs :: [FilePath]
srcs = [FilePath] -> [FilePath]
forall a. HasCallStack => [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