diff options
| author |  Joey Hess <joey@kitenet.net> | 2014-02-12 22:36:16 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2014-02-12 22:50:41 -0400 |
| commit | bedf143ce587c823c7f168a869d16cce4153e46b (patch) | |
| tree | 351e07f89e691b700ce43263ce5013b8321baef7 /Types/MetaData.hs | |
| parent | 406402220e50a6aea2e73c61693b0a93bfae9f38 (diff) | |
improve simplifier
Diffstat (limited to 'Types/MetaData.hs')
| -rw-r--r-- | Types/MetaData.hs | 23 |
1 files changed, 8 insertions, 15 deletions
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 |