Remove BlobRef.readBlob and add BlobRef.readWeakBlobRef

The only uses of BlobRef.readBlob were in the context of withWeakBlobRef
so we can go straight to a helper function that does just that.

Also remove now-unused WriteBufferBlobs.readBlob

Author: dcoutts

src/Database/LSMTree/Internal/BlobRef.hs

@@ -17,7 +17,7 @@ module Database.LSMTree.Internal.BlobRef (
   , removeReference
   , removeReferences
   , readRawBlobRef
-  , readBlob
+  , readWeakBlobRef
   , readBlobIOOp
   ) where
 
@@ -188,17 +188,16 @@ readRawBlobRef ::
 readRawBlobRef fs RawBlobRef {rawBlobRefFile, rawBlobRefSpan} =
     BlobFile.readBlobFile fs rawBlobRefFile rawBlobRefSpan
 
-{-# SPECIALISE readBlob ::
-     HasFS IO h
-  -> StrongBlobRef IO h
-  -> IO SerialisedBlob #-}
-readBlob ::
-     (MonadThrow m, PrimMonad m)
+{-# SPECIALISE readWeakBlobRef :: HasFS IO h -> WeakBlobRef IO h -> IO SerialisedBlob #-}
+readWeakBlobRef ::
+     (MonadMask m, PrimMonad m)
   => HasFS m h
-  -> StrongBlobRef m h
+  -> WeakBlobRef m h
   -> m SerialisedBlob
-readBlob fs StrongBlobRef {strongBlobRefFile, strongBlobRefSpan} =
-    BlobFile.readBlobFile fs strongBlobRefFile strongBlobRefSpan
+readWeakBlobRef fs wref =
+    bracket (deRefWeakBlobRef wref) removeReference $
+      \StrongBlobRef {strongBlobRefFile, strongBlobRefSpan} ->
+        BlobFile.readBlobFile fs strongBlobRefFile strongBlobRefSpan
 
 readBlobIOOp ::
      P.MutableByteArray s -> Int

src/Database/LSMTree/Internal/WriteBufferBlobs.hs

@@ -27,7 +27,6 @@ module Database.LSMTree.Internal.WriteBufferBlobs (
     addReference,
     removeReference,
     addBlob,
-    readBlob,
     mkRawBlobRef,
     mkWeakBlobRef,
     -- * For tests
@@ -170,15 +169,6 @@ writeBlobAtOffset fs h (SerialisedBlob' (VP.Vector boff blen ba)) off = do
              (FS.AbsOffset off)
     return ()
 
-{-# SPECIALISE readBlob :: HasFS IO h -> WriteBufferBlobs IO h -> BlobSpan -> IO SerialisedBlob #-}
-readBlob :: (PrimMonad m, MonadThrow m)
-         => HasFS m h
-         -> WriteBufferBlobs m h
-         -> BlobSpan
-         -> m SerialisedBlob
-readBlob fs WriteBufferBlobs {blobFile} blobspan =
-    readBlobFile fs blobFile blobspan
-
 -- | Helper function to make a 'RawBlobRef' that points into a
 -- 'WriteBufferBlobs'.
 mkRawBlobRef :: WriteBufferBlobs m h

test/Test/Database/LSMTree/Internal.hs

@@ -197,7 +197,7 @@ prop_interimOpenTable dat = ioProperty $
     fetchBlobs :: FS.HasFS IO h
                ->    (V.Vector (Maybe (Entry v (WeakBlobRef IO h))))
                -> IO (V.Vector (Maybe (Entry v SerialisedBlob)))
-    fetchBlobs hfs = traverse (traverse (traverse (fetchBlob hfs)))
+    fetchBlobs hfs = traverse (traverse (traverse (readWeakBlobRef hfs)))
 
     Test.InMemLookupData { runData, lookups = keysToLookup } = dat
     ks = V.map serialiseKey (V.fromList keysToLookup)
@@ -242,7 +242,7 @@ prop_roundtripCursor lb ub kops = ioProperty $
     fetchBlobs :: FS.HasFS IO h
              ->     V.Vector (k, (v, Maybe (WeakBlobRef IO h)))
              -> IO (V.Vector (k, (v, Maybe SerialisedBlob)))
-    fetchBlobs hfs = traverse (traverse (traverse (traverse (fetchBlob hfs))))
+    fetchBlobs hfs = traverse (traverse (traverse (traverse (readWeakBlobRef hfs))))
 
     toOffsetKey = maybe NoOffsetKey (OffsetKey . coerce)
 
@@ -288,6 +288,3 @@ readCursorUntil resolve ub cursor = go V.empty
 appendSerialisedValue :: ResolveSerialisedValue
 appendSerialisedValue (SerialisedValue x) (SerialisedValue y) =
     SerialisedValue (x <> y)
-
-fetchBlob :: FS.HasFS IO h -> WeakBlobRef IO h -> IO SerialisedBlob
-fetchBlob hfs bref = withWeakBlobRef bref (readBlob hfs)

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

@@ -44,8 +44,7 @@ import           Database.LSMTree.Extras.Generators
 import           Database.LSMTree.Extras.RunData (RunData (..),
                      liftArbitrary2Map, liftShrink2Map,
                      unsafeFlushAsWriteBuffer)
-import           Database.LSMTree.Internal.BlobRef (BlobSpan, WeakBlobRef,
-                     readBlob, withWeakBlobRef)
+import           Database.LSMTree.Internal.BlobRef
 import           Database.LSMTree.Internal.Entry as Entry
 import           Database.LSMTree.Internal.IndexCompact as Index
 import           Database.LSMTree.Internal.Lookup
@@ -325,9 +324,7 @@ prop_roundtripFromWriteBufferLookupIO (SmallList dats) =
     fetchBlobs :: FS.HasFS IO h
                ->    (V.Vector (Maybe (Entry v (WeakBlobRef IO h))))
                -> IO (V.Vector (Maybe (Entry v SerialisedBlob)))
-    fetchBlobs hfs = traverse (traverse (traverse fetchBlob))
-      where
-        fetchBlob bref = withWeakBlobRef bref (readBlob hfs)
+    fetchBlobs hfs = traverse (traverse (traverse (readWeakBlobRef hfs)))
 
 -- | Given a bunch of 'InMemLookupData', prepare the data into the form needed
 -- for 'lookupsIO': a write buffer (and blobs) and a vector of on-disk runs.