Put generator and shrinker test utilities in their own module

Just a small preparatory refactoring, since we'll be importing these test
utilities in following commits

Author: jorisdral

lsm-tree.cabal

@@ -384,6 +384,7 @@ test-suite lsm-tree-test
     Test.Database.LSMTree.StateMachine.Op
     Test.Database.LSMTree.UnitTests
     Test.System.Posix.Fcntl.NoCache
+    Test.Util.Arbitrary
     Test.Util.FS
     Test.Util.Orphans
     Test.Util.PrettyProxy

test/Test/Database/LSMTree/Generators.hs

@@ -3,12 +3,8 @@
 
 module Test.Database.LSMTree.Generators (
     tests
-  , prop_arbitraryAndShrinkPreserveInvariant
-  , prop_forAllArbitraryAndShrinkPreserveInvariant
-  , deepseqInvariant
   ) where
 
-import           Control.DeepSeq (NFData, deepseq)
 import           Data.Bifoldable (bifoldMap)
 import           Data.Coerce (coerce)
 import qualified Data.Map.Strict as Map
@@ -26,9 +22,10 @@ import           Database.LSMTree.Internal.RawBytes (RawBytes (..))
 import           Database.LSMTree.Internal.Serialise
 
 import qualified Test.QuickCheck as QC
-import           Test.QuickCheck (Arbitrary (..), Gen, Property, Testable (..))
+import           Test.QuickCheck (Property)
 import           Test.Tasty (TestTree, localOption, testGroup)
 import           Test.Tasty.QuickCheck (QuickCheckMaxSize (..), testProperty)
+import           Test.Util.Arbitrary
 
 tests :: TestTree
 tests = testGroup "Test.Database.LSMTree.Generators" [
@@ -54,27 +51,6 @@ tests = testGroup "Test.Database.LSMTree.Generators" [
         ]
     ]
 
-prop_arbitraryAndShrinkPreserveInvariant ::
-    forall a. (Arbitrary a, Show a) => (a -> Bool) -> [TestTree]
-prop_arbitraryAndShrinkPreserveInvariant =
-    prop_forAllArbitraryAndShrinkPreserveInvariant arbitrary shrink
-
-prop_forAllArbitraryAndShrinkPreserveInvariant ::
-    forall a. Show a => Gen a -> (a -> [a]) -> (a -> Bool) -> [TestTree]
-prop_forAllArbitraryAndShrinkPreserveInvariant gen shr inv =
-    [ testProperty "Arbitrary satisfies invariant" $
-            property $ QC.forAllShrink gen shr inv
-    , testProperty "Shrinking satisfies invariant" $
-            property $ QC.forAll gen $ \x ->
-                         case shr x of
-                           [] -> QC.label "no shrinks" $ property True
-                           xs -> QC.forAll (QC.growingElements xs) inv
-    ]
-
--- | Trivial invariant, but checks that the value is finite
-deepseqInvariant :: NFData a => a -> Bool
-deepseqInvariant x = x `deepseq` True
-
 prop_packRawBytesPinnedOrUnpinned :: Bool -> [Word8] -> Bool
 prop_packRawBytesPinnedOrUnpinned pinned ws =
     packRawBytesPinnedOrUnpinned pinned ws == RawBytes (VP.fromList ws)

test/Test/Database/LSMTree/Internal/Lookup.hs

@@ -66,12 +66,12 @@ import qualified System.FS.API as FS
 import           System.FS.API (Handle (..), mkFsPath)
 import qualified System.FS.BlockIO.API as FS
 import           System.FS.BlockIO.API
-import           Test.Database.LSMTree.Generators (deepseqInvariant,
-                     prop_arbitraryAndShrinkPreserveInvariant,
-                     prop_forAllArbitraryAndShrinkPreserveInvariant)
 import           Test.QuickCheck
 import           Test.Tasty
 import           Test.Tasty.QuickCheck
+import           Test.Util.Arbitrary (deepseqInvariant,
+                     prop_arbitraryAndShrinkPreserveInvariant,
+                     prop_forAllArbitraryAndShrinkPreserveInvariant)
 import           Test.Util.FS (withTempIOHasBlockIO)
 
 tests :: TestTree

test/Test/Util/Arbitrary.hs

@@ -0,0 +1,34 @@
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE TypeApplications    #-}
+
+module Test.Util.Arbitrary (
+    prop_arbitraryAndShrinkPreserveInvariant
+  , prop_forAllArbitraryAndShrinkPreserveInvariant
+  , deepseqInvariant
+  ) where
+
+import           Control.DeepSeq (NFData, deepseq)
+import           Test.QuickCheck
+import           Test.Tasty (TestTree)
+import           Test.Tasty.QuickCheck (testProperty)
+
+prop_arbitraryAndShrinkPreserveInvariant ::
+    forall a. (Arbitrary a, Show a) => (a -> Bool) -> [TestTree]
+prop_arbitraryAndShrinkPreserveInvariant =
+    prop_forAllArbitraryAndShrinkPreserveInvariant arbitrary shrink
+
+prop_forAllArbitraryAndShrinkPreserveInvariant ::
+    forall a. Show a => Gen a -> (a -> [a]) -> (a -> Bool) -> [TestTree]
+prop_forAllArbitraryAndShrinkPreserveInvariant gen shr inv =
+    [ testProperty "Arbitrary satisfies invariant" $
+            property $ forAllShrink gen shr inv
+    , testProperty "Shrinking satisfies invariant" $
+            property $ forAll gen $ \x ->
+                         case shr x of
+                           [] -> label "no shrinks" $ property True
+                           xs -> forAll (growingElements xs) inv
+    ]
+
+-- | Trivial invariant, but checks that the value is finite
+deepseqInvariant :: NFData a => a -> Bool
+deepseqInvariant x = x `deepseq` True