Expose withNewSession and withRestoreSession from the public API

jorisdral · jorisdral · commit 3b2d9955a607 · 2025-06-25T15:06:35.000+02:00
diff --git a/src/Database/LSMTree.hs b/src/Database/LSMTree.hs
@@ -21,8 +21,12 @@ module Database.LSMTree (
   Session,
   withOpenSession,
   withOpenSessionIO,
+  withNewSession,
+  withRestoreSession,
   openSession,
   openSessionIO,
+  newSession,
+  restoreSession,
   closeSession,
 
   -- * Tables
@@ -465,6 +469,110 @@ withOpenSessionIO tracer sessionDir action = do
   withIOHasBlockIO hasFS defaultIOCtxParams $ \hasBlockIO ->
     withOpenSession tracer hasFS hasBlockIO sessionSalt sessionDirFsPath action
 
+{- |
+Run an action with access to a new session.
+
+The session directory must be empty.
+
+If there are no open tables or cursors when the session terminates, then the disk I\/O complexity of this operation is \(O(1)\).
+Otherwise, 'closeTable' is called for each open table and 'closeCursor' is called for each open cursor.
+Consequently, the worst-case disk I\/O complexity of this operation depends on the merge policy of the open tables in the session.
+The following assumes all tables in the session have the same merge policy:
+
+['LazyLevelling']:
+  \(O(o \: T \log_T \frac{n}{B})\).
+
+The variable \(o\) refers to the number of open tables and cursors in the session.
+
+This function is exception-safe for both synchronous and asynchronous exceptions.
+
+It is recommended to use this function instead of 'newSession' and 'closeSession'.
+
+Throws the following exceptions:
+
+['SessionDirDoesNotExistError']:
+    If the session directory does not exist.
+['SessionDirLockedError']:
+    If the session directory is locked by another process.
+['SessionDirCorruptedError']:
+    If the session directory is malformed.
+-}
+{-# SPECIALISE
+  withNewSession ::
+    Tracer IO LSMTreeTrace ->
+    HasFS IO HandleIO ->
+    HasBlockIO IO HandleIO ->
+    Salt ->
+    FsPath ->
+    (Session IO -> IO a) ->
+    IO a
+  #-}
+withNewSession ::
+  forall m h a.
+  (IOLike m, Typeable h) =>
+  Tracer m LSMTreeTrace ->
+  HasFS m h ->
+  HasBlockIO m h ->
+  -- | The session salt.
+  Salt ->
+  -- | The session directory.
+  FsPath ->
+  (Session m -> m a) ->
+  m a
+withNewSession tracer hasFS hasBlockIO sessionSalt sessionDir action = do
+  Internal.withNewSession tracer hasFS hasBlockIO sessionSalt sessionDir (action . Session)
+
+{- |
+Run an action with access to a restored session.
+
+The session directory must be non-empty: a session must have previously been
+opened and closed in this directory.
+
+If there are no open tables or cursors when the session terminates, then the disk I\/O complexity of this operation is \(O(1)\).
+Otherwise, 'closeTable' is called for each open table and 'closeCursor' is called for each open cursor.
+Consequently, the worst-case disk I\/O complexity of this operation depends on the merge policy of the open tables in the session.
+The following assumes all tables in the session have the same merge policy:
+
+['LazyLevelling']:
+  \(O(o \: T \log_T \frac{n}{B})\).
+
+The variable \(o\) refers to the number of open tables and cursors in the session.
+
+This function is exception-safe for both synchronous and asynchronous exceptions.
+
+It is recommended to use this function instead of 'restoreSession' and 'closeSession'.
+
+Throws the following exceptions:
+
+['SessionDirDoesNotExistError']:
+    If the session directory does not exist.
+['SessionDirLockedError']:
+    If the session directory is locked by another process.
+['SessionDirCorruptedError']:
+    If the session directory is malformed.
+-}
+{-# SPECIALISE
+  withRestoreSession ::
+    Tracer IO LSMTreeTrace ->
+    HasFS IO HandleIO ->
+    HasBlockIO IO HandleIO ->
+    FsPath ->
+    (Session IO -> IO a) ->
+    IO a
+  #-}
+withRestoreSession ::
+  forall m h a.
+  (IOLike m, Typeable h) =>
+  Tracer m LSMTreeTrace ->
+  HasFS m h ->
+  HasBlockIO m h ->
+  -- | The session directory.
+  FsPath ->
+  (Session m -> m a) ->
+  m a
+withRestoreSession tracer hasFS hasBlockIO sessionDir action = do
+  Internal.withRestoreSession tracer hasFS hasBlockIO sessionDir (action . Session)
+
 {- |
 Open a session from a session directory.
 
@@ -523,6 +631,86 @@ openSessionIO tracer sessionDir = do
   bracketOnError acquireHasBlockIO releaseHasBlockIO $ \hasBlockIO ->
     openSession tracer hasFS hasBlockIO sessionSalt sessionDirFsPath
 
+{- |
+Create a new session.
+
+The session directory must be empty.
+
+The worst-case disk I\/O complexity of this operation is \(O(1)\).
+
+__Warning:__ Sessions hold open resources and must be closed using 'closeSession'.
+
+Throws the following exceptions:
+
+['SessionDirDoesNotExistError']:
+    If the session directory does not exist.
+['SessionDirLockedError']:
+    If the session directory is locked by another process.
+['SessionDirCorruptedError']:
+    If the session directory is malformed.
+-}
+{-# SPECIALISE
+  newSession ::
+    Tracer IO LSMTreeTrace ->
+    HasFS IO HandleIO ->
+    HasBlockIO IO HandleIO ->
+    Salt ->
+    FsPath ->
+    IO (Session IO)
+  #-}
+newSession ::
+  forall m h.
+  (IOLike m, Typeable h) =>
+  Tracer m LSMTreeTrace ->
+  HasFS m h ->
+  HasBlockIO m h ->
+  -- | The session salt.
+  Salt ->
+  -- | The session directory.
+  FsPath ->
+  m (Session m)
+newSession tracer hasFS hasBlockIO sessionSalt sessionDir =
+  Session <$> Internal.newSession tracer hasFS hasBlockIO sessionSalt sessionDir
+
+{- |
+Restore a session from a session directory.
+
+The session directory must be non-empty: a session must have previously been
+opened (and closed) in this directory.
+
+The worst-case disk I\/O complexity of this operation is \(O(1)\).
+
+__Warning:__ Sessions hold open resources and must be closed using 'closeSession'.
+
+Throws the following exceptions:
+
+['SessionDirDoesNotExistError']:
+    If the session directory does not exist.
+['SessionDirLockedError']:
+    If the session directory is locked by another process.
+['SessionDirCorruptedError']:
+    If the session directory is malformed.
+-}
+{-# SPECIALISE
+  restoreSession ::
+    Tracer IO LSMTreeTrace ->
+    HasFS IO HandleIO ->
+    HasBlockIO IO HandleIO ->
+    FsPath ->
+    IO (Session IO)
+  #-}
+restoreSession ::
+  forall m h.
+  (IOLike m, Typeable h) =>
+  Tracer m LSMTreeTrace ->
+  HasFS m h ->
+  HasBlockIO m h ->
+  -- | The session directory.
+  FsPath ->
+  m (Session m)
+restoreSession tracer hasFS hasBlockIO sessionDir =
+  Session <$> Internal.restoreSession tracer hasFS hasBlockIO sessionDir
+
 {- |
 Close a session.
 
diff --git a/src/Database/LSMTree/Internal/Unsafe.hs b/src/Database/LSMTree/Internal/Unsafe.hs
@@ -39,7 +39,11 @@ module Database.LSMTree.Internal.Unsafe (
   , withKeepSessionOpen
     -- ** Implementation of public API
   , withOpenSession
+  , withNewSession
+  , withRestoreSession
   , openSession
+  , newSession
+  , restoreSession
   , closeSession
     -- * Table
   , Table (..)
@@ -340,6 +344,40 @@ withOpenSession tr hfs hbio salt dir k = do
       (openSession tr hfs hbio salt dir)
       closeSession
       k
+
+{-# INLINE withNewSession #-}
+withNewSession ::
+     forall m h a.
+     (MonadSTM m, MonadMVar m, PrimMonad m, MonadMask m)
+  => Tracer m LSMTreeTrace
+  -> HasFS m h
+  -> HasBlockIO m h
+  -> Bloom.Salt
+  -> FsPath -- ^ Path to the session directory
+  -> (Session m h -> m a)
+  -> m a
+withNewSession tr hfs hbio salt dir k = do
+    bracket
+      (newSession tr hfs hbio salt dir)
+      closeSession
+      k
+
+{-# INLINE withRestoreSession #-}
+withRestoreSession ::
+     forall m h a.
+     (MonadSTM m, MonadMVar m, PrimMonad m, MonadMask m, MonadEvaluate m)
+  => Tracer m LSMTreeTrace
+  -> HasFS m h
+  -> HasBlockIO m h
+  -> FsPath -- ^ Path to the session directory
+  -> (Session m h -> m a)
+  -> m a
+withRestoreSession tr hfs hbio dir k = do
+    bracket
+      (restoreSession tr hfs hbio dir)
+      closeSession
+      k
+
 {-# SPECIALISE openSession ::
      Tracer IO LSMTreeTrace
   -> HasFS IO h
diff --git a/test/Test/Database/LSMTree/Internal.hs b/test/Test/Database/LSMTree/Internal.hs
@@ -33,8 +33,8 @@ import           Test.Util.FS
 tests :: TestTree
 tests = testGroup "Test.Database.LSMTree.Internal" [
       testGroup "Session" [
-          testProperty "newSession" newSession
-        , testProperty "restoreSession" restoreSession
+          testProperty "prop_newSession" prop_newSession
+        , testProperty "prop_restoreSession" prop_restoreSession
         , testProperty "sessionDirLocked" sessionDirLocked
         , testCase "sessionDirCorrupted" sessionDirCorrupted
         , testCase "sessionDirDoesNotExist" sessionDirDoesNotExist
@@ -56,13 +56,13 @@ testTableConfig = defaultTableConfig {
       confWriteBufferAlloc = AllocNumEntries 3
     }
 
-newSession ::
+prop_newSession ::
      Positive (Small Int)
   -> V.Vector (Word64, Entry Word64 Word64)
   -> Property
-newSession (Positive (Small bufferSize)) es =
+prop_newSession (Positive (Small bufferSize)) es =
     ioProperty $
-    withTempIOHasBlockIO "newSession" $ \hfs hbio ->
+    withTempIOHasBlockIO "prop_newSession" $ \hfs hbio ->
     withOpenSession nullTracer hfs hbio testSalt (FS.mkFsPath []) $ \session ->
       withTable session conf (updates const es')
   where
@@ -71,13 +71,13 @@ newSession (Positive (Small bufferSize)) es =
       }
     es' = fmap (bimap serialiseKey (bimap serialiseValue serialiseBlob)) es
 
-restoreSession ::
+prop_restoreSession ::
      Positive (Small Int)
   -> V.Vector (Word64, Entry Word64 Word64)
   -> Property
-restoreSession (Positive (Small bufferSize)) es =
+prop_restoreSession (Positive (Small bufferSize)) es =
     ioProperty $
-    withTempIOHasBlockIO "restoreSession" $ \hfs hbio -> do
+    withTempIOHasBlockIO "prop_restoreSession" $ \hfs hbio -> do
       withOpenSession nullTracer hfs hbio testSalt (FS.mkFsPath []) $ \session1 ->
         withTable session1 conf (updates const es')
       withOpenSession nullTracer hfs hbio testSalt (FS.mkFsPath []) $ \session2 ->
