Refactor: change BlobRef m (Handle h) to BlobRef m h

data BlobRef m h previously contained:
      blobRefFile  :: !h
which meant allmost all uses of BlobRef had to be BlobRef m (Handle h)

Now we make that internal:
      blobRefFile  :: !(FS.Handle h)
and so all uses are now simply BlobRef m h

This continues with the trend to avoid having to use (Handle h)
everywhere.

This is a large but simple patch, that just deals with the fallout of
this local change.

Author: dcoutts

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

@@ -395,9 +395,9 @@ deriving stock instance Generic (RunReader m h)
 deriving anyclass instance (Typeable m, Typeable (PrimState m), Typeable h)
                         => NoThunks (RunReader m h)
 
-deriving stock instance Generic (Reader.Entry m (Handle h))
+deriving stock instance Generic (Reader.Entry m h)
 deriving anyclass instance (Typeable m, Typeable (PrimState m), Typeable h)
-                        => NoThunks (Reader.Entry m (Handle h))
+                        => NoThunks (Reader.Entry m h)
 
 {-------------------------------------------------------------------------------
   RawPage
@@ -418,7 +418,7 @@ deriving anyclass instance NoThunks RawOverflowPage
 -------------------------------------------------------------------------------}
 
 deriving stock instance Generic (BlobRef m h)
-deriving anyclass instance (NoThunks h, Typeable (PrimState m))
+deriving anyclass instance (Typeable h, Typeable (PrimState m))
                         => NoThunks (BlobRef m h)
 
 deriving stock instance Generic BlobSpan

src/Database/LSMTree/Common.hs

@@ -63,7 +63,7 @@ import qualified Database.LSMTree.Internal.MergeSchedule as Internal
 import qualified Database.LSMTree.Internal.Paths as Internal
 import qualified Database.LSMTree.Internal.Range as Internal
 import           Database.LSMTree.Internal.Serialise.Class
-import           System.FS.API (FsPath, Handle, HasFS)
+import           System.FS.API (FsPath, HasFS)
 import           System.FS.BlockIO.API (HasBlockIO)
 import           System.FS.IO (HandleIO)
 
@@ -268,7 +268,7 @@ type BlobRef :: (Type -> Type) -> Type -> Type
 type role BlobRef nominal nominal
 data BlobRef m blob where
     BlobRef :: Typeable h
-            => Internal.WeakBlobRef m (Handle h)
+            => Internal.WeakBlobRef m h
             -> BlobRef m blob
 
 instance Show (BlobRef m blob) where

src/Database/LSMTree/Internal.hs

@@ -116,8 +116,7 @@ import           Database.LSMTree.Internal.UniqCounter
 import qualified Database.LSMTree.Internal.WriteBuffer as WB
 import qualified Database.LSMTree.Internal.WriteBufferBlobs as WBB
 import qualified System.FS.API as FS
-import           System.FS.API (FsError, FsErrorPath (..), FsPath, Handle,
-                     HasFS)
+import           System.FS.API (FsError, FsErrorPath (..), FsPath, HasFS)
 import qualified System.FS.API.Lazy as FS
 import qualified System.FS.BlockIO.API as FS
 import           System.FS.BlockIO.API (HasBlockIO)
@@ -724,14 +723,14 @@ close t = do
      ResolveSerialisedValue
   -> V.Vector SerialisedKey
   -> Table IO h
-  -> IO (V.Vector (Maybe (Entry SerialisedValue (WeakBlobRef IO (Handle h))))) #-}
+  -> IO (V.Vector (Maybe (Entry SerialisedValue (WeakBlobRef IO h)))) #-}
 -- | See 'Database.LSMTree.Normal.lookups'.
 lookups ::
      (MonadST m, MonadSTM m, MonadThrow m)
   => ResolveSerialisedValue
   -> V.Vector SerialisedKey
   -> Table m h
-  -> m (V.Vector (Maybe (Entry SerialisedValue (WeakBlobRef m (Handle h)))))
+  -> m (V.Vector (Maybe (Entry SerialisedValue (WeakBlobRef m h))))
 lookups resolve ks t = do
     traceWith (tableTracer t) $ TraceLookups (V.length ks)
     withOpenTable t $ \thEnv ->
@@ -753,15 +752,15 @@ lookups resolve ks t = do
      ResolveSerialisedValue
   -> Range SerialisedKey
   -> Table IO h
-  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef IO (Handle h)) -> res)
+  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef IO h) -> res)
   -> IO (V.Vector res) #-}
 -- | See 'Database.LSMTree.Normal.rangeLookup'.
 rangeLookup ::
      (MonadFix m, MonadMask m, MonadMVar m, MonadST m, MonadSTM m)
   => ResolveSerialisedValue
   -> Range SerialisedKey
   -> Table m h
-  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef m (Handle h)) -> res)
+  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef m h) -> res)
      -- ^ How to map to a query result, different for normal/monoidal
   -> m (V.Vector res)
 rangeLookup resolve range t fromEntry = do
@@ -828,12 +827,12 @@ updates resolve es t = do
 
 {-# SPECIALISE retrieveBlobs ::
      Session IO h
-  -> V.Vector (WeakBlobRef IO (FS.Handle h))
+  -> V.Vector (WeakBlobRef IO h)
   -> IO (V.Vector SerialisedBlob) #-}
 retrieveBlobs ::
-     (MonadFix m, MonadMask m, MonadST m, MonadSTM m)
+     (MonadMask m, MonadST m, MonadSTM m)
   => Session m h
-  -> V.Vector (WeakBlobRef m (FS.Handle h))
+  -> V.Vector (WeakBlobRef m h)
   -> m (V.Vector SerialisedBlob)
 retrieveBlobs sesh wrefs =
     withOpenSession sesh $ \seshEnv ->
@@ -1023,7 +1022,7 @@ closeCursor Cursor {..} = do
      ResolveSerialisedValue
   -> Int
   -> Cursor IO h
-  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef IO (Handle h)) -> res)
+  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef IO h) -> res)
   -> IO (V.Vector res) #-}
 -- | See 'Database.LSMTree.Normal.readCursor'.
 readCursor ::
@@ -1032,7 +1031,7 @@ readCursor ::
   => ResolveSerialisedValue
   -> Int  -- ^ Maximum number of entries to read
   -> Cursor m h
-  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef m (Handle h)) -> res)
+  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef m h) -> res)
      -- ^ How to map to a query result, different for normal/monoidal
   -> m (V.Vector res)
 readCursor resolve n cursor fromEntry =
@@ -1043,7 +1042,7 @@ readCursor resolve n cursor fromEntry =
   -> (SerialisedKey -> Bool)
   -> Int
   -> Cursor IO h
-  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef IO (Handle h)) -> res)
+  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef IO h) -> res)
   -> IO (V.Vector res) #-}
 -- | @readCursorWhile _ p n cursor _@ reads elements until either:
 --
@@ -1060,7 +1059,7 @@ readCursorWhile ::
   -> (SerialisedKey -> Bool)  -- ^ Only read as long as this predicate holds
   -> Int  -- ^ Maximum number of entries to read
   -> Cursor m h
-  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef m (Handle h)) -> res)
+  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef m h) -> res)
      -- ^ How to map to a query result, different for normal/monoidal
   -> m (V.Vector res)
 readCursorWhile resolve keyIsWanted n Cursor {..} fromEntry = do

src/Database/LSMTree/Internal/BlobRef.hs

@@ -42,7 +42,7 @@ import qualified System.FS.BlockIO.API as FS
 --
 -- See 'Database.LSMTree.Common.BlobRef' for more info.
 data BlobRef m h = BlobRef {
-      blobRefFile  :: !h
+      blobRefFile  :: !(FS.Handle h)
     , blobRefCount :: {-# UNPACK #-} !(RefCounter m)
     , blobRefSpan  :: {-# UNPACK #-} !BlobSpan
     }
@@ -141,12 +141,12 @@ removeReferences = V.mapM_ removeReference
 
 {-# SPECIALISE readBlob ::
      HasFS IO h
-  -> BlobRef IO (FS.Handle h)
+  -> BlobRef IO h
   -> IO SerialisedBlob #-}
 readBlob ::
      (MonadThrow m, PrimMonad m)
   => HasFS m h
-  -> BlobRef m (FS.Handle h)
+  -> BlobRef m h
   -> m SerialisedBlob
 readBlob fs BlobRef {
               blobRefFile,
@@ -164,7 +164,7 @@ readBlob fs BlobRef {
 
 readBlobIOOp ::
      P.MutableByteArray s -> Int
-  -> BlobRef m (FS.Handle h)
+  -> BlobRef m h
   -> FS.IOOp s h
 readBlobIOOp buf bufoff
              BlobRef {

src/Database/LSMTree/Internal/Cursor.hs

@@ -9,8 +9,8 @@ import           Control.Monad.Class.MonadST (MonadST (..))
 import           Control.Monad.Class.MonadThrow
 import           Control.Monad.Fix (MonadFix)
 import qualified Data.Vector as V
-import           Database.LSMTree.Internal.BlobRef (WeakBlobRef (..))
-import qualified Database.LSMTree.Internal.BlobRef as BlobRef
+import           Database.LSMTree.Internal.BlobRef (BlobRef,
+                     WeakBlobRef (..))
 import           Database.LSMTree.Internal.Entry (Entry)
 import qualified Database.LSMTree.Internal.Entry as Entry
 import           Database.LSMTree.Internal.Lookup (ResolveSerialisedValue)
@@ -19,13 +19,12 @@ import qualified Database.LSMTree.Internal.RunReaders as Readers
 import           Database.LSMTree.Internal.Serialise (SerialisedKey,
                      SerialisedValue)
 import qualified Database.LSMTree.Internal.Vector as V
-import           System.FS.API (Handle)
 
 {-# INLINE readEntriesWhile #-}
 {-# SPECIALISE readEntriesWhile :: forall h res.
      ResolveSerialisedValue
   -> (SerialisedKey -> Bool)
-  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef IO (Handle h)) -> res)
+  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef IO h) -> res)
   -> Readers.Readers IO h
   -> Int
   -> IO (V.Vector res, Readers.HasMore) #-}
@@ -39,7 +38,7 @@ readEntriesWhile :: forall h m res.
      (MonadFix m, MonadMask m, MonadST m, MonadSTM m)
   => ResolveSerialisedValue
   -> (SerialisedKey -> Bool)
-  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef m (Handle h)) -> res)
+  -> (SerialisedKey -> SerialisedValue -> Maybe (WeakBlobRef m h) -> res)
   -> Readers.Readers m h
   -> Int
   -> m (V.Vector res, Readers.HasMore)
@@ -107,7 +106,7 @@ readEntriesWhile resolve keyIsWanted fromEntry readers n =
     -- Once we have a resolved entry, we still have to make sure it's not
     -- a 'Delete', since we only want to write values to the result vector.
     handleResolved :: SerialisedKey
-                   -> Entry SerialisedValue (BlobRef.BlobRef m (Handle h))
+                   -> Entry SerialisedValue (BlobRef m h)
                    -> Readers.HasMore
                    -> m (Maybe res, Readers.HasMore)
     handleResolved key entry hasMore =
@@ -123,7 +122,7 @@ readEntriesWhile resolve keyIsWanted fromEntry readers n =
               Readers.Drained -> return (Nothing, Readers.Drained)
 
     toResult :: SerialisedKey
-             -> Entry SerialisedValue (BlobRef.BlobRef m (Handle h))
+             -> Entry SerialisedValue (BlobRef m h)
              -> Maybe res
     toResult key = \case
         Entry.Insert v -> Just $ fromEntry key v Nothing

src/Database/LSMTree/Internal/Lookup.hs

@@ -163,7 +163,7 @@ data ByteCountDiscrepancy = ByteCountDiscrepancy {
     -> V.Vector IndexCompact
     -> V.Vector (Handle h)
     -> V.Vector SerialisedKey
-    -> IO (V.Vector (Maybe (Entry SerialisedValue (WeakBlobRef IO (Handle h)))))
+    -> IO (V.Vector (Maybe (Entry SerialisedValue (WeakBlobRef IO h))))
   #-}
 -- | Batched lookups in I\/O.
 --
@@ -183,7 +183,7 @@ lookupsIO ::
   -> V.Vector IndexCompact -- ^ The indexes inside @rs@
   -> V.Vector (Handle h) -- ^ The file handles to the key\/value files inside @rs@
   -> V.Vector SerialisedKey
-  -> m (V.Vector (Maybe (Entry SerialisedValue (WeakBlobRef m (Handle h)))))
+  -> m (V.Vector (Maybe (Entry SerialisedValue (WeakBlobRef m h))))
 lookupsIO !hbio !mgr !resolveV !wb !wbblobs !rs !blooms !indexes !kopsFiles !ks =
     assert precondition $
     withArena mgr $ \arena -> do
@@ -208,7 +208,7 @@ lookupsIO !hbio !mgr !resolveV !wb !wbblobs !rs !blooms !indexes !kopsFiles !ks
     -> VP.Vector RunIxKeyIx
     -> V.Vector (IOOp RealWorld h)
     -> VU.Vector IOResult
-    -> IO (V.Vector (Maybe (Entry SerialisedValue (WeakBlobRef IO (Handle h)))))
+    -> IO (V.Vector (Maybe (Entry SerialisedValue (WeakBlobRef IO h))))
   #-}
 -- | Intra-page lookups, and combining lookup results from multiple runs and
 -- the write buffer.
@@ -227,7 +227,7 @@ intraPageLookups ::
   -> VP.Vector RunIxKeyIx
   -> V.Vector (IOOp (PrimState m) h)
   -> VU.Vector IOResult
-  -> m (V.Vector (Maybe (Entry SerialisedValue (WeakBlobRef m (Handle h)))))
+  -> m (V.Vector (Maybe (Entry SerialisedValue (WeakBlobRef m h))))
 intraPageLookups !resolveV !wb !wbblobs !rs !ks !rkixs !ioops !ioress = do
     -- We accumulate results into the 'res' vector. When there are several
     -- lookup hits for the same key then we combine the results. The combining
@@ -256,7 +256,7 @@ intraPageLookups !resolveV !wb !wbblobs !rs !ks !rkixs !ioops !ioress = do
 
     loop ::
          VM.MVector (PrimState m)
-                    (Maybe (Entry SerialisedValue (WeakBlobRef m (Handle h))))
+                    (Maybe (Entry SerialisedValue (WeakBlobRef m h)))
       -> Int
       -> m ()
     loop !res !ioopix

src/Database/LSMTree/Internal/Merge.hs

@@ -45,7 +45,6 @@ import           Database.LSMTree.Internal.RunReaders (Readers)
 import qualified Database.LSMTree.Internal.RunReaders as Readers
 import           Database.LSMTree.Internal.Serialise
 import           GHC.Stack (HasCallStack)
-import qualified System.FS.API as FS
 import           System.FS.API (HasFS)
 import           System.FS.BlockIO.API (HasBlockIO)
 
@@ -357,14 +356,14 @@ steps Merge {..} requestedSteps = assertStepsInvariant <$> do
      Level
   -> RunBuilder IO h
   -> SerialisedKey
-  -> Reader.Entry IO (FS.Handle h)
+  -> Reader.Entry IO h
   -> IO () #-}
 writeReaderEntry ::
      (MonadSTM m, MonadST m, MonadThrow m)
   => Level
   -> RunBuilder m h
   -> SerialisedKey
-  -> Reader.Entry m (FS.Handle h)
+  -> Reader.Entry m h
   -> m ()
 writeReaderEntry level builder key (Reader.Entry entryFull) =
       -- Small entry.
@@ -397,14 +396,14 @@ writeReaderEntry level builder key entry@(Reader.EntryOverflow prefix page _ ove
      Level
   -> RunBuilder IO h
   -> SerialisedKey
-  -> Entry SerialisedValue (BlobRef IO (FS.Handle h))
+  -> Entry SerialisedValue (BlobRef IO h)
   -> IO () #-}
 writeSerialisedEntry ::
      (MonadSTM m, MonadST m, MonadThrow m)
   => Level
   -> RunBuilder m h
   -> SerialisedKey
-  -> Entry SerialisedValue (BlobRef m (FS.Handle h))
+  -> Entry SerialisedValue (BlobRef m h)
   -> m ()
 writeSerialisedEntry level builder key entry =
     when (shouldWriteEntry level entry) $

src/Database/LSMTree/Internal/Run.hs

@@ -144,7 +144,7 @@ removeReferenceN :: (PrimMonad m, MonadMask m) => Run m h -> Word64 -> m ()
 removeReferenceN r = RC.removeReferenceN (runRefCounter r)
 
 -- | Helper function to make a 'BlobRef' that points into a 'Run'.
-mkBlobRefForRun :: Run m h -> BlobSpan -> BlobRef m (FS.Handle h)
+mkBlobRefForRun :: Run m h -> BlobSpan -> BlobRef m h
 mkBlobRefForRun Run{runBlobFile} blobRefSpan =
     BlobRef {
       blobRefFile  = blobFileHandle runBlobFile,

src/Database/LSMTree/Internal/RunBuilder.hs

@@ -106,7 +106,7 @@ new fs hbio runBuilderFsPaths numEntries alloc = do
 {-# SPECIALISE addKeyOp ::
      RunBuilder IO h
   -> SerialisedKey
-  -> Entry SerialisedValue (BlobRef IO (FS.Handle h))
+  -> Entry SerialisedValue (BlobRef IO h)
   -> IO () #-}
 -- | Add a key\/op pair.
 --
@@ -125,7 +125,7 @@ addKeyOp ::
      (MonadST m, MonadSTM m, MonadThrow m)
   => RunBuilder m h
   -> SerialisedKey
-  -> Entry SerialisedValue (BlobRef m (FS.Handle h))
+  -> Entry SerialisedValue (BlobRef m h)
   -> m ()
 addKeyOp builder@RunBuilder{runBuilderAcc} key op = do
     -- TODO: the fmap entry here reallocates even when there are no blobs.
@@ -275,13 +275,13 @@ writeBlob RunBuilder{..} blob = do
 
 {-# SPECIALISE copyBlob ::
      RunBuilder IO h
-  -> BlobRef IO (FS.Handle h)
-  -> IO BlobRef.BlobSpan #-}
+  -> BlobRef IO h
+  -> IO BlobSpan #-}
 copyBlob ::
      (MonadSTM m, MonadThrow m, PrimMonad m)
   => RunBuilder m h
-  -> BlobRef m (FS.Handle h)
-  -> m BlobRef.BlobSpan
+  -> BlobRef m h
+  -> m BlobSpan
 copyBlob builder@RunBuilder {..} blobref = do
     blob <- BlobRef.readBlob runBuilderHasFS blobref
     writeBlob builder blob

src/Database/LSMTree/Internal/RunReader.hs

@@ -214,13 +214,13 @@ appendOverflow len overflowPages (SerialisedValue prefix) =
 
 {-# SPECIALISE next ::
      RunReader IO h
-  -> IO (Result IO (FS.Handle h)) #-}
+  -> IO (Result IO h) #-}
 -- | Stop using the 'RunReader' after getting 'Empty', because the 'Reader' is
 -- automatically closed!
 next :: forall m h.
      (MonadCatch m, MonadSTM m, MonadST m)
   => RunReader m h
-  -> m (Result m (FS.Handle h))
+  -> m (Result m h)
 next reader@RunReader {..} = do
     readMutVar readerCurrentPage >>= \case
       Nothing ->
@@ -229,7 +229,7 @@ next reader@RunReader {..} = do
         entryNo <- readPrimVar readerCurrentEntryNo
         go entryNo page
   where
-    go :: Word16 -> RawPage -> m (Result m (FS.Handle h))
+    go :: Word16 -> RawPage -> m (Result m h)
     go !entryNo !page =
         -- take entry from current page (resolve blob if necessary)
         case rawPageIndex page entryNo of
@@ -252,7 +252,7 @@ next reader@RunReader {..} = do
           IndexEntryOverflow key entry lenSuffix -> do
             -- TODO: we know that we need the next page, could already load?
             modifyPrimVar readerCurrentEntryNo (+1)
-            let entry' :: E.Entry SerialisedValue (BlobRef m (FS.Handle h))
+            let entry' :: E.Entry SerialisedValue (BlobRef m h)
                 entry' = fmap (Run.mkBlobRefForRun readerRun) entry
             overflowPages <- readOverflowPages readerHasFS readerKOpsHandle lenSuffix
             let rawEntry = mkEntryOverflow entry' page lenSuffix overflowPages