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
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
|
{- git-annex presence log
-
- This is used to store presence information in the git-annex branch in
- a way that can be union merged.
-
- A line of the log will look like: "date N INFO"
- Where N=1 when the INFO is present, and 0 otherwise.
-
- Copyright 2010-2011 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module PresenceLog (
LogStatus(..),
addLog,
readLog,
parseLog,
writeLog,
logNow,
compactLog,
currentLog,
LogLine
) where
import Data.Time.Clock.POSIX
import Data.Time
import System.Locale
import qualified Data.Map as M
import Control.Monad.State (liftIO)
import Control.Applicative
import qualified Branch
import Types
data LogLine = LogLine {
date :: POSIXTime,
status :: LogStatus,
info :: String
} deriving (Eq)
data LogStatus = InfoPresent | InfoMissing | Undefined
deriving (Eq)
instance Show LogStatus where
show InfoPresent = "1"
show InfoMissing = "0"
show Undefined = "undefined"
instance Read LogStatus where
readsPrec _ "1" = [(InfoPresent, "")]
readsPrec _ "0" = [(InfoMissing, "")]
readsPrec _ _ = [(Undefined, "")]
instance Show LogLine where
show (LogLine d s i) = unwords [show d, show s, i]
instance Read LogLine where
-- This parser is robust in that even unparsable log lines are
-- read without an exception being thrown.
-- Such lines have a status of Undefined.
readsPrec _ string =
if length w >= 3
then maybe bad good pdate
else bad
where
w = words string
s = read $ w !! 1
i = w !! 2
pdate :: Maybe UTCTime
pdate = parseTime defaultTimeLocale "%s%Qs" $ head w
good v = ret $ LogLine (utcTimeToPOSIXSeconds v) s i
bad = ret $ LogLine 0 Undefined ""
ret v = [(v, "")]
addLog :: FilePath -> LogLine -> Annex ()
addLog file line = do
ls <- readLog file
writeLog file (compactLog $ line:ls)
{- Reads a log file.
- Note that the LogLines returned may be in any order. -}
readLog :: FilePath -> Annex [LogLine]
readLog file = parseLog <$> Branch.get file
parseLog :: String -> [LogLine]
parseLog = filter parsable . map read . lines
where
-- some lines may be unparseable, avoid them
parsable l = status l /= Undefined
{- Stores a set of lines in a log file -}
writeLog :: FilePath -> [LogLine] -> Annex ()
writeLog file ls = Branch.change file (unlines $ map show ls)
{- Generates a new LogLine with the current date. -}
logNow :: LogStatus -> String -> Annex LogLine
logNow s i = do
now <- liftIO getPOSIXTime
return $ LogLine now s i
{- Reads a log and returns only the info that is still in effect. -}
currentLog :: FilePath -> Annex [String]
currentLog file = map info . filterPresent <$> readLog file
{- Returns the info from LogLines that are in effect. -}
filterPresent :: [LogLine] -> [LogLine]
filterPresent = filter (\l -> InfoPresent == status l) . compactLog
{- Compacts a set of logs, returning a subset that contains the current
- status. -}
compactLog :: [LogLine] -> [LogLine]
compactLog = M.elems . foldr mapLog M.empty
type LogMap = M.Map String LogLine
{- Inserts a log into a map of logs, if the log has better (ie, newer)
- information than the other logs in the map -}
mapLog :: LogLine -> LogMap -> LogMap
mapLog l m =
if better
then M.insert i l m
else m
where
better = maybe True newer $ M.lookup i m
newer l' = date l' <= date l
i = info l
|
