Merge pull request #612 from IntersectMBO/jeltsch/ordinary-index-key-assertions

Add assertions about keys to ordinary-index construction

Author: jeltsch

src/Database/LSMTree/Internal/Index/OrdinaryAcc.hs

@@ -1,3 +1,5 @@
+{-# LANGUAGE CPP #-}
+
 {- HLINT ignore "Avoid restricted alias" -}
 
 {-|
@@ -32,6 +34,10 @@ import           Database.LSMTree.Internal.Vector (byteVectorFromPrim)
 import           Database.LSMTree.Internal.Vector.Growing (GrowingVector)
 import qualified Database.LSMTree.Internal.Vector.Growing as Growing (append,
                      freeze, new)
+#ifdef NO_IGNORE_ASSERTS
+import qualified Database.LSMTree.Internal.Vector.Growing as Growing
+                     (readMaybeLast)
+#endif
 
 {-|
     A general-purpose fence pointer index under incremental construction.
@@ -80,10 +86,15 @@ keyListElem (SerialisedKey' keyBytes) = [keySizeBytes, keyBytes] where
 appendSingle :: (SerialisedKey, SerialisedKey)
              -> IndexOrdinaryAcc s
              -> ST s (Maybe Chunk)
-appendSingle (_, key) (IndexOrdinaryAcc lastKeys baler)
-    = do
-          Growing.append lastKeys 1 key
-          feedBaler (keyListElem key) baler
+appendSingle (firstKey, lastKey) (IndexOrdinaryAcc lastKeys baler)
+    = assert (firstKey <= lastKey) $
+      do
+#ifdef NO_IGNORE_ASSERTS
+          maybeLastLastKey <- Growing.readMaybeLast lastKeys
+          assert (all (< firstKey) maybeLastLastKey) $ return ()
+#endif
+          Growing.append lastKeys 1 lastKey
+          feedBaler (keyListElem lastKey) baler
 
 {-|
     For a specification of this operation, see the documentation of [its
@@ -94,6 +105,10 @@ appendMulti :: (SerialisedKey, Word32)
             -> ST s [Chunk]
 appendMulti (key, overflowPageCount) (IndexOrdinaryAcc lastKeys baler)
     = do
+#ifdef NO_IGNORE_ASSERTS
+          maybeLastLastKey <- Growing.readMaybeLast lastKeys
+          assert (all (< key) maybeLastLastKey) $ return ()
+#endif
           Growing.append lastKeys pageCount key
           maybeToList <$> feedBaler keyListElems baler
     where

src/Database/LSMTree/Internal/Vector/Growing.hs

@@ -8,11 +8,12 @@ module Database.LSMTree.Internal.Vector.Growing
     GrowingVector (GrowingVector),
     new,
     append,
-    freeze
+    freeze,
+    readMaybeLast
 )
 where
 
-import           Prelude hiding (init, last, length)
+import           Prelude hiding (init, last, length, read)
 
 import           Control.Monad (when)
 import           Control.Monad.ST.Strict (ST)
@@ -22,8 +23,8 @@ import           Data.STRef.Strict (STRef, newSTRef, readSTRef, writeSTRef)
 import           Data.Vector (Vector)
 import qualified Data.Vector as Mutable (freeze)
 import           Data.Vector.Mutable (MVector)
-import qualified Data.Vector.Mutable as Mutable (grow, length, new, set, slice,
-                     take)
+import qualified Data.Vector.Mutable as Mutable (grow, length, new, read, set,
+                     slice, take)
 
 {-|
     A vector with support for appending elements.
@@ -118,3 +119,13 @@ freeze (GrowingVector bufferRef lengthRef) = do
     buffer <- readSTRef bufferRef
     length <- readPrimVar lengthRef
     Mutable.freeze (Mutable.take length buffer)
+
+-- | Reads the last element of a growing vector if it exists.
+readMaybeLast :: GrowingVector s a -> ST s (Maybe a)
+readMaybeLast (GrowingVector bufferRef lengthRef) = do
+    length <- readPrimVar lengthRef
+    if length == 0
+        then return Nothing
+        else do
+                 buffer <- readSTRef bufferRef
+                 Just <$> Mutable.read buffer (pred length)