{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE BangPatterns   #-}
{-# LANGUAGE EmptyDataDecls #-}

-- |
-- Module: Database.LMDB
-- Copyright: (c) 2026 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- Minimal bindings to
-- [LMDB](https://www.symas.com/lmdb), an embedded ACID key-value
-- store. The upstream LMDB C source is vendored under @cbits\/@ at
-- release @LMDB_0.9.33@; no external @liblmdb@ is needed.
--
-- LMDB has a single-writer, many-reader transaction model and uses
-- memory mapping for zero-copy reads. This module presents that as a
-- bracketed @IO@-only interface.
--
-- Read-only and read-write transactions are distinguished at the type
-- level via a phantom parameter on 'Txn', so using a write primitive
-- (e.g. 'put') on a read transaction is a compile-time error.
--
-- Most operations throw 'LMDBException' on error. 'get' and 'del' are
-- the exceptions: they map a missing key onto 'Nothing' and 'False'
-- respectively, since absence is normal control flow.

module Database.LMDB (
  -- * Environments
    Env
  , EnvFlags(..)
  , defaultEnvFlags
  , open
  , close
  , withEnv

  -- * Transactions
  , Txn
  , RO
  , RW
  , withReadTxn
  , withWriteTxn

  -- * Databases
  , Dbi
  , openDbi

  -- * Key-value operations
  , get
  , put
  , del

  -- * Cursors
  , Cursor
  , withCursor
  , cursorFirst
  , cursorLast
  , cursorNext
  , cursorPrev
  , cursorSeek

  -- * Errors
  , LMDBException(..)
  ) where

import Control.Exception
  ( Exception, bracket, bracketOnError, mask, onException, throwIO)
import qualified Data.ByteString as BS
import qualified Data.ByteString.Unsafe as BU
import Foreign.C.String (peekCString, withCString)
import Foreign.C.Types (CInt, CSize, CUInt)
import Foreign.Marshal.Alloc (alloca, allocaBytes)
import Foreign.Ptr (Ptr, nullPtr, plusPtr)
import Foreign.Storable (peek, peekByteOff, pokeByteOff)
import Database.LMDB.Internal

-- handles --------------------------------------------------------------------

-- | An LMDB environment. Roughly, an open database file (or, with
--   'envNoSubdir' off, a directory containing one).
newtype Env = Env (Ptr MDB_env)

-- | Phantom tag for read-only transactions.
data RO

-- | Phantom tag for read-write transactions.
data RW

-- | A transaction. The phantom @s@ distinguishes 'RO' from 'RW' so
--   that write operations refuse to type-check against read-only
--   transactions.
newtype Txn s = Txn (Ptr MDB_txn)

-- | A database identifier within an 'Env'.
newtype Dbi = Dbi MDB_dbi

-- | A cursor for range-scanning a 'Dbi'.
newtype Cursor s = Cursor (Ptr MDB_cursor)

-- environment flags ----------------------------------------------------------

-- | Configuration for 'open'.
data EnvFlags = EnvFlags
  { EnvFlags -> Int
envMapSize  :: !Int
    -- ^ map size in bytes; LMDB will refuse writes beyond this. The
    --   default of 10 MiB is intentionally small — set it to something
    --   appropriate for your workload before opening.
  , EnvFlags -> Int
envMaxDbs   :: !Int
    -- ^ maximum number of named sub-databases. Default 1.
  , EnvFlags -> Bool
envNoSubdir :: !Bool
    -- ^ if 'True', treat the path as a regular file rather than a
    --   directory containing @data.mdb@ and @lock.mdb@.
  , EnvFlags -> Bool
envReadOnly :: !Bool
    -- ^ open the environment read-only.
  , EnvFlags -> Bool
envNoSync   :: !Bool
    -- ^ skip @fsync@ at commit time. Faster, but a crash may lose
    --   the last transaction. The database remains internally
    --   consistent.
  } deriving Int -> EnvFlags -> ShowS
[EnvFlags] -> ShowS
EnvFlags -> String
(Int -> EnvFlags -> ShowS)
-> (EnvFlags -> String) -> ([EnvFlags] -> ShowS) -> Show EnvFlags
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> EnvFlags -> ShowS
showsPrec :: Int -> EnvFlags -> ShowS
$cshow :: EnvFlags -> String
show :: EnvFlags -> String
$cshowList :: [EnvFlags] -> ShowS
showList :: [EnvFlags] -> ShowS
Show

-- | Default 'EnvFlags': 10 MiB map, one database, directory layout,
--   read-write, syncing at commit.
--
--   >>> envMapSize defaultEnvFlags
--   10485760
defaultEnvFlags :: EnvFlags
defaultEnvFlags :: EnvFlags
defaultEnvFlags = EnvFlags
  { envMapSize :: Int
envMapSize  = Int
10 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
1024
  , envMaxDbs :: Int
envMaxDbs   = Int
1
  , envNoSubdir :: Bool
envNoSubdir = Bool
False
  , envReadOnly :: Bool
envReadOnly = Bool
False
  , envNoSync :: Bool
envNoSync   = Bool
False
  }

envFlagBits :: EnvFlags -> CUInt
envFlagBits :: EnvFlags -> CUInt
envFlagBits EnvFlags { envNoSubdir :: EnvFlags -> Bool
envNoSubdir = Bool
nsd, envReadOnly :: EnvFlags -> Bool
envReadOnly = Bool
ro, envNoSync :: EnvFlags -> Bool
envNoSync = Bool
ns } =
  (if Bool
nsd then CUInt
_MDB_NOSUBDIR else CUInt
0)
    CUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
+ (if Bool
ro then CUInt
_MDB_RDONLY   else CUInt
0)
    CUInt -> CUInt -> CUInt
forall a. Num a => a -> a -> a
+ (if Bool
ns then CUInt
_MDB_NOSYNC   else CUInt
0)

-- error handling -------------------------------------------------------------

-- | A typed wrapper around LMDB error codes. 'LMDBOther' carries the
--   raw error code plus the message from @mdb_strerror@.
data LMDBException
  = LMDBKeyExist
  | LMDBNotFound          -- ^ Only seen via "Database.LMDB.Internal";
                          --   the safe layer maps this to 'Nothing'
                          --   or 'False' instead of throwing.
  | LMDBMapFull
  | LMDBCorrupted
  | LMDBPanic
  | LMDBVersionMismatch
  | LMDBOther !Int !String
  deriving Int -> LMDBException -> ShowS
[LMDBException] -> ShowS
LMDBException -> String
(Int -> LMDBException -> ShowS)
-> (LMDBException -> String)
-> ([LMDBException] -> ShowS)
-> Show LMDBException
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LMDBException -> ShowS
showsPrec :: Int -> LMDBException -> ShowS
$cshow :: LMDBException -> String
show :: LMDBException -> String
$cshowList :: [LMDBException] -> ShowS
showList :: [LMDBException] -> ShowS
Show

instance Exception LMDBException

throwLmdb :: CInt -> IO a
throwLmdb :: forall a. CInt -> IO a
throwLmdb CInt
code
  | CInt
code CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
_MDB_KEYEXIST         = LMDBException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO LMDBException
LMDBKeyExist
  | CInt
code CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
_MDB_NOTFOUND         = LMDBException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO LMDBException
LMDBNotFound
  | CInt
code CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
_MDB_MAP_FULL         = LMDBException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO LMDBException
LMDBMapFull
  | CInt
code CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
_MDB_CORRUPTED        = LMDBException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO LMDBException
LMDBCorrupted
  | CInt
code CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
_MDB_PANIC            = LMDBException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO LMDBException
LMDBPanic
  | CInt
code CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
== CInt
_MDB_VERSION_MISMATCH = LMDBException -> IO a
forall e a. (HasCallStack, Exception e) => e -> IO a
throwIO LMDBException
LMDBVersionMismatch
  | Bool
otherwise = do
      msg <- CInt -> IO (Ptr CChar)
mdb_strerror CInt
code IO (Ptr CChar) -> (Ptr CChar -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Ptr CChar -> IO String
peekCString
      throwIO (LMDBOther (fromIntegral code) msg)

check :: CInt -> IO ()
check :: CInt -> IO ()
check CInt
0 = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
check CInt
c = CInt -> IO ()
forall a. CInt -> IO a
throwLmdb CInt
c
{-# INLINE check #-}

-- environment lifecycle ------------------------------------------------------

-- | Open an LMDB environment at the given path. The path must already
--   exist (as a directory unless 'envNoSubdir' is set, in which case
--   the file's parent directory must exist).
--
--   Throws 'LMDBException' on failure.
--
--   >>> env <- open "/tmp/mydb" defaultEnvFlags { envNoSubdir = True }
open :: FilePath -> EnvFlags -> IO Env
open :: String -> EnvFlags -> IO Env
open String
path EnvFlags
flags = ((forall a. IO a -> IO a) -> IO Env) -> IO Env
forall b. ((forall a. IO a -> IO a) -> IO b) -> IO b
mask (((forall a. IO a -> IO a) -> IO Env) -> IO Env)
-> ((forall a. IO a -> IO a) -> IO Env) -> IO Env
forall a b. (a -> b) -> a -> b
$ \forall a. IO a -> IO a
restore -> do
  envp <- (Ptr (Ptr MDB_env) -> IO (Ptr MDB_env)) -> IO (Ptr MDB_env)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr MDB_env) -> IO (Ptr MDB_env)) -> IO (Ptr MDB_env))
-> (Ptr (Ptr MDB_env) -> IO (Ptr MDB_env)) -> IO (Ptr MDB_env)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr MDB_env)
pp -> do
    CInt -> IO ()
check (CInt -> IO ()) -> IO CInt -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr (Ptr MDB_env) -> IO CInt
mdb_env_create Ptr (Ptr MDB_env)
pp
    Ptr (Ptr MDB_env) -> IO (Ptr MDB_env)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr MDB_env)
pp
  let env = Ptr MDB_env -> Env
Env Ptr MDB_env
envp
  flip onException (close env) . restore $ do
    check =<< mdb_env_set_mapsize envp
                  (fromIntegral (envMapSize flags))
    check =<< mdb_env_set_maxdbs envp
                  (fromIntegral (envMaxDbs flags))
    withCString path $ \Ptr CChar
cpath ->
      CInt -> IO ()
check (CInt -> IO ()) -> IO CInt -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr MDB_env -> Ptr CChar -> CUInt -> CMode -> IO CInt
mdb_env_open Ptr MDB_env
envp Ptr CChar
cpath (EnvFlags -> CUInt
envFlagBits EnvFlags
flags) CMode
0o644
  pure env

-- | Close an environment. Must not be called while transactions are
--   live.
close :: Env -> IO ()
close :: Env -> IO ()
close (Env Ptr MDB_env
envp) = Ptr MDB_env -> IO ()
mdb_env_close Ptr MDB_env
envp

-- | Bracketed environment lifecycle: 'open' the environment, run the
--   action, 'close' on exit (including async exceptions).
--
--   >>> withEnv "/tmp/mydb" defaultEnvFlags $ \env -> ...
withEnv :: FilePath -> EnvFlags -> (Env -> IO a) -> IO a
withEnv :: forall a. String -> EnvFlags -> (Env -> IO a) -> IO a
withEnv String
path EnvFlags
flags = IO Env -> (Env -> IO ()) -> (Env -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (String -> EnvFlags -> IO Env
open String
path EnvFlags
flags) Env -> IO ()
close

-- transactions ---------------------------------------------------------------

beginTxn :: Env -> CUInt -> IO (Ptr MDB_txn)
beginTxn :: Env -> CUInt -> IO (Ptr MDB_txn)
beginTxn (Env Ptr MDB_env
envp) CUInt
flags = (Ptr (Ptr MDB_txn) -> IO (Ptr MDB_txn)) -> IO (Ptr MDB_txn)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr MDB_txn) -> IO (Ptr MDB_txn)) -> IO (Ptr MDB_txn))
-> (Ptr (Ptr MDB_txn) -> IO (Ptr MDB_txn)) -> IO (Ptr MDB_txn)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr MDB_txn)
pp -> do
  CInt -> IO ()
check (CInt -> IO ()) -> IO CInt -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr MDB_env -> Ptr MDB_txn -> CUInt -> Ptr (Ptr MDB_txn) -> IO CInt
mdb_txn_begin Ptr MDB_env
envp Ptr MDB_txn
forall a. Ptr a
nullPtr CUInt
flags Ptr (Ptr MDB_txn)
pp
  Ptr (Ptr MDB_txn) -> IO (Ptr MDB_txn)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr MDB_txn)
pp

-- | Run an action in a read-only transaction. The transaction is
--   aborted on exit; read transactions have no work to commit.
--
--   >>> withReadTxn env $ \txn -> ...
withReadTxn :: Env -> (Txn RO -> IO a) -> IO a
withReadTxn :: forall a. Env -> (Txn RO -> IO a) -> IO a
withReadTxn Env
env Txn RO -> IO a
act = IO (Ptr MDB_txn)
-> (Ptr MDB_txn -> IO ()) -> (Ptr MDB_txn -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
  (Env -> CUInt -> IO (Ptr MDB_txn)
beginTxn Env
env CUInt
_MDB_RDONLY)
  Ptr MDB_txn -> IO ()
mdb_txn_abort
  (\Ptr MDB_txn
txnp -> do
      r <- Txn RO -> IO a
act (Ptr MDB_txn -> Txn RO
forall s. Ptr MDB_txn -> Txn s
Txn Ptr MDB_txn
txnp)
      mdb_txn_abort txnp
      pure r)

-- | Run an action in a read-write transaction. Commits if the action
--   returns normally; aborts on exception.
--
--   >>> withWriteTxn env $ \txn -> ...
withWriteTxn :: Env -> (Txn RW -> IO a) -> IO a
withWriteTxn :: forall a. Env -> (Txn RW -> IO a) -> IO a
withWriteTxn Env
env Txn RW -> IO a
act = IO (Ptr MDB_txn)
-> (Ptr MDB_txn -> IO ()) -> (Ptr MDB_txn -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracketOnError
  (Env -> CUInt -> IO (Ptr MDB_txn)
beginTxn Env
env CUInt
0)
  Ptr MDB_txn -> IO ()
mdb_txn_abort
  (\Ptr MDB_txn
txnp -> do
      r <- Txn RW -> IO a
act (Ptr MDB_txn -> Txn RW
forall s. Ptr MDB_txn -> Txn s
Txn Ptr MDB_txn
txnp)
      check =<< mdb_txn_commit txnp
      pure r)

-- databases ------------------------------------------------------------------

-- | Open a database within a transaction. Pass 'Nothing' for the
--   unnamed default database. If the @create@ flag is 'True', the
--   database is created if it does not already exist — and the
--   transaction must be a read-write transaction.
--
--   >>> dbi <- openDbi txn Nothing True
openDbi
  :: Txn s
  -> Maybe BS.ByteString -- ^ database name; 'Nothing' for the default
  -> Bool                -- ^ create if not present
  -> IO Dbi
openDbi :: forall s. Txn s -> Maybe ByteString -> Bool -> IO Dbi
openDbi (Txn Ptr MDB_txn
txnp) Maybe ByteString
mname Bool
create = (Ptr CUInt -> IO Dbi) -> IO Dbi
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CUInt -> IO Dbi) -> IO Dbi)
-> (Ptr CUInt -> IO Dbi) -> IO Dbi
forall a b. (a -> b) -> a -> b
$ \Ptr CUInt
pp -> do
  let flags :: CUInt
flags = if Bool
create then CUInt
_MDB_CREATE else CUInt
0
      go :: Ptr CChar -> IO Dbi
go Ptr CChar
cstr = do
        CInt -> IO ()
check (CInt -> IO ()) -> IO CInt -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr MDB_txn -> Ptr CChar -> CUInt -> Ptr CUInt -> IO CInt
mdb_dbi_open Ptr MDB_txn
txnp Ptr CChar
cstr CUInt
flags Ptr CUInt
pp
        CUInt -> Dbi
Dbi (CUInt -> Dbi) -> IO CUInt -> IO Dbi
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CUInt -> IO CUInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CUInt
pp
  case Maybe ByteString
mname of
    Maybe ByteString
Nothing -> Ptr CChar -> IO Dbi
go Ptr CChar
forall a. Ptr a
nullPtr
    Just ByteString
nm -> ByteString -> (Ptr CChar -> IO Dbi) -> IO Dbi
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
BU.unsafeUseAsCString ByteString
nm Ptr CChar -> IO Dbi
go

-- bytestring <-> MDB_val helpers --------------------------------------------

-- An MDB_val is two words: a CSize length at offset 0, a payload Ptr
-- at offset 8 (on 64-bit). We poke fields directly rather than going
-- through the Storable instance so hot paths don't depend on it being
-- inlined.

withBSAsVal :: BS.ByteString -> (Ptr MDB_val -> IO a) -> IO a
withBSAsVal :: forall a. ByteString -> (Ptr MDB_val -> IO a) -> IO a
withBSAsVal ByteString
bs Ptr MDB_val -> IO a
k =
  ByteString -> (CStringLen -> IO a) -> IO a
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
bs ((CStringLen -> IO a) -> IO a) -> (CStringLen -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
p, Int
n) ->
  Int -> (Ptr MDB_val -> IO a) -> IO a
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
16 ((Ptr MDB_val -> IO a) -> IO a) -> (Ptr MDB_val -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Ptr MDB_val
vp -> do
    Ptr MDB_val -> Int -> CSize -> IO ()
forall b. Ptr b -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MDB_val
vp Int
0 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n :: CSize)
    Ptr MDB_val -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MDB_val
vp Int
8 Ptr CChar
p
    Ptr MDB_val -> IO a
k Ptr MDB_val
vp
{-# INLINE withBSAsVal #-}

peekVal :: Ptr MDB_val -> IO BS.ByteString
peekVal :: Ptr MDB_val -> IO ByteString
peekVal Ptr MDB_val
vp = do
  sz <- Ptr MDB_val -> Int -> IO CSize
forall b. Ptr b -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr MDB_val
vp Int
0 :: IO CSize
  pd <- peekByteOff vp 8
  BS.packCStringLen (pd, fromIntegral sz)
{-# INLINE peekVal #-}

-- key-value ops --------------------------------------------------------------

-- | Look up a key. Returns 'Nothing' if not found. Other LMDB errors
--   throw 'LMDBException'.
--
--   The returned 'BS.ByteString' is a copy of the data; LMDB's
--   memory-mapped buffer is not aliased into Haskell.
--
--   >>> get txn dbi "hello"
--   Just "world"
get
  :: Txn s
  -> Dbi
  -> BS.ByteString               -- ^ key
  -> IO (Maybe BS.ByteString)    -- ^ value, if present
get :: forall s. Txn s -> Dbi -> ByteString -> IO (Maybe ByteString)
get (Txn Ptr MDB_txn
txnp) (Dbi CUInt
dbi) ByteString
k =
  ByteString
-> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
k ((CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (CStringLen -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
kdata, Int
klen) ->
  Int
-> (Ptr MDB_val -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr MDB_val -> IO (Maybe ByteString)) -> IO (Maybe ByteString))
-> (Ptr MDB_val -> IO (Maybe ByteString)) -> IO (Maybe ByteString)
forall a b. (a -> b) -> a -> b
$ \Ptr MDB_val
kp -> do
    let !vp :: Ptr b
vp = Ptr MDB_val
kp Ptr MDB_val -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16
    Ptr MDB_val -> Int -> CSize -> IO ()
forall b. Ptr b -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MDB_val
kp Int
0 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
klen :: CSize)
    Ptr MDB_val -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MDB_val
kp Int
8 Ptr CChar
kdata
    code <- Ptr MDB_txn -> CUInt -> Ptr MDB_val -> Ptr MDB_val -> IO CInt
mdb_get Ptr MDB_txn
txnp CUInt
dbi Ptr MDB_val
kp Ptr MDB_val
forall a. Ptr a
vp
    if   code == _MDB_NOTFOUND
    then pure Nothing
    else do
      check code
      Just <$> peekVal vp
{-# INLINE get #-}

-- | Insert or replace a key. Throws 'LMDBException' on failure.
--
--   >>> put txn dbi "hello" "world"
put
  :: Txn RW
  -> Dbi
  -> BS.ByteString -- ^ key
  -> BS.ByteString -- ^ value
  -> IO ()
put :: Txn RW -> Dbi -> ByteString -> ByteString -> IO ()
put (Txn Ptr MDB_txn
txnp) (Dbi CUInt
dbi) ByteString
k ByteString
v =
  ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
k ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
kdata, Int
klen) ->
  ByteString -> (CStringLen -> IO ()) -> IO ()
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
v ((CStringLen -> IO ()) -> IO ()) -> (CStringLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
vdata, Int
vlen) ->
  Int -> (Ptr MDB_val -> IO ()) -> IO ()
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr MDB_val -> IO ()) -> IO ())
-> (Ptr MDB_val -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr MDB_val
kp -> do
    let !vp :: Ptr b
vp = Ptr MDB_val
kp Ptr MDB_val -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16
    Ptr MDB_val -> Int -> CSize -> IO ()
forall b. Ptr b -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MDB_val
kp Int
0 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
klen :: CSize)
    Ptr MDB_val -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MDB_val
kp Int
8 Ptr CChar
kdata
    Ptr (ZonkAny 0) -> Int -> CSize -> IO ()
forall b. Ptr b -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr (ZonkAny 0)
forall a. Ptr a
vp Int
0 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
vlen :: CSize)
    Ptr (ZonkAny 1) -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr (ZonkAny 1)
forall a. Ptr a
vp Int
8 Ptr CChar
vdata
    CInt -> IO ()
check (CInt -> IO ()) -> IO CInt -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr MDB_txn
-> CUInt -> Ptr MDB_val -> Ptr MDB_val -> CUInt -> IO CInt
mdb_put Ptr MDB_txn
txnp CUInt
dbi Ptr MDB_val
kp Ptr MDB_val
forall a. Ptr a
vp CUInt
0
{-# INLINE put #-}

-- | Delete a key. Returns 'True' if the key existed and was removed,
--   'False' if it was already absent.
--
--   >>> del txn dbi "hello"
--   True
del
  :: Txn RW
  -> Dbi
  -> BS.ByteString -- ^ key
  -> IO Bool       -- ^ 'True' if the key was present and removed
del :: Txn RW -> Dbi -> ByteString -> IO Bool
del (Txn Ptr MDB_txn
txnp) (Dbi CUInt
dbi) ByteString
k =
  ByteString -> (Ptr MDB_val -> IO Bool) -> IO Bool
forall a. ByteString -> (Ptr MDB_val -> IO a) -> IO a
withBSAsVal ByteString
k ((Ptr MDB_val -> IO Bool) -> IO Bool)
-> (Ptr MDB_val -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \Ptr MDB_val
kp -> do
    code <- Ptr MDB_txn -> CUInt -> Ptr MDB_val -> Ptr MDB_val -> IO CInt
mdb_del Ptr MDB_txn
txnp CUInt
dbi Ptr MDB_val
kp Ptr MDB_val
forall a. Ptr a
nullPtr
    if   code == _MDB_NOTFOUND then pure False
    else do
      check code
      pure True
{-# INLINE del #-}

-- cursors --------------------------------------------------------------------

-- | Bracketed cursor lifecycle: open a cursor over the given 'Dbi',
--   run the action, close the cursor on exit (including async
--   exceptions).
--
--   >>> withCursor txn dbi $ \cur -> ...
withCursor :: Txn s -> Dbi -> (Cursor s -> IO a) -> IO a
withCursor :: forall s a. Txn s -> Dbi -> (Cursor s -> IO a) -> IO a
withCursor (Txn Ptr MDB_txn
txnp) (Dbi CUInt
dbi) Cursor s -> IO a
act = IO (Ptr MDB_cursor)
-> (Ptr MDB_cursor -> IO ()) -> (Ptr MDB_cursor -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket IO (Ptr MDB_cursor)
open' Ptr MDB_cursor -> IO ()
mdb_cursor_close Ptr MDB_cursor -> IO a
use'
  where
    open' :: IO (Ptr MDB_cursor)
open' = (Ptr (Ptr MDB_cursor) -> IO (Ptr MDB_cursor))
-> IO (Ptr MDB_cursor)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr MDB_cursor) -> IO (Ptr MDB_cursor))
 -> IO (Ptr MDB_cursor))
-> (Ptr (Ptr MDB_cursor) -> IO (Ptr MDB_cursor))
-> IO (Ptr MDB_cursor)
forall a b. (a -> b) -> a -> b
$ \Ptr (Ptr MDB_cursor)
pp -> do
      CInt -> IO ()
check (CInt -> IO ()) -> IO CInt -> IO ()
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Ptr MDB_txn -> CUInt -> Ptr (Ptr MDB_cursor) -> IO CInt
mdb_cursor_open Ptr MDB_txn
txnp CUInt
dbi Ptr (Ptr MDB_cursor)
pp
      Ptr (Ptr MDB_cursor) -> IO (Ptr MDB_cursor)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr MDB_cursor)
pp
    use' :: Ptr MDB_cursor -> IO a
use' Ptr MDB_cursor
p = Cursor s -> IO a
act (Ptr MDB_cursor -> Cursor s
forall s. Ptr MDB_cursor -> Cursor s
Cursor Ptr MDB_cursor
p)

-- Scan-position helper (no input key): one 32-byte buffer for both
-- output MDB_vals.
cursorMove
  :: Cursor s
  -> CInt              -- MDB_cursor_op
  -> IO (Maybe (BS.ByteString, BS.ByteString))
cursorMove :: forall s. Cursor s -> CInt -> IO (Maybe (ByteString, ByteString))
cursorMove (Cursor Ptr MDB_cursor
cp) CInt
op =
  Int
-> (Ptr MDB_val -> IO (Maybe (ByteString, ByteString)))
-> IO (Maybe (ByteString, ByteString))
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr MDB_val -> IO (Maybe (ByteString, ByteString)))
 -> IO (Maybe (ByteString, ByteString)))
-> (Ptr MDB_val -> IO (Maybe (ByteString, ByteString)))
-> IO (Maybe (ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ \Ptr MDB_val
kp -> do
    let !vp :: Ptr b
vp = Ptr MDB_val
kp Ptr MDB_val -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16
    code <- Ptr MDB_cursor -> Ptr MDB_val -> Ptr MDB_val -> CInt -> IO CInt
mdb_cursor_get Ptr MDB_cursor
cp Ptr MDB_val
kp Ptr MDB_val
forall a. Ptr a
vp CInt
op
    if   code == _MDB_NOTFOUND
    then pure Nothing
    else do
      check code
      k <- peekVal kp
      v <- peekVal vp
      pure (Just (k, v))
{-# INLINE cursorMove #-}

-- | Position at the first key/value pair, or 'Nothing' on an empty
--   database.
--
--   >>> cursorFirst cur
--   Just ("a","alpha")
cursorFirst :: Cursor s -> IO (Maybe (BS.ByteString, BS.ByteString))
cursorFirst :: forall s. Cursor s -> IO (Maybe (ByteString, ByteString))
cursorFirst Cursor s
c = Cursor s -> CInt -> IO (Maybe (ByteString, ByteString))
forall s. Cursor s -> CInt -> IO (Maybe (ByteString, ByteString))
cursorMove Cursor s
c CInt
_MDB_FIRST
{-# INLINE cursorFirst #-}

-- | Position at the last key/value pair, or 'Nothing' on an empty
--   database.
cursorLast :: Cursor s -> IO (Maybe (BS.ByteString, BS.ByteString))
cursorLast :: forall s. Cursor s -> IO (Maybe (ByteString, ByteString))
cursorLast Cursor s
c = Cursor s -> CInt -> IO (Maybe (ByteString, ByteString))
forall s. Cursor s -> CInt -> IO (Maybe (ByteString, ByteString))
cursorMove Cursor s
c CInt
_MDB_LAST
{-# INLINE cursorLast #-}

-- | Advance to the next key/value pair, or 'Nothing' if already at
--   the end.
cursorNext :: Cursor s -> IO (Maybe (BS.ByteString, BS.ByteString))
cursorNext :: forall s. Cursor s -> IO (Maybe (ByteString, ByteString))
cursorNext Cursor s
c = Cursor s -> CInt -> IO (Maybe (ByteString, ByteString))
forall s. Cursor s -> CInt -> IO (Maybe (ByteString, ByteString))
cursorMove Cursor s
c CInt
_MDB_NEXT
{-# INLINE cursorNext #-}

-- | Step back to the previous key/value pair, or 'Nothing' if already
--   at the start.
cursorPrev :: Cursor s -> IO (Maybe (BS.ByteString, BS.ByteString))
cursorPrev :: forall s. Cursor s -> IO (Maybe (ByteString, ByteString))
cursorPrev Cursor s
c = Cursor s -> CInt -> IO (Maybe (ByteString, ByteString))
forall s. Cursor s -> CInt -> IO (Maybe (ByteString, ByteString))
cursorMove Cursor s
c CInt
_MDB_PREV
{-# INLINE cursorPrev #-}

-- | Position at the first key /greater than or equal to/ the given
--   key, or 'Nothing' if no such key exists.
--
--   >>> cursorSeek cur "m"
--   Just ("n","november")
cursorSeek
  :: Cursor s
  -> BS.ByteString
  -> IO (Maybe (BS.ByteString, BS.ByteString))
cursorSeek :: forall s.
Cursor s -> ByteString -> IO (Maybe (ByteString, ByteString))
cursorSeek (Cursor Ptr MDB_cursor
cp) ByteString
k =
  ByteString
-> (CStringLen -> IO (Maybe (ByteString, ByteString)))
-> IO (Maybe (ByteString, ByteString))
forall a. ByteString -> (CStringLen -> IO a) -> IO a
BU.unsafeUseAsCStringLen ByteString
k ((CStringLen -> IO (Maybe (ByteString, ByteString)))
 -> IO (Maybe (ByteString, ByteString)))
-> (CStringLen -> IO (Maybe (ByteString, ByteString)))
-> IO (Maybe (ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ \(Ptr CChar
kdata, Int
klen) ->
  Int
-> (Ptr MDB_val -> IO (Maybe (ByteString, ByteString)))
-> IO (Maybe (ByteString, ByteString))
forall a b. Int -> (Ptr a -> IO b) -> IO b
allocaBytes Int
32 ((Ptr MDB_val -> IO (Maybe (ByteString, ByteString)))
 -> IO (Maybe (ByteString, ByteString)))
-> (Ptr MDB_val -> IO (Maybe (ByteString, ByteString)))
-> IO (Maybe (ByteString, ByteString))
forall a b. (a -> b) -> a -> b
$ \Ptr MDB_val
kp -> do
    let !vp :: Ptr b
vp = Ptr MDB_val
kp Ptr MDB_val -> Int -> Ptr b
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` Int
16
    Ptr MDB_val -> Int -> CSize -> IO ()
forall b. Ptr b -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MDB_val
kp Int
0 (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
klen :: CSize)
    Ptr MDB_val -> Int -> Ptr CChar -> IO ()
forall b. Ptr b -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MDB_val
kp Int
8 Ptr CChar
kdata
    code <- Ptr MDB_cursor -> Ptr MDB_val -> Ptr MDB_val -> CInt -> IO CInt
mdb_cursor_get Ptr MDB_cursor
cp Ptr MDB_val
kp Ptr MDB_val
forall a. Ptr a
vp CInt
_MDB_SET_RANGE
    if   code == _MDB_NOTFOUND
    then pure Nothing
    else do
      check code
      ok <- peekVal kp
      ov <- peekVal vp
      pure (Just (ok, ov))