{-# LINE 1 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
-- Much of the code below was obtained from the lmdb library:
-- https://hackage.haskell.org/package/lmdb (https://hackage.haskell.org/package/lmdb-0.2.5/src/LICENSE)
module Streamly.External.LMDB.Internal.Foreign where



import Control.Exception (Exception, throwIO)
import Control.Monad (when)
import Foreign ((.|.), Ptr, Storable (alignment, peek, peekByteOff,
                poke, pokeByteOff, sizeOf), Word16, Word32, alloca, nullPtr)
import Foreign.C.String (CString, peekCString, withCString)
import Foreign.C.Types (CChar, CInt (CInt), CSize (CSize), CUInt (CUInt))

import qualified Data.List as L

type MDB_mode_t = Word32
{-# LINE 17 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
type MDB_dbi_t = Word32
{-# LINE 18 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
type MDB_cursor_op_t = Word32
{-# LINE 19 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}

data MDB_env
data MDB_txn
data MDB_cursor

data MDB_val = MDB_val
    { MDB_val -> CSize
mv_size :: {-# UNPACK #-} !CSize
    , MDB_val -> Ptr CChar
mv_data :: {-# UNPACK #-} !(Ptr CChar) }

instance Storable MDB_val where
    alignment :: MDB_val -> Int
alignment MDB_val
_ = Int
8
{-# LINE 30 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    {-# INLINE alignment #-}
    sizeOf :: MDB_val -> Int
sizeOf MDB_val
_ = (Int
16)
{-# LINE 32 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    {-# INLINE sizeOf #-}
    peek :: Ptr MDB_val -> IO MDB_val
peek Ptr MDB_val
ptr = do
        CSize
sz <- (\Ptr MDB_val
hsc_ptr -> Ptr MDB_val -> Int -> IO CSize
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr MDB_val
hsc_ptr Int
0) Ptr MDB_val
ptr
{-# LINE 35 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
        Ptr CChar
pd <- (\Ptr MDB_val
hsc_ptr -> Ptr MDB_val -> Int -> IO (Ptr CChar)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr MDB_val
hsc_ptr Int
8) Ptr MDB_val
ptr
{-# LINE 36 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
        MDB_val -> IO MDB_val
forall (m :: * -> *) a. Monad m => a -> m a
return (MDB_val -> IO MDB_val) -> MDB_val -> IO MDB_val
forall a b. (a -> b) -> a -> b
$! CSize -> Ptr CChar -> MDB_val
MDB_val CSize
sz Ptr CChar
pd
    {-# INLINE peek #-}
    poke :: Ptr MDB_val -> MDB_val -> IO ()
poke Ptr MDB_val
ptr (MDB_val CSize
sz Ptr CChar
pd) = do
        (\Ptr MDB_val
hsc_ptr -> Ptr MDB_val -> Int -> CSize -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MDB_val
hsc_ptr Int
0) Ptr MDB_val
ptr CSize
sz
{-# LINE 40 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
        (\Ptr MDB_val
hsc_ptr -> Ptr MDB_val -> Int -> Ptr CChar -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr MDB_val
hsc_ptr Int
8) Ptr MDB_val
ptr Ptr CChar
pd
{-# LINE 41 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    {-# INLINE poke #-}

foreign import ccall unsafe "lmdb.h mdb_strerror"
    c_mdb_strerror :: CInt -> IO CString

foreign import ccall unsafe "lmdb.h mdb_env_create"
    c_mdb_env_create :: Ptr (Ptr MDB_env) -> IO CInt

foreign import ccall unsafe "lmdb.h mdb_env_set_mapsize"
    c_mdb_env_set_mapsize :: Ptr MDB_env -> CSize -> IO CInt

foreign import ccall unsafe "lmdb.h mdb_env_set_maxreaders"
    c_mdb_env_set_maxreaders :: Ptr MDB_env -> CUInt -> IO CInt

foreign import ccall unsafe "lmdb.h mdb_env_set_maxdbs"
    c_mdb_env_set_maxdbs :: Ptr MDB_env -> MDB_dbi_t -> IO CInt

foreign import ccall unsafe "lmdb.h mdb_env_open"
    c_mdb_env_open :: Ptr MDB_env -> CString -> CUInt -> MDB_mode_t -> IO CInt

foreign import ccall unsafe "lmdb.h mdb_txn_begin"
    c_mdb_txn_begin :: Ptr MDB_env -> Ptr MDB_txn -> CUInt -> Ptr (Ptr MDB_txn) -> IO CInt

foreign import ccall unsafe "lmdb.h mdb_dbi_open"
    c_mdb_dbi_open :: Ptr MDB_txn -> CString -> CUInt -> Ptr MDB_dbi_t -> IO CInt

foreign import ccall unsafe "lmdb.h mdb_txn_commit"
    c_mdb_txn_commit :: Ptr MDB_txn -> IO CInt

foreign import ccall unsafe "lmdb.h mdb_txn_abort"
    c_mdb_txn_abort :: Ptr MDB_txn -> IO ()

foreign import ccall unsafe "lmdb.h mdb_cursor_open"
    c_mdb_cursor_open :: Ptr MDB_txn -> MDB_dbi_t -> Ptr (Ptr MDB_cursor) -> IO CInt

foreign import ccall unsafe "lmdb.h mdb_cursor_get"
    c_mdb_cursor_get :: Ptr MDB_cursor -> Ptr MDB_val -> Ptr MDB_val -> MDB_cursor_op_t -> IO CInt

foreign import ccall unsafe "lmdb.h mdb_cursor_close"
    c_mdb_cursor_close :: Ptr MDB_cursor -> IO ()

foreign import ccall unsafe "lmdb.h mdb_get"
    c_mdb_get :: Ptr MDB_txn -> MDB_dbi_t -> Ptr MDB_val -> Ptr MDB_val -> IO CInt

foreign import ccall unsafe "lmdb.h mdb_put"
    c_mdb_put :: Ptr MDB_txn -> MDB_dbi_t -> Ptr MDB_val -> Ptr MDB_val -> CUInt -> IO CInt

foreign import ccall unsafe "streamly_lmdb_foreign.h mdb_put_"
    c_mdb_put_ :: Ptr MDB_txn -> MDB_dbi_t -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> CUInt -> IO CInt

foreign import ccall unsafe "lmdb.h mdb_drop"
    c_mdb_drop :: Ptr MDB_txn -> MDB_dbi_t -> CInt -> IO CInt

data LMDB_Error = LMDB_Error
    { LMDB_Error -> String
e_context     :: String
    , LMDB_Error -> String
e_description :: String
    , LMDB_Error -> Either Int MDB_ErrCode
e_code        :: Either Int MDB_ErrCode
    } deriving (Int -> LMDB_Error -> ShowS
[LMDB_Error] -> ShowS
LMDB_Error -> String
(Int -> LMDB_Error -> ShowS)
-> (LMDB_Error -> String)
-> ([LMDB_Error] -> ShowS)
-> Show LMDB_Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LMDB_Error] -> ShowS
$cshowList :: [LMDB_Error] -> ShowS
show :: LMDB_Error -> String
$cshow :: LMDB_Error -> String
showsPrec :: Int -> LMDB_Error -> ShowS
$cshowsPrec :: Int -> LMDB_Error -> ShowS
Show)
instance Exception LMDB_Error

data MDB_ErrCode
    = MDB_KEYEXIST
    | MDB_NOTFOUND
    | MDB_PAGE_NOTFOUND
    | MDB_CORRUPTED
    | MDB_PANIC
    | MDB_VERSION_MISMATCH
    | MDB_INVALID
    | MDB_MAP_FULL
    | MDB_DBS_FULL
    | MDB_READERS_FULL
    | MDB_TLS_FULL
    | MDB_TXN_FULL
    | MDB_CURSOR_FULL
    | MDB_PAGE_FULL
    | MDB_MAP_RESIZED
    | MDB_INCOMPATIBLE
    | MDB_BAD_RSLOT
    | MDB_BAD_TXN
    | MDB_BAD_VALSIZE
    | MDB_BAD_DBI
    deriving (MDB_ErrCode -> MDB_ErrCode -> Bool
(MDB_ErrCode -> MDB_ErrCode -> Bool)
-> (MDB_ErrCode -> MDB_ErrCode -> Bool) -> Eq MDB_ErrCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MDB_ErrCode -> MDB_ErrCode -> Bool
$c/= :: MDB_ErrCode -> MDB_ErrCode -> Bool
== :: MDB_ErrCode -> MDB_ErrCode -> Bool
$c== :: MDB_ErrCode -> MDB_ErrCode -> Bool
Eq, Int -> MDB_ErrCode -> ShowS
[MDB_ErrCode] -> ShowS
MDB_ErrCode -> String
(Int -> MDB_ErrCode -> ShowS)
-> (MDB_ErrCode -> String)
-> ([MDB_ErrCode] -> ShowS)
-> Show MDB_ErrCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MDB_ErrCode] -> ShowS
$cshowList :: [MDB_ErrCode] -> ShowS
show :: MDB_ErrCode -> String
$cshow :: MDB_ErrCode -> String
showsPrec :: Int -> MDB_ErrCode -> ShowS
$cshowsPrec :: Int -> MDB_ErrCode -> ShowS
Show)

{-# INLINE errCodes #-}
errCodes :: [(MDB_ErrCode, Int)]
errCodes :: [(MDB_ErrCode, Int)]
errCodes =
    [ (MDB_ErrCode
MDB_KEYEXIST, -Int
30799)
{-# LINE 128 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_NOTFOUND, -30798)
{-# LINE 129 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_PAGE_NOTFOUND, -30797)
{-# LINE 130 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_CORRUPTED, -30796)
{-# LINE 131 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_PANIC, -30795)
{-# LINE 132 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_VERSION_MISMATCH, -30794)
{-# LINE 133 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_INVALID, -30793)
{-# LINE 134 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_MAP_FULL, -30792)
{-# LINE 135 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_DBS_FULL, -30791)
{-# LINE 136 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_READERS_FULL, -30790)
{-# LINE 137 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_TLS_FULL, -30789)
{-# LINE 138 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_TXN_FULL, -30788)
{-# LINE 139 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_CURSOR_FULL, -30787)
{-# LINE 140 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_PAGE_FULL, -30786)
{-# LINE 141 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_MAP_RESIZED, -30785)
{-# LINE 142 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_INCOMPATIBLE, -30784)
{-# LINE 143 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_BAD_RSLOT, -30783)
{-# LINE 144 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_BAD_TXN, -30782)
{-# LINE 145 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_BAD_VALSIZE, -30781)
{-# LINE 146 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}
    , (MDB_BAD_DBI, -30780) ]
{-# LINE 147 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}

{-# INLINE numToErrVal #-}
numToErrVal :: Int -> Either Int MDB_ErrCode
numToErrVal :: Int -> Either Int MDB_ErrCode
numToErrVal Int
code =
    case ((MDB_ErrCode, Int) -> Bool)
-> [(MDB_ErrCode, Int)] -> Maybe (MDB_ErrCode, Int)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
L.find ((Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
code) (Int -> Bool)
-> ((MDB_ErrCode, Int) -> Int) -> (MDB_ErrCode, Int) -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MDB_ErrCode, Int) -> Int
forall a b. (a, b) -> b
snd) [(MDB_ErrCode, Int)]
errCodes of
        Maybe (MDB_ErrCode, Int)
Nothing -> Int -> Either Int MDB_ErrCode
forall a b. a -> Either a b
Left Int
code
        Just (MDB_ErrCode
ec,Int
_) -> MDB_ErrCode -> Either Int MDB_ErrCode
forall a b. b -> Either a b
Right MDB_ErrCode
ec

{-# INLINE throwLMDBErrNum #-}
throwLMDBErrNum :: String -> CInt -> IO noReturn
throwLMDBErrNum :: String -> CInt -> IO noReturn
throwLMDBErrNum String
context CInt
errNum = do
    String
desc <- Ptr CChar -> IO String
peekCString (Ptr CChar -> IO String) -> IO (Ptr CChar) -> IO String
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< CInt -> IO (Ptr CChar)
c_mdb_strerror CInt
errNum
    LMDB_Error -> IO noReturn
forall e a. Exception e => e -> IO a
throwIO (LMDB_Error -> IO noReturn) -> LMDB_Error -> IO noReturn
forall a b. (a -> b) -> a -> b
$! LMDB_Error :: String -> String -> Either Int MDB_ErrCode -> LMDB_Error
LMDB_Error
        { e_context :: String
e_context = String
context
        , e_description :: String
e_description = String
desc
        , e_code :: Either Int MDB_ErrCode
e_code = Int -> Either Int MDB_ErrCode
numToErrVal (CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
errNum) }

mdb_notfound :: CInt
mdb_notfound :: CInt
mdb_notfound = -CInt
30798
{-# LINE 166 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}

mdb_rdonly :: CUInt
mdb_rdonly :: CUInt
mdb_rdonly = CUInt
131072
{-# LINE 169 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}

mdb_notls :: CUInt
mdb_notls :: CUInt
mdb_notls = CUInt
2097152
{-# LINE 172 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}

mdb_nosubdir :: CUInt
mdb_nosubdir :: CUInt
mdb_nosubdir = CUInt
16384
{-# LINE 175 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}

mdb_nooverwrite :: CUInt
mdb_nooverwrite :: CUInt
mdb_nooverwrite = CUInt
16
{-# LINE 178 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}

mdb_append :: CUInt
mdb_append :: CUInt
mdb_append = CUInt
131072
{-# LINE 181 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}

mdb_create :: CUInt
mdb_create :: CUInt
mdb_create = CUInt
262144
{-# LINE 184 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}

combineOptions :: [CUInt] -> CUInt
combineOptions :: [CUInt] -> CUInt
combineOptions = (CUInt -> CUInt -> CUInt) -> CUInt -> [CUInt] -> CUInt
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CUInt -> CUInt -> CUInt
forall a. Bits a => a -> a -> a
(.|.) CUInt
0

mdb_first :: MDB_cursor_op_t
mdb_first :: MDB_cursor_op_t
mdb_first = MDB_cursor_op_t
0
{-# LINE 190 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}

mdb_last :: MDB_cursor_op_t
mdb_last :: MDB_cursor_op_t
mdb_last = MDB_cursor_op_t
6
{-# LINE 193 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}

mdb_next :: MDB_cursor_op_t
mdb_next :: MDB_cursor_op_t
mdb_next = MDB_cursor_op_t
8
{-# LINE 196 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}

mdb_prev :: MDB_cursor_op_t
mdb_prev :: MDB_cursor_op_t
mdb_prev = MDB_cursor_op_t
12
{-# LINE 199 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}

mdb_set_range :: MDB_cursor_op_t
mdb_set_range :: MDB_cursor_op_t
mdb_set_range = MDB_cursor_op_t
17
{-# LINE 202 "src/Streamly/External/LMDB/Internal/Foreign.hsc" #-}

mdb_env_create :: IO (Ptr MDB_env)
mdb_env_create :: IO (Ptr MDB_env)
mdb_env_create = do
    (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)
ppenv -> Ptr (Ptr MDB_env) -> IO CInt
c_mdb_env_create Ptr (Ptr MDB_env)
ppenv IO CInt -> (CInt -> IO (Ptr MDB_env)) -> IO (Ptr MDB_env)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
rc ->
        if CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0 then String -> CInt -> IO (Ptr MDB_env)
forall noReturn. String -> CInt -> IO noReturn
throwLMDBErrNum String
"mdb_env_create" CInt
rc else Ptr (Ptr MDB_env) -> IO (Ptr MDB_env)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr MDB_env)
ppenv

mdb_env_set_mapsize :: Ptr MDB_env -> Int -> IO ()
mdb_env_set_mapsize :: Ptr MDB_env -> Int -> IO ()
mdb_env_set_mapsize Ptr MDB_env
penv Int
size =
    Ptr MDB_env -> CSize -> IO CInt
c_mdb_env_set_mapsize Ptr MDB_env
penv (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size) IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
rc ->
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> CInt -> IO ()
forall noReturn. String -> CInt -> IO noReturn
throwLMDBErrNum String
"mdb_env_set_mapsize" CInt
rc

mdb_env_set_maxdbs :: Ptr MDB_env -> Int -> IO ()
mdb_env_set_maxdbs :: Ptr MDB_env -> Int -> IO ()
mdb_env_set_maxdbs Ptr MDB_env
penv Int
num =
    Ptr MDB_env -> MDB_cursor_op_t -> IO CInt
c_mdb_env_set_maxdbs Ptr MDB_env
penv (Int -> MDB_cursor_op_t
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
num) IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
rc ->
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> CInt -> IO ()
forall noReturn. String -> CInt -> IO noReturn
throwLMDBErrNum String
"mdb_env_set_maxdbs" CInt
rc

mdb_env_set_maxreaders :: Ptr MDB_env -> Int -> IO ()
mdb_env_set_maxreaders :: Ptr MDB_env -> Int -> IO ()
mdb_env_set_maxreaders Ptr MDB_env
penv Int
num =
    Ptr MDB_env -> CUInt -> IO CInt
c_mdb_env_set_maxreaders Ptr MDB_env
penv (Int -> CUInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> CUInt) -> Int -> CUInt
forall a b. (a -> b) -> a -> b
$ Int
num) IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
rc ->
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> CInt -> IO ()
forall noReturn. String -> CInt -> IO noReturn
throwLMDBErrNum String
"mdb_env_set_maxreaders" CInt
rc

mdb_env_open :: Ptr MDB_env -> FilePath -> CUInt -> IO ()
mdb_env_open :: Ptr MDB_env -> String -> CUInt -> IO ()
mdb_env_open Ptr MDB_env
penv String
path CUInt
flags =
    String -> (Ptr CChar -> IO ()) -> IO ()
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
path ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
cpath ->
        Ptr MDB_env -> Ptr CChar -> CUInt -> MDB_cursor_op_t -> IO CInt
c_mdb_env_open Ptr MDB_env
penv Ptr CChar
cpath CUInt
flags MDB_cursor_op_t
0o660 IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
rc ->
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> CInt -> IO ()
forall noReturn. String -> CInt -> IO noReturn
throwLMDBErrNum String
"mdb_env_open" CInt
rc

mdb_txn_begin :: Ptr MDB_env -> Ptr MDB_txn -> CUInt -> IO (Ptr MDB_txn)
mdb_txn_begin :: Ptr MDB_env -> Ptr MDB_txn -> CUInt -> IO (Ptr MDB_txn)
mdb_txn_begin Ptr MDB_env
penv Ptr MDB_txn
parent 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)
pptxn -> Ptr MDB_env -> Ptr MDB_txn -> CUInt -> Ptr (Ptr MDB_txn) -> IO CInt
c_mdb_txn_begin Ptr MDB_env
penv Ptr MDB_txn
parent CUInt
flags Ptr (Ptr MDB_txn)
pptxn IO CInt -> (CInt -> IO (Ptr MDB_txn)) -> IO (Ptr MDB_txn)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
rc ->
        if CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0 then String -> CInt -> IO (Ptr MDB_txn)
forall noReturn. String -> CInt -> IO noReturn
throwLMDBErrNum String
"mdb_txn_begin" CInt
rc else Ptr (Ptr MDB_txn) -> IO (Ptr MDB_txn)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr MDB_txn)
pptxn

-- If the commit fails, aborts the transaction.
mdb_txn_commit :: Ptr MDB_txn -> IO ()
mdb_txn_commit :: Ptr MDB_txn -> IO ()
mdb_txn_commit Ptr MDB_txn
ptxn =
    Ptr MDB_txn -> IO CInt
c_mdb_txn_commit Ptr MDB_txn
ptxn IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
rc ->
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr MDB_txn -> IO ()
c_mdb_txn_abort Ptr MDB_txn
ptxn IO () -> IO () -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> CInt -> IO ()
forall noReturn. String -> CInt -> IO noReturn
throwLMDBErrNum String
"mdb_txn_commit" CInt
rc

mdb_cursor_open :: Ptr MDB_txn -> MDB_dbi_t -> IO (Ptr MDB_cursor)
mdb_cursor_open :: Ptr MDB_txn -> MDB_cursor_op_t -> IO (Ptr MDB_cursor)
mdb_cursor_open Ptr MDB_txn
ptxn MDB_cursor_op_t
dbi =
    (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)
ppcurs -> Ptr MDB_txn -> MDB_cursor_op_t -> Ptr (Ptr MDB_cursor) -> IO CInt
c_mdb_cursor_open Ptr MDB_txn
ptxn MDB_cursor_op_t
dbi Ptr (Ptr MDB_cursor)
ppcurs IO CInt -> (CInt -> IO (Ptr MDB_cursor)) -> IO (Ptr MDB_cursor)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
rc ->
        if CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0 then Ptr MDB_txn -> IO ()
c_mdb_txn_abort Ptr MDB_txn
ptxn IO () -> IO (Ptr MDB_cursor) -> IO (Ptr MDB_cursor)
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> CInt -> IO (Ptr MDB_cursor)
forall noReturn. String -> CInt -> IO noReturn
throwLMDBErrNum String
"mdb_cursor_open" CInt
rc else Ptr (Ptr MDB_cursor) -> IO (Ptr MDB_cursor)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr MDB_cursor)
ppcurs

mdb_dbi_open :: Ptr MDB_txn -> Maybe String -> CUInt -> IO MDB_dbi_t
mdb_dbi_open :: Ptr MDB_txn -> Maybe String -> CUInt -> IO MDB_cursor_op_t
mdb_dbi_open Ptr MDB_txn
ptxn Maybe String
name CUInt
flags = do
    Maybe String
-> (Ptr CChar -> IO MDB_cursor_op_t) -> IO MDB_cursor_op_t
forall a. Maybe String -> (Ptr CChar -> IO a) -> IO a
withCStringMaybe Maybe String
name ((Ptr CChar -> IO MDB_cursor_op_t) -> IO MDB_cursor_op_t)
-> (Ptr CChar -> IO MDB_cursor_op_t) -> IO MDB_cursor_op_t
forall a b. (a -> b) -> a -> b
$ \Ptr CChar
cname ->
        (Ptr MDB_cursor_op_t -> IO MDB_cursor_op_t) -> IO MDB_cursor_op_t
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr MDB_cursor_op_t -> IO MDB_cursor_op_t) -> IO MDB_cursor_op_t)
-> (Ptr MDB_cursor_op_t -> IO MDB_cursor_op_t)
-> IO MDB_cursor_op_t
forall a b. (a -> b) -> a -> b
$ \Ptr MDB_cursor_op_t
pdbi -> Ptr MDB_txn -> Ptr CChar -> CUInt -> Ptr MDB_cursor_op_t -> IO CInt
c_mdb_dbi_open Ptr MDB_txn
ptxn Ptr CChar
cname CUInt
flags Ptr MDB_cursor_op_t
pdbi IO CInt -> (CInt -> IO MDB_cursor_op_t) -> IO MDB_cursor_op_t
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
rc ->
            if CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0 then Ptr MDB_txn -> IO ()
c_mdb_txn_abort Ptr MDB_txn
ptxn IO () -> IO MDB_cursor_op_t -> IO MDB_cursor_op_t
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> String -> CInt -> IO MDB_cursor_op_t
forall noReturn. String -> CInt -> IO noReturn
throwLMDBErrNum String
"mdb_dbi_open" CInt
rc else Ptr MDB_cursor_op_t -> IO MDB_cursor_op_t
forall a. Storable a => Ptr a -> IO a
peek Ptr MDB_cursor_op_t
pdbi

{-# INLINE mdb_put #-}
mdb_put :: Ptr MDB_txn -> MDB_dbi_t -> Ptr MDB_val -> Ptr MDB_val -> CUInt -> IO ()
mdb_put :: Ptr MDB_txn
-> MDB_cursor_op_t -> Ptr MDB_val -> Ptr MDB_val -> CUInt -> IO ()
mdb_put Ptr MDB_txn
ptxn MDB_cursor_op_t
dbi Ptr MDB_val
pk Ptr MDB_val
pv CUInt
flags =
    Ptr MDB_txn
-> MDB_cursor_op_t
-> Ptr MDB_val
-> Ptr MDB_val
-> CUInt
-> IO CInt
c_mdb_put Ptr MDB_txn
ptxn MDB_cursor_op_t
dbi Ptr MDB_val
pk Ptr MDB_val
pv CUInt
flags IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
rc ->
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> CInt -> IO ()
forall noReturn. String -> CInt -> IO noReturn
throwLMDBErrNum String
"mdb_put" CInt
rc

{-# INLINE mdb_put_ #-}
mdb_put_ :: Ptr MDB_txn -> MDB_dbi_t -> Ptr CChar -> CSize -> Ptr CChar -> CSize -> CUInt -> IO ()
mdb_put_ :: Ptr MDB_txn
-> MDB_cursor_op_t
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> CUInt
-> IO ()
mdb_put_ Ptr MDB_txn
ptxn MDB_cursor_op_t
dbi Ptr CChar
pk CSize
ks Ptr CChar
pv CSize
vs CUInt
flags =
    Ptr MDB_txn
-> MDB_cursor_op_t
-> Ptr CChar
-> CSize
-> Ptr CChar
-> CSize
-> CUInt
-> IO CInt
c_mdb_put_ Ptr MDB_txn
ptxn MDB_cursor_op_t
dbi Ptr CChar
pk CSize
ks Ptr CChar
pv CSize
vs CUInt
flags IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
rc ->
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> CInt -> IO ()
forall noReturn. String -> CInt -> IO noReturn
throwLMDBErrNum String
"mdb_put_" CInt
rc

mdb_clear :: Ptr MDB_txn -> MDB_dbi_t -> IO ()
mdb_clear :: Ptr MDB_txn -> MDB_cursor_op_t -> IO ()
mdb_clear Ptr MDB_txn
ptxn MDB_cursor_op_t
dbi =
    Ptr MDB_txn -> MDB_cursor_op_t -> CInt -> IO CInt
c_mdb_drop Ptr MDB_txn
ptxn MDB_cursor_op_t
dbi CInt
0 IO CInt -> (CInt -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \CInt
rc ->
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CInt
rc CInt -> CInt -> Bool
forall a. Eq a => a -> a -> Bool
/= CInt
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ String -> CInt -> IO ()
forall noReturn. String -> CInt -> IO noReturn
throwLMDBErrNum String
"mdb_clear" CInt
rc

-- | Use a nullable CString.
withCStringMaybe :: Maybe String -> (CString -> IO a) -> IO a
withCStringMaybe :: Maybe String -> (Ptr CChar -> IO a) -> IO a
withCStringMaybe Maybe String
Nothing Ptr CChar -> IO a
f = Ptr CChar -> IO a
f Ptr CChar
forall a. Ptr a
nullPtr
withCStringMaybe (Just String
s) Ptr CChar -> IO a
f = String -> (Ptr CChar -> IO a) -> IO a
forall a. String -> (Ptr CChar -> IO a) -> IO a
withCString String
s Ptr CChar -> IO a
f