fs-sim utils for filtering Errors

IntersectMBO · Jan 15, 2025 · 0a6ab58 · 0a6ab58
1 parent fcbc71e
commit 0a6ab58
Show file tree

Hide file tree

Showing 2 changed files with 24 additions and 13 deletions.
diff --git a/test/Test/Database/LSMTree/StateMachine.hs b/test/Test/Database/LSMTree/StateMachine.hs
@@ -114,7 +114,6 @@ import qualified System.FS.Sim.Error as FSSim
 import           System.FS.Sim.Error (Errors)
 import qualified System.FS.Sim.MockFS as MockFS
 import           System.FS.Sim.MockFS (MockFS)
-import qualified System.FS.Sim.Stream as Stream
 import           System.FS.Sim.Stream (Stream)
 import           System.IO.Temp (createTempDirectory,
                      getCanonicalTemporaryDirectory)
@@ -133,7 +132,7 @@ import qualified Test.QuickCheck.StateModel.Lockstep.Run as Lockstep.Run
 import           Test.Tasty (TestTree, testGroup)
 import           Test.Tasty.QuickCheck (testProperty)
 import           Test.Util.FS (approximateEqStream, assertNoOpenHandles,
-                     assertNumOpenHandles)
+                     assertNumOpenHandles, noRemoveDirectoryRecursiveE)
 import           Test.Util.PrettyProxy
 import           Test.Util.TypeFamilyWrappers (WrapBlob (..), WrapBlobRef (..),
                      WrapCursor (..), WrapTable (..))
@@ -1415,13 +1414,7 @@ arbitraryActionWithVars _ label ctx (ModelState st _stats) =
      ++ [ (1, fmap Some $ OpenSnapshot @k @v @b PrettyProxy <$>
                 genErrors <*> pure label <*> genUsedSnapshotName)
         | not (null usedSnapshotNames)
-        , let genErrors = do
-                merrs <- QC.arbitrary
-                case merrs of
-                  Nothing -> pure Nothing
-                  Just errs -> pure . Just $ errs {
-                      FSSim.removeDirectoryRecursiveE = Stream.empty
-                    }
+        , let genErrors = fmap noRemoveDirectoryRecursiveE <$> QC.arbitrary
         ]
 
      ++ [ (1, fmap Some $ DeleteSnapshot <$> genUsedSnapshotName)

diff --git a/test/Test/Util/FS.hs b/test/Test/Util/FS.hs
@@ -24,6 +24,10 @@ module Test.Util.FS (
   , assertNumOpenHandles
     -- * Equality
   , approximateEqStream
+    -- * Errors
+  , noHCloseE
+  , noRemoveFileE
+  , noRemoveDirectoryRecursiveE
     -- * Arbitrary
   , NoCleanupErrors (..)
   ) where
@@ -240,6 +244,19 @@ approximateEqStream (UnsafeStream infoXs xs) (UnsafeStream infoYs ys) =
       (Finite, Finite)     ->  xs == ys
       (_, _)               -> False
 
+{-------------------------------------------------------------------------------
+  Errors
+-------------------------------------------------------------------------------}
+
+noHCloseE :: Errors -> Errors
+noHCloseE errs = errs { hCloseE = Stream.empty }
+
+noRemoveFileE :: Errors -> Errors
+noRemoveFileE errs = errs { removeFileE = Stream.empty }
+
+noRemoveDirectoryRecursiveE :: Errors -> Errors
+noRemoveDirectoryRecursiveE errs = errs { removeDirectoryRecursiveE = Stream.empty }
+
 {-------------------------------------------------------------------------------
   Arbitrary
 -------------------------------------------------------------------------------}
@@ -249,10 +266,11 @@ newtype NoCleanupErrors = NoCleanupErrors Errors
   deriving stock Show
 
 mkNoCleanupErrors :: Errors -> NoCleanupErrors
-mkNoCleanupErrors errs = NoCleanupErrors $ errs {
-      hCloseE = Stream.empty
-    , removeFileE = Stream.empty
-    }
+mkNoCleanupErrors errs = NoCleanupErrors $
+      noHCloseE
+    $ noRemoveFileE
+    $ noRemoveDirectoryRecursiveE
+    $ errs
 
 instance Arbitrary NoCleanupErrors where
   arbitrary = do