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
|
{- git-annex general metadata storage log
-
- A line of the log will look like "timestamp field [+-]value [...]"
-
- Note that unset values are preserved. Consider this case:
-
- We have:
-
- 100 foo +x
- 200 foo -x
-
- An unmerged remote has:
-
- 150 foo +x
-
- After union merge, because the foo -x was preserved, we know that
- after the other remote redundantly set foo +x, it was unset,
- and so foo currently has no value.
-
-
- Copyright 2014 Joey Hess <joey@kitenet.net>
-
- Licensed under the GNU GPL version 3 or higher.
-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Logs.MetaData (
getCurrentMetaData,
getMetaData,
setMetaData,
unsetMetaData,
addMetaData,
currentMetaData,
) where
import Common.Annex
import Types.MetaData
import qualified Annex.Branch
import Logs
import Logs.SingleValue
import qualified Data.Set as S
import Data.Time.Clock.POSIX
instance SingleValueSerializable MetaData where
serialize = Types.MetaData.serialize
deserialize = Types.MetaData.deserialize
getMetaData :: Key -> Annex (Log MetaData)
getMetaData = readLog . metaDataLogFile
{- Go through the log from oldest to newest, and combine it all
- into a single MetaData representing the current state. -}
getCurrentMetaData :: Key -> Annex MetaData
getCurrentMetaData = currentMetaData . collect <$$> getMetaData
where
collect = foldl' unionMetaData newMetaData . map value . S.toAscList
setMetaData :: Key -> MetaField -> String -> Annex ()
setMetaData = setMetaData' True
unsetMetaData :: Key -> MetaField -> String -> Annex ()
unsetMetaData = setMetaData' False
setMetaData' :: Bool -> Key -> MetaField -> String -> Annex ()
setMetaData' isset k field s = addMetaData k $
updateMetaData field (mkMetaValue (CurrentlySet isset) s) newMetaData
{- Adds in some metadata, which can override existing values, or unset
- them, but otherwise leaves any existing metadata as-is. -}
addMetaData :: Key -> MetaData -> Annex ()
addMetaData k metadata = do
now <- liftIO getPOSIXTime
Annex.Branch.change (metaDataLogFile k) $
showLog . simplifyLog
. S.insert (LogEntry now metadata)
. parseLog
{- Simplify a log, removing historical values that are no longer
- needed.
-
- This is not as simple as just making a single log line with the newest
- state of all metadata. Consider this case:
-
- We have:
-
- 100 foo +x bar +y
- 200 foo -x
-
- An unmerged remote has:
-
- 150 bar +z baz +w
-
- If what we have were simplified to "200 foo -x bar +y" then when the line
- from the remote became available, it would be older than the simplified
- line, and its change to bar would not take effect. That is wrong.
-
- Instead, simplify it to: (this simpliciation is optional)
-
- 100 bar +y (100 foo +x bar +y)
- 200 foo -x
-
- Now merging with the remote yields:
-
- 100 bar +y (100 foo +x bar +y)
- 150 bar +z baz +w
- 200 foo -x
-
- Simplifying again:
-
- 150 bar +z baz +w
- 200 foo -x
-
- In practice, there is little benefit to making simplications to lines
- that only remove some values, while leaving others on the line.
- Since lines are kept in git, that likely increases the size of the
- git repo (depending on compression), rather than saving any space.
-
- So, the only simplication that is actually done is to throw out an
- old line when all the values in it have been overridden by lines that
- came before
-}
simplifyLog :: Log MetaData -> Log MetaData
simplifyLog s = case S.toDescList s of
(newest:rest) -> S.fromList $ go [newest] (value newest) rest
_ -> s
where
go c _ [] = c
go c newer (l:ls)
| older `hasUniqueMetaData` newer =
go (l:c) (unionMetaData older newer) ls
| otherwise = go c newer ls
where
older = value l
|
