Modernize Index module to use modern record extensions

lsm-tree/src-core/Database/LSMTree/Internal/Index/Compact.hs

@@ -1,4 +1,7 @@
-{-# OPTIONS_HADDOCK not-home #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NoFieldSelectors      #-}
+{-# LANGUAGE OverloadedRecordDot   #-}
+{-# OPTIONS_HADDOCK not-home       #-}
 
 -- | A compact fence-pointer index for uniformly distributed keys.
 --
@@ -394,33 +397,33 @@ search :: SerialisedKey -> IndexCompact -> PageSpan
 -- search key. The code below is annotated with [x,y] or [x, y) comments that
 -- describe the known page number interval at that point in the search
 -- algorithm.
-search k IndexCompact{..} =
+search k idx =
     let !primbits = keyTopBits64 k in
     -- [0, n), where n is the length of the P array
-    case unsafeSearchLE primbits icPrimary of
+    case unsafeSearchLE primbits idx.icPrimary of
       Nothing ->
         -- TODO: if the P array is indeed empty, then this violates the
         -- guarantee that we return a valid page span! We should specify that a
         -- compact index should be non-empty.
-        if VU.length icLargerThanPage == 0 then singlePage (PageNo 0) else
+        if VU.length idx.icLargerThanPage == 0 then singlePage (PageNo 0) else
         -- [0, n), our page span definitely starts at 0, but we still have to
         -- consult the LTP array to check whether the value on page 0 overflows
         -- into subsequent pages.
-        let !i = bitLongestPrefixFromTo (BoundExclusive 0) NoBound (Bit True) icLargerThanPage
+        let !i = bitLongestPrefixFromTo (BoundExclusive 0) NoBound (Bit True) idx.icLargerThanPage
         -- [0, i]
         in  multiPage (PageNo 0) (PageNo i)
       Just !i ->
         -- [0, i]
-        if unBit $ icClashes VU.! i then
+        if unBit $ idx.icClashes VU.! i then
           -- [0, i], now in clash recovery mode.
           let -- i is the *last* index in a range of contiguous pages that all
               -- clash. Since i is the end of the range, we search backwards
               -- through the C array to find the start of this range.
               !i1 = PageNo $ fromMaybe 0 $
-                bitIndexFromToRev (BoundInclusive 0) (BoundInclusive i) (Bit False) icClashes
+                bitIndexFromToRev (BoundInclusive 0) (BoundInclusive i) (Bit False) idx.icClashes
               -- The TB map is consulted to find the closest key smaller than k.
               !i2 = maybe (PageNo 0) snd $
-                Map.lookupLE (makeUnslicedKey k) icTieBreaker
+                Map.lookupLE (makeUnslicedKey k) idx.icTieBreaker
               -- If i2 < i1, then it means the clashing pages were all just part
               -- of the same larger-than-page value. Entries are only included
               -- in the TB map if the clash was a *proper* clash.
@@ -430,7 +433,7 @@ search k IndexCompact{..} =
               PageNo !i3 = max i1 i2
               -- [max i1 i2, i], this is equivalent to taking the intersection
               -- of [i1, i] and [i2, i]
-              !i4 = bitLongestPrefixFromTo (BoundExclusive i3) (BoundInclusive i) (Bit True) icLargerThanPage
+              !i4 = bitLongestPrefixFromTo (BoundExclusive i3) (BoundInclusive i) (Bit True) idx.icLargerThanPage
           in  multiPage (PageNo i3) (PageNo i4)
               -- [i3, i4], we consulted the LTP array to check whether the value
               -- on page i3 overflows into subsequent pages
@@ -441,17 +444,17 @@ search k IndexCompact{..} =
 
 
 countClashes :: IndexCompact -> Int
-countClashes = Map.size . icTieBreaker
+countClashes idx = Map.size idx.icTieBreaker
 
 hasClashes :: IndexCompact -> Bool
-hasClashes = not . Map.null . icTieBreaker
+hasClashes idx = not (Map.null idx.icTieBreaker)
 
 {-|
     For a specification of this operation, see the documentation of [its
     type-agnostic version]('Database.LSMTree.Internal.Index.sizeInPages').
 -}
 sizeInPages :: IndexCompact -> NumPages
-sizeInPages = NumPages . toEnum . VU.length . icPrimary
+sizeInPages idx = NumPages . toEnum . VU.length $ idx.icPrimary
 
 {-------------------------------------------------------------------------------
   Non-incremental serialisation
@@ -461,7 +464,7 @@ sizeInPages = NumPages . toEnum . VU.length . icPrimary
 toLBS :: NumEntries -> IndexCompact -> LBS.ByteString
 toLBS numEntries index =
      headerLBS
-  <> LBS.fromStrict (Chunk.toByteString (word64VectorToChunk (icPrimary index)))
+  <> LBS.fromStrict (Chunk.toByteString (word64VectorToChunk (index.icPrimary)))
   <> finalLBS numEntries index
 
 {-------------------------------------------------------------------------------
@@ -489,22 +492,23 @@ headerLBS =
     type-agnostic version]('Database.LSMTree.Internal.Index.finalLBS').
 -}
 finalLBS :: NumEntries -> IndexCompact -> LBS.ByteString
-finalLBS (NumEntries numEntries) IndexCompact {..} =
+finalLBS (NumEntries numEntries) idx =
     -- use a builder, since it is all relatively small
     BB.toLazyByteString $
-         putBitVec icClashes
-      <> putBitVec icLargerThanPage
-      <> putTieBreaker icTieBreaker
+         putBitVec idx.icClashes
+      <> putBitVec idx.icLargerThanPage
+      <> putTieBreaker idx.icTieBreaker
       <> BB.word64Host (fromIntegral numPages)
       <> BB.word64Host (fromIntegral numEntries)
   where
-    numPages = VU.length icPrimary
+    numPages = VU.length idx.icPrimary
 
 -- | Constructs a chunk containing the contents of a vector of 64-bit words.
 word64VectorToChunk :: VU.Vector Word64 -> Chunk
 word64VectorToChunk (VU.V_Word64 (VP.Vector off len ba)) =
     Chunk (mkPrimVector (mul8 off) (mul8 len) ba)
 
+
 -- | Padded to 64 bit.
 --
 -- Assumes that the bitvector has a byte-aligned offset.
@@ -595,7 +599,12 @@ fromSBS (SBS ba') = do
     when (bytesUsed < sizeofByteArray ba) $
       Left "Byte array is too large for components"
 
-    pure (NumEntries numEntries, IndexCompact {..})
+    pure (NumEntries numEntries, IndexCompact {
+      icPrimary = icPrimary,
+      icClashes = icClashes,
+      icTieBreaker = icTieBreaker,
+      icLargerThanPage = icLargerThanPage
+    })
 
 type Offset32 = Int
 type Offset64 = Int

lsm-tree/src-core/Database/LSMTree/Internal/Index/CompactAcc.hs

@@ -1,5 +1,8 @@
-{-# LANGUAGE CPP #-}
-{-# OPTIONS_HADDOCK not-home #-}
+{-# LANGUAGE CPP                   #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NoFieldSelectors      #-}
+{-# LANGUAGE OverloadedRecordDot   #-}
+{-# OPTIONS_HADDOCK not-home       #-}
 
 -- |
 -- Incremental construction of a compact index yields chunks of the primary array
@@ -129,15 +132,15 @@ newWithDefaults = new 1024
     type-agnostic version]('Database.LSMTree.Internal.Index.appendSingle').
 -}
 appendSingle :: forall s. (SerialisedKey, SerialisedKey) -> IndexCompactAcc s -> ST s (Maybe Chunk)
-appendSingle (minKey, maxKey) ica@IndexCompactAcc{..} = do
+appendSingle (minKey, maxKey) ica = do
 #ifdef NO_IGNORE_ASSERTS
-    lastMinKey <- readSTRef icaLastMinKey
+    lastMinKey <- readSTRef ica.icaLastMinKey
     assert (minKey <= maxKey && smaybe True (<= minKey) lastMinKey) $ pure ()  -- sorted
 #endif
-    pageNo <- readSTRef icaCurrentPageNumber
-    let ix = pageNo `mod` icaMaxChunkSize
+    pageNo <- readSTRef ica.icaCurrentPageNumber
+    let ix = pageNo `mod` ica.icaMaxChunkSize
     goAppend pageNo ix
-    writeSTRef icaCurrentPageNumber $! pageNo + 1
+    writeSTRef ica.icaCurrentPageNumber $! pageNo + 1
     yield ica
   where
     minPrimbits, maxPrimbits :: Word64
@@ -156,31 +159,31 @@ appendSingle (minKey, maxKey) ica@IndexCompactAcc{..} = do
         -- | Set value in primary vector
         writePrimary :: ST s ()
         writePrimary =
-            readSTRef icaPrimary >>= \cs -> VUM.write (NE.head cs) ix minPrimbits
+            readSTRef ica.icaPrimary >>= \cs -> VUM.write (NE.head cs) ix minPrimbits
 
         -- | Set value in clash vector, tie-breaker map and larger-than-page
         -- vector
         writeClashesAndLTP :: ST s ()
         writeClashesAndLTP = do
-            lastMaxPrimbits <- readSTRef icaLastMaxPrimbits
+            lastMaxPrimbits <- readSTRef ica.icaLastMaxPrimbits
             let clash = lastMaxPrimbits == SJust minPrimbits
-            writeSTRef icaLastMaxPrimbits $! SJust maxPrimbits
+            writeSTRef ica.icaLastMaxPrimbits $! SJust maxPrimbits
 
-            lastMinKey <- readSTRef icaLastMinKey
+            lastMinKey <- readSTRef ica.icaLastMinKey
             let ltp = SJust minKey == lastMinKey
-            writeSTRef icaLastMinKey $! SJust minKey
+            writeSTRef ica.icaLastMinKey $! SJust minKey
 
-            readSTRef icaClashes >>= \cs -> VUM.write (NE.head cs) ix (Bit clash)
-            readSTRef icaLargerThanPage >>= \cs -> VUM.write (NE.head cs) ix (Bit ltp)
+            readSTRef ica.icaClashes >>= \cs -> VUM.write (NE.head cs) ix (Bit clash)
+            readSTRef ica.icaLargerThanPage >>= \cs -> VUM.write (NE.head cs) ix (Bit ltp)
             when (clash && not ltp) $
-              modifySTRef' icaTieBreaker (Map.insert (makeUnslicedKey minKey) (PageNo pageNo))
+              modifySTRef' ica.icaTieBreaker (Map.insert (makeUnslicedKey minKey) (PageNo pageNo))
 
 {-|
     For a specification of this operation, see the documentation of [its
     type-agnostic version]('Database.LSMTree.Internal.Index.appendMulti').
 -}
 appendMulti :: forall s. (SerialisedKey, Word32) -> IndexCompactAcc s -> ST s [Chunk]
-appendMulti (k, n0) ica@IndexCompactAcc{..} =
+appendMulti (k, n0) ica =
     maybe id (:) <$> appendSingle (k, k) ica <*> overflows (fromIntegral n0)
   where
     minPrimbits :: Word64
@@ -192,16 +195,16 @@ appendMulti (k, n0) ica@IndexCompactAcc{..} =
     overflows n
       | n <= 0 = pure []
       | otherwise = do
-          pageNo <- readSTRef icaCurrentPageNumber
-          let ix = pageNo `mod` icaMaxChunkSize -- will be 0 in recursive calls
-              remInChunk = min n (icaMaxChunkSize - ix)
-          readSTRef icaPrimary >>= \cs ->
+          pageNo <- readSTRef ica.icaCurrentPageNumber
+          let ix = pageNo `mod` ica.icaMaxChunkSize -- will be 0 in recursive calls
+              remInChunk = min n (ica.icaMaxChunkSize - ix)
+          readSTRef ica.icaPrimary >>= \cs ->
             unsafeWriteRange (NE.head cs) (BoundInclusive ix) (BoundExclusive $ ix + remInChunk) minPrimbits
-          readSTRef icaClashes >>= \cs ->
+          readSTRef ica.icaClashes >>= \cs ->
             unsafeWriteRange (NE.head cs) (BoundInclusive ix) (BoundExclusive $ ix + remInChunk) (Bit True)
-          readSTRef icaLargerThanPage >>= \cs ->
+          readSTRef ica.icaLargerThanPage >>= \cs ->
             unsafeWriteRange (NE.head cs) (BoundInclusive ix) (BoundExclusive $ ix + remInChunk) (Bit True)
-          writeSTRef icaCurrentPageNumber $! pageNo + remInChunk
+          writeSTRef ica.icaCurrentPageNumber $! pageNo + remInChunk
           res <- yield ica
           maybe id (:) res <$> overflows (n - remInChunk)
 
@@ -212,13 +215,13 @@ appendMulti (k, n0) ica@IndexCompactAcc{..} =
 --
 -- INVARIANTS: see [construction invariants](#construction-invariants).
 yield :: IndexCompactAcc s -> ST s (Maybe Chunk)
-yield IndexCompactAcc{..} = do
-    pageNo <- readSTRef icaCurrentPageNumber
-    if pageNo `mod` icaMaxChunkSize == 0 then do -- The current chunk is full
-      primaryChunk <- VU.unsafeFreeze . NE.head =<< readSTRef icaPrimary
-      modifySTRef' icaPrimary . NE.cons =<< newPinnedMVec64 icaMaxChunkSize
-      modifySTRef' icaClashes . NE.cons =<< VUM.new icaMaxChunkSize
-      modifySTRef' icaLargerThanPage . NE.cons =<< VUM.new icaMaxChunkSize
+yield ica = do
+    pageNo <- readSTRef ica.icaCurrentPageNumber
+    if pageNo `mod` ica.icaMaxChunkSize == 0 then do -- The current chunk is full
+      primaryChunk <- VU.unsafeFreeze . NE.head =<< readSTRef ica.icaPrimary
+      modifySTRef' ica.icaPrimary . NE.cons =<< newPinnedMVec64 ica.icaMaxChunkSize
+      modifySTRef' ica.icaClashes . NE.cons =<< VUM.new ica.icaMaxChunkSize
+      modifySTRef' ica.icaLargerThanPage . NE.cons =<< VUM.new ica.icaMaxChunkSize
       pure $ Just (word64VectorToChunk primaryChunk)
     else -- the current chunk is not yet full
       pure Nothing
@@ -228,16 +231,16 @@ yield IndexCompactAcc{..} = do
     type-agnostic version]('Database.LSMTree.Internal.Index.unsafeEnd').
 -}
 unsafeEnd :: IndexCompactAcc s -> ST s (Maybe Chunk, IndexCompact)
-unsafeEnd IndexCompactAcc{..} = do
-    pageNo <- readSTRef icaCurrentPageNumber
-    let ix = pageNo `mod` icaMaxChunkSize
+unsafeEnd ica = do
+    pageNo <- readSTRef ica.icaCurrentPageNumber
+    let ix = pageNo `mod` ica.icaMaxChunkSize
 
     chunksPrimary <-
-      traverse VU.unsafeFreeze . sliceCurrent ix =<< readSTRef icaPrimary
+      traverse VU.unsafeFreeze . sliceCurrent ix =<< readSTRef ica.icaPrimary
     chunksClashes <-
-      traverse VU.unsafeFreeze . sliceCurrent ix =<< readSTRef icaClashes
+      traverse VU.unsafeFreeze . sliceCurrent ix =<< readSTRef ica.icaClashes
     chunksLargerThanPage <-
-      traverse VU.unsafeFreeze . sliceCurrent ix =<< readSTRef icaLargerThanPage
+      traverse VU.unsafeFreeze . sliceCurrent ix =<< readSTRef ica.icaLargerThanPage
 
     -- Only slice out a chunk if there are entries in the chunk
     let mchunk = if ix == 0
@@ -247,9 +250,14 @@ unsafeEnd IndexCompactAcc{..} = do
     let icPrimary = VU.concat . reverse $ chunksPrimary
     let icClashes = VU.concat . reverse $ chunksClashes
     let icLargerThanPage = VU.concat . reverse $ chunksLargerThanPage
-    icTieBreaker <- readSTRef icaTieBreaker
+    icTieBreaker <- readSTRef ica.icaTieBreaker
 
-    pure (mchunk, IndexCompact {..})
+    pure (mchunk, IndexCompact {
+        icPrimary = icPrimary,
+        icClashes = icClashes,
+        icTieBreaker = icTieBreaker,
+        icLargerThanPage = icLargerThanPage
+    })
   where
     -- The current (most recent) chunk of the bitvectors is only partially
     -- constructed, so we need to only use the part that is already filled.

lsm-tree/test/Test/Database/LSMTree/Internal/Index/Compact.hs

@@ -1,6 +1,8 @@
-{-# LANGUAGE LambdaCase      #-}
-{-# LANGUAGE RecordWildCards #-}
-{-# OPTIONS_GHC -Wno-orphans #-}
+{-# LANGUAGE LambdaCase            #-}
+{-# LANGUAGE DuplicateRecordFields #-}
+{-# LANGUAGE NoFieldSelectors      #-}
+{-# LANGUAGE OverloadedRecordDot   #-}
+{-# OPTIONS_GHC -Wno-orphans       #-}
 
 module Test.Database.LSMTree.Internal.Index.Compact (tests) where
 
@@ -315,9 +317,9 @@ prop_total_deserialisation word32s =
         -- Just forcing the index is not enough. The underlying vectors might
         -- point to outside of the byte array, so we check they are valid.
         (numEntries, ic) `deepseq`
-             vec64IsValid (icPrimary ic)
-          && bitVecIsValid (icClashes ic)
-          && bitVecIsValid (icLargerThanPage ic)
+             vec64IsValid ic.icPrimary
+          && bitVecIsValid ic.icClashes
+          && bitVecIsValid ic.icLargerThanPage
   where
     vec64IsValid (VU.V_Word64 (VP.Vector off len ba)) =
       off >= 0 && len >= 0 && mul8 (off + len) <= sizeofByteArray ba
@@ -385,7 +387,7 @@ labelIndex ic =
 
 multiPageValuesClash :: IndexCompact -> Bool
 multiPageValuesClash ic
-    | VU.length (icClashes ic) < 3 = False
+    | VU.length ic.icClashes < 3 = False
     | otherwise                   = VU.any p $ VU.zip4 v1 v2 v3 v4
   where
     -- note: @i = j - 1@ and @k = j + 1@. This gives us a local view of a
@@ -396,8 +398,8 @@ multiPageValuesClash ic
          unBit ltpi && not (unBit ltpj) && unBit ltpk
          -- and they clash
       && unBit cj
-    v1 = VU.tail (icClashes ic)
-    v2 = icLargerThanPage ic
+    v1 = VU.tail ic.icClashes
+    v2 = ic.icLargerThanPage
     v3 = VU.tail v2
     v4 = VU.tail v3
 
@@ -408,7 +410,7 @@ countContiguousClashes ic = actualContigClashes
   where
     -- filtered is a list of maximal sub-vectors that have only only contiguous
     -- clashes
-    zipped    = VU.zip (icClashes ic) (icLargerThanPage ic)
+    zipped    = VU.zip ic.icClashes ic.icLargerThanPage
     grouped   = VU.groupBy (\x y -> fst x == fst y) zipped
     filtered  = filter (VU.all (\(c, _ltp) -> c == Bit True)) grouped
     -- clashes that are part of a multi-page value shouldn't be counted towards
@@ -478,8 +480,8 @@ instance Arbitrary Chunks where
     -- shrink number of pages
     [ Chunks chunks' index
         { icPrimary = primary'
-        , icClashes = VU.slice 0 numPages' (icClashes index)
-        , icLargerThanPage = VU.slice 0 numPages' (icLargerThanPage index)
+        , icClashes = VU.slice 0 numPages' index.icClashes
+        , icLargerThanPage = VU.slice 0 numPages' index.icLargerThanPage
         }
     | chunks' <- shrink chunks
     , let primary' = mconcat chunks'
@@ -489,5 +491,5 @@ instance Arbitrary Chunks where
     [ Chunks chunks index
         { icTieBreaker = tieBreaker'
         }
-    | tieBreaker' <- shrink (icTieBreaker index)
+    | tieBreaker' <- shrink index.icTieBreaker
     ]