diff options
| -rw-r--r-- | Logs/MetaData.hs | 24 | ||||
| -rw-r--r-- | Types/MetaData.hs | 23 |
2 files changed, 17 insertions, 30 deletions
diff --git a/Logs/MetaData.hs b/Logs/MetaData.hs index 153d8fa63..6d070125c 100644 --- a/Logs/MetaData.hs +++ b/Logs/MetaData.hs @@ -96,14 +96,16 @@ addMetaData k metadata = do - 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) + - Instead, simplify it to: - - - 100 bar +y (100 foo +x bar +y) + - 100 bar +y - 200 foo -x - + - TODO: The above simplification is not implemented yet. + - - Now merging with the remote yields: - - - 100 bar +y (100 foo +x bar +y) + - 100 bar +y - 150 bar +z baz +w - 200 foo -x - @@ -111,15 +113,6 @@ addMetaData k metadata = do - - 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 after. -} simplifyLog :: Log MetaData -> Log MetaData simplifyLog s = case S.toDescList s of @@ -128,8 +121,9 @@ simplifyLog s = case S.toDescList s of where go c _ [] = c go c newer (l:ls) - | hasUniqueMetaData newer older = - go (l:c) (unionMetaData older newer) ls - | otherwise = go c newer ls + | unique == newMetaData = go c newer ls + | otherwise = go (l { value = unique } : c) + (unionMetaData unique newer) ls where older = value l + unique = older `differenceMetaData` newer diff --git a/Types/MetaData.hs b/Types/MetaData.hs index c701731c9..a3fe58483 100644 --- a/Types/MetaData.hs +++ b/Types/MetaData.hs @@ -23,7 +23,7 @@ module Types.MetaData ( newMetaData, updateMetaData, unionMetaData, - hasUniqueMetaData, + differenceMetaData, currentMetaData, currentMetaDataValues, getAllMetaData, @@ -154,18 +154,13 @@ unionMetaData :: MetaData -> MetaData -> MetaData unionMetaData (MetaData old) (MetaData new) = MetaData $ M.unionWith S.union new old -{- Checks if m contains any fields with values that are not - - the same in comparewith. Note that unset and set values are - - considered to be the same, so if m sets a value and comparewith - - unsets it, m is not unique. However, if m changes the value, - - or adds a new value, it is unique. -} -hasUniqueMetaData :: MetaData -> MetaData -> Bool -hasUniqueMetaData (MetaData comparewith) (MetaData m) = - any uniquefield (M.toList m) +differenceMetaData :: MetaData -> MetaData -> MetaData +differenceMetaData (MetaData m) (MetaData excludem) = MetaData $ + M.differenceWith diff m excludem where - uniquefield :: (MetaField, S.Set MetaValue) -> Bool - uniquefield (f, v) = maybe True (uniquevalue v) (M.lookup f comparewith) - uniquevalue v1 v2 = not $ S.null $ S.difference v1 v2 + diff sl sr = + let s = S.difference sl sr + in if S.null s then Nothing else Just s isSet :: MetaValue -> Bool isSet (MetaValue (CurrentlySet isset) _) = isset @@ -203,9 +198,7 @@ prop_metadata_sane :: MetaData -> MetaField -> MetaValue -> Bool prop_metadata_sane m f v = and [ S.member v $ getAllMetaData f m' , not (isSet v) || S.member v (currentMetaDataValues f m') - , not (hasUniqueMetaData m m) - , hasUniqueMetaData newMetaData m' - , not (hasUniqueMetaData m' newMetaData) + , differenceMetaData m' newMetaData == m' ] where m' = updateMetaData f v m |