testing-utils: added set properties

IntersectMBO · May 7, 2024 · 44899a7 · 44899a7
1 parent 406f712
commit 44899a7
Show file tree

Hide file tree

Showing 2 changed files with 23 additions and 0 deletions.
diff --git a/ouroboros-network-testing/CHANGELOG.md b/ouroboros-network-testing/CHANGELOG.md
@@ -6,6 +6,8 @@
 
 ### Non-Breaking changes
 
+* Added `isSubsetProperty` and `disjoinSetsProperty` to `Ouroboros.Network.Testing.Utils`.
+
 ## 0.6.0.0 -- 2024-02-21
 
 ### Breaking changes

diff --git a/ouroboros-network-testing/src/Ouroboros/Network/Testing/Utils.hs b/ouroboros-network-testing/src/Ouroboros/Network/Testing/Utils.hs
@@ -10,6 +10,9 @@ module Ouroboros.Network.Testing.Utils
     Delay (..)
   , genDelayWithPrecision
   , SmallDelay (..)
+  -- * Set properties
+  , isSubsetProperty
+  , disjointSetsProperty
     -- * QuickCheck Utils
   , arbitrarySubset
   , shrinkVector
@@ -139,6 +142,24 @@ renderRanges r n = show lower ++ " -- " ++ show upper
     lower = n - n `mod` r
     upper = lower + (r-1)
 
+-- 
+-- Set properties
+--
+
+isSubsetProperty :: (Ord a, Show a) => String -> Set a -> Set a -> Property
+isSubsetProperty name a b =
+    let d = a Set.\\ b
+    in counterexample
+        (name ++ "violates subset property: " ++ show d)
+        (Set.null d)
+
+disjointSetsProperty :: (Ord a, Show a) => String -> Set a -> Set a -> Property
+disjointSetsProperty name a b =
+    let d = a `Set.intersection` b
+    in counterexample
+        (name ++ "vaiolates disjoint set property: " ++ show d)
+        (Set.null d)
+
 --
 -- Tracing tools
 --