{-# LANGUAGE MagicHash #-}

-- | On disk key-value tables, implemented as Log Structured Merge (LSM) trees.
--
-- This module is the API for \"monoidal\" tables, as opposed to \"normal\"
-- tables (that do not support monoidal updates and unions).
--
-- Key features:
--
-- * Basic key\/value operations: lookup, insert, delete
-- * Monoidal operations: mupsert
-- * Merging of tables
-- * Range lookups by key or key prefix
-- * On-disk durability is /only/ via named snapshots: ordinary operations
--   are otherwise not durable
-- * Opening tables from previous named snapshots
-- * Full persistent data structure by cheap table duplication: all duplicate
--   tables can be both accessed and modified
-- * High performance lookups on SSDs by I\/O batching and concurrency
--
-- This module is intended to be imported qualified.
--
-- > import qualified Database.LSMTree.Monoidal as LSMT
--
module Database.LSMTree.Monoidal (
    -- * Exceptions
    Common.SessionDirDoesNotExistError (..)
  , Common.SessionDirLockedError (..)
  , Common.SessionDirCorruptedError (..)
  , Common.SessionClosedError (..)
  , Common.TableClosedError (..)
  , Common.TableCorruptedError (..)
  , Common.TableTooLargeError (..)
  , Common.TableUnionNotCompatibleError (..)
  , Common.SnapshotExistsError (..)
  , Common.SnapshotDoesNotExistError (..)
  , Common.SnapshotCorruptedError (..)
  , Common.SnapshotNotCompatibleError (..)
  , Common.BlobRefInvalidError (..)
  , Common.CursorClosedError (..)
  , Common.FileFormat (..)
  , Common.FileCorruptedError (..)
  , Common.InvalidSnapshotNameError (..)

    -- * Tracing
  , Common.LSMTreeTrace (..)
  , Common.TableTrace (..)
  , Common.MergeTrace (..)

    -- * Table sessions
  , Session
  , withSession
  , openSession
  , closeSession

    -- * Table
  , Table
  , Common.TableConfig (..)
  , Common.defaultTableConfig
  , Common.SizeRatio (..)
  , Common.MergePolicy (..)
  , Common.WriteBufferAlloc (..)
  , Common.NumEntries (..)
  , Common.BloomFilterAlloc (..)
  , Common.defaultBloomFilterAlloc
  , Common.FencePointerIndexType (..)
  , Common.DiskCachePolicy (..)
  , Common.MergeSchedule (..)
  , Common.defaultMergeSchedule
  , withTable
  , new
  , close
    -- ** Resource management
    -- $resource-management

    -- ** Exception safety
    -- $exception-safety

    -- * Table queries and updates
    -- ** Queries
  , lookups
  , LookupResult (..)
  , rangeLookup
  , Range (..)
  , QueryResult (..)
    -- ** Cursor
  , Cursor
  , withCursor
  , withCursorAtOffset
  , newCursor
  , newCursorAtOffset
  , closeCursor
  , readCursor
    -- ** Updates
  , inserts
  , deletes
  , mupserts
  , updates
  , Update (..)

    -- * Durability (snapshots)
  , Common.SnapshotName
  , Common.toSnapshotName
  , Common.isValidSnapshotName
  , Common.SnapshotLabel (..)
  , createSnapshot
  , openSnapshot
  , Common.TableConfigOverride
  , Common.configNoOverride
  , Common.configOverrideDiskCachePolicy
  , deleteSnapshot
  , listSnapshots

    -- * Persistence
  , duplicate

    -- * Table union
  , union
  , unions
  , UnionDebt (..)
  , remainingUnionDebt
  , UnionCredits (..)
  , supplyUnionCredits

    -- * Concurrency
    -- $concurrency

    -- * Serialisation
  , SerialiseKey
  , SerialiseValue

    -- * Monoidal value resolution
  , ResolveValue (..)
  , resolveDeserialised
    -- ** Properties
  , resolveValueValidOutput
  , resolveValueAssociativity

    -- * Utility types
  , IOLike
  ) where

import           Control.DeepSeq
import           Control.Exception (assert)
import           Control.Monad (zipWithM, (<$!>))
import           Control.Monad.Class.MonadThrow
import           Data.Bifunctor (Bifunctor (..))
import           Data.Coerce (coerce)
import           Data.Kind (Type)
import           Data.List.NonEmpty (NonEmpty (..))
import           Data.Monoid (Sum (..))
import           Data.Typeable (Proxy (..), Typeable, eqT, type (:~:) (Refl),
                     typeRep)
import qualified Data.Vector as V
import           Database.LSMTree.Common (IOLike, Range (..), SerialiseKey,
                     SerialiseValue (..), Session, 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.Entry as Entry
import           Database.LSMTree.Internal.RawBytes (RawBytes)
import qualified Database.LSMTree.Internal.Serialise as Internal
import qualified Database.LSMTree.Internal.Vector as V
import           GHC.Exts (Proxy#, proxy#)

-- $resource-management
-- See "Database.LSMTree.Normal#g:resource"

-- $exception-safety
-- See "Database.LSMTree.Normal#g:exception"

-- $concurrency
-- See "Database.LSMTree.Normal#g:concurrency"

{-------------------------------------------------------------------------------
  Tables
-------------------------------------------------------------------------------}

-- | A handle to an on-disk key\/value table.
--
-- An LSMT table is an individual key value mapping with in-memory and on-disk
-- parts. A table is the object\/reference by which an in-use LSM table will be
-- operated upon. In this API it identifies a single mutable instance of an LSM
-- table. The duplicate tables feature allows for there to may be many such
-- instances in use at once.
type Table = Internal.MonoidalTable

{-# SPECIALISE withTable ::
     Session IO
  -> Common.TableConfig
  -> (Table IO k v -> IO a)
  -> IO a #-}
-- | (Asynchronous) exception-safe, bracketed opening and closing of a table.
--
-- If possible, it is recommended to use this function instead of 'new' and
-- 'close'.
withTable :: forall m k v a.
     IOLike m
  => Session m
  -> Common.TableConfig
  -> (Table m k v -> m a)
  -> m a
withTable :: forall (m :: * -> *) k v a.
IOLike m =>
Session m -> TableConfig -> (Table m k v -> m a) -> m a
withTable (Internal.Session' Session m h
sesh) TableConfig
conf Table m k v -> m a
action =
    Session m h -> TableConfig -> (Table m h -> m a) -> m a
forall (m :: * -> *) h a.
(MonadMask m, MonadSTM m, MonadMVar m, PrimMonad m) =>
Session m h -> TableConfig -> (Table m h -> m a) -> m a
Internal.withTable Session m h
sesh TableConfig
conf ((Table m h -> m a) -> m a) -> (Table m h -> m a) -> m a
forall a b. (a -> b) -> a -> b
$
      Table m k v -> m a
action (Table m k v -> m a)
-> (Table m h -> Table m k v) -> Table m h -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Table m h -> Table m k v
forall (m :: * -> *) k v h.
Typeable h =>
Table m h -> MonoidalTable m k v
Internal.MonoidalTable

{-# SPECIALISE new ::
     Session IO
  -> Common.TableConfig
  -> IO (Table IO k v) #-}
-- | Create a new empty table, returning a fresh table.
--
-- NOTE: tables hold open resources (such as open files) and should be
-- closed using 'close' as soon as they are no longer used.
--
new :: forall m k v.
     IOLike m
  => Session m
  -> Common.TableConfig
  -> m (Table m k v)
new :: forall (m :: * -> *) k v.
IOLike m =>
Session m -> TableConfig -> m (Table m k v)
new (Internal.Session' Session m h
sesh) TableConfig
conf = Table m h -> MonoidalTable m k v
forall (m :: * -> *) k v h.
Typeable h =>
Table m h -> MonoidalTable m k v
Internal.MonoidalTable (Table m h -> MonoidalTable m k v)
-> m (Table m h) -> m (MonoidalTable m k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Session m h -> TableConfig -> m (Table m h)
forall (m :: * -> *) h.
(MonadSTM m, MonadMVar m, PrimMonad m, MonadMask m) =>
Session m h -> TableConfig -> m (Table m h)
Internal.new Session m h
sesh TableConfig
conf

{-# SPECIALISE close ::
     Table IO k v
  -> IO () #-}
-- | Close a table. 'close' is idempotent. All operations on a closed
-- handle will throw an exception.
--
-- Any on-disk files and in-memory data that are no longer referenced after
-- closing the table are lost forever. Use 'Snapshot's to ensure data is
-- not lost.
close :: forall m k v.
     IOLike m
  => Table m k v
  -> m ()
close :: forall (m :: * -> *) k v. IOLike m => Table m k v -> m ()
close (Internal.MonoidalTable Table m h
t) = Table m h -> m ()
forall (m :: * -> *) h.
(MonadMask m, MonadSTM m, MonadMVar m, PrimMonad m) =>
Table m h -> m ()
Internal.close Table m h
t

{-------------------------------------------------------------------------------
  Table queries
-------------------------------------------------------------------------------}

-- | Result of a single point lookup.
data LookupResult v =
    NotFound
  | Found !v
  deriving stock (LookupResult v -> LookupResult v -> Bool
(LookupResult v -> LookupResult v -> Bool)
-> (LookupResult v -> LookupResult v -> Bool)
-> Eq (LookupResult v)
forall v. Eq v => LookupResult v -> LookupResult v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => LookupResult v -> LookupResult v -> Bool
== :: LookupResult v -> LookupResult v -> Bool
$c/= :: forall v. Eq v => LookupResult v -> LookupResult v -> Bool
/= :: LookupResult v -> LookupResult v -> Bool
Eq, Int -> LookupResult v -> ShowS
[LookupResult v] -> ShowS
LookupResult v -> String
(Int -> LookupResult v -> ShowS)
-> (LookupResult v -> String)
-> ([LookupResult v] -> ShowS)
-> Show (LookupResult v)
forall v. Show v => Int -> LookupResult v -> ShowS
forall v. Show v => [LookupResult v] -> ShowS
forall v. Show v => LookupResult v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> LookupResult v -> ShowS
showsPrec :: Int -> LookupResult v -> ShowS
$cshow :: forall v. Show v => LookupResult v -> String
show :: LookupResult v -> String
$cshowList :: forall v. Show v => [LookupResult v] -> ShowS
showList :: [LookupResult v] -> ShowS
Show, (forall a b. (a -> b) -> LookupResult a -> LookupResult b)
-> (forall a b. a -> LookupResult b -> LookupResult a)
-> Functor LookupResult
forall a b. a -> LookupResult b -> LookupResult a
forall a b. (a -> b) -> LookupResult a -> LookupResult b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> LookupResult a -> LookupResult b
fmap :: forall a b. (a -> b) -> LookupResult a -> LookupResult b
$c<$ :: forall a b. a -> LookupResult b -> LookupResult a
<$ :: forall a b. a -> LookupResult b -> LookupResult a
Functor, (forall m. Monoid m => LookupResult m -> m)
-> (forall m a. Monoid m => (a -> m) -> LookupResult a -> m)
-> (forall m a. Monoid m => (a -> m) -> LookupResult a -> m)
-> (forall a b. (a -> b -> b) -> b -> LookupResult a -> b)
-> (forall a b. (a -> b -> b) -> b -> LookupResult a -> b)
-> (forall b a. (b -> a -> b) -> b -> LookupResult a -> b)
-> (forall b a. (b -> a -> b) -> b -> LookupResult a -> b)
-> (forall a. (a -> a -> a) -> LookupResult a -> a)
-> (forall a. (a -> a -> a) -> LookupResult a -> a)
-> (forall a. LookupResult a -> [a])
-> (forall a. LookupResult a -> Bool)
-> (forall a. LookupResult a -> Int)
-> (forall a. Eq a => a -> LookupResult a -> Bool)
-> (forall a. Ord a => LookupResult a -> a)
-> (forall a. Ord a => LookupResult a -> a)
-> (forall a. Num a => LookupResult a -> a)
-> (forall a. Num a => LookupResult a -> a)
-> Foldable LookupResult
forall a. Eq a => a -> LookupResult a -> Bool
forall a. Num a => LookupResult a -> a
forall a. Ord a => LookupResult a -> a
forall m. Monoid m => LookupResult m -> m
forall a. LookupResult a -> Bool
forall a. LookupResult a -> Int
forall a. LookupResult a -> [a]
forall a. (a -> a -> a) -> LookupResult a -> a
forall m a. Monoid m => (a -> m) -> LookupResult a -> m
forall b a. (b -> a -> b) -> b -> LookupResult a -> b
forall a b. (a -> b -> b) -> b -> LookupResult a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => LookupResult m -> m
fold :: forall m. Monoid m => LookupResult m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> LookupResult a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> LookupResult a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> LookupResult a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> LookupResult a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> LookupResult a -> b
foldr :: forall a b. (a -> b -> b) -> b -> LookupResult a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> LookupResult a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> LookupResult a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> LookupResult a -> b
foldl :: forall b a. (b -> a -> b) -> b -> LookupResult a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> LookupResult a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> LookupResult a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> LookupResult a -> a
foldr1 :: forall a. (a -> a -> a) -> LookupResult a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> LookupResult a -> a
foldl1 :: forall a. (a -> a -> a) -> LookupResult a -> a
$ctoList :: forall a. LookupResult a -> [a]
toList :: forall a. LookupResult a -> [a]
$cnull :: forall a. LookupResult a -> Bool
null :: forall a. LookupResult a -> Bool
$clength :: forall a. LookupResult a -> Int
length :: forall a. LookupResult a -> Int
$celem :: forall a. Eq a => a -> LookupResult a -> Bool
elem :: forall a. Eq a => a -> LookupResult a -> Bool
$cmaximum :: forall a. Ord a => LookupResult a -> a
maximum :: forall a. Ord a => LookupResult a -> a
$cminimum :: forall a. Ord a => LookupResult a -> a
minimum :: forall a. Ord a => LookupResult a -> a
$csum :: forall a. Num a => LookupResult a -> a
sum :: forall a. Num a => LookupResult a -> a
$cproduct :: forall a. Num a => LookupResult a -> a
product :: forall a. Num a => LookupResult a -> a
Foldable, Functor LookupResult
Foldable LookupResult
(Functor LookupResult, Foldable LookupResult) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> LookupResult a -> f (LookupResult b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    LookupResult (f a) -> f (LookupResult a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> LookupResult a -> m (LookupResult b))
-> (forall (m :: * -> *) a.
    Monad m =>
    LookupResult (m a) -> m (LookupResult a))
-> Traversable LookupResult
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
LookupResult (m a) -> m (LookupResult a)
forall (f :: * -> *) a.
Applicative f =>
LookupResult (f a) -> f (LookupResult a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LookupResult a -> m (LookupResult b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LookupResult a -> f (LookupResult b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LookupResult a -> f (LookupResult b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> LookupResult a -> f (LookupResult b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
LookupResult (f a) -> f (LookupResult a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
LookupResult (f a) -> f (LookupResult a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LookupResult a -> m (LookupResult b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> LookupResult a -> m (LookupResult b)
$csequence :: forall (m :: * -> *) a.
Monad m =>
LookupResult (m a) -> m (LookupResult a)
sequence :: forall (m :: * -> *) a.
Monad m =>
LookupResult (m a) -> m (LookupResult a)
Traversable)

{-# SPECIALISE lookups ::
     (SerialiseKey k, SerialiseValue v, ResolveValue v)
  => Table IO k v
  -> V.Vector k
  -> IO (V.Vector (LookupResult v)) #-}
{-# INLINEABLE lookups #-}
-- | Perform a batch of lookups.
--
-- Lookups can be performed concurrently from multiple Haskell threads.
lookups :: forall m k v.
     (IOLike m, SerialiseKey k, SerialiseValue v, ResolveValue v)
  => Table m k v
  -> V.Vector k
  -> m (V.Vector (LookupResult v))
lookups :: forall (m :: * -> *) k v.
(IOLike m, SerialiseKey k, SerialiseValue v, ResolveValue v) =>
Table m k v -> Vector k -> m (Vector (LookupResult v))
lookups (Internal.MonoidalTable Table m h
t) Vector k
ks =
    (Maybe (Entry SerialisedValue (WeakBlobRef m h)) -> LookupResult v)
-> Vector (Maybe (Entry SerialisedValue (WeakBlobRef m h)))
-> Vector (LookupResult v)
forall a b. (a -> b) -> Vector a -> Vector b
V.map Maybe (Entry SerialisedValue (WeakBlobRef m h)) -> LookupResult v
forall {v} {b}.
SerialiseValue v =>
Maybe (Entry SerialisedValue b) -> LookupResult v
toLookupResult (Vector (Maybe (Entry SerialisedValue (WeakBlobRef m h)))
 -> Vector (LookupResult v))
-> m (Vector (Maybe (Entry SerialisedValue (WeakBlobRef m h))))
-> m (Vector (LookupResult v))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
    ResolveSerialisedValue
-> Vector SerialisedKey
-> Table m h
-> m (Vector (Maybe (Entry SerialisedValue (WeakBlobRef m h))))
forall (m :: * -> *) h.
(MonadAsync m, MonadMask m, MonadMVar m, MonadST m) =>
ResolveSerialisedValue
-> Vector SerialisedKey
-> Table m h
-> m (Vector (Maybe (Entry SerialisedValue (WeakBlobRef m h))))
Internal.lookups
      (forall v. ResolveValue v => Proxy v -> ResolveSerialisedValue
forall {k} (v :: k).
ResolveValue v =>
Proxy v -> ResolveSerialisedValue
resolve @v Proxy v
forall {k} (t :: k). Proxy t
Proxy)
      ((k -> SerialisedKey) -> Vector k -> Vector SerialisedKey
forall a b. (a -> b) -> Vector a -> Vector b
V.map k -> SerialisedKey
forall k. SerialiseKey k => k -> SerialisedKey
Internal.serialiseKey Vector k
ks)
      Table m h
t
  where
    toLookupResult :: Maybe (Entry SerialisedValue b) -> LookupResult v
toLookupResult (Just Entry SerialisedValue b
e) = case Entry SerialisedValue b
e of
      Entry.Insert SerialisedValue
v           -> v -> LookupResult v
forall v. v -> LookupResult v
Found (SerialisedValue -> v
forall v. SerialiseValue v => SerialisedValue -> v
Internal.deserialiseValue SerialisedValue
v)
      Entry.InsertWithBlob SerialisedValue
v b
_ -> v -> LookupResult v
forall v. v -> LookupResult v
Found (SerialisedValue -> v
forall v. SerialiseValue v => SerialisedValue -> v
Internal.deserialiseValue SerialisedValue
v)
      Entry.Mupdate SerialisedValue
v          -> v -> LookupResult v
forall v. v -> LookupResult v
Found (SerialisedValue -> v
forall v. SerialiseValue v => SerialisedValue -> v
Internal.deserialiseValue SerialisedValue
v)
      Entry SerialisedValue b
Entry.Delete             -> LookupResult v
forall v. LookupResult v
NotFound
    toLookupResult Maybe (Entry SerialisedValue b)
Nothing = LookupResult v
forall v. LookupResult v
NotFound

-- | A result for one point in a cursor read or range query.
data QueryResult k v =
    FoundInQuery !k !v
  deriving stock (QueryResult k v -> QueryResult k v -> Bool
(QueryResult k v -> QueryResult k v -> Bool)
-> (QueryResult k v -> QueryResult k v -> Bool)
-> Eq (QueryResult k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v.
(Eq k, Eq v) =>
QueryResult k v -> QueryResult k v -> Bool
$c== :: forall k v.
(Eq k, Eq v) =>
QueryResult k v -> QueryResult k v -> Bool
== :: QueryResult k v -> QueryResult k v -> Bool
$c/= :: forall k v.
(Eq k, Eq v) =>
QueryResult k v -> QueryResult k v -> Bool
/= :: QueryResult k v -> QueryResult k v -> Bool
Eq, Int -> QueryResult k v -> ShowS
[QueryResult k v] -> ShowS
QueryResult k v -> String
(Int -> QueryResult k v -> ShowS)
-> (QueryResult k v -> String)
-> ([QueryResult k v] -> ShowS)
-> Show (QueryResult k v)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => Int -> QueryResult k v -> ShowS
forall k v. (Show k, Show v) => [QueryResult k v] -> ShowS
forall k v. (Show k, Show v) => QueryResult k v -> String
$cshowsPrec :: forall k v. (Show k, Show v) => Int -> QueryResult k v -> ShowS
showsPrec :: Int -> QueryResult k v -> ShowS
$cshow :: forall k v. (Show k, Show v) => QueryResult k v -> String
show :: QueryResult k v -> String
$cshowList :: forall k v. (Show k, Show v) => [QueryResult k v] -> ShowS
showList :: [QueryResult k v] -> ShowS
Show, (forall a b. (a -> b) -> QueryResult k a -> QueryResult k b)
-> (forall a b. a -> QueryResult k b -> QueryResult k a)
-> Functor (QueryResult k)
forall a b. a -> QueryResult k b -> QueryResult k a
forall a b. (a -> b) -> QueryResult k a -> QueryResult k b
forall k a b. a -> QueryResult k b -> QueryResult k a
forall k a b. (a -> b) -> QueryResult k a -> QueryResult k b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall k a b. (a -> b) -> QueryResult k a -> QueryResult k b
fmap :: forall a b. (a -> b) -> QueryResult k a -> QueryResult k b
$c<$ :: forall k a b. a -> QueryResult k b -> QueryResult k a
<$ :: forall a b. a -> QueryResult k b -> QueryResult k a
Functor, (forall m. Monoid m => QueryResult k m -> m)
-> (forall m a. Monoid m => (a -> m) -> QueryResult k a -> m)
-> (forall m a. Monoid m => (a -> m) -> QueryResult k a -> m)
-> (forall a b. (a -> b -> b) -> b -> QueryResult k a -> b)
-> (forall a b. (a -> b -> b) -> b -> QueryResult k a -> b)
-> (forall b a. (b -> a -> b) -> b -> QueryResult k a -> b)
-> (forall b a. (b -> a -> b) -> b -> QueryResult k a -> b)
-> (forall a. (a -> a -> a) -> QueryResult k a -> a)
-> (forall a. (a -> a -> a) -> QueryResult k a -> a)
-> (forall a. QueryResult k a -> [a])
-> (forall a. QueryResult k a -> Bool)
-> (forall a. QueryResult k a -> Int)
-> (forall a. Eq a => a -> QueryResult k a -> Bool)
-> (forall a. Ord a => QueryResult k a -> a)
-> (forall a. Ord a => QueryResult k a -> a)
-> (forall a. Num a => QueryResult k a -> a)
-> (forall a. Num a => QueryResult k a -> a)
-> Foldable (QueryResult k)
forall a. Eq a => a -> QueryResult k a -> Bool
forall a. Num a => QueryResult k a -> a
forall a. Ord a => QueryResult k a -> a
forall m. Monoid m => QueryResult k m -> m
forall a. QueryResult k a -> Bool
forall a. QueryResult k a -> Int
forall a. QueryResult k a -> [a]
forall a. (a -> a -> a) -> QueryResult k a -> a
forall k a. Eq a => a -> QueryResult k a -> Bool
forall k a. Num a => QueryResult k a -> a
forall k a. Ord a => QueryResult k a -> a
forall m a. Monoid m => (a -> m) -> QueryResult k a -> m
forall k m. Monoid m => QueryResult k m -> m
forall k a. QueryResult k a -> Bool
forall k a. QueryResult k a -> Int
forall k a. QueryResult k a -> [a]
forall b a. (b -> a -> b) -> b -> QueryResult k a -> b
forall a b. (a -> b -> b) -> b -> QueryResult k a -> b
forall k a. (a -> a -> a) -> QueryResult k a -> a
forall k m a. Monoid m => (a -> m) -> QueryResult k a -> m
forall k b a. (b -> a -> b) -> b -> QueryResult k a -> b
forall k a b. (a -> b -> b) -> b -> QueryResult k a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall k m. Monoid m => QueryResult k m -> m
fold :: forall m. Monoid m => QueryResult k m -> m
$cfoldMap :: forall k m a. Monoid m => (a -> m) -> QueryResult k a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> QueryResult k a -> m
$cfoldMap' :: forall k m a. Monoid m => (a -> m) -> QueryResult k a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> QueryResult k a -> m
$cfoldr :: forall k a b. (a -> b -> b) -> b -> QueryResult k a -> b
foldr :: forall a b. (a -> b -> b) -> b -> QueryResult k a -> b
$cfoldr' :: forall k a b. (a -> b -> b) -> b -> QueryResult k a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> QueryResult k a -> b
$cfoldl :: forall k b a. (b -> a -> b) -> b -> QueryResult k a -> b
foldl :: forall b a. (b -> a -> b) -> b -> QueryResult k a -> b
$cfoldl' :: forall k b a. (b -> a -> b) -> b -> QueryResult k a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> QueryResult k a -> b
$cfoldr1 :: forall k a. (a -> a -> a) -> QueryResult k a -> a
foldr1 :: forall a. (a -> a -> a) -> QueryResult k a -> a
$cfoldl1 :: forall k a. (a -> a -> a) -> QueryResult k a -> a
foldl1 :: forall a. (a -> a -> a) -> QueryResult k a -> a
$ctoList :: forall k a. QueryResult k a -> [a]
toList :: forall a. QueryResult k a -> [a]
$cnull :: forall k a. QueryResult k a -> Bool
null :: forall a. QueryResult k a -> Bool
$clength :: forall k a. QueryResult k a -> Int
length :: forall a. QueryResult k a -> Int
$celem :: forall k a. Eq a => a -> QueryResult k a -> Bool
elem :: forall a. Eq a => a -> QueryResult k a -> Bool
$cmaximum :: forall k a. Ord a => QueryResult k a -> a
maximum :: forall a. Ord a => QueryResult k a -> a
$cminimum :: forall k a. Ord a => QueryResult k a -> a
minimum :: forall a. Ord a => QueryResult k a -> a
$csum :: forall k a. Num a => QueryResult k a -> a
sum :: forall a. Num a => QueryResult k a -> a
$cproduct :: forall k a. Num a => QueryResult k a -> a
product :: forall a. Num a => QueryResult k a -> a
Foldable, Functor (QueryResult k)
Foldable (QueryResult k)
(Functor (QueryResult k), Foldable (QueryResult k)) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> QueryResult k a -> f (QueryResult k b))
-> (forall (f :: * -> *) a.
    Applicative f =>
    QueryResult k (f a) -> f (QueryResult k a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> QueryResult k a -> m (QueryResult k b))
-> (forall (m :: * -> *) a.
    Monad m =>
    QueryResult k (m a) -> m (QueryResult k a))
-> Traversable (QueryResult k)
forall k. Functor (QueryResult k)
forall k. Foldable (QueryResult k)
forall k (m :: * -> *) a.
Monad m =>
QueryResult k (m a) -> m (QueryResult k a)
forall k (f :: * -> *) a.
Applicative f =>
QueryResult k (f a) -> f (QueryResult k a)
forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QueryResult k a -> m (QueryResult k b)
forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QueryResult k a -> f (QueryResult k b)
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
 Applicative f =>
 (a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
    Monad m =>
    (a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a.
Monad m =>
QueryResult k (m a) -> m (QueryResult k a)
forall (f :: * -> *) a.
Applicative f =>
QueryResult k (f a) -> f (QueryResult k a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QueryResult k a -> m (QueryResult k b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QueryResult k a -> f (QueryResult k b)
$ctraverse :: forall k (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QueryResult k a -> f (QueryResult k b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> QueryResult k a -> f (QueryResult k b)
$csequenceA :: forall k (f :: * -> *) a.
Applicative f =>
QueryResult k (f a) -> f (QueryResult k a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
QueryResult k (f a) -> f (QueryResult k a)
$cmapM :: forall k (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QueryResult k a -> m (QueryResult k b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> QueryResult k a -> m (QueryResult k b)
$csequence :: forall k (m :: * -> *) a.
Monad m =>
QueryResult k (m a) -> m (QueryResult k a)
sequence :: forall (m :: * -> *) a.
Monad m =>
QueryResult k (m a) -> m (QueryResult k a)
Traversable)

{-# SPECIALISE rangeLookup ::
     (SerialiseKey k, SerialiseValue v, ResolveValue v)
  => Table IO k v
  -> Range k
  -> IO (V.Vector (QueryResult k v)) #-}
-- | Perform a range lookup.
--
-- Range lookups can be performed concurrently from multiple Haskell threads.
rangeLookup :: forall m k v.
     (IOLike m, SerialiseKey k, SerialiseValue v, ResolveValue v)
  => Table m k v
  -> Range k
  -> m (V.Vector (QueryResult k v))
rangeLookup :: forall (m :: * -> *) k v.
(IOLike m, SerialiseKey k, SerialiseValue v, ResolveValue v) =>
Table m k v -> Range k -> m (Vector (QueryResult k v))
rangeLookup (Internal.MonoidalTable Table m h
t) Range k
range =
    ResolveSerialisedValue
-> Range SerialisedKey
-> Table m h
-> (SerialisedKey
    -> SerialisedValue -> Maybe (WeakBlobRef m h) -> QueryResult k v)
-> m (Vector (QueryResult k v))
forall (m :: * -> *) h res.
(MonadMask m, MonadMVar m, MonadST m, MonadSTM m) =>
ResolveSerialisedValue
-> Range SerialisedKey
-> Table m h
-> (SerialisedKey
    -> SerialisedValue -> Maybe (WeakBlobRef m h) -> res)
-> m (Vector res)
Internal.rangeLookup (forall v. ResolveValue v => Proxy v -> ResolveSerialisedValue
forall {k} (v :: k).
ResolveValue v =>
Proxy v -> ResolveSerialisedValue
resolve @v Proxy v
forall {k} (t :: k). Proxy t
Proxy)(k -> SerialisedKey
forall k. SerialiseKey k => k -> SerialisedKey
Internal.serialiseKey (k -> SerialisedKey) -> Range k -> Range SerialisedKey
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Range k
range) Table m h
t ((SerialisedKey
  -> SerialisedValue -> Maybe (WeakBlobRef m h) -> QueryResult k v)
 -> m (Vector (QueryResult k v)))
-> (SerialisedKey
    -> SerialisedValue -> Maybe (WeakBlobRef m h) -> QueryResult k v)
-> m (Vector (QueryResult k v))
forall a b. (a -> b) -> a -> b
$ \SerialisedKey
k SerialisedValue
v Maybe (WeakBlobRef m h)
mblob ->
      Bool -> QueryResult k v -> QueryResult k v
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Maybe (WeakBlobRef m h) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (WeakBlobRef m h)
mblob) (QueryResult k v -> QueryResult k v)
-> QueryResult k v -> QueryResult k v
forall a b. (a -> b) -> a -> b
$
        k -> v -> QueryResult k v
forall k v. k -> v -> QueryResult k v
FoundInQuery (SerialisedKey -> k
forall k. SerialiseKey k => SerialisedKey -> k
Internal.deserialiseKey SerialisedKey
k) (SerialisedValue -> v
forall v. SerialiseValue v => SerialisedValue -> v
Internal.deserialiseValue SerialisedValue
v)

{-------------------------------------------------------------------------------
  Cursor
-------------------------------------------------------------------------------}

-- | A read-only view into a table.
--
-- A cursor allows reading from a table sequentially (according to serialised
-- key ordering) in an incremental fashion. For example, this allows doing a
-- table scan in small chunks.
-- Once a cursor has been created, updates to the referenced table don't affect
-- the cursor.
type Cursor :: (Type -> Type) -> Type -> Type -> Type
type Cursor = Internal.MonoidalCursor

{-# SPECIALISE withCursor ::
     Table IO k v
  -> (Cursor IO k v -> IO a)
  -> IO a #-}
-- | (Asynchronous) exception-safe, bracketed opening and closing of a cursor.
--
-- If possible, it is recommended to use this function instead of 'newCursor'
-- and 'closeCursor'.
withCursor :: forall m k v a.
     IOLike m
  => Table m k v
  -> (Cursor m k v -> m a)
  -> m a
withCursor :: forall (m :: * -> *) k v a.
IOLike m =>
Table m k v -> (Cursor m k v -> m a) -> m a
withCursor (Internal.MonoidalTable Table m h
t) Cursor m k v -> m a
action =
    OffsetKey -> Table m h -> (Cursor m h -> m a) -> m a
forall (m :: * -> *) h a.
(MonadMask m, MonadMVar m, MonadST m, MonadSTM m) =>
OffsetKey -> Table m h -> (Cursor m h -> m a) -> m a
Internal.withCursor OffsetKey
Internal.NoOffsetKey Table m h
t (Cursor m k v -> m a
action (Cursor m k v -> m a)
-> (Cursor m h -> Cursor m k v) -> Cursor m h -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor m h -> Cursor m k v
forall (m :: * -> *) k v h.
Typeable h =>
Cursor m h -> MonoidalCursor m k v
Internal.MonoidalCursor)

{-# SPECIALISE withCursorAtOffset ::
     SerialiseKey k
  => k
  -> Table IO k v
  -> (Cursor IO k v -> IO a)
  -> IO a #-}
-- | A variant of 'withCursor' that allows initialising the cursor at an offset
-- within the table such that the first entry the cursor returns will be the
-- one with the lowest key that is greater than or equal to the given key.
-- In other words, it uses an inclusive lower bound.
--
-- NOTE: The ordering of the serialised keys will be used, which can lead to
-- unexpected results if the 'SerialiseKey' instance is not order-preserving!
withCursorAtOffset :: forall m k v a.
     (IOLike m, SerialiseKey k)
  => k
  -> Table m k v
  -> (Cursor m k v -> m a)
  -> m a
withCursorAtOffset :: forall (m :: * -> *) k v a.
(IOLike m, SerialiseKey k) =>
k -> Table m k v -> (Cursor m k v -> m a) -> m a
withCursorAtOffset k
offset (Internal.MonoidalTable Table m h
t) Cursor m k v -> m a
action =
    OffsetKey -> Table m h -> (Cursor m h -> m a) -> m a
forall (m :: * -> *) h a.
(MonadMask m, MonadMVar m, MonadST m, MonadSTM m) =>
OffsetKey -> Table m h -> (Cursor m h -> m a) -> m a
Internal.withCursor (SerialisedKey -> OffsetKey
Internal.OffsetKey (k -> SerialisedKey
forall k. SerialiseKey k => k -> SerialisedKey
Internal.serialiseKey k
offset)) Table m h
t ((Cursor m h -> m a) -> m a) -> (Cursor m h -> m a) -> m a
forall a b. (a -> b) -> a -> b
$
      Cursor m k v -> m a
action (Cursor m k v -> m a)
-> (Cursor m h -> Cursor m k v) -> Cursor m h -> m a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cursor m h -> Cursor m k v
forall (m :: * -> *) k v h.
Typeable h =>
Cursor m h -> MonoidalCursor m k v
Internal.MonoidalCursor

{-# SPECIALISE newCursor ::
     Table IO k v
  -> IO (Cursor IO k v) #-}
-- | Create a new cursor to read from a given table. Future updates to the table
-- will not be reflected in the cursor. The cursor starts at the beginning, i.e.
-- the minimum key of the table.
--
-- Consider using 'withCursor' instead.
--
-- NOTE: cursors hold open resources (such as open files) and should be closed
-- using 'close' as soon as they are no longer used.
newCursor :: forall m k v.
     IOLike m
  => Table m k v
  -> m (Cursor m k v)
newCursor :: forall (m :: * -> *) k v.
IOLike m =>
Table m k v -> m (Cursor m k v)
newCursor (Internal.MonoidalTable Table m h
t) =
    Cursor m h -> MonoidalCursor m k v
forall (m :: * -> *) k v h.
Typeable h =>
Cursor m h -> MonoidalCursor m k v
Internal.MonoidalCursor (Cursor m h -> MonoidalCursor m k v)
-> m (Cursor m h) -> m (MonoidalCursor m k v)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!> OffsetKey -> Table m h -> m (Cursor m h)
forall (m :: * -> *) h.
(MonadMask m, MonadMVar m, MonadST m, MonadSTM m) =>
OffsetKey -> Table m h -> m (Cursor m h)
Internal.newCursor OffsetKey
Internal.NoOffsetKey Table m h
t

{-# SPECIALISE newCursorAtOffset ::
     SerialiseKey k
  => k
  -> Table IO k v
  -> IO (Cursor IO k v) #-}
-- | A variant of 'newCursor' that allows initialising the cursor at an offset
-- within the table such that the first entry the cursor returns will be the
-- one with the lowest key that is greater than or equal to the given key.
-- In other words, it uses an inclusive lower bound.
--
-- NOTE: The ordering of the serialised keys will be used, which can lead to
-- unexpected results if the 'SerialiseKey' instance is not order-preserving!
newCursorAtOffset :: forall m k v.
     (IOLike m, SerialiseKey k)
  => k
  -> Table m k v
  -> m (Cursor m k v)
newCursorAtOffset :: forall (m :: * -> *) k v.
(IOLike m, SerialiseKey k) =>
k -> Table m k v -> m (Cursor m k v)
newCursorAtOffset k
offset (Internal.MonoidalTable Table m h
t) =
    Cursor m h -> MonoidalCursor m k v
forall (m :: * -> *) k v h.
Typeable h =>
Cursor m h -> MonoidalCursor m k v
Internal.MonoidalCursor (Cursor m h -> MonoidalCursor m k v)
-> m (Cursor m h) -> m (MonoidalCursor m k v)
forall (m :: * -> *) a b. Monad m => (a -> b) -> m a -> m b
<$!>
      OffsetKey -> Table m h -> m (Cursor m h)
forall (m :: * -> *) h.
(MonadMask m, MonadMVar m, MonadST m, MonadSTM m) =>
OffsetKey -> Table m h -> m (Cursor m h)
Internal.newCursor (SerialisedKey -> OffsetKey
Internal.OffsetKey (k -> SerialisedKey
forall k. SerialiseKey k => k -> SerialisedKey
Internal.serialiseKey k
offset)) Table m h
t

{-# SPECIALISE closeCursor ::
     Cursor IO k v
  -> IO () #-}
-- | Close a cursor. 'closeCursor' is idempotent. All operations on a closed
-- cursor will throw an exception.
closeCursor :: forall m k v.
     IOLike m
  => Cursor m k v
  -> m ()
closeCursor :: forall (m :: * -> *) k v. IOLike m => Cursor m k v -> m ()
closeCursor (Internal.MonoidalCursor Cursor m h
c) = Cursor m h -> m ()
forall (m :: * -> *) h.
(MonadMask m, MonadMVar m, MonadSTM m, PrimMonad m) =>
Cursor m h -> m ()
Internal.closeCursor Cursor m h
c

{-# SPECIALISE readCursor ::
     (SerialiseKey k, SerialiseValue v, ResolveValue v)
  => Int
  -> Cursor IO k v
  -> IO (V.Vector (QueryResult k v)) #-}
-- | Read the next @n@ entries from the cursor. The resulting vector is shorter
-- than @n@ if the end of the table has been reached. The cursor state is
-- updated, so the next read will continue where this one ended.
--
-- The cursor gets locked for the duration of the call, preventing concurrent
-- reads.
--
-- NOTE: entries are returned in order of the serialised keys, which might not
-- agree with @Ord k@. See 'SerialiseKey' for more information.
readCursor :: forall m k v.
     ( IOLike m
     , SerialiseKey k
     , SerialiseValue v
     , ResolveValue v
     )
  => Int
  -> Cursor m k v
  -> m (V.Vector (QueryResult k v))
readCursor :: forall (m :: * -> *) k v.
(IOLike m, SerialiseKey k, SerialiseValue v, ResolveValue v) =>
Int -> Cursor m k v -> m (Vector (QueryResult k v))
readCursor Int
n (Internal.MonoidalCursor Cursor m h
c) =
    ResolveSerialisedValue
-> Int
-> Cursor m h
-> (SerialisedKey
    -> SerialisedValue -> Maybe (WeakBlobRef m h) -> QueryResult k v)
-> m (Vector (QueryResult k v))
forall (m :: * -> *) h res.
(MonadMask m, MonadMVar m, MonadST m, MonadSTM m) =>
ResolveSerialisedValue
-> Int
-> Cursor m h
-> (SerialisedKey
    -> SerialisedValue -> Maybe (WeakBlobRef m h) -> res)
-> m (Vector res)
Internal.readCursor (forall v. ResolveValue v => Proxy v -> ResolveSerialisedValue
forall {k} (v :: k).
ResolveValue v =>
Proxy v -> ResolveSerialisedValue
resolve @v Proxy v
forall {k} (t :: k). Proxy t
Proxy) Int
n Cursor m h
c ((SerialisedKey
  -> SerialisedValue -> Maybe (WeakBlobRef m h) -> QueryResult k v)
 -> m (Vector (QueryResult k v)))
-> (SerialisedKey
    -> SerialisedValue -> Maybe (WeakBlobRef m h) -> QueryResult k v)
-> m (Vector (QueryResult k v))
forall a b. (a -> b) -> a -> b
$ \SerialisedKey
k SerialisedValue
v Maybe (WeakBlobRef m h)
mblob ->
      Bool -> QueryResult k v -> QueryResult k v
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Maybe (WeakBlobRef m h) -> Bool
forall a. Maybe a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Maybe (WeakBlobRef m h)
mblob) (QueryResult k v -> QueryResult k v)
-> QueryResult k v -> QueryResult k v
forall a b. (a -> b) -> a -> b
$
        k -> v -> QueryResult k v
forall k v. k -> v -> QueryResult k v
FoundInQuery (SerialisedKey -> k
forall k. SerialiseKey k => SerialisedKey -> k
Internal.deserialiseKey SerialisedKey
k) (SerialisedValue -> v
forall v. SerialiseValue v => SerialisedValue -> v
Internal.deserialiseValue SerialisedValue
v)

{-------------------------------------------------------------------------------
  Table updates
-------------------------------------------------------------------------------}

-- | Monoidal tables support insert, delete and monoidal upsert operations.
--
-- An __update__ is a term that groups all types of table-manipulating
-- operations, like inserts, deletes and mupserts.
data Update v =
    Insert !v
  | Delete
    -- | TODO: should be given a more suitable name.
  | Mupsert !v
  deriving stock (Int -> Update v -> ShowS
[Update v] -> ShowS
Update v -> String
(Int -> Update v -> ShowS)
-> (Update v -> String) -> ([Update v] -> ShowS) -> Show (Update v)
forall v. Show v => Int -> Update v -> ShowS
forall v. Show v => [Update v] -> ShowS
forall v. Show v => Update v -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall v. Show v => Int -> Update v -> ShowS
showsPrec :: Int -> Update v -> ShowS
$cshow :: forall v. Show v => Update v -> String
show :: Update v -> String
$cshowList :: forall v. Show v => [Update v] -> ShowS
showList :: [Update v] -> ShowS
Show, Update v -> Update v -> Bool
(Update v -> Update v -> Bool)
-> (Update v -> Update v -> Bool) -> Eq (Update v)
forall v. Eq v => Update v -> Update v -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall v. Eq v => Update v -> Update v -> Bool
== :: Update v -> Update v -> Bool
$c/= :: forall v. Eq v => Update v -> Update v -> Bool
/= :: Update v -> Update v -> Bool
Eq)

instance NFData v => NFData (Update v) where
  rnf :: Update v -> ()
rnf (Insert v
v)  = v -> ()
forall a. NFData a => a -> ()
rnf v
v
  rnf Update v
Delete      = ()
  rnf (Mupsert v
v) = v -> ()
forall a. NFData a => a -> ()
rnf v
v

{-# SPECIALISE updates ::
     (SerialiseKey k, SerialiseValue v, ResolveValue v)
  => Table IO k v
  -> V.Vector (k, Update v)
  -> IO () #-}
-- | Perform a mixed batch of inserts, deletes and monoidal upserts.
--
-- If there are duplicate keys in the same batch, then keys nearer to the front
-- of the vector take precedence.
--
-- Updates can be performed concurrently from multiple Haskell threads.
updates :: forall m k v.
     ( IOLike m
     , SerialiseKey k
     , SerialiseValue v
     , ResolveValue v
     )
  => Table m k v
  -> V.Vector (k, Update v)
  -> m ()
updates :: forall (m :: * -> *) k v.
(IOLike m, SerialiseKey k, SerialiseValue v, ResolveValue v) =>
Table m k v -> Vector (k, Update v) -> m ()
updates (Internal.MonoidalTable Table m h
t) Vector (k, Update v)
es = do
    ResolveSerialisedValue
-> Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob)
-> Table m h
-> m ()
forall (m :: * -> *) h.
(MonadMask m, MonadMVar m, MonadST m, MonadSTM m) =>
ResolveSerialisedValue
-> Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob)
-> Table m h
-> m ()
Internal.updates
      (forall v. ResolveValue v => Proxy v -> ResolveSerialisedValue
forall {k} (v :: k).
ResolveValue v =>
Proxy v -> ResolveSerialisedValue
resolve @v Proxy v
forall {k} (t :: k). Proxy t
Proxy)
      (((k, Update v)
 -> (SerialisedKey, Entry SerialisedValue SerialisedBlob))
-> Vector (k, Update v)
-> Vector (SerialisedKey, Entry SerialisedValue SerialisedBlob)
forall a b. (a -> b) -> Vector a -> Vector b
V.mapStrict (k, Update v)
-> (SerialisedKey, Entry SerialisedValue SerialisedBlob)
serialiseEntry Vector (k, Update v)
es)
      Table m h
t
  where
    serialiseEntry :: (k, Update v)
-> (SerialisedKey, Entry SerialisedValue SerialisedBlob)
serialiseEntry = (k -> SerialisedKey)
-> (Update v -> Entry SerialisedValue SerialisedBlob)
-> (k, Update v)
-> (SerialisedKey, Entry SerialisedValue SerialisedBlob)
forall a b c d. (a -> b) -> (c -> d) -> (a, c) -> (b, d)
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap k -> SerialisedKey
forall k. SerialiseKey k => k -> SerialisedKey
Internal.serialiseKey Update v -> Entry SerialisedValue SerialisedBlob
serialiseOp
    serialiseOp :: Update v -> Entry SerialisedValue SerialisedBlob
serialiseOp = (v -> SerialisedValue)
-> Entry v SerialisedBlob -> Entry SerialisedValue SerialisedBlob
forall a b c. (a -> b) -> Entry a c -> Entry b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first v -> SerialisedValue
forall v. SerialiseValue v => v -> SerialisedValue
Internal.serialiseValue (Entry v SerialisedBlob -> Entry SerialisedValue SerialisedBlob)
-> (Update v -> Entry v SerialisedBlob)
-> Update v
-> Entry SerialisedValue SerialisedBlob
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Update v -> Entry v SerialisedBlob
forall b. Update v -> Entry v b
updateToEntry

    updateToEntry :: Update v -> Entry.Entry v b
    updateToEntry :: forall b. Update v -> Entry v b
updateToEntry = \case
        Insert v
v  -> v -> Entry v b
forall v b. v -> Entry v b
Entry.Insert v
v
        Mupsert v
v -> v -> Entry v b
forall v b. v -> Entry v b
Entry.Mupdate v
v
        Update v
Delete    -> Entry v b
forall v b. Entry v b
Entry.Delete

{-# SPECIALISE inserts ::
     (SerialiseKey k, SerialiseValue v, ResolveValue v)
  => Table IO k v
  -> V.Vector (k, v)
  -> IO () #-}
-- | Perform a batch of inserts.
--
-- Inserts can be performed concurrently from multiple Haskell threads.
inserts :: forall m k v.
     ( IOLike m
     , SerialiseKey k
     , SerialiseValue v
     , ResolveValue v
     )
  => Table m k v
  -> V.Vector (k, v)
  -> m ()
inserts :: forall (m :: * -> *) k v.
(IOLike m, SerialiseKey k, SerialiseValue v, ResolveValue v) =>
Table m k v -> Vector (k, v) -> m ()
inserts Table m k v
t = Table m k v -> Vector (k, Update v) -> m ()
forall (m :: * -> *) k v.
(IOLike m, SerialiseKey k, SerialiseValue v, ResolveValue v) =>
Table m k v -> Vector (k, Update v) -> m ()
updates Table m k v
t (Vector (k, Update v) -> m ())
-> (Vector (k, v) -> Vector (k, Update v)) -> Vector (k, v) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> (k, Update v)) -> Vector (k, v) -> Vector (k, Update v)
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((v -> Update v) -> (k, v) -> (k, Update v)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second v -> Update v
forall v. v -> Update v
Insert)

{-# SPECIALISE deletes ::
     (SerialiseKey k, SerialiseValue v, ResolveValue v)
  => Table IO k v
  -> V.Vector k
  -> IO () #-}
-- | Perform a batch of deletes.
--
-- Deletes can be performed concurrently from multiple Haskell threads.
deletes :: forall m k v.
     ( IOLike m
     , SerialiseKey k
     , SerialiseValue v
     , ResolveValue v
     )
  => Table m k v
  -> V.Vector k
  -> m ()
deletes :: forall (m :: * -> *) k v.
(IOLike m, SerialiseKey k, SerialiseValue v, ResolveValue v) =>
Table m k v -> Vector k -> m ()
deletes Table m k v
t = Table m k v -> Vector (k, Update v) -> m ()
forall (m :: * -> *) k v.
(IOLike m, SerialiseKey k, SerialiseValue v, ResolveValue v) =>
Table m k v -> Vector (k, Update v) -> m ()
updates Table m k v
t (Vector (k, Update v) -> m ())
-> (Vector k -> Vector (k, Update v)) -> Vector k -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (k -> (k, Update v)) -> Vector k -> Vector (k, Update v)
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (,Update v
forall v. Update v
Delete)

{-# SPECIALISE mupserts ::
     (SerialiseKey k, SerialiseValue v, ResolveValue v)
  => Table IO k v
  -> V.Vector (k, v)
  -> IO () #-}
-- | Perform a batch of monoidal upserts.
--
-- Monoidal upserts can be performed concurrently from multiple Haskell threads.
mupserts :: forall m k v.
     ( IOLike m
     , SerialiseKey k
     , SerialiseValue v
     , ResolveValue v
     )
  => Table m k v
  -> V.Vector (k, v)
  -> m ()
mupserts :: forall (m :: * -> *) k v.
(IOLike m, SerialiseKey k, SerialiseValue v, ResolveValue v) =>
Table m k v -> Vector (k, v) -> m ()
mupserts Table m k v
t = Table m k v -> Vector (k, Update v) -> m ()
forall (m :: * -> *) k v.
(IOLike m, SerialiseKey k, SerialiseValue v, ResolveValue v) =>
Table m k v -> Vector (k, Update v) -> m ()
updates Table m k v
t (Vector (k, Update v) -> m ())
-> (Vector (k, v) -> Vector (k, Update v)) -> Vector (k, v) -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((k, v) -> (k, Update v)) -> Vector (k, v) -> Vector (k, Update v)
forall a b. (a -> b) -> Vector a -> Vector b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((v -> Update v) -> (k, v) -> (k, Update v)
forall b c a. (b -> c) -> (a, b) -> (a, c)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second v -> Update v
forall v. v -> Update v
Mupsert)

{-------------------------------------------------------------------------------
  Snapshots
-------------------------------------------------------------------------------}

{-# SPECIALISE createSnapshot ::
     Common.SnapshotLabel
  -> Common.SnapshotName
  -> Table IO k v
  -> IO () #-}
-- | Make the current value of a table durable on-disk by taking a snapshot and
-- giving the snapshot a name. This is the __only__ mechanism to make a table
-- durable -- ordinary insert\/delete operations are otherwise not preserved.
--
-- Snapshots have names and the table may be opened later using 'openSnapshot'
-- via that name. Names are strings and the management of the names is up to the
-- user of the library.
--
-- The names correspond to disk files, which imposes some constraints on length
-- and what characters can be used.
--
-- Snapshotting does not close the table.
--
-- Taking a snapshot is /relatively/ cheap, but it is not so cheap that one can
-- use it after every operation. In the implementation, it must at least flush
-- the write buffer to disk.
--
-- Concurrency:
--
-- * It is safe to concurrently make snapshots from any table, provided that
--   the snapshot names are distinct (otherwise this would be a race).
--
createSnapshot :: forall m k v.
     IOLike m
  => Common.SnapshotLabel
  -> Common.SnapshotName
  -> Table m k v
  -> m ()
createSnapshot :: forall (m :: * -> *) k v.
IOLike m =>
SnapshotLabel -> SnapshotName -> Table m k v -> m ()
createSnapshot SnapshotLabel
label SnapshotName
snap (Internal.MonoidalTable Table m h
t) =
    SnapshotName
-> SnapshotLabel -> SnapshotTableType -> Table m h -> m ()
forall (m :: * -> *) h.
(MonadMask m, MonadMVar m, MonadST m, MonadSTM m) =>
SnapshotName
-> SnapshotLabel -> SnapshotTableType -> Table m h -> m ()
Internal.createSnapshot SnapshotName
snap SnapshotLabel
label SnapshotTableType
Common.SnapMonoidalTable Table m h
t

{-# SPECIALISE openSnapshot ::
     ResolveValue v
  => Session IO
  -> Common.TableConfigOverride
  -> Common.SnapshotLabel
  -> Common.SnapshotName
  -> IO (Table IO k v) #-}
-- | Open a table from a named snapshot, returning a new table.
--
-- NOTE: close tables using 'close' as soon as they are
-- unused.
--
-- Exceptions:
--
-- * Opening a non-existent snapshot is an error.
--
-- * Opening a snapshot but expecting the wrong type of table is an error. e.g.,
--   the following will fail:
--
-- @
-- example session = do
--   t <- 'new' \@IO \@Int \@Int \@Int session _
--   'createSnapshot' "intTable" t
--   'openSnapshot' \@IO \@Bool \@Bool \@Bool session "intTable"
-- @
openSnapshot :: forall m k v.
     ( IOLike m
     , ResolveValue v
     )
  => Session m
  -> Common.TableConfigOverride -- ^ Optional config override
  -> Common.SnapshotLabel
  -> Common.SnapshotName
  -> m (Table m k v)
openSnapshot :: forall (m :: * -> *) k v.
(IOLike m, ResolveValue v) =>
Session m
-> TableConfigOverride
-> SnapshotLabel
-> SnapshotName
-> m (Table m k v)
openSnapshot (Internal.Session' Session m h
sesh) TableConfigOverride
override SnapshotLabel
label SnapshotName
snap =
    Table m h -> MonoidalTable m k v
forall (m :: * -> *) k v h.
Typeable h =>
Table m h -> MonoidalTable m k v
Internal.MonoidalTable (Table m h -> MonoidalTable m k v)
-> m (Table m h) -> m (MonoidalTable m k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      Session m h
-> SnapshotLabel
-> SnapshotTableType
-> TableConfigOverride
-> SnapshotName
-> ResolveSerialisedValue
-> m (Table m h)
forall (m :: * -> *) h.
(MonadMask m, MonadMVar m, MonadST m, MonadSTM m) =>
Session m h
-> SnapshotLabel
-> SnapshotTableType
-> TableConfigOverride
-> SnapshotName
-> ResolveSerialisedValue
-> m (Table m h)
Internal.openSnapshot
        Session m h
sesh
        SnapshotLabel
label
        SnapshotTableType
Common.SnapMonoidalTable
        TableConfigOverride
override
        SnapshotName
snap
        (forall v. ResolveValue v => Proxy v -> ResolveSerialisedValue
forall {k} (v :: k).
ResolveValue v =>
Proxy v -> ResolveSerialisedValue
resolve @v Proxy v
forall {k} (t :: k). Proxy t
Proxy)

{-------------------------------------------------------------------------------
  Multiple writable tables
-------------------------------------------------------------------------------}

{-# SPECIALISE duplicate ::
     Table IO k v
  -> IO (Table IO k v) #-}
-- | Create a logically independent duplicate of a table. This returns a
-- new table.
--
-- A table and its duplicate are logically independent: changes to one
-- are not visible to the other. However, in-memory and on-disk data are
-- shared internally.
--
-- This operation enables /fully persistent/ use of tables by duplicating the
-- table prior to a batch of mutating operations. The duplicate retains the
-- original table value, and can still be modified independently.
--
-- This is persistence in the sense of persistent data structures (not of on-disk
-- persistence). The usual definition of a persistent data structure is one in
-- which each operation preserves the previous version of the structure when
-- the structure is modified. Full persistence is if every version can be both
-- accessed and modified. This API does not directly fit the definition because
-- the update operations do mutate the table value, however full persistence
-- can be emulated by duplicating the table prior to a mutating operation.
--
-- Duplication itself is cheap. In particular it requires no disk I\/O, and
-- requires little additional memory. Just as with normal persistent data
-- structures, making use of multiple tables will have corresponding costs in
-- terms of memory and disk space. Initially the two tables will share
-- everything (both in memory and on disk) but as more and more update
-- operations are performed on each, the sharing will decrease. Ultimately the
-- memory and disk cost will be the same as if each table were entirely
-- independent.
--
-- NOTE: duplication create a new table, which should be closed when no
-- longer needed.
--
duplicate :: forall m k v.
     IOLike m
  => Table m k v
  -> m (Table m k v)
duplicate :: forall (m :: * -> *) k v.
IOLike m =>
Table m k v -> m (Table m k v)
duplicate (Internal.MonoidalTable Table m h
t) = Table m h -> MonoidalTable m k v
forall (m :: * -> *) k v h.
Typeable h =>
Table m h -> MonoidalTable m k v
Internal.MonoidalTable (Table m h -> MonoidalTable m k v)
-> m (Table m h) -> m (MonoidalTable m k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Table m h -> m (Table m h)
forall (m :: * -> *) h.
(MonadMask m, MonadMVar m, MonadST m, MonadSTM m) =>
Table m h -> m (Table m h)
Internal.duplicate Table m h
t

{-------------------------------------------------------------------------------
  Table union
-------------------------------------------------------------------------------}

{-# SPECIALISE union ::
     Table IO k v
  -> Table IO k v
  -> IO (Table IO k v) #-}
-- | Union two full tables, creating a new table.
--
-- A good mental model of this operation is @'Data.Map.Lazy.unionWith' (<>)@ on
-- @'Data.Map.Lazy.Map' k v@.
--
-- Multiple tables of the same type but with different configuration parameters
-- can live in the same session. However, 'union' only works for tables that
-- have the same key\/value types and configuration parameters.
--
-- NOTE: unioning tables creates a new table, but does not close the tables that
-- were used as inputs.
union :: forall m k v.
     IOLike m
  => Table m k v
  -> Table m k v
  -> m (Table m k v)
union :: forall (m :: * -> *) k v.
IOLike m =>
Table m k v -> Table m k v -> m (Table m k v)
union Table m k v
t1 Table m k v
t2 = NonEmpty (Table m k v) -> m (Table m k v)
forall (m :: * -> *) k v.
IOLike m =>
NonEmpty (Table m k v) -> m (Table m k v)
unions (NonEmpty (Table m k v) -> m (Table m k v))
-> NonEmpty (Table m k v) -> m (Table m k v)
forall a b. (a -> b) -> a -> b
$ Table m k v
t1 Table m k v -> [Table m k v] -> NonEmpty (Table m k v)
forall a. a -> [a] -> NonEmpty a
:| [Table m k v
t2]

{-# SPECIALISE unions ::
     NonEmpty (Table IO k v)
  -> IO (Table IO k v) #-}
-- | Like 'union', but for @n@ tables.
--
-- A good mental model of this operation is @'Data.Map.Lazy.unionsWith' (<>)@ on
-- @'Data.Map.Lazy.Map' k v@.
unions :: forall m k v.
     IOLike m
  => NonEmpty (Table m k v)
  -> m (Table m k v)
unions :: forall (m :: * -> *) k v.
IOLike m =>
NonEmpty (Table m k v) -> m (Table m k v)
unions (Table m k v
t :| [Table m k v]
ts) =
    case Table m k v
t of
      Internal.MonoidalTable (Table m h
t' :: Internal.Table m h) -> do
        [Table m h]
ts' <- (Int -> Table m k v -> m (Table m h))
-> [Int] -> [Table m k v] -> m [Table m h]
forall (m :: * -> *) a b c.
Applicative m =>
(a -> b -> m c) -> [a] -> [b] -> m [c]
zipWithM (Proxy# h -> Int -> Table m k v -> m (Table m h)
forall h.
Typeable h =>
Proxy# h -> Int -> Table m k v -> m (Table m h)
checkTableType (forall a. Proxy# a
forall {k} (a :: k). Proxy# a
proxy# @h)) [Int
1..] [Table m k v]
ts
        Table m h -> Table m k v
forall (m :: * -> *) k v h.
Typeable h =>
Table m h -> MonoidalTable m k v
Internal.MonoidalTable (Table m h -> Table m k v) -> m (Table m h) -> m (Table m k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty (Table m h) -> m (Table m h)
forall (m :: * -> *) h.
(MonadMask m, MonadMVar m, MonadST m, MonadSTM m) =>
NonEmpty (Table m h) -> m (Table m h)
Internal.unions (Table m h
t' Table m h -> [Table m h] -> NonEmpty (Table m h)
forall a. a -> [a] -> NonEmpty a
:| [Table m h]
ts')
  where
    checkTableType ::
         forall h. Typeable h
      => Proxy# h
      -> Int
      -> Table m k v
      -> m (Internal.Table m h)
    checkTableType :: forall h.
Typeable h =>
Proxy# h -> Int -> Table m k v -> m (Table m h)
checkTableType Proxy# h
_ Int
i (Internal.MonoidalTable (Table m h
t' :: Internal.Table m h'))
      | Just h :~: h
Refl <- forall {k} (a :: k) (b :: k).
(Typeable a, Typeable b) =>
Maybe (a :~: b)
forall a b. (Typeable a, Typeable b) => Maybe (a :~: b)
eqT @h @h' = Table m h -> m (Table m h)
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Table m h
Table m h
t'
      | Bool
otherwise = TableUnionNotCompatibleError -> m (Table m h)
forall e a. Exception e => e -> m a
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwIO (TableUnionNotCompatibleError -> m (Table m h))
-> TableUnionNotCompatibleError -> m (Table m h)
forall a b. (a -> b) -> a -> b
$ Int -> TypeRep -> Int -> TypeRep -> TableUnionNotCompatibleError
Common.ErrTableUnionHandleTypeMismatch Int
0 (Proxy h -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy h -> TypeRep) -> Proxy h -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @h) Int
i (Proxy h -> TypeRep
forall {k} (proxy :: k -> *) (a :: k).
Typeable a =>
proxy a -> TypeRep
typeRep (Proxy h -> TypeRep) -> Proxy h -> TypeRep
forall a b. (a -> b) -> a -> b
$ forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @h')

{-# 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 :: forall (m :: * -> *) k v. IOLike m => Table m k v -> m UnionDebt
remainingUnionDebt (Internal.MonoidalTable Table m h
t) =
    (\(Internal.UnionDebt Int
x) -> Int -> UnionDebt
UnionDebt Int
x) (UnionDebt -> UnionDebt) -> m UnionDebt -> m UnionDebt
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      Table m h -> m UnionDebt
forall (m :: * -> *) h.
(MonadSTM m, MonadMVar m, MonadThrow m, PrimMonad m) =>
Table m h -> m UnionDebt
Internal.remainingUnionDebt Table m h
t

{-# SPECIALISE supplyUnionCredits ::
     ResolveValue v => 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.
--
-- This function returns any surplus of union credits as /leftover/ credits when
-- a union has finished. In particular, if the returned number of credits is
-- non-negative, then the union is finished.
supplyUnionCredits ::
     forall m k v. (IOLike m, ResolveValue v)
  => Table m k v
  -> UnionCredits
  -> m UnionCredits
supplyUnionCredits :: forall (m :: * -> *) k v.
(IOLike m, ResolveValue v) =>
Table m k v -> UnionCredits -> m UnionCredits
supplyUnionCredits (Internal.MonoidalTable Table m h
t) (UnionCredits Int
credits) =
    (\(Internal.UnionCredits Int
x) -> Int -> UnionCredits
UnionCredits Int
x) (UnionCredits -> UnionCredits) -> m UnionCredits -> m UnionCredits
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
      ResolveSerialisedValue
-> Table m h -> UnionCredits -> m UnionCredits
forall (m :: * -> *) h.
(MonadST m, MonadSTM m, MonadMVar m, MonadMask m) =>
ResolveSerialisedValue
-> Table m h -> UnionCredits -> m UnionCredits
Internal.supplyUnionCredits
        (forall v. ResolveValue v => Proxy v -> ResolveSerialisedValue
forall {k} (v :: k).
ResolveValue v =>
Proxy v -> ResolveSerialisedValue
resolve @v Proxy v
forall {k} (t :: k). Proxy t
Proxy)
        Table m h
t
        (Int -> UnionCredits
Internal.UnionCredits Int
credits)

{-------------------------------------------------------------------------------
  Monoidal value resolution
-------------------------------------------------------------------------------}

-- | A class to specify how to resolve/merge values when using monoidal updates
-- ('Mupsert'). This is required for merging entries during compaction and also
-- for doing lookups, resolving multiple entries of the same key on the fly.
-- The class has some laws, which should be tested (e.g. with QuickCheck).
--
-- It is okay to assume that the input bytes can be deserialised using
-- 'deserialiseValue', as they are produced by either 'serialiseValue' or
-- 'resolveValue' itself, which are required to produce deserialisable output.
--
-- Prerequisites:
--
-- * [Valid Output] The result of resolution should always be deserialisable.
--   See 'resolveValueValidOutput'.
-- * [Associativity] Resolving values should be associative.
--   See 'resolveValueAssociativity'.
--
-- Future opportunities for optimisations:
--
-- * Include a function that determines whether it is safe to remove an 'Update'
--   from the last level of an LSM tree.
--
-- * Include a function @v -> RawBytes -> RawBytes@, which can then be used when
--   inserting into the write buffer. Currently, using 'resolveDeserialised'
--   means that the inserted value is serialised and (if there is another value
--   with the same key in the write buffer) immediately deserialised again.
--
-- TODO: The laws depend on 'SerialiseValue', should we make it a superclass?
-- TODO: should we additionally require Totality (for any input 'RawBytes',
--       resolution should successfully provide a result)? This could reduce the
--       risk of encountering errors during a run merge.
class ResolveValue v where
  resolveValue :: Proxy v -> RawBytes -> RawBytes -> RawBytes

-- | Test the __Valid Output__ law for the 'ResolveValue' class
resolveValueValidOutput :: forall v.
     (SerialiseValue v, ResolveValue v, NFData v)
  => v -> v -> Bool
resolveValueValidOutput :: forall v.
(SerialiseValue v, ResolveValue v, NFData v) =>
v -> v -> Bool
resolveValueValidOutput (v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue -> RawBytes
x) (v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue -> RawBytes
y) =
    (RawBytes -> v
forall v. SerialiseValue v => RawBytes -> v
deserialiseValue (Proxy v -> RawBytes -> RawBytes -> RawBytes
forall {k} (v :: k).
ResolveValue v =>
Proxy v -> RawBytes -> RawBytes -> RawBytes
resolveValue (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v) RawBytes
x RawBytes
y) :: v) v -> Bool -> Bool
forall a b. NFData a => a -> b -> b
`deepseq` Bool
True

-- | Test the __Associativity__ law for the 'ResolveValue' class
resolveValueAssociativity :: forall v.
     (SerialiseValue v, ResolveValue v)
  => v -> v -> v -> Bool
resolveValueAssociativity :: forall v. (SerialiseValue v, ResolveValue v) => v -> v -> v -> Bool
resolveValueAssociativity (v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue -> RawBytes
x) (v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue -> RawBytes
y) (v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue -> RawBytes
z) =
    RawBytes
x RawBytes -> RawBytes -> RawBytes
<+> (RawBytes
y RawBytes -> RawBytes -> RawBytes
<+> RawBytes
z) RawBytes -> RawBytes -> Bool
forall a. Eq a => a -> a -> Bool
== (RawBytes
x RawBytes -> RawBytes -> RawBytes
<+> RawBytes
y) RawBytes -> RawBytes -> RawBytes
<+> RawBytes
z
  where
    <+> :: RawBytes -> RawBytes -> RawBytes
(<+>) = Proxy v -> RawBytes -> RawBytes -> RawBytes
forall {k} (v :: k).
ResolveValue v =>
Proxy v -> RawBytes -> RawBytes -> RawBytes
resolveValue (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v)

-- | A helper function to implement 'resolveValue' by operating on the
-- deserialised representation. Note that especially for simple types it
-- should be possible to provide a more efficient implementation by directly
-- operating on the 'RawBytes'.
--
-- This function could potentially be used to provide a default implementation
-- for 'resolveValue', but it's probably best to be explicit about instances.
--
-- To satisfy the prerequisites of 'ResolveValue', the function provided to
-- 'resolveDeserialised' should itself satisfy some properties:
--
-- * [Associativity] The provided function should be associative.
-- * [Totality] The provided function should be total.
resolveDeserialised :: forall v.
     SerialiseValue v
  => (v -> v -> v) -> Proxy v -> RawBytes -> RawBytes -> RawBytes
resolveDeserialised :: forall v.
SerialiseValue v =>
(v -> v -> v) -> Proxy v -> RawBytes -> RawBytes -> RawBytes
resolveDeserialised v -> v -> v
f Proxy v
_ RawBytes
x RawBytes
y =
    v -> RawBytes
forall v. SerialiseValue v => v -> RawBytes
serialiseValue (v -> v -> v
f (RawBytes -> v
forall v. SerialiseValue v => RawBytes -> v
deserialiseValue RawBytes
x) (RawBytes -> v
forall v. SerialiseValue v => RawBytes -> v
deserialiseValue RawBytes
y))

resolve ::  forall v. ResolveValue v => Proxy v -> Internal.ResolveSerialisedValue
resolve :: forall {k} (v :: k).
ResolveValue v =>
Proxy v -> ResolveSerialisedValue
resolve = (RawBytes -> RawBytes -> RawBytes) -> ResolveSerialisedValue
forall a b. Coercible a b => a -> b
coerce ((RawBytes -> RawBytes -> RawBytes) -> ResolveSerialisedValue)
-> (Proxy v -> RawBytes -> RawBytes -> RawBytes)
-> Proxy v
-> ResolveSerialisedValue
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Proxy v -> RawBytes -> RawBytes -> RawBytes
forall {k} (v :: k).
ResolveValue v =>
Proxy v -> RawBytes -> RawBytes -> RawBytes
resolveValue

-- | Mostly to give an example instance (plus the property tests for it).
-- Additionally, this instance for 'Sum' provides a nice monoidal, numerical
-- aggregator.
instance (Num a, SerialiseValue a) => ResolveValue (Sum a) where
  resolveValue :: Proxy (Sum a) -> RawBytes -> RawBytes -> RawBytes
resolveValue = (Sum a -> Sum a -> Sum a)
-> Proxy (Sum a) -> RawBytes -> RawBytes -> RawBytes
forall v.
SerialiseValue v =>
(v -> v -> v) -> Proxy v -> RawBytes -> RawBytes -> RawBytes
resolveDeserialised Sum a -> Sum a -> Sum a
forall a. Num a => a -> a -> a
(+)