improve simplifier

This commit is contained in:
Joey Hess 2014-02-12 22:36:16 -04:00
parent a05ac13e92
commit 8076530284
2 changed files with 17 additions and 30 deletions

View file

@ -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

View file

@ -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