improve simplifier

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

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