Merge pull request #630 from IntersectMBO/jdral/incoming-run

Miscellaneous changes for `IncomingRun`

Author: dcoutts

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

@@ -41,6 +41,7 @@ import           Database.LSMTree.Internal.Chunk
 import           Database.LSMTree.Internal.Config
 import           Database.LSMTree.Internal.CRC32C
 import           Database.LSMTree.Internal.Entry
+import           Database.LSMTree.Internal.IncomingRun
 import           Database.LSMTree.Internal.Index
 import           Database.LSMTree.Internal.Index.Compact
 import           Database.LSMTree.Internal.Index.CompactAcc

src/Database/LSMTree/Internal.hs

@@ -106,6 +106,7 @@ import qualified Database.LSMTree.Internal.BlobRef as BlobRef
 import           Database.LSMTree.Internal.Config
 import qualified Database.LSMTree.Internal.Cursor as Cursor
 import           Database.LSMTree.Internal.Entry (Entry)
+import           Database.LSMTree.Internal.IncomingRun (IncomingRun (..))
 import           Database.LSMTree.Internal.Lookup (ByteCountDiscrepancy,
                      ResolveSerialisedValue, lookupsIO,
                      lookupsIOWithoutWriteBuffer)

src/Database/LSMTree/Internal/IncomingRun.hs

@@ -25,7 +25,6 @@ module Database.LSMTree.Internal.IncomingRun (
   , immediatelyCompleteIncomingRun
   ) where
 
-import           Control.ActionRegistry
 import           Control.Concurrent.Class.MonadMVar.Strict
 import           Control.DeepSeq (NFData (..))
 import           Control.Monad.Class.MonadST (MonadST)
@@ -64,18 +63,17 @@ instance NFData MergePolicyForLevel where
   rnf LevelTiering   = ()
   rnf LevelLevelling = ()
 
-{-# SPECIALISE duplicateIncomingRun :: ActionRegistry IO -> IncomingRun IO h -> IO (IncomingRun IO h) #-}
+{-# SPECIALISE duplicateIncomingRun :: IncomingRun IO h -> IO (IncomingRun IO h) #-}
 duplicateIncomingRun ::
      (PrimMonad m, MonadMask m)
-  => ActionRegistry m
-  -> IncomingRun m h
+  => IncomingRun m h
   -> m (IncomingRun m h)
-duplicateIncomingRun reg (Single r) =
-    Single <$> withRollback reg (dupRef r) releaseRef
+duplicateIncomingRun (Single r) =
+    Single <$> dupRef r
 
-duplicateIncomingRun reg (Merging mp md mcv mr) =
+duplicateIncomingRun (Merging mp md mcv mr) =
     Merging mp md <$> (newPrimVar =<< readPrimVar mcv)
-                  <*> withRollback reg (dupRef mr) releaseRef
+                  <*> dupRef mr
 
 {-# SPECIALISE releaseIncomingRun :: IncomingRun IO h -> IO () #-}
 releaseIncomingRun ::

src/Database/LSMTree/Internal/MergeSchedule.hs

@@ -23,13 +23,7 @@ module Database.LSMTree.Internal.MergeSchedule (
     -- * Levels, runs and ongoing merges
   , Levels
   , Level (..)
-  , IncomingRun (..)
   , MergePolicyForLevel (..)
-  , newIncomingSingleRun
-  , newIncomingMergingRun
-  , releaseIncomingRun
-  , supplyCreditsIncomingRun
-  , snapshotIncomingRun
   , mergingRunParamsForLevel
     -- * Union level
   , UnionLevel (..)
@@ -326,7 +320,7 @@ duplicateLevels ::
   -> m (Levels m h)
 duplicateLevels reg levels =
     forMStrict levels $ \Level {incomingRun, residentRuns} -> do
-      incomingRun'  <- duplicateIncomingRun reg incomingRun
+      incomingRun'  <- withRollback reg (duplicateIncomingRun incomingRun) releaseIncomingRun
       residentRuns' <- forMStrict residentRuns $ \r ->
                          withRollback reg (dupRef r) releaseRef
       return $! Level {
@@ -710,6 +704,7 @@ addRunToLevels tr conf@TableConfig{..} resolve hfs hbio root uc r0 reg levels ul
               TraceCompletedMerge (Run.size r) (Run.runFsPathsNumber r)
 
       return ir
+
 {-# SPECIALISE newIncomingRunAtLevel ::
      Tracer IO (AtLevel MergeTrace)
   -> HasFS IO h

src/Database/LSMTree/Internal/Snapshot.hs

@@ -49,6 +49,7 @@ import qualified Data.Vector as V
 import           Database.LSMTree.Internal.Config
 import           Database.LSMTree.Internal.CRC32C (checkCRC)
 import qualified Database.LSMTree.Internal.CRC32C as CRC
+import           Database.LSMTree.Internal.IncomingRun
 import           Database.LSMTree.Internal.Lookup (ResolveSerialisedValue)
 import qualified Database.LSMTree.Internal.Merge as Merge
 import           Database.LSMTree.Internal.MergeSchedule