Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
19 changes: 1 addition & 18 deletions src/Database/LSMTree.hs
Original file line number Diff line number Diff line change
Expand Up @@ -24,7 +24,6 @@ module Database.LSMTree (
withNewSession,
withRestoreSession,
openSession,
openSessionIO,
newSession,
restoreSession,
closeSession,
Expand Down Expand Up @@ -275,7 +274,7 @@ import qualified Database.LSMTree.Internal.Unsafe as Internal
import Prelude hiding (lookup, take, takeWhile)
import System.FS.API (FsPath, HasFS (..), MountPoint (..), mkFsPath)
import System.FS.BlockIO.API (HasBlockIO (..), defaultIOCtxParams)
import System.FS.BlockIO.IO (ioHasBlockIO, withIOHasBlockIO)
import System.FS.BlockIO.IO (withIOHasBlockIO)
import System.FS.IO (HandleIO, ioHasFS)
import System.Random (randomIO)

Expand Down Expand Up @@ -622,22 +621,6 @@ openSession ::
openSession tracer hasFS hasBlockIO sessionSalt sessionDir =
Session <$> Internal.openSession tracer hasFS hasBlockIO sessionSalt sessionDir

-- | Variant of 'openSession' that is specialised to 'IO' using the real filesystem.
openSessionIO ::
Tracer IO LSMTreeTrace ->
-- | The session directory.
FilePath ->
IO (Session IO)
openSessionIO tracer sessionDir = do
let mountPoint = MountPoint sessionDir
let sessionDirFsPath = mkFsPath []
let hasFS = ioHasFS mountPoint
sessionSalt <- randomIO
let acquireHasBlockIO = ioHasBlockIO hasFS defaultIOCtxParams
let releaseHasBlockIO HasBlockIO{close} = close
bracketOnError acquireHasBlockIO releaseHasBlockIO $ \hasBlockIO ->
openSession tracer hasFS hasBlockIO sessionSalt sessionDirFsPath

{- |
Create a new session.

Expand Down
25 changes: 21 additions & 4 deletions src/Database/LSMTree/Simple.hs
Original file line number Diff line number Diff line change
Expand Up @@ -157,7 +157,8 @@ module Database.LSMTree.Simple (
) where

import Control.ActionRegistry (mapExceptionWithActionRegistry)
import Control.Exception.Base (Exception, SomeException (..))
import Control.Exception (Exception, SomeException (..),
bracketOnError, finally)
import Data.Bifunctor (Bifunctor (..))
import Data.Coerce (coerce)
import Data.Kind (Type)
Expand Down Expand Up @@ -185,7 +186,14 @@ import Database.LSMTree (BloomFilterAlloc, CursorClosedError (..),
serialiseValueIdentity, serialiseValueIdentityUpToSlicing,
toSnapshotName)
import qualified Database.LSMTree as LSMT
import qualified Database.LSMTree.Internal.Types as LSMT
import qualified Database.LSMTree.Internal.Unsafe as Internal
import Prelude hiding (lookup, take, takeWhile)
import System.FS.API (MountPoint (..), mkFsPath)
import System.FS.BlockIO.API (HasBlockIO (..), defaultIOCtxParams)
import System.FS.BlockIO.IO (ioHasBlockIO)
import System.FS.IO (ioHasFS)
import System.Random (randomIO)

--------------------------------------------------------------------------------
-- Example
Expand Down Expand Up @@ -450,7 +458,14 @@ openSession ::
openSession dir = do
let tracer = mempty
_convertSessionDirErrors dir $ do
Session <$> LSMT.openSessionIO tracer dir
let mountPoint = MountPoint dir
let sessionDirFsPath = mkFsPath []
let hasFS = ioHasFS mountPoint
sessionSalt <- randomIO
let acquireHasBlockIO = ioHasBlockIO hasFS defaultIOCtxParams
let releaseHasBlockIO HasBlockIO{close} = close
bracketOnError acquireHasBlockIO releaseHasBlockIO $ \hasBlockIO ->
Session <$> LSMT.openSession tracer hasFS hasBlockIO sessionSalt sessionDirFsPath

{- |
Close a session.
Expand All @@ -471,8 +486,10 @@ All other operations on a closed session will throw an exception.
closeSession ::
Session ->
IO ()
closeSession (Session session) =
LSMT.closeSession session
closeSession (Session session@(LSMT.Session session')) = do
HasBlockIO{close} <- Internal.withKeepSessionOpen session' $
pure . Internal.sessionHasBlockIO
LSMT.closeSession session `finally` close

--------------------------------------------------------------------------------
-- Tables
Expand Down