diff options
| -rw-r--r-- | Logs/MetaData.hs | 4 | ||||
| -rw-r--r-- | Test.hs | 2 | ||||
| -rw-r--r-- | Types/MetaData.hs | 9 |
3 files changed, 9 insertions, 6 deletions
diff --git a/Logs/MetaData.hs b/Logs/MetaData.hs index 6f7f4154a..153d8fa63 100644 --- a/Logs/MetaData.hs +++ b/Logs/MetaData.hs @@ -119,7 +119,7 @@ addMetaData k metadata = do - - 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 + - came after. -} simplifyLog :: Log MetaData -> Log MetaData simplifyLog s = case S.toDescList s of @@ -128,7 +128,7 @@ simplifyLog s = case S.toDescList s of where go c _ [] = c go c newer (l:ls) - | older `hasUniqueMetaData` newer = + | hasUniqueMetaData newer older = go (l:c) (unionMetaData older newer) ls | otherwise = go c newer ls where @@ -145,7 +145,7 @@ properties = localOption (QuickCheckTests 1000) $ testGroup "QuickCheck" , testProperty "prop_hashes_stable" Utility.Hash.prop_hashes_stable , testProperty "prop_schedule_roundtrips" Utility.Scheduled.prop_schedule_roundtrips , testProperty "prop_duration_roundtrips" Utility.HumanTime.prop_duration_roundtrips - , testProperty "prop_updateMetaData_sane" Types.MetaData.prop_updateMetaData_sane + , testProperty "prop_metadata_sane" Types.MetaData.prop_metadata_sane , testProperty "prop_metadata_serialize" Types.MetaData.prop_metadata_serialize ] diff --git a/Types/MetaData.hs b/Types/MetaData.hs index 53a9b6944..c701731c9 100644 --- a/Types/MetaData.hs +++ b/Types/MetaData.hs @@ -29,7 +29,7 @@ module Types.MetaData ( getAllMetaData, serialize, deserialize, - prop_updateMetaData_sane, + prop_metadata_sane, prop_metadata_serialize ) where @@ -199,10 +199,13 @@ instance Arbitrary MetaValue where instance Arbitrary MetaField where arbitrary = MetaField <$> arbitrary `suchThat` legalField -prop_updateMetaData_sane :: MetaData -> MetaField -> MetaValue -> Bool -prop_updateMetaData_sane m f v = and +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) ] where m' = updateMetaData f v m |