Add BlobFile.writeBlob and use it in WriteBufferBlobs

It's a bit harder to provide something for RunBuilder since it has its
own infrastructure for updating CRCs along with writing.

Author: dcoutts

src/Database/LSMTree/Internal/BlobFile.hs

@@ -5,6 +5,7 @@ module Database.LSMTree.Internal.BlobFile (
   , RemoveFileOnClose (..)
   , openBlobFile
   , readBlob
+  , writeBlob
   ) where
 
 import           Control.DeepSeq (NFData (..))
@@ -13,8 +14,8 @@ import           Control.Monad.Class.MonadThrow (MonadMask, MonadThrow)
 import           Control.Monad.Primitive (PrimMonad)
 import           Control.RefCount (RefCounter)
 import qualified Control.RefCount as RC
-import qualified Data.Primitive.ByteArray as P (newPinnedByteArray,
-                     unsafeFreezeByteArray)
+import qualified Data.Primitive.ByteArray as P
+import qualified Data.Vector.Primitive as VP
 import           Data.Word (Word32, Word64)
 import qualified Database.LSMTree.Internal.RawBytes as RB
 import           Database.LSMTree.Internal.Serialise (SerialisedBlob (..))
@@ -103,3 +104,21 @@ readBlob fs BlobFile {blobFileHandle}
     ba <- P.unsafeFreezeByteArray mba
     let !rb = RB.fromByteArray 0 len ba
     return (SerialisedBlob rb)
+
+{-# SPECIALISE writeBlob :: HasFS IO h -> BlobFile IO h -> SerialisedBlob -> Word64 -> IO () #-}
+writeBlob ::
+     (MonadThrow m, PrimMonad m)
+  => HasFS m h
+  -> BlobFile m h
+  -> SerialisedBlob
+  -> Word64
+  -> m ()
+writeBlob fs BlobFile {blobFileHandle}
+          (SerialisedBlob' (VP.Vector boff blen ba)) off = do
+    mba <- P.unsafeThawByteArray ba
+    _   <- FS.hPutBufExactlyAt
+             fs blobFileHandle mba
+             (FS.BufferOffset boff)
+             (fromIntegral blen :: FS.ByteCount)
+             (FS.AbsOffset off)
+    return ()

src/Database/LSMTree/Internal/RunBuilder.hs

@@ -285,8 +285,8 @@ copyBlob ::
 copyBlob builder@RunBuilder {..} blobref = do
     blob <- BlobRef.readRawBlobRef runBuilderHasFS blobref
     writeBlob builder blob
-    --TODO: consier adding write blob functions to BlobFile
-    -- variants: at offset, at file pointer with CRC update.
+    --TODO: can't easily switch this to use BlobFile.writeBlob because
+    -- RunBuilder currently does everything uniformly with ChecksumHandle.
 
 {-# SPECIALISE writeFilter ::
      RunBuilder IO h

src/Database/LSMTree/Internal/WriteBufferBlobs.hs

@@ -37,9 +37,7 @@ import           Control.DeepSeq (NFData (..))
 import           Control.Monad.Class.MonadThrow
 import           Control.Monad.Primitive (PrimMonad, PrimState)
 import qualified Control.RefCount as RC
-import           Data.Primitive.ByteArray as P
 import           Data.Primitive.PrimVar as P
-import qualified Data.Vector.Primitive as VP
 import           Data.Word (Word64)
 import           Database.LSMTree.Internal.BlobFile hiding (removeReference)
 import qualified Database.LSMTree.Internal.BlobFile as BlobFile
@@ -48,7 +46,6 @@ import           Database.LSMTree.Internal.BlobRef (RawBlobRef (..),
 import           Database.LSMTree.Internal.Serialise
 import qualified System.FS.API as FS
 import           System.FS.API (HasFS)
-import qualified System.Posix.Types as FS (ByteCount)
 
 -- | A single 'WriteBufferBlobs' may be shared between multiple tables.
 -- As a consequence of being shared, the management of the shared state has to
@@ -148,28 +145,12 @@ addBlob :: (PrimMonad m, MonadThrow m)
 addBlob fs WriteBufferBlobs {blobFile, blobFilePointer} blob = do
     let blobsize = sizeofBlob blob
     bloboffset <- updateFilePointer blobFilePointer blobsize
-    writeBlobAtOffset fs (blobFileHandle blobFile) blob bloboffset
+    BlobFile.writeBlob fs blobFile blob bloboffset
     return BlobSpan {
       blobSpanOffset = bloboffset,
       blobSpanSize   = fromIntegral blobsize
     }
 
-{-# SPECIALISE writeBlobAtOffset :: HasFS IO h -> FS.Handle h -> SerialisedBlob -> Word64 -> IO () #-}
-writeBlobAtOffset :: (PrimMonad m, MonadThrow m)
-                  => HasFS m h
-                  -> FS.Handle h
-                  -> SerialisedBlob
-                  -> Word64
-                  -> m ()
-writeBlobAtOffset fs h (SerialisedBlob' (VP.Vector boff blen ba)) off = do
-    mba <- P.unsafeThawByteArray ba
-    _   <- FS.hPutBufExactlyAt
-             fs h mba
-             (FS.BufferOffset boff)
-             (fromIntegral blen :: FS.ByteCount)
-             (FS.AbsOffset off)
-    return ()
-
 -- | Helper function to make a 'RawBlobRef' that points into a
 -- 'WriteBufferBlobs'.
 mkRawBlobRef :: WriteBufferBlobs m h