Public API: add union debt/credits types and related functions

Author: jorisdral

src/Database/LSMTree.hs

@@ -83,6 +83,10 @@ module Database.LSMTree (
     -- * Table union
   , union
   , unions
+  , UnionDebt (..)
+  , remainingUnionDebt
+  , UnionCredits (..)
+  , supplyUnionCredits
 
     -- * Serialisation
   , SerialiseKey
@@ -112,8 +116,8 @@ import           Data.Typeable (Proxy (..), Typeable, eqT, type (:~:) (Refl))
 import qualified Data.Vector as V
 import           Database.LSMTree.Common (BlobRef (BlobRef), IOLike, Range (..),
                      SerialiseKey, SerialiseValue, Session, SnapshotName,
-                     closeSession, deleteSnapshot, listSnapshots, openSession,
-                     withSession)
+                     UnionCredits (..), UnionDebt (..), closeSession,
+                     deleteSnapshot, listSnapshots, openSession, withSession)
 import qualified Database.LSMTree.Common as Common
 import qualified Database.LSMTree.Internal as Internal
 import qualified Database.LSMTree.Internal.BlobRef as Internal
@@ -552,6 +556,22 @@ unions (t :| ts) =
       | Just Refl <- eqT @h @h' = pure t'
       | otherwise = throwIO (Internal.ErrUnionsTableTypeMismatch 0 i)
 
+{-# SPECIALISE remainingUnionDebt :: Table IO k v b -> IO UnionDebt #-}
+remainingUnionDebt :: IOLike m => Table m k v b -> m UnionDebt
+remainingUnionDebt (Internal.Table' t) =
+    (\(Internal.UnionDebt x) -> UnionDebt x) <$>
+      Internal.remainingUnionDebt t
+
+{-# SPECIALISE supplyUnionCredits :: Table IO k v b -> UnionCredits -> IO UnionCredits #-}
+supplyUnionCredits ::
+     IOLike m
+  => Table m k v b
+  -> UnionCredits
+  -> m UnionCredits
+supplyUnionCredits (Internal.Table' t) (UnionCredits credits) =
+    (\(Internal.UnionCredits x) -> UnionCredits x) <$>
+      Internal.supplyUnionCredits t (Internal.UnionCredits credits)
+
 {-------------------------------------------------------------------------------
   Monoidal value resolution
 -------------------------------------------------------------------------------}

src/Database/LSMTree/Common.hs

@@ -43,6 +43,9 @@ module Database.LSMTree.Common (
   , Internal.TableConfigOverride
   , Internal.configNoOverride
   , Internal.configOverrideDiskCachePolicy
+    -- * Unions
+  , UnionDebt (..)
+  , UnionCredits (..)
   ) where
 
 import           Control.Concurrent.Class.MonadMVar.Strict
@@ -259,3 +262,24 @@ data BlobRef m b where
 
 instance Show (BlobRef m b) where
     showsPrec d (BlobRef b) = showsPrec d b
+
+{-------------------------------------------------------------------------------
+  Unions
+-------------------------------------------------------------------------------}
+
+-- | The /current/ upper bound on the number of 'UnionCredits' that have to be
+-- supplied before a @union@ is completed.
+--
+-- The union debt is the number of merging steps that need to be performed /at
+-- most/ until the delayed work of performing a @union@ is completed. This
+-- includes the cost of completing merges that were part of the union's input
+-- tables.
+newtype UnionDebt = UnionDebt Int
+  deriving stock (Show, Eq)
+
+-- | Credits are used to pay off 'UnionDebt', completing a @union@ in the
+-- process.
+--
+-- A union credit corresponds to a single merging step being performed.
+newtype UnionCredits = UnionCredits Int
+  deriving stock (Show, Eq)

src/Database/LSMTree/Monoidal.hs

@@ -100,6 +100,10 @@ module Database.LSMTree.Monoidal (
     -- * Table union
   , union
   , unions
+  , UnionDebt (..)
+  , remainingUnionDebt
+  , UnionCredits (..)
+  , supplyUnionCredits
 
     -- * Concurrency
     -- $concurrency
@@ -132,7 +136,8 @@ import           Data.Proxy (Proxy (Proxy))
 import           Data.Typeable (Typeable, eqT, type (:~:) (Refl))
 import qualified Data.Vector as V
 import           Database.LSMTree.Common (IOLike, Range (..), SerialiseKey,
-                     SerialiseValue (..), Session, SnapshotName, closeSession,
+                     SerialiseValue (..), Session, SnapshotName,
+                     UnionCredits (..), UnionDebt (..), closeSession,
                      deleteSnapshot, listSnapshots, openSession, withSession)
 import qualified Database.LSMTree.Common as Common
 import qualified Database.LSMTree.Internal as Internal
@@ -700,6 +705,31 @@ unions (t :| ts) =
       | Just Refl <- eqT @h @h' = pure t'
       | otherwise = throwIO (Internal.ErrUnionsTableTypeMismatch 0 i)
 
+{-# SPECIALISE remainingUnionDebt :: Table IO k v -> IO UnionDebt #-}
+-- | Return the current union debt. This debt can be reduced until it is paid
+-- off using @supplyUnionCredits@.
+remainingUnionDebt :: IOLike m => Table m k v -> m UnionDebt
+remainingUnionDebt (Internal.MonoidalTable t) =
+    (\(Internal.UnionDebt x) -> UnionDebt x) <$>
+      Internal.remainingUnionDebt t
+
+{-# SPECIALISE supplyUnionCredits :: Table IO k v -> UnionCredits -> IO UnionCredits #-}
+-- | Supply union credits to reduce union debt.
+--
+-- Supplying union credits leads to union merging work being performed in
+-- batches. This reduces the union debt returned by @remainingUnionDebt@. Union
+-- debt will be reduced by /at least/ the number of supplied union credits. It
+-- is therefore advisable to query @remainingUnionDebt@ every once in a while to
+-- see what the current debt is.
+supplyUnionCredits ::
+     IOLike m
+  => Table m k v
+  -> UnionCredits
+  -> m UnionCredits
+supplyUnionCredits (Internal.MonoidalTable t) (UnionCredits credits) =
+    (\(Internal.UnionCredits x) -> UnionCredits x) <$>
+      Internal.supplyUnionCredits t (Internal.UnionCredits credits)
+
 {-------------------------------------------------------------------------------
   Monoidal value resolution
 -------------------------------------------------------------------------------}

src/Database/LSMTree/Normal.hs

@@ -101,6 +101,10 @@ module Database.LSMTree.Normal (
     -- * Table union
   , union
   , unions
+  , UnionDebt (..)
+  , remainingUnionDebt
+  , UnionCredits (..)
+  , supplyUnionCredits
 
     -- * Concurrency #concurrency#
     -- $concurrency
@@ -123,8 +127,8 @@ import           Data.Typeable (Typeable, eqT, type (:~:) (Refl))
 import qualified Data.Vector as V
 import           Database.LSMTree.Common (BlobRef (BlobRef), IOLike, Range (..),
                      SerialiseKey, SerialiseValue, Session, SnapshotName,
-                     closeSession, deleteSnapshot, listSnapshots, openSession,
-                     withSession)
+                     UnionCredits (..), UnionDebt (..), closeSession,
+                     deleteSnapshot, listSnapshots, openSession, withSession)
 import qualified Database.LSMTree.Common as Common
 import qualified Database.LSMTree.Internal as Internal
 import qualified Database.LSMTree.Internal.BlobRef as Internal
@@ -820,3 +824,28 @@ unions (t :| ts) =
     checkTableType _ i (Internal.NormalTable (t' :: Internal.Table m h'))
       | Just Refl <- eqT @h @h' = pure t'
       | otherwise = throwIO (Internal.ErrUnionsTableTypeMismatch 0 i)
+
+{-# SPECIALISE remainingUnionDebt :: Table IO k v b -> IO UnionDebt #-}
+-- | Return the current union debt. This debt can be reduced until it is paid
+-- off using @supplyUnionCredits@.
+remainingUnionDebt :: IOLike m => Table m k v b -> m UnionDebt
+remainingUnionDebt (Internal.NormalTable t) =
+    (\(Internal.UnionDebt x) -> UnionDebt x) <$>
+      Internal.remainingUnionDebt t
+
+{-# SPECIALISE supplyUnionCredits :: Table IO k v b -> UnionCredits -> IO UnionCredits #-}
+-- | Supply union credits to reduce union debt.
+--
+-- Supplying union credits leads to union merging work being performed in
+-- batches. This reduces the union debt returned by @remainingUnionDebt@. Union
+-- debt will be reduced by /at least/ the number of supplied union credits. It
+-- is therefore advisable to query @remainingUnionDebt@ every once in a while to
+-- see what the current debt is.
+supplyUnionCredits ::
+     IOLike m
+  => Table m k v b
+  -> UnionCredits
+  -> m UnionCredits
+supplyUnionCredits (Internal.NormalTable t) (UnionCredits credits) =
+    (\(Internal.UnionCredits x) -> UnionCredits x) <$>
+      Internal.supplyUnionCredits t (Internal.UnionCredits credits)