Merge pull request #498 from IntersectMBO/mheinzel/module-merging-run

Split out module MergingRun

lsm-tree.cabal

@@ -139,6 +139,7 @@ library
     Database.LSMTree.Internal.Lookup
     Database.LSMTree.Internal.Merge
     Database.LSMTree.Internal.MergeSchedule
+    Database.LSMTree.Internal.MergingRun
     Database.LSMTree.Internal.Page
     Database.LSMTree.Internal.PageAcc
     Database.LSMTree.Internal.PageAcc1

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

@@ -45,6 +45,7 @@ import           Database.LSMTree.Internal.Index.CompactAcc
 import           Database.LSMTree.Internal.Merge hiding (Level)
 import qualified Database.LSMTree.Internal.Merge as Merge
 import           Database.LSMTree.Internal.MergeSchedule
+import           Database.LSMTree.Internal.MergingRun
 import           Database.LSMTree.Internal.Page
 import           Database.LSMTree.Internal.PageAcc
 import           Database.LSMTree.Internal.Paths

src/Database/LSMTree/Internal.hs

@@ -1112,7 +1112,9 @@ createSnapshot resolve snap label tableType t = do
           -- credits as if the buffer was full, and then flush the (possibly)
           -- underfull buffer. However, note that this bit of code
           -- here is probably going to change anyway because of #392
-          supplyCredits conf (Credit $ unNumEntries $ case confWriteBufferAlloc conf of AllocNumEntries x -> x) (tableLevels content)
+          let credits = case confWriteBufferAlloc conf of
+                AllocNumEntries n -> Credits (unNumEntries n)
+          supplyCredits conf credits (tableLevels content)
           content' <- flushWriteBuffer
                 (TraceMerge `contramap` tableTracer t)
                 conf
@@ -1196,6 +1198,7 @@ openSnapshot sesh label tableType override snap resolve = do
         snapLevels' <- openRuns reg hfs hbio conf (sessionUniqCounter seshEnv) snapDir actDir snapLevels
         -- Convert from the snapshot format, restoring merge progress in the process
         tableLevels <- fromSnapLevels reg hfs hbio conf (sessionUniqCounter seshEnv) resolve actDir snapLevels'
+        releaseRuns reg snapLevels'
 
         tableCache <- mkLevelsCache reg tableLevels
         newWith reg sesh seshEnv conf' am $! TableContent {