File: File.hs

package info (click to toggle)
haskell-fast-logger 3.2.6-1
  • links: PTS, VCS
  • area: main
  • in suites: sid
  • size: 168 kB
  • sloc: haskell: 944; makefile: 3
file content (94 lines) | stat: -rw-r--r-- 2,995 bytes parent folder | download
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
{-# 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
    { log_file :: FilePath
    , log_file_size :: Integer
    -- ^ Max log file size (in bytes) before requiring rotation.
    , 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
    { timed_log_file :: FilePath
    -- ^ base file path
    , timed_timefmt :: TimeFormat
    -- ^ time format to prepend
    , 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
    , 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 file = do
    dirExist <- doesDirectoryExist 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 = takeDirectory file

-- | Rotating log files.
rotate :: FileLogSpec -> IO ()
rotate spec = mapM_ move srcdsts
  where
    path = log_file spec
    n = log_backup_number spec
    dsts' = reverse . ("" :) . map (('.' :) . show) $ [0 .. n - 1]
    dsts = map (path ++) dsts'
    srcs = drop 1 dsts
    srcdsts = zip srcs dsts
    move (src, dst) = do
        exist <- doesFileExist src
        when exist $ renameFile src dst

-- | Prefix file name with formatted time
prefixTime :: FormattedTime -> FilePath -> FilePath
prefixTime time path = dropFileName path </> unpack time ++ "-" ++ takeFileName path