Add unit tests for the trivial case of querying and supplying union credits

The trivial case is when the table has no union level, as then there is
no union debt, and supplying credits returns them all as leftovers.

And implement these trivial cases.

Author: dcoutts

src/Database/LSMTree/Internal.hs

@@ -1630,8 +1630,10 @@ remainingUnionDebt :: (MonadSTM m, MonadThrow m) => Table m h -> m UnionDebt
 remainingUnionDebt t = do
     traceWith (tableTracer t) TraceRemainingUnionDebt
     withOpenTable t $ \tEnv -> do
-      RW.withReadAccess (tableContent tEnv) $ \_tableContent -> do
-        error "remainingUnionDebt: not yet implemented"
+      RW.withReadAccess (tableContent tEnv) $ \tableContent ->
+        case tableUnionLevel tableContent of
+          NoUnion -> pure (UnionDebt 0)
+          Union{} -> error "remainingUnionDebt: not yet implemented"
 
 -- | See 'Database.LSMTree.Normal.UnionCredits'.
 newtype UnionCredits = UnionCredits Int
@@ -1644,5 +1646,7 @@ supplyUnionCredits t credits = do
     traceWith (tableTracer t) $ TraceSupplyUnionCredits credits
     withOpenTable t $ \tEnv -> do
       -- TODO: should this be acquiring read or write access?
-      RW.withWriteAccess (tableContent tEnv) $ \_tableContent -> do
-        error "supplyUnionCredits: not yet implemented"
+      RW.withWriteAccess (tableContent tEnv) $ \tableContent ->
+        case tableUnionLevel tableContent of
+          NoUnion -> pure (tableContent, credits) -- all leftovers
+          Union{} -> error "supplyUnionCredits: not yet implemented"

test/Database/LSMTree/Model/Session.hs

@@ -844,7 +844,9 @@ supplyUnionCredits ::
   -> UnionCredits
   -> m UnionCredits
 supplyUnionCredits t@Table{..} c@(UnionCredits credits)
-  | credits <= 0 = pure c
+  | credits <= 0 = do
+      _ <- guardTableIsOpen t
+      pure c
   | otherwise = do
       (updc, table) <- guardTableIsOpen t
       when (isUnionDescendant == IsUnionDescendant) $

test/Test/Database/LSMTree/UnitTests.hs

@@ -34,6 +34,7 @@ tests =
       , testCase      "unit_twoTableTypes"  unit_twoTableTypes
       , testCase      "unit_snapshots"      unit_snapshots
       , testCase      "unit_unions_1"       unit_unions_1
+      , testCase      "unit_union_credits"  unit_union_credits
       ]
 
 unit_blobs :: (String -> IO ()) -> Assertion
@@ -174,6 +175,21 @@ unit_unions_1 =
           r'' <- lookups table'' [Key1 17]
           V.map ignoreBlobRef r'' @?= [Found (Value1 44)]
 
+-- | Querying or supplying union credits to non-union tables is trivial.
+unit_union_credits :: Assertion
+unit_union_credits =
+    withTempIOHasBlockIO "test" $ \hfs hbio ->
+    withSession nullTracer hfs hbio (FS.mkFsPath []) $ \sess ->
+    withTable @_ @Key1 @Value1 @Blob1 sess defaultTableConfig $ \table -> do
+      inserts table [(Key1 17, Value1 42, Nothing)]
+
+      -- The table is not the result of a union, so the debt is always 0,
+      UnionDebt debt <- remainingUnionDebt table
+      debt @?= 0
+
+      -- and supplying credits returns them all as leftovers.
+      UnionCredits leftover <- supplyUnionCredits table (UnionCredits 42)
+      leftover @?= 42
 
 ignoreBlobRef :: Functor f => f (BlobRef m b) -> f ()
 ignoreBlobRef = fmap (const ())