Finish switching of index-using tests to ordinary indexes

src-extras/Database/LSMTree/Extras/Generators.hs

@@ -36,6 +36,7 @@ module Database.LSMTree.Extras.Generators (
   , LargeRawBytes (..)
   , isKeyForIndexCompact
   , KeyForIndexCompact (..)
+  , BiasedKey (..)
   , BiasedKeyForIndexCompact (..)
     -- * helpers
   , shrinkVec
@@ -564,26 +565,40 @@ instance Arbitrary KeyForIndexCompact where
 
 deriving newtype instance SerialiseKey KeyForIndexCompact
 
+-- we try to make collisions and close keys more likely (very crudely)
+arbitraryBiasedKey :: (RawBytes -> k) -> Gen RawBytes -> Gen k
+arbitraryBiasedKey fromRB genUnbiased = fromRB <$> frequency
+    [ (6, genUnbiased)
+    , (1, do
+        lastByte <- QC.sized $ skewedWithMax . fromIntegral
+        return (RB.pack ([1,3,3,7,0,1,7] <> [lastByte]))
+      )
+    ]
+    where
+      -- generates a value in range from 0 to ub, but skewed towards low end
+      skewedWithMax ub0 = do
+        ub1 <- QC.chooseBoundedIntegral (0, ub0)
+        ub2 <- QC.chooseBoundedIntegral (0, ub1)
+        QC.chooseBoundedIntegral (0, ub2)
+
+newtype BiasedKey = BiasedKey { getBiasedKey :: RawBytes }
+  deriving stock (Eq, Ord, Show)
+  deriving newtype NFData
+
+instance Arbitrary BiasedKey where
+  arbitrary = arbitraryBiasedKey BiasedKey arbitrary
+
+  shrink (BiasedKey rb) = [BiasedKey rb' | rb' <- shrink rb]
+
+deriving newtype instance SerialiseKey BiasedKey
+
 newtype BiasedKeyForIndexCompact =
     BiasedKeyForIndexCompact { getBiasedKeyForIndexCompact :: RawBytes }
   deriving stock (Eq, Ord, Show)
   deriving newtype NFData
 
 instance Arbitrary BiasedKeyForIndexCompact where
-  -- we try to make collisions and close keys more likely (very crudely)
-  arbitrary = BiasedKeyForIndexCompact <$> frequency
-      [ (6, genKeyForIndexCompact)
-      , (1, do
-          lastByte <- QC.sized $ skewedWithMax . fromIntegral
-          return (RB.pack ([1,3,3,7,0,1,7] <> [lastByte]))
-        )
-      ]
-      where
-        -- generates a value in range from 0 to ub, but skewed towards low end
-        skewedWithMax ub0 = do
-          ub1 <- QC.chooseBoundedIntegral (0, ub0)
-          ub2 <- QC.chooseBoundedIntegral (0, ub1)
-          QC.chooseBoundedIntegral (0, ub2)
+  arbitrary = arbitraryBiasedKey BiasedKeyForIndexCompact genKeyForIndexCompact
 
   shrink (BiasedKeyForIndexCompact rb) =
       [ BiasedKeyForIndexCompact rb'

test/Test/Database/LSMTree/Generators.hs

@@ -3,7 +3,7 @@ module Test.Database.LSMTree.Generators (
   ) where
 
 import           Data.Bifoldable (bifoldMap)
-import           Data.Coerce (coerce)
+import           Data.Coerce (Coercible, coerce)
 import qualified Data.Map.Strict as Map
 import qualified Data.Vector.Primitive as VP
 import           Data.Word (Word64, Word8)
@@ -70,8 +70,15 @@ tests = testGroup "Test.Database.LSMTree.Generators" [
         prop_arbitraryAndShrinkPreserveInvariant noTags $
           isKeyForIndexCompact . getBiasedKeyForIndexCompact
     , testGroup "lists of key/op pairs" $
-        prop_arbitraryAndShrinkPreserveInvariant labelTestKOps $
-          deepseqInvariant
+        [ testGroup "BiasedKey" $
+            prop_arbitraryAndShrinkPreserveInvariant
+              (labelTestKOps @BiasedKey)
+              deepseqInvariant
+        , testGroup "BiasedKeyForIndexCompact" $
+            prop_arbitraryAndShrinkPreserveInvariant
+              (labelTestKOps @BiasedKeyForIndexCompact)
+              deepseqInvariant
+        ]
     , testGroup "helpers"
         [ testProperty "prop_shrinkVec" $ \vec ->
             shrinkVec (QC.shrink @Int) vec === map VP.fromList (QC.shrink (VP.toList vec))
@@ -127,9 +134,13 @@ labelRawBytes rb =
     QC.tabulate "size" [showPowersOf 2 (RB.size rb)]
 
 type TestEntry = Entry SerialisedValue BlobSpan
-type TestKOp = (BiasedKeyForIndexCompact, TestEntry)
+type TestKOp k = (k, TestEntry)
 
-labelTestKOps :: [TestKOp] -> Property -> Property
+labelTestKOps ::
+     Coercible k SerialisedKey
+  => [TestKOp k]
+  -> Property
+  -> Property
 labelTestKOps kops' =
       QC.tabulate "key occurrences (>1 is collision)" (map (show . snd) (Map.assocs keyCounts))
     . QC.tabulate "key sizes" (map (showPowersOf 4 . sizeofKey) keys)

test/Test/Database/LSMTree/Internal.hs

@@ -17,7 +17,7 @@ import qualified Data.Map.Strict as Map
 import           Data.Maybe (isJust, mapMaybe)
 import qualified Data.Vector as V
 import           Data.Word
-import           Database.LSMTree.Extras.Generators (KeyForIndexCompact (..))
+import           Database.LSMTree.Extras.Generators ()
 import           Database.LSMTree.Internal
 import           Database.LSMTree.Internal.BlobRef
 import           Database.LSMTree.Internal.Config
@@ -132,9 +132,9 @@ showLeft x = \case
 --    == takeWhile ((<= ub) . key) . dropWhile ((< lb) . key)
 -- @
 prop_roundtripCursor ::
-     Maybe KeyForIndexCompact  -- ^ Inclusive lower bound
-  -> Maybe KeyForIndexCompact  -- ^ Inclusive upper bound
-  -> V.Vector (KeyForIndexCompact, Entry SerialisedValue SerialisedBlob)
+     Maybe SerialisedKey  -- ^ Inclusive lower bound
+  -> Maybe SerialisedKey  -- ^ Inclusive upper bound
+  -> V.Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob)
   -> Property
 prop_roundtripCursor lb ub kops = ioProperty $
     withTempIOHasBlockIO "prop_roundtripCursor" $ \hfs hbio -> do
@@ -171,17 +171,17 @@ prop_roundtripCursor lb ub kops = ioProperty $
       Mupdate v          -> Just (v, Nothing)
       Delete             -> Nothing
 
-    duplicates :: Map.Map KeyForIndexCompact Int
+    duplicates :: Map.Map SerialisedKey Int
     duplicates =
       Map.filter (> 1) $
         Map.fromListWith (+) . map (\(k, _) -> (k, 1)) $
           V.toList kops
 
 readCursorUntil ::
      ResolveSerialisedValue
-  -> Maybe KeyForIndexCompact  -- Inclusive upper bound
+  -> Maybe SerialisedKey  -- Inclusive upper bound
   -> Cursor IO h
-  -> IO (V.Vector (KeyForIndexCompact,
+  -> IO (V.Vector (SerialisedKey,
                    (SerialisedValue,
                     Maybe (WeakBlobRef IO h))))
 readCursorUntil resolve ub cursor = go V.empty

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

@@ -47,7 +47,7 @@ import           Database.LSMTree.Extras.RunData (RunData (..),
 import           Database.LSMTree.Internal.BlobRef
 import           Database.LSMTree.Internal.Entry as Entry
 import           Database.LSMTree.Internal.Index (Index, IndexType)
-import qualified Database.LSMTree.Internal.Index as Index (IndexType (Compact),
+import qualified Database.LSMTree.Internal.Index as Index (IndexType (Ordinary),
                      search)
 import           Database.LSMTree.Internal.Lookup
 import           Database.LSMTree.Internal.Page (PageNo (PageNo), PageSpan (..))
@@ -309,7 +309,7 @@ prop_roundtripFromWriteBufferLookupIO ::
 prop_roundtripFromWriteBufferLookupIO (SmallList dats) =
     ioProperty $
     withTempIOHasBlockIO "prop_roundtripFromWriteBufferLookupIO" $ \hfs hbio ->
-    withWbAndRuns hfs hbio Index.Compact dats $ \wb wbblobs runs -> do
+    withWbAndRuns hfs hbio Index.Ordinary dats $ \wb wbblobs runs -> do
     let model :: Map SerialisedKey (Entry SerialisedValue SerialisedBlob)
         model = Map.unionsWith (Entry.combine resolveV) (map runData dats)
         keys  = V.fromList [ k | InMemLookupData{lookups} <- dats
@@ -433,7 +433,7 @@ mkTestRun dat = (rawPages, b, ic)
 
     -- one-shot run construction
     (pages, b, ic) = runST $ do
-      racc <- Run.new nentries (RunAllocFixed 10) Index.Compact
+      racc <- Run.new nentries (RunAllocFixed 10) Index.Ordinary
       let kops = Map.toList dat
       psopss <- traverse (uncurry (Run.addKeyOp racc)) kops
       (mp, _ , b', ic', _) <- Run.unsafeFinalise racc

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

@@ -10,11 +10,10 @@ import qualified Data.Map.Strict as Map
 import           Data.Maybe (isJust)
 import qualified Data.Vector as V
 import           Database.LSMTree.Extras
-import           Database.LSMTree.Extras.Generators (KeyForIndexCompact)
 import           Database.LSMTree.Extras.RunData
 import qualified Database.LSMTree.Internal.BlobFile as BlobFile
 import qualified Database.LSMTree.Internal.Entry as Entry
-import qualified Database.LSMTree.Internal.Index as Index (IndexType (Compact))
+import qualified Database.LSMTree.Internal.Index as Index (IndexType (Ordinary))
 import           Database.LSMTree.Internal.Merge (MergeType (..))
 import qualified Database.LSMTree.Internal.Merge as Merge
 import           Database.LSMTree.Internal.PageAcc (entryWouldFitInPage)
@@ -65,7 +64,7 @@ runParams =
     RunBuilder.RunParams {
       runParamCaching = RunBuilder.CacheRunData,
       runParamAlloc   = RunAcc.RunAllocFixed 10,
-      runParamIndex   = Index.Compact
+      runParamIndex   = Index.Ordinary
     }
 
 -- | Creating multiple runs from write buffers and merging them leads to the
@@ -77,7 +76,7 @@ prop_MergeDistributes ::
      FS.HasBlockIO IO h ->
      MergeType ->
      StepSize ->
-     SmallList (RunData KeyForIndexCompact SerialisedValue SerialisedBlob) ->
+     SmallList (RunData SerialisedKey SerialisedValue SerialisedBlob) ->
      IO Property
 prop_MergeDistributes fs hbio mergeType stepSize (SmallList rds) = do
     let path = FS.mkFsPath []
@@ -153,7 +152,7 @@ prop_AbortMerge ::
      FS.HasBlockIO IO h ->
      MergeType ->
      StepSize ->
-     SmallList (RunData KeyForIndexCompact SerialisedValue SerialisedBlob) ->
+     SmallList (RunData SerialisedKey SerialisedValue SerialisedBlob) ->
      IO Property
 prop_AbortMerge fs hbio mergeType (Positive stepSize) (SmallList wbs) = do
     let path = FS.mkFsPath []

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

@@ -14,12 +14,11 @@ import           Data.Coerce (coerce)
 import qualified Data.Map.Strict as Map
 import           Data.Maybe (fromJust)
 import qualified Data.Primitive.ByteArray as BA
-import           Database.LSMTree.Extras.Generators (KeyForIndexCompact (..))
 import           Database.LSMTree.Extras.RunData
 import           Database.LSMTree.Internal.BlobRef (BlobSpan (..))
 import qualified Database.LSMTree.Internal.CRC32C as CRC
 import           Database.LSMTree.Internal.Entry
-import qualified Database.LSMTree.Internal.Index as Index (IndexType (Compact))
+import qualified Database.LSMTree.Internal.Index as Index (IndexType (Ordinary))
 import           Database.LSMTree.Internal.Paths (RunFsPaths (..),
                      WriteBufferFsPaths (..))
 import qualified Database.LSMTree.Internal.Paths as Paths
@@ -96,7 +95,7 @@ runParams =
     RunBuilder.RunParams {
       runParamCaching = RunBuilder.CacheRunData,
       runParamAlloc   = RunAcc.RunAllocFixed 10,
-      runParamIndex   = Index.Compact
+      runParamIndex   = Index.Ordinary
     }
 
 -- | Runs in IO, with a real file system.
@@ -186,7 +185,7 @@ readBlobFromBS bs (BlobSpan off sz) =
 prop_WriteNumEntries ::
      FS.HasFS IO h
   -> FS.HasBlockIO IO h
-  -> RunData KeyForIndexCompact SerialisedValue SerialisedBlob
+  -> RunData SerialisedKey SerialisedValue SerialisedBlob
   -> IO Property
 prop_WriteNumEntries fs hbio wb@(RunData m) =
     withRunAt fs hbio runParams (simplePath 42) wb' $ \run -> do
@@ -204,7 +203,7 @@ prop_WriteNumEntries fs hbio wb@(RunData m) =
 prop_WriteAndOpen ::
      FS.HasFS IO h
   -> FS.HasBlockIO IO h
-  -> RunData KeyForIndexCompact SerialisedValue SerialisedBlob
+  -> RunData SerialisedKey SerialisedValue SerialisedBlob
   -> IO Property
 prop_WriteAndOpen fs hbio wb =
     withRunAt fs hbio runParams (simplePath 1337) (serialiseRunData wb) $ \written ->
@@ -237,7 +236,7 @@ prop_WriteAndOpen fs hbio wb =
 prop_WriteAndOpenWriteBuffer ::
      FS.HasFS IO h
   -> FS.HasBlockIO IO h
-  -> RunData KeyForIndexCompact SerialisedValue SerialisedBlob
+  -> RunData SerialisedKey SerialisedValue SerialisedBlob
   -> IO Property
 prop_WriteAndOpenWriteBuffer hfs hbio rd = do
   -- Serialise run data as write buffer:
@@ -261,7 +260,7 @@ prop_WriteAndOpenWriteBuffer hfs hbio rd = do
 prop_WriteRunEqWriteWriteBuffer ::
      FS.HasFS IO h
   -> FS.HasBlockIO IO h
-  -> RunData KeyForIndexCompact SerialisedValue SerialisedBlob
+  -> RunData SerialisedKey SerialisedValue SerialisedBlob
   -> IO Property
 prop_WriteRunEqWriteWriteBuffer hfs hbio rd = do
   -- Serialise run data as run:

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

@@ -15,7 +15,7 @@ import           Data.Maybe
 import qualified Data.Vector.Primitive as VP
 import           Database.LSMTree.Internal.BlobRef (BlobSpan (..))
 import           Database.LSMTree.Internal.Entry
-import qualified Database.LSMTree.Internal.Index as Index (IndexType (Compact),
+import qualified Database.LSMTree.Internal.Index as Index (IndexType (Ordinary),
                      search)
 import           Database.LSMTree.Internal.Page (PageNo (PageNo), singlePage)
 import qualified Database.LSMTree.Internal.PageAcc as PageAcc
@@ -57,7 +57,7 @@ test_singleKeyRun =  do
         !e = InsertWithBlob (SerialisedValue' (VP.fromList [48, 19])) (BlobSpan 55 77)
 
     (addRes, (mp, mc, b, ic, _numEntries)) <- stToIO $ do
-      racc <- new (NumEntries 1) (RunAllocFixed 10) Index.Compact
+      racc <- new (NumEntries 1) (RunAllocFixed 10) Index.Ordinary
       addRes <- addKeyOp racc k e
       (addRes,) <$> unsafeFinalise racc
 

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

@@ -47,7 +47,7 @@ runParams =
     RunBuilder.RunParams {
       runParamCaching = RunBuilder.CacheRunData,
       runParamAlloc   = RunAcc.RunAllocFixed 10,
-      runParamIndex   = Index.Compact
+      runParamIndex   = Index.Ordinary
     }
 
 -- | 'new' in an existing directory should be succesfull.

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

@@ -8,12 +8,11 @@ module Test.Database.LSMTree.Internal.RunReader (
 import           Control.RefCount
 import           Data.Coerce (coerce)
 import qualified Data.Map as Map
-import           Database.LSMTree.Extras.Generators
-                     (BiasedKeyForIndexCompact (..))
+import           Database.LSMTree.Extras.Generators (BiasedKey (..))
 import           Database.LSMTree.Extras.RunData
 import           Database.LSMTree.Internal.BlobRef
 import           Database.LSMTree.Internal.Entry (Entry)
-import qualified Database.LSMTree.Internal.Index as Index (IndexType (Compact))
+import qualified Database.LSMTree.Internal.Index as Index (IndexType (Ordinary))
 import           Database.LSMTree.Internal.Run (Run)
 import qualified Database.LSMTree.Internal.RunAcc as RunAcc
 import qualified Database.LSMTree.Internal.RunBuilder as RunBuilder
@@ -71,7 +70,7 @@ runParams =
     RunBuilder.RunParams {
       runParamCaching = RunBuilder.CacheRunData,
       runParamAlloc   = RunAcc.RunAllocFixed 10,
-      runParamIndex   = Index.Compact
+      runParamIndex   = Index.Ordinary
     }
 
 -- | Creating a run from a write buffer and reading from the run yields the
@@ -86,8 +85,8 @@ runParams =
 prop_readAtOffset ::
      FS.HasFS IO h
   -> FS.HasBlockIO IO h
-  -> RunData BiasedKeyForIndexCompact SerialisedValue SerialisedBlob
-  -> Maybe BiasedKeyForIndexCompact
+  -> RunData BiasedKey SerialisedValue SerialisedBlob
+  -> Maybe BiasedKey
   -> IO Property
 prop_readAtOffset fs hbio rd offsetKey =
     withRunAt fs hbio runParams (simplePath 42) rd' $ \run -> do
@@ -109,15 +108,15 @@ prop_readAtOffset fs hbio rd offsetKey =
 prop_readAtOffsetExisting ::
      FS.HasFS IO h
   -> FS.HasBlockIO IO h
-  -> RunData BiasedKeyForIndexCompact SerialisedValue SerialisedBlob
+  -> RunData BiasedKey SerialisedValue SerialisedBlob
   -> NonNegative Int
   -> IO Property
 prop_readAtOffsetExisting fs hbio rd (NonNegative index)
   | null kops = pure discard
   | otherwise =
       prop_readAtOffset fs hbio rd (Just (keys !! (index `mod` length keys)))
   where
-    keys :: [BiasedKeyForIndexCompact]
+    keys :: [BiasedKey]
     keys = coerce (fst <$> kops)
     kops = Map.toList (unRunData rd)
 
@@ -130,8 +129,8 @@ prop_readAtOffsetExisting fs hbio rd (NonNegative index)
 prop_readAtOffsetIdempotence ::
      FS.HasFS IO h
   -> FS.HasBlockIO IO h
-  -> RunData BiasedKeyForIndexCompact SerialisedValue SerialisedBlob
-  -> Maybe BiasedKeyForIndexCompact
+  -> RunData BiasedKey SerialisedValue SerialisedBlob
+  -> Maybe BiasedKey
   -> IO Property
 prop_readAtOffsetIdempotence fs hbio rd offsetKey =
     withRunAt fs hbio runParams (simplePath 42) rd' $ \run -> do
@@ -155,7 +154,7 @@ prop_readAtOffsetIdempotence fs hbio rd offsetKey =
 prop_readAtOffsetReadHead ::
      FS.HasFS IO h
   -> FS.HasBlockIO IO h
-  -> RunData BiasedKeyForIndexCompact SerialisedValue SerialisedBlob
+  -> RunData BiasedKey SerialisedValue SerialisedBlob
   -> IO Property
 prop_readAtOffsetReadHead fs hbio rd =
     withRunAt fs hbio runParams (simplePath 42) rd' $ \run -> do