fix: apply fixes based on PR feedback

Author: wenkokke

src/Database/LSMTree/Internal/Snapshot.hs

@@ -97,16 +97,16 @@ newtype SnapshotLabel = SnapshotLabel Text
 -- TODO: revisit if we need three table types.
 data SnapshotTableType
   = SnapSimpleTable
+  | SnapFullTable
   | SnapNormalTable
   | SnapMonoidalTable
-  | SnapFullTable
   deriving stock (Eq, Show)
 
 instance NFData SnapshotTableType where
   rnf SnapSimpleTable   = ()
+  rnf SnapFullTable     = ()
   rnf SnapNormalTable   = ()
   rnf SnapMonoidalTable = ()
-  rnf SnapFullTable     = ()
 
 data SnapshotMetaData = SnapshotMetaData {
     -- | See 'SnapshotLabel'.

src/Database/LSMTree/Internal/Snapshot/Codec.hs

@@ -247,19 +247,19 @@ instance DecodeVersioned SnapshotLabel where
 -- TableType
 
 instance Encode SnapshotTableType where
-  encode SnapNormalTable   = encodeWord 0
-  encode SnapMonoidalTable = encodeWord 1
-  encode SnapFullTable     = encodeWord 2
-  encode SnapSimpleTable   = encodeWord 3
+  encode SnapSimpleTable   = encodeWord 0
+  encode SnapFullTable     = encodeWord 1
+  encode SnapNormalTable   = encodeWord 2
+  encode SnapMonoidalTable = encodeWord 3
 
 instance DecodeVersioned SnapshotTableType where
   decodeVersioned V0 = do
       tag <- decodeWord
       case tag of
-        0 -> pure SnapNormalTable
-        1 -> pure SnapMonoidalTable
-        2 -> pure SnapFullTable
-        3 -> pure SnapSimpleTable
+        0 -> pure SnapSimpleTable
+        1 -> pure SnapFullTable
+        2 -> pure SnapNormalTable
+        3 -> pure SnapMonoidalTable
         _ -> fail ("[SnapshotTableType] Unexpected tag: " <> show tag)
 
 instance Encode SnapshotRun where

src/Database/LSMTree/Simple.hs

@@ -1,6 +1,3 @@
--- TODO: Disable this warning once LSMTreeError is split.
-{-# OPTIONS_GHC -Wno-incomplete-patterns #-}
-
 {- |
 Module      : Database.LSMTree.Simple
 Copyright   : (c) 2023, Input Output Global, Inc. (IOG)
@@ -126,7 +123,7 @@ module Database.LSMTree.Simple (
     TableClosedError (..),
     TableCorruptedError (..),
     TableTooLargeError (..),
-    TableNotCompatibleError (..),
+    TableUnionNotCompatibleError (..),
     SnapshotExistsError (..),
     SnapshotDoesNotExistError (..),
     SnapshotCorruptedError (..),
@@ -137,7 +134,7 @@ module Database.LSMTree.Simple (
 ) where
 
 import           Control.Exception.Base (Exception, SomeException (..), bracket,
-                     mapException)
+                     mapException, assert)
 import           Control.Monad (join)
 import           Data.Bifunctor (Bifunctor (..))
 import           Data.Kind (Type)
@@ -150,7 +147,7 @@ import           Database.LSMTree.Internal (BlobRefInvalidError (..),
                      SnapshotCorruptedError (..),
                      SnapshotDoesNotExistError (..), SnapshotExistsError (..),
                      SnapshotNotCompatibleError (..), TableClosedError (..),
-                     TableCorruptedError (..), TableNotCompatibleError (..),
+                     TableCorruptedError (..), TableUnionNotCompatibleError (..),
                      TableTooLargeError (..))
 import qualified Database.LSMTree.Internal as Internal
 import           Database.LSMTree.Internal.Config
@@ -238,10 +235,10 @@ To prevent resource and memory leaks due to asynchronous exceptions,
 it is recommended to use the [bracketed](#bracketed) functions whenever
 possible, and otherwise:
 
-*   Run functions that allocate, use, and release a resource with asynchronous
+*   Run functions that allocate and release a resource with asynchronous
     exceptions masked.
-*   Pair functions that allocate a resource with a masked cleanup function,
-    e.g., using 'bracket'.
+*   Ensure that every use allocate operation is followed by the corresponding release
+    operation even in the presence of asynchronous exceptions, e.g., using 'bracket'.
 -}
 
 --------------------------------------------------------------------------------
@@ -269,12 +266,18 @@ the table by using 'duplicate' and performing the read operations on the duplica
 However, this requires that the 'duplicate' operation /happens before/ the subsequent
 writes, as it is a race to duplicate concurrently with any writes.
 As this package does not provide any construct for synchronisation or atomic
-operations, this ordering of operations must be accomplished by other means.
+operations, this ordering of operations must be accomplished by the user through
+other means.
 
-An 'Cursor' creates a stable view of a table and can safely be read while
+A 'Cursor' creates a stable view of a table and can safely be read while
 modifying the original table. However, reading the 'next' key\/value pair from
 a cursor locks the view, so concurrent reads on the same cursor block.
 This is because 'next' updates the cursor's current position.
+
+Session handles may be used concurrently from multiple Haskell threads,
+but concurrent use of read and write operations may introduce races.
+Specifically, it is a race to use `listSnapshots` and `deleteSnapshots`
+with the same session handle concurrently.
 -}
 
 --------------------------------------------------------------------------------
@@ -314,11 +317,11 @@ newtype Session = Session {unSession :: Internal.Session IO HandleIO}
 {- |
 Throws the following exceptions:
 
-['SessionDoesNotExistError']:
+['SessionDirDoesNotExistError']:
     If the session directory does not exist.
-['SessionLockedError']:
+['SessionDirLockedError']:
     If the session directory is locked by another process.
-['SessionCorruptedError']:
+['SessionDirCorruptedError']:
     If the session directory is malformed.
 -}
 withSession ::
@@ -338,11 +341,11 @@ withSession dir action = do
 {- |
 Throws the following exceptions:
 
-['SessionDoesNotExistError']:
+['SessionDirDoesNotExistError']:
     If the session directory does not exist.
-['SessionLockedError']:
+['SessionDirLockedError']:
     If the session directory is locked by another process.
-['SessionCorruptedError']:
+['SessionDirCorruptedError']:
     If the session directory is malformed.
 -}
 openSession ::
@@ -365,9 +368,7 @@ closeSession = Internal.closeSession . unSession
 -- Tables
 --------------------------------------------------------------------------------
 
-{- | A table is a handle to an LSM-tree key\/value store.
-
-  Each table is a handle to an individual key\/value store with both in-memory and on-disk parts.
+{- | A table is a handle to an individual LSM-tree key\/value store with both in-memory and on-disk parts.
 
   __Warning:__ Tables are ephemeral. Once you close a table, its data is lost forever. To persist tables, use [snapshots](#g:snapshots).
 -}
@@ -382,7 +383,7 @@ data Table k v
 
 This function is exception-safe for both synchronous and asynchronous exceptions.
 
-It is recommended to use this function instead of 'new' and 'closeTable'.
+It is recommended to use this function instead of 'newTable' and 'closeTable'.
 
 Throws the following exceptions:
 
@@ -540,8 +541,9 @@ rangeLookup ::
     Range k ->
     IO (Vector (k, v))
 rangeLookup (Table table) range =
-    Internal.rangeLookup const (Internal.serialiseKey <$> range) table $ \k v !_b ->
-        (Internal.deserialiseKey k, Internal.deserialiseValue v)
+    Internal.rangeLookup const (Internal.serialiseKey <$> range) table $ \ !k !v !b ->
+        assert (null b) $
+            (Internal.deserialiseKey k, Internal.deserialiseValue v)
 
 --------------------------------------------------------------------------------
 -- Updates
@@ -672,6 +674,9 @@ withDuplicate table =
 
 {- | Duplicate a table.
 
+The duplicate is an independent copy of the given table.
+The duplicate is unaffected by subsequent updates to the given table and vice versa.
+
 __Warning:__ The duplicate must be independently closed using 'closeTable'.
 
 Throws the following exceptions:
@@ -697,16 +702,16 @@ This function is exception-safe for both synchronous and asynchronous exceptions
 
 It is recommended to use this function instead of 'union' and 'closeTable'.
 
-__Warning:__ Both input tables must be from the same 'Session' and have the same configuration parameters.
+__Warning:__ Both input tables must be from the same 'Session'.
 
 Throws the following exceptions:
 
 ['SessionClosedError']:
     If the session is closed.
 ['TableClosedError']:
     If the table is closed.
-['TableNotCompatibleError']:
-    If both tables are not from the same 'Session' or have different configuration parameters.
+['TableUnionNotCompatibleError']:
+    If both tables are not from the same 'Session'.
 -}
 withUnion ::
     Table k v ->
@@ -726,18 +731,20 @@ withUnions tables =
 
 {- | Create a table that contains the union of the entries of the given tables.
 
+The union of two tables is left-biased.
+
 __Warning:__ The new table must be independently closed using 'closeTable'.
 
-__Warning:__ Both input tables must be from the same 'Session' and have the same configuration parameters.
+__Warning:__ Both input tables must be from the same 'Session'.
 
 Throws the following exceptions:
 
 ['SessionClosedError']:
     If the session is closed.
 ['TableClosedError']:
     If the table is closed.
-['TableNotCompatibleError']:
-    If both tables are not from the same 'Session' or have different configuration parameters.
+['TableUnionNotCompatibleError']:
+    If both tables are not from the same 'Session'.
 -}
 union ::
     Table k v ->
@@ -1008,10 +1015,11 @@ next iterator = do
 {- | Read the next batch of table entries from the cursor.
 
 The size of the batch is /at most/ equal to the given number, but may contain fewer entries.
+In practice, this occurs only when the cursor reaches the end of the table.
 
 The following property holds:
 
-prop> take n cursor = catMaybes <$> sequence (replicate n (next cursor))
+prop> take n cursor = catMaybes <$> replicateM n (next cursor)
 
 Throws the following exceptions:
 
@@ -1025,8 +1033,9 @@ take ::
     Cursor k v ->
     IO (Vector (k, v))
 take n (Cursor cursor) =
-    Internal.readCursor const n cursor $ \ !k !v !_b ->
-        (Internal.deserialiseKey k, Internal.deserialiseValue v)
+    Internal.readCursor const n cursor $ \ !k !v !b ->
+        assert (null b) $
+            (Internal.deserialiseKey k, Internal.deserialiseValue v)
 
 {- | Variant of 'take' that accepts an additional predicate to determine whether or not to continue reading.
 
@@ -1048,6 +1057,7 @@ takeWhile ::
     Cursor k v ->
     IO (Vector (k, v))
 takeWhile n p (Cursor cursor) =
+    -- TODO: Rewrite to use a variant of 'readCursorWhile' that works without the maximum batch size.
     Internal.readCursorWhile const (p . Internal.deserialiseKey) n cursor $ \ !k !v !_b ->
         (Internal.deserialiseKey k, Internal.deserialiseValue v)
 

test/Test/Database/LSMTree/Internal/Snapshot/Codec.hs

@@ -221,8 +221,7 @@ instance Arbitrary SnapshotLabel where
   shrink (SnapshotLabel txt) = SnapshotLabel <$> shrink txt
 
 instance Arbitrary SnapshotTableType where
-  -- TODO: add SnapSimpleTable and SnapFullTable
-  arbitrary = elements [SnapNormalTable, SnapMonoidalTable]
+  arbitrary = elements [SnapSimpleTable, SnapFullTable, SnapNormalTable, SnapMonoidalTable]
   shrink _ = []
 
 instance Arbitrary SnapshotRun where

test/Test/Database/LSMTree/Internal/Snapshot/Codec/Golden.hs

@@ -193,10 +193,10 @@ enumerateSnapshotLabel =
 
 enumerateSnapshotTableType :: [(ComponentAnnotation, SnapshotTableType)]
 enumerateSnapshotTableType =
-  -- TODO: add SnapSimpleTable
-  [ ("N0", SnapNormalTable)
-  , ("N1", SnapMonoidalTable)
-  , ("N2", SnapFullTable)
+  [ ("N0", SnapSimpleTable)
+  , ("N1", SnapFullTable)
+  , ("N2", SnapNormalTable)
+  , ("N3", SnapMonoidalTable)
   ]
 
 enumerateTableConfig :: [(ComponentAnnotation, TableConfig)]