Class: add union debt/credits types and related functions

Author: jorisdral

test/Database/LSMTree/Class.hs

@@ -185,6 +185,21 @@ class (IsSession (Session h)) => IsTable h where
         => NonEmpty (h m k v b)
         -> m (h m k v b)
 
+    remainingUnionDebt ::
+           ( IOLike m
+           , C k v b
+           )
+        => h m k v b
+        -> m UnionDebt
+
+    supplyUnionCredits ::
+           ( IOLike m
+           , C k v b
+           )
+        => h m k v b
+        -> UnionCredits
+        -> m UnionCredits
+
 withTableNew :: forall h m k v b a.
     (IOLike m, IsTable h, C k v b)
   => Session h m
@@ -277,5 +292,8 @@ instance IsTable R.Table where
     openSnapshot sesh snap = R.openSnapshot sesh R.configNoOverride snap
 
     duplicate = R.duplicate
+
     union = R.union
     unions = R.unions
+    remainingUnionDebt = R.remainingUnionDebt
+    supplyUnionCredits = R.supplyUnionCredits

test/Database/LSMTree/Class/Common.hs

@@ -15,7 +15,7 @@ import           Data.Typeable (Typeable)
 import           Database.LSMTree (ResolveValue)
 import           Database.LSMTree.Common as Types (IOLike, Range (..),
                      SerialiseKey, SerialiseValue, SnapshotLabel (..),
-                     SnapshotName)
+                     SnapshotName, UnionCredits (..), UnionDebt (..))
 import qualified Database.LSMTree.Common as R
 import           System.FS.API (FsPath, HasFS)
 import           System.FS.BlockIO.API (HasBlockIO)

test/Database/LSMTree/Model/IO.hs

@@ -92,8 +92,9 @@ instance Class.IsTable Table where
 
     union (Table s1 t1) (Table _s2 t2) =
       Table s1 <$> runInOpenSession s1 (Model.union Model.getResolve t1 t2)
-
     unions ts =
         Table s <$> runInOpenSession s (Model.unions Model.getResolve (fmap thTable ts))
       where
         Table s _ = NE.head ts
+    remainingUnionDebt (Table s t) = runInOpenSession s (Model.remainingUnionDebt t)
+    supplyUnionCredits (Table s t) credits = runInOpenSession s (Model.supplyUnionCredits t credits)