{-# 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)
data FileLogSpec = FileLogSpec
{ FileLogSpec -> FilePath
log_file :: FilePath
, FileLogSpec -> Integer
log_file_size :: Integer
, FileLogSpec -> Int
log_backup_number :: Int
}
data TimedFileLogSpec = TimedFileLogSpec
{ TimedFileLogSpec -> FilePath
timed_log_file :: FilePath
, TimedFileLogSpec -> TimeFormat
timed_timefmt :: TimeFormat
, TimedFileLogSpec -> TimeFormat -> TimeFormat -> Bool
timed_same_timeframe :: FormattedTime -> FormattedTime -> Bool
, TimedFileLogSpec -> FilePath -> IO ()
timed_post_process :: FilePath -> IO ()
}
check :: FilePath -> IO ()
check :: FilePath -> IO ()
check FilePath
file = do
dirExist <- FilePath -> IO Bool
doesDirectoryExist FilePath
dir
unless dirExist $ fail $ dir ++ " does not exist or is not a directory."
dirPerm <- getPermissions dir
unless (writable dirPerm) $ fail $ dir ++ " is not writable."
exist <- doesFileExist file
when exist $ do
perm <- getPermissions file
unless (writable perm) $ fail $ file ++ " is not writable."
where
dir :: FilePath
dir = FilePath -> FilePath
takeDirectory FilePath
file
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
exist <- FilePath -> IO Bool
doesFileExist FilePath
src
when exist $ renameFile src dst
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