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
129
130
131
132
133
134
135
136
137
138
139
140
141
142
|
{- git-annex uuid-based logs
-
- This is used to store information about a UUID in a way that can
- be union merged.
-
- A line of the log will look like: "UUID[ INFO[ timestamp=foo]]"
- The timestamp is last for backwards compatability reasons,
- and may not be present on old log lines.
-
- New uuid based logs instead use the form: "timestamp UUID INFO"
-
- Copyright 2011-2013 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
module Logs.UUIDBased (
Log,
LogEntry(..),
TimeStamp(..),
parseLog,
parseLogNew,
parseLogWithUUID,
showLog,
showLogNew,
changeLog,
addLog,
simpleMap,
prop_TimeStamp_sane,
prop_addLog_sane,
) where
import qualified Data.Map as M
import Data.Time.Clock.POSIX
import Data.Time
import System.Locale
import Common
import Types.UUID
data TimeStamp = Unknown | Date POSIXTime
deriving (Eq, Ord, Show)
data LogEntry a = LogEntry
{ changed :: TimeStamp
, value :: a
} deriving (Eq, Show)
type Log a = M.Map UUID (LogEntry a)
tskey :: String
tskey = "timestamp="
showLog :: (a -> String) -> Log a -> String
showLog shower = unlines . map showpair . M.toList
where
showpair (k, LogEntry (Date p) v) =
unwords [fromUUID k, shower v, tskey ++ show p]
showpair (k, LogEntry Unknown v) =
unwords [fromUUID k, shower v]
showLogNew :: (a -> String) -> Log a -> String
showLogNew shower = unlines . map showpair . M.toList
where
showpair (k, LogEntry (Date p) v) =
unwords [show p, fromUUID k, shower v]
showpair (k, LogEntry Unknown v) =
unwords ["0", fromUUID k, shower v]
parseLog :: (String -> Maybe a) -> String -> Log a
parseLog = parseLogWithUUID . const
parseLogWithUUID :: (UUID -> String -> Maybe a) -> String -> Log a
parseLogWithUUID parser = M.fromListWith best . mapMaybe parse . lines
where
parse line
-- This is a workaround for a bug that caused
-- NoUUID items to be stored in the log.
-- It can be removed at any time; is just here to clean
-- up logs where that happened temporarily.
| " " `isPrefixOf` line = Nothing
| null ws = Nothing
| otherwise = parser u (unwords info) >>= makepair
where
makepair v = Just (u, LogEntry ts v)
ws = words line
u = toUUID $ Prelude.head ws
t = Prelude.last ws
ts
| tskey `isPrefixOf` t =
pdate $ drop 1 $ dropWhile (/= '=') t
| otherwise = Unknown
info
| ts == Unknown = drop 1 ws
| otherwise = drop 1 $ beginning ws
pdate s = case parseTime defaultTimeLocale "%s%Qs" s of
Nothing -> Unknown
Just d -> Date $ utcTimeToPOSIXSeconds d
parseLogNew :: (String -> Maybe a) -> String -> Log a
parseLogNew parser = M.fromListWith best . mapMaybe parse . lines
where
parse line = do
let (ts, rest) = splitword line
(u, v) = splitword rest
date <- Date . utcTimeToPOSIXSeconds <$> parseTime defaultTimeLocale "%s%Qs" ts
val <- parser v
Just (toUUID u, LogEntry date val)
splitword = separate (== ' ')
changeLog :: POSIXTime -> UUID -> a -> Log a -> Log a
changeLog t u v = M.insert u $ LogEntry (Date t) v
{- Only add an LogEntry if it's newer (or at least as new as) than any
- existing LogEntry for a UUID. -}
addLog :: UUID -> LogEntry a -> Log a -> Log a
addLog = M.insertWith' best
{- Converts a Log into a simple Map without the timestamp information.
- This is a one-way trip, but useful for code that never needs to change
- the log. -}
simpleMap :: Log a -> M.Map UUID a
simpleMap = M.map value
best :: LogEntry a -> LogEntry a -> LogEntry a
best new old
| changed old > changed new = old
| otherwise = new
-- Unknown is oldest.
prop_TimeStamp_sane :: Bool
prop_TimeStamp_sane = Unknown < Date 1
prop_addLog_sane :: Bool
prop_addLog_sane = newWins && newestWins
where
newWins = addLog (UUID "foo") (LogEntry (Date 1) "new") l == l2
newestWins = addLog (UUID "foo") (LogEntry (Date 1) "newest") l2 /= l2
l = M.fromList [(UUID "foo", LogEntry (Date 0) "old")]
l2 = M.fromList [(UUID "foo", LogEntry (Date 1) "new")]
|
