module Database.LMDB.Raw
( LMDB_Version(..), lmdb_version, lmdb_dyn_version
, LMDB_Error(..), MDB_ErrCode(..)
, MDB_env
, MDB_dbi, MDB_dbi'
, MDB_txn, MDB_txnid
, MDB_cursor, MDB_cursor'
, MDB_val, mv_size, mv_data
, MDB_stat, ms_psize, ms_depth, ms_branch_pages, ms_leaf_pages, ms_overflow_pages, ms_entries
, MDB_envinfo, me_mapaddr, me_mapsize, me_last_pgno, me_last_txnid, me_maxreaders, me_numreaders
, MDB_cmp_func, wrapCmpFn
, MDB_EnvFlag(..), MDB_DbFlag(..)
, MDB_cursor_op(..)
, MDB_WriteFlag(..), MDB_WriteFlags, compileWriteFlags
, mdb_env_create
, mdb_env_open
, mdb_env_copy
, mdb_env_stat
, mdb_env_info
, mdb_env_sync, mdb_env_sync_flush
, mdb_env_close
, mdb_env_set_flags, mdb_env_unset_flags
, mdb_env_get_flags
, mdb_env_get_path
, mdb_env_set_mapsize
, mdb_env_set_maxreaders
, mdb_env_get_maxreaders
, mdb_env_set_maxdbs
, mdb_env_get_maxkeysize
, mdb_txn_begin
, mdb_txn_env
, mdb_txn_commit
, mdb_txn_abort
, mdb_dbi_open
, mdb_stat
, mdb_dbi_flags
, mdb_dbi_close
, mdb_drop, mdb_clear
, mdb_set_compare
, mdb_set_dupsort
, mdb_dbi_open'
, mdb_stat'
, mdb_dbi_flags'
, mdb_dbi_close'
, mdb_drop', mdb_clear'
, mdb_get, mdb_put, mdb_del, mdb_reserve
, mdb_get', mdb_put', mdb_del', mdb_reserve'
, mdb_cmp, mdb_dcmp
, mdb_cmp', mdb_dcmp'
, mdb_cursor_open
, mdb_cursor_get
, mdb_cursor_put
, mdb_cursor_del
, mdb_cursor_close
, mdb_cursor_txn
, mdb_cursor_dbi
, mdb_cursor_count
, mdb_cursor_open'
, mdb_cursor_get'
, mdb_cursor_put'
, mdb_cursor_del'
, mdb_cursor_close'
, mdb_cursor_txn'
, mdb_cursor_dbi'
, mdb_cursor_count'
, mdb_reader_list
, mdb_reader_check
) where
import Foreign
import Foreign.C
import Control.Applicative
import Control.Monad
import Control.Exception
import Control.Concurrent
import qualified Data.Array.Unboxed as A
import qualified Data.List as L
import Data.Typeable
import Data.Function (on)
import Data.Maybe (isNothing)
import Data.IORef
foreign import ccall "lmdb.h mdb_version" _mdb_version :: Ptr CInt -> Ptr CInt -> Ptr CInt -> IO CString
foreign import ccall "lmdb.h mdb_strerror" _mdb_strerror :: CInt -> CString
foreign import ccall "lmdb.h mdb_env_create" _mdb_env_create :: Ptr (Ptr MDB_env) -> IO CInt
foreign import ccall "lmdb.h mdb_env_open" _mdb_env_open :: Ptr MDB_env -> CString -> CUInt -> MDB_mode_t -> IO CInt
foreign import ccall "lmdb.h mdb_env_copy" _mdb_env_copy :: Ptr MDB_env -> CString -> IO CInt
foreign import ccall "lmdb.h mdb_env_stat" _mdb_env_stat :: Ptr MDB_env -> Ptr MDB_stat -> IO CInt
foreign import ccall "lmdb.h mdb_env_info" _mdb_env_info :: Ptr MDB_env -> Ptr MDB_envinfo -> IO CInt
foreign import ccall "lmdb.h mdb_env_sync" _mdb_env_sync :: Ptr MDB_env -> CInt -> IO CInt
foreign import ccall "lmdb.h mdb_env_close" _mdb_env_close :: Ptr MDB_env -> IO ()
foreign import ccall "lmdb.h mdb_env_set_flags" _mdb_env_set_flags :: Ptr MDB_env -> CUInt -> CInt -> IO CInt
foreign import ccall "lmdb.h mdb_env_get_flags" _mdb_env_get_flags :: Ptr MDB_env -> Ptr CUInt -> IO CInt
foreign import ccall "lmdb.h mdb_env_get_path" _mdb_env_get_path :: Ptr MDB_env -> Ptr CString -> IO CInt
foreign import ccall "lmdb.h mdb_env_set_mapsize" _mdb_env_set_mapsize :: Ptr MDB_env -> CSize -> IO CInt
foreign import ccall "lmdb.h mdb_env_set_maxreaders" _mdb_env_set_maxreaders :: Ptr MDB_env -> CUInt -> IO CInt
foreign import ccall "lmdb.h mdb_env_get_maxreaders" _mdb_env_get_maxreaders :: Ptr MDB_env -> Ptr CUInt -> IO CInt
foreign import ccall "lmdb.h mdb_env_set_maxdbs" _mdb_env_set_maxdbs :: Ptr MDB_env -> MDB_dbi_t -> IO CInt
foreign import ccall "lmdb.h mdb_env_get_maxkeysize" _mdb_env_get_maxkeysize :: Ptr MDB_env -> IO CInt
foreign import ccall "lmdb.h mdb_txn_begin" _mdb_txn_begin :: Ptr MDB_env -> Ptr MDB_txn -> CUInt -> Ptr (Ptr MDB_txn) -> IO CInt
foreign import ccall "lmdb.h mdb_txn_commit" _mdb_txn_commit :: Ptr MDB_txn -> IO CInt
foreign import ccall "lmdb.h mdb_txn_abort" _mdb_txn_abort :: Ptr MDB_txn -> IO ()
foreign import ccall "lmdb.h mdb_dbi_open" _mdb_dbi_open :: Ptr MDB_txn -> CString -> CUInt -> Ptr MDB_dbi_t -> IO CInt
foreign import ccall "lmdb.h mdb_stat" _mdb_stat :: Ptr MDB_txn -> MDB_dbi_t -> Ptr MDB_stat -> IO CInt
foreign import ccall "lmdb.h mdb_dbi_flags" _mdb_dbi_flags :: Ptr MDB_txn -> MDB_dbi_t -> Ptr CUInt -> IO CInt
foreign import ccall "lmdb.h mdb_dbi_close" _mdb_dbi_close :: Ptr MDB_env -> MDB_dbi_t -> IO ()
foreign import ccall "lmdb.h mdb_drop" _mdb_drop :: Ptr MDB_txn -> MDB_dbi_t -> CInt -> IO CInt
foreign import ccall "lmdb.h mdb_set_compare" _mdb_set_compare :: Ptr MDB_txn -> MDB_dbi -> FunPtr MDB_cmp_func -> IO CInt
foreign import ccall "lmdb.h mdb_set_dupsort" _mdb_set_dupsort :: Ptr MDB_txn -> MDB_dbi -> FunPtr MDB_cmp_func -> IO CInt
foreign import ccall safe "lmdb.h mdb_cmp" _mdb_cmp :: Ptr MDB_txn -> MDB_dbi -> Ptr MDB_val -> Ptr MDB_val -> IO CInt
foreign import ccall safe "lmdb.h mdb_dcmp" _mdb_dcmp :: Ptr MDB_txn -> MDB_dbi -> Ptr MDB_val -> Ptr MDB_val -> IO CInt
foreign import ccall unsafe "lmdb.h mdb_cmp" _mdb_cmp' :: Ptr MDB_txn -> MDB_dbi' -> Ptr MDB_val -> Ptr MDB_val -> IO CInt
foreign import ccall unsafe "lmdb.h mdb_dcmp" _mdb_dcmp' :: Ptr MDB_txn -> MDB_dbi' -> Ptr MDB_val -> Ptr MDB_val -> IO CInt
foreign import ccall safe "lmdb.h mdb_get" _mdb_get :: Ptr MDB_txn -> MDB_dbi -> Ptr MDB_val -> Ptr MDB_val -> IO CInt
foreign import ccall safe "lmdb.h mdb_put" _mdb_put :: Ptr MDB_txn -> MDB_dbi -> Ptr MDB_val -> Ptr MDB_val -> MDB_WriteFlags -> IO CInt
foreign import ccall safe "lmdb.h mdb_del" _mdb_del :: Ptr MDB_txn -> MDB_dbi -> Ptr MDB_val -> Ptr MDB_val -> IO CInt
foreign import ccall unsafe "lmdb.h mdb_get" _mdb_get' :: Ptr MDB_txn -> MDB_dbi' -> Ptr MDB_val -> Ptr MDB_val -> IO CInt
foreign import ccall unsafe "lmdb.h mdb_put" _mdb_put' :: Ptr MDB_txn -> MDB_dbi' -> Ptr MDB_val -> Ptr MDB_val -> MDB_WriteFlags -> IO CInt
foreign import ccall unsafe "lmdb.h mdb_del" _mdb_del' :: Ptr MDB_txn -> MDB_dbi' -> Ptr MDB_val -> Ptr MDB_val -> IO CInt
foreign import ccall safe "lmdb.h mdb_cursor_open" _mdb_cursor_open :: Ptr MDB_txn -> MDB_dbi -> Ptr (Ptr MDB_cursor) -> IO CInt
foreign import ccall safe "lmdb.h mdb_cursor_close" _mdb_cursor_close :: Ptr MDB_cursor -> IO ()
foreign import ccall safe "lmdb.h mdb_cursor_get" _mdb_cursor_get :: Ptr MDB_cursor -> Ptr MDB_val -> Ptr MDB_val -> (Word32) -> IO CInt
foreign import ccall safe "lmdb.h mdb_cursor_put" _mdb_cursor_put :: Ptr MDB_cursor -> Ptr MDB_val -> Ptr MDB_val -> MDB_WriteFlags -> IO CInt
foreign import ccall safe "lmdb.h mdb_cursor_del" _mdb_cursor_del :: Ptr MDB_cursor -> MDB_WriteFlags -> IO CInt
foreign import ccall safe "lmdb.h mdb_cursor_count" _mdb_cursor_count :: Ptr MDB_cursor -> Ptr CSize -> IO CInt
foreign import ccall unsafe "lmdb.h mdb_cursor_open" _mdb_cursor_open' :: Ptr MDB_txn -> MDB_dbi' -> Ptr (Ptr MDB_cursor') -> IO CInt
foreign import ccall unsafe "lmdb.h mdb_cursor_close" _mdb_cursor_close' :: Ptr MDB_cursor' -> IO ()
foreign import ccall unsafe "lmdb.h mdb_cursor_get" _mdb_cursor_get' :: Ptr MDB_cursor' -> Ptr MDB_val -> Ptr MDB_val -> (Word32) -> IO CInt
foreign import ccall unsafe "lmdb.h mdb_cursor_put" _mdb_cursor_put' :: Ptr MDB_cursor' -> Ptr MDB_val -> Ptr MDB_val -> MDB_WriteFlags -> IO CInt
foreign import ccall unsafe "lmdb.h mdb_cursor_del" _mdb_cursor_del' :: Ptr MDB_cursor' -> MDB_WriteFlags -> IO CInt
foreign import ccall unsafe "lmdb.h mdb_cursor_count" _mdb_cursor_count' :: Ptr MDB_cursor' -> Ptr CSize -> IO CInt
foreign import ccall "lmdb.h mdb_reader_list" _mdb_reader_list :: Ptr MDB_env -> FunPtr MDB_msg_func -> Ptr () -> IO CInt
foreign import ccall "lmdb.h mdb_reader_check" _mdb_reader_check :: Ptr MDB_env -> Ptr CInt -> IO CInt
type MDB_cmp_func = Ptr MDB_val -> Ptr MDB_val -> IO CInt
foreign import ccall "wrapper" wrapCmpFn :: MDB_cmp_func -> IO (FunPtr MDB_cmp_func)
type MDB_msg_func = CString -> Ptr () -> IO CInt
foreign import ccall "wrapper" wrapMsgFunc :: MDB_msg_func -> IO (FunPtr MDB_msg_func)
_peekCInt :: Ptr CInt -> IO CInt
_peekCInt = peek
_peekCUInt :: Ptr CUInt -> IO CUInt
_peekCUInt = peek
data LMDB_Version = LMDB_Version
{ v_major :: !Int
, v_minor :: !Int
, v_patch :: !Int
, v_text :: !String
} deriving (Eq, Ord, Show)
lmdb_version :: LMDB_Version
lmdb_version = LMDB_Version
{ v_major = 0
, v_minor = 9
, v_patch = 10
, v_text = "MDB 0.9.10: (November 11, 2013)"
}
lmdb_dyn_version :: IO LMDB_Version
lmdb_dyn_version =
let szInt = sizeOf (undefined :: CInt) in
allocaBytes (3 * szInt) $ \ pMajor -> do
let pMinor = pMajor `plusPtr` szInt
let pPatch = pMinor `plusPtr` szInt
cvText <- _mdb_version pMajor pMinor pPatch
vMajor <- fromIntegral <$> _peekCInt pMajor
vMinor <- fromIntegral <$> _peekCInt pMinor
vPatch <- fromIntegral <$> _peekCInt pPatch
vText <- peekCString cvText
return $! LMDB_Version
{ v_major = vMajor
, v_minor = vMinor
, v_patch = vPatch
, v_text = vText
}
data LMDB_Error = LMDB_Error
{ e_context :: String
, e_description :: String
, e_code :: Either Int MDB_ErrCode
} deriving (Eq, Ord, Show, Typeable)
instance Exception LMDB_Error
data MDB_env = MDB_env
{ _env_ptr :: !(Ptr MDB_env)
, _env_wlock :: !(MVar ThreadId)
}
data MDB_txn = MDB_txn
{ _txn_ptr :: !(Ptr MDB_txn)
, _txn_env :: !MDB_env
, _txn_rw :: !Bool
, _txn_p :: !(Maybe MDB_txn)
}
newtype MDB_txnid = MDB_txnid { _txnid :: MDB_txnid_t } deriving (Ord, Eq, Show)
newtype MDB_dbi = MDB_dbi { _dbi :: MDB_dbi_t }
data MDB_cursor = MDB_cursor
{ _crs_ptr :: !(Ptr MDB_cursor)
, _crs_dbi :: !MDB_dbi
, _crs_txn :: !MDB_txn
}
newtype MDB_dbi' = MDB_dbi' { _dbi' :: MDB_dbi_t }
data MDB_cursor' = MDB_cursor'
{ _crs_ptr' :: !(Ptr MDB_cursor')
, _crs_dbi' :: !MDB_dbi'
, _crs_txn' :: !MDB_txn
}
type MDB_mode_t = Word32
type MDB_dbi_t = Word32
type MDB_txnid_t = CSize
data MDB_val = MDB_val
{ mv_size :: !CSize
, mv_data :: !(Ptr Word8)
}
data MDB_stat = MDB_stat
{ ms_psize :: !CUInt
, ms_depth :: !CUInt
, ms_branch_pages :: !CSize
, ms_leaf_pages :: !CSize
, ms_overflow_pages :: !CSize
, ms_entries :: !CSize
} deriving (Eq, Ord, Show)
data MDB_envinfo = MDB_envinfo
{ me_mapaddr :: !(Ptr ())
, me_mapsize :: !CSize
, me_last_pgno :: !CSize
, me_last_txnid :: !MDB_txnid
, me_maxreaders :: !CUInt
, me_numreaders :: !CUInt
} deriving (Eq, Ord, Show)
data MDB_EnvFlag
= MDB_FIXEDMAP
| MDB_NOSUBDIR
| MDB_NOSYNC
| MDB_RDONLY
| MDB_NOMETASYNC
| MDB_WRITEMAP
| MDB_MAPASYNC
| MDB_NOLOCK
| MDB_NORDAHEAD
| MDB_NOMEMINIT
deriving (Eq, Ord, Bounded, A.Ix, Show)
envFlags :: [(MDB_EnvFlag, Int)]
envFlags =
[(MDB_FIXEDMAP, 1)
,(MDB_NOSUBDIR, 16384)
,(MDB_NOSYNC, 65536)
,(MDB_RDONLY, 131072)
,(MDB_NOMETASYNC, 262144)
,(MDB_WRITEMAP, 524288)
,(MDB_MAPASYNC, 1048576)
,(MDB_NOLOCK, 4194304)
,(MDB_NORDAHEAD, 8388608)
,(MDB_NOMEMINIT, 16777216)
]
envFlagsArray :: A.UArray MDB_EnvFlag Int
envFlagsArray = A.accumArray (.|.) 0 (minBound, maxBound) envFlags
compileEnvFlags :: [MDB_EnvFlag] -> CUInt
compileEnvFlags = fromIntegral . L.foldl' (.|.) 0 . fmap ((A.!) envFlagsArray)
decompileBitFlags :: [(a,Int)] -> Int -> [a]
decompileBitFlags optFlags n = fmap fst $ L.filter fullMatch optFlags where
fullMatch (_,f) = (f == (n .&. f))
decompileEnvFlags :: CUInt -> [MDB_EnvFlag]
decompileEnvFlags = decompileBitFlags envFlags . fromIntegral
data MDB_DbFlag
= MDB_REVERSEKEY
| MDB_DUPSORT
| MDB_INTEGERKEY
| MDB_DUPFIXED
| MDB_INTEGERDUP
| MDB_REVERSEDUP
| MDB_CREATE
deriving (Eq, Ord, Bounded, A.Ix, Show)
dbFlags :: [(MDB_DbFlag, Int)]
dbFlags =
[(MDB_REVERSEKEY, 2)
,(MDB_DUPSORT, 4)
,(MDB_INTEGERKEY, 8)
,(MDB_DUPFIXED, 16)
,(MDB_INTEGERDUP, 32)
,(MDB_REVERSEDUP, 64)
,(MDB_CREATE, 262144)
]
dbFlagsArray :: A.UArray MDB_DbFlag Int
dbFlagsArray = A.accumArray (.|.) 0 (minBound,maxBound) dbFlags
compileDBFlags :: [MDB_DbFlag] -> CUInt
compileDBFlags = fromIntegral . L.foldl' (.|.) 0 . fmap ((A.!) dbFlagsArray)
decompileDBFlags :: CUInt -> [MDB_DbFlag]
decompileDBFlags = decompileBitFlags dbFlags . fromIntegral
data MDB_WriteFlag
= MDB_NOOVERWRITE
| MDB_NODUPDATA
| MDB_CURRENT
| MDB_APPEND
| MDB_APPENDDUP
deriving (Eq, Ord, Bounded, A.Ix, Show)
writeFlags :: [(MDB_WriteFlag, Int)]
writeFlags =
[(MDB_NOOVERWRITE, 16)
,(MDB_NODUPDATA, 32)
,(MDB_CURRENT, 64)
,(MDB_APPEND, 131072)
,(MDB_APPENDDUP, 262144)
]
writeFlagsArray :: A.UArray MDB_WriteFlag Int
writeFlagsArray = A.accumArray (.|.) 0 (minBound,maxBound) writeFlags
newtype MDB_WriteFlags = MDB_WriteFlags CUInt
compileWriteFlags :: [MDB_WriteFlag] -> MDB_WriteFlags
compileWriteFlags = MDB_WriteFlags . L.foldl' addWF 0 where
addWF n wf = n .|. fromIntegral (writeFlagsArray A.! wf)
data MDB_cursor_op
= MDB_FIRST
| MDB_FIRST_DUP
| MDB_GET_BOTH
| MDB_GET_BOTH_RANGE
| MDB_GET_CURRENT
| MDB_GET_MULTIPLE
| MDB_LAST
| MDB_LAST_DUP
| MDB_NEXT
| MDB_NEXT_DUP
| MDB_NEXT_MULTIPLE
| MDB_NEXT_NODUP
| MDB_PREV
| MDB_PREV_DUP
| MDB_PREV_NODUP
| MDB_SET
| MDB_SET_KEY
| MDB_SET_RANGE
deriving (Eq, Ord, Bounded, A.Ix, Show)
cursorOps :: [(MDB_cursor_op, Int)]
cursorOps =
[(MDB_FIRST, 0)
,(MDB_FIRST_DUP, 1)
,(MDB_GET_BOTH, 2)
,(MDB_GET_BOTH_RANGE, 3)
,(MDB_GET_CURRENT, 4)
,(MDB_GET_MULTIPLE, 5)
,(MDB_LAST, 6)
,(MDB_LAST_DUP, 7)
,(MDB_NEXT, 8)
,(MDB_NEXT_DUP, 9)
,(MDB_NEXT_MULTIPLE, 10)
,(MDB_NEXT_NODUP, 11)
,(MDB_PREV, 12)
,(MDB_PREV_DUP, 13)
,(MDB_PREV_NODUP, 14)
,(MDB_SET, 15)
,(MDB_SET_KEY, 16)
,(MDB_SET_RANGE, 17)
]
cursorOpsArray :: A.UArray MDB_cursor_op Int
cursorOpsArray = A.accumArray (flip const) minBound (minBound,maxBound) cursorOps
cursorOp :: MDB_cursor_op -> (Word32)
cursorOp = fromIntegral . (A.!) cursorOpsArray
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
deriving (Eq, Ord, Bounded, A.Ix, Show)
errCodes :: [(MDB_ErrCode, Int)]
errCodes =
[(MDB_KEYEXIST, 30799)
,(MDB_NOTFOUND, 30798)
,(MDB_PAGE_NOTFOUND, 30797)
,(MDB_CORRUPTED, 30796)
,(MDB_PANIC, 30795)
,(MDB_VERSION_MISMATCH, 30794)
,(MDB_INVALID, 30793)
,(MDB_MAP_FULL, 30792)
,(MDB_DBS_FULL, 30791)
,(MDB_READERS_FULL, 30790)
,(MDB_TLS_FULL, 30789)
,(MDB_TXN_FULL, 30788)
,(MDB_CURSOR_FULL, 30787)
,(MDB_PAGE_FULL, 30786)
,(MDB_MAP_RESIZED, 30785)
,(MDB_INCOMPATIBLE, 30784)
,(MDB_BAD_RSLOT, 30783)
,(MDB_BAD_TXN, 30782)
,(MDB_BAD_VALSIZE, 30781)
]
_numToErrVal :: Int -> Either Int MDB_ErrCode
_numToErrVal code =
case L.find ((== code) . snd) errCodes of
Nothing -> Left code
Just (ec,_) -> Right ec
_throwLMDBErrNum :: String -> CInt -> IO noReturn
_throwLMDBErrNum context errNum = do
desc <- peekCString (_mdb_strerror errNum)
throwIO $! LMDB_Error
{ e_context = context
, e_description = desc
, e_code = _numToErrVal (fromIntegral errNum)
}
mdb_env_create :: IO MDB_env
mdb_env_create = alloca $ \ ppEnv ->
lmdb_validate_version_match >>
_mdb_env_create ppEnv >>= \ rc ->
if (0 /= rc) then _throwLMDBErrNum "mdb_env_create" rc else
MDB_env <$> peek ppEnv <*> newEmptyMVar
lmdb_validate_version_match :: IO ()
lmdb_validate_version_match =
let vStat = lmdb_version in
lmdb_dyn_version >>= \ vDyn ->
unless (versionMatch vStat vDyn) $
throwIO $! LMDB_Error
{ e_context = "lmdb_validate_version_match"
, e_description = "Haskell bindings: " ++ show vStat
++ "\tDynamic library: " ++ show vDyn
, e_code = Right MDB_VERSION_MISMATCH
}
versionMatch :: LMDB_Version -> LMDB_Version -> Bool
versionMatch vA vB = matchMajor && matchMinor where
matchMajor = ((==) `on` v_major) vA vB
matchMinor = ((==) `on` v_minor) vA vB
mdb_env_open :: MDB_env -> FilePath -> [MDB_EnvFlag] -> IO ()
mdb_env_open env fp flags =
let iFlags = (2097152) .|. (compileEnvFlags flags) in
let unix_mode = (6 * 64 + 6 * 8) in
withCString fp $ \ cfp ->
_mdb_env_open (_env_ptr env) cfp iFlags unix_mode >>= \ rc ->
unless (0 == rc) $
_throwLMDBErrNum "mdb_env_open" rc
mdb_env_copy :: MDB_env -> FilePath -> IO ()
mdb_env_copy env fp =
runInBoundThread $
bracket_ (_lockEnv env) (_unlockEnv env) $
withCString fp $ \ cfp ->
_mdb_env_copy (_env_ptr env) cfp >>= \ rc ->
unless (0 == rc) (_throwLMDBErrNum "mdb_env_copy" rc)
mdb_env_stat :: MDB_env -> IO MDB_stat
mdb_env_stat env =
alloca $ \ pStats ->
_mdb_env_stat (_env_ptr env) pStats >>= \ rc ->
if (0 == rc) then peek pStats else
_throwLMDBErrNum "mdb_env_stat" rc
mdb_env_info :: MDB_env -> IO MDB_envinfo
mdb_env_info env =
alloca $ \ pInfo ->
_mdb_env_info (_env_ptr env) pInfo >>= \ rc ->
if (0 == rc) then peek pInfo else
_throwLMDBErrNum "mdb_env_info" rc
mdb_env_sync :: MDB_env -> IO ()
mdb_env_sync env =
_mdb_env_sync (_env_ptr env) 0 >>= \ rc ->
unless (0 == rc) (_throwLMDBErrNum "mdb_env_sync" rc)
mdb_env_sync_flush :: MDB_env -> IO ()
mdb_env_sync_flush env =
_mdb_env_sync (_env_ptr env) 1 >>= \ rc ->
unless (0 == rc) (_throwLMDBErrNum "mdb_env_sync_flush" rc)
mdb_env_close :: MDB_env -> IO ()
mdb_env_close env = _lockEnv env >> _mdb_env_close (_env_ptr env)
mdb_env_set_flags :: MDB_env -> [MDB_EnvFlag] -> IO ()
mdb_env_set_flags env flags =
_mdb_env_set_flags (_env_ptr env) (compileEnvFlags flags) 1 >>= \ rc ->
unless (0 == rc) $ _throwLMDBErrNum "mdb_env_set_flags" rc
mdb_env_unset_flags :: MDB_env -> [MDB_EnvFlag] -> IO ()
mdb_env_unset_flags env flags =
_mdb_env_set_flags (_env_ptr env) (compileEnvFlags flags) 0 >>= \ rc ->
unless (0 == rc) $ _throwLMDBErrNum "mdb_env_unset_flags" rc
mdb_env_get_flags :: MDB_env -> IO [MDB_EnvFlag]
mdb_env_get_flags env = alloca $ \ pFlags ->
_mdb_env_get_flags (_env_ptr env) pFlags >>= \ rc ->
if (0 == rc) then decompileEnvFlags <$> peek pFlags else
_throwLMDBErrNum "mdb_env_get_flags" rc
mdb_env_get_path :: MDB_env -> IO FilePath
mdb_env_get_path env = alloca $ \ pPathStr ->
_mdb_env_get_path (_env_ptr env) pPathStr >>= \ rc ->
if (0 == rc) then peekCString =<< peek pPathStr else
_throwLMDBErrNum "mdb_env_get_path" rc
mdb_env_set_mapsize :: MDB_env -> Int -> IO ()
mdb_env_set_mapsize env nBytes =
_mdb_env_set_mapsize (_env_ptr env) (fromIntegral nBytes) >>= \ rc ->
unless (0 == rc) (_throwLMDBErrNum "mdb_env_set_mapsize" rc)
mdb_env_set_maxreaders :: MDB_env -> Int -> IO ()
mdb_env_set_maxreaders env nReaders =
_mdb_env_set_maxreaders (_env_ptr env) (fromIntegral nReaders) >>= \ rc ->
unless (0 == rc) (_throwLMDBErrNum "mdb_env_set_maxreaders" rc)
mdb_env_get_maxreaders :: MDB_env -> IO Int
mdb_env_get_maxreaders env = alloca $ \ pCount ->
_mdb_env_get_maxreaders (_env_ptr env) pCount >>= \ rc ->
if (0 == rc) then fromIntegral <$> _peekCUInt pCount else
_throwLMDBErrNum "mdb_env_get_maxreaders" rc
mdb_env_set_maxdbs :: MDB_env -> Int -> IO ()
mdb_env_set_maxdbs env nDBs =
_mdb_env_set_maxdbs (_env_ptr env) (fromIntegral nDBs) >>= \ rc ->
unless (0 == rc) (_throwLMDBErrNum "mdb_env_set_maxdbs" rc)
mdb_env_get_maxkeysize :: MDB_env -> IO Int
mdb_env_get_maxkeysize env = fromIntegral <$> _mdb_env_get_maxkeysize (_env_ptr env)
mdb_reader_check :: MDB_env -> IO Int
mdb_reader_check env =
alloca $ \ pCount ->
_mdb_reader_check (_env_ptr env) pCount >>= \ rc ->
if (0 == rc) then fromIntegral <$> _peekCInt pCount else
_throwLMDBErrNum "mdb_reader_check" rc
mdb_reader_list :: MDB_env -> IO [String]
mdb_reader_list env =
newIORef [] >>= \ rf ->
let onMsg cs _ =
peekCString cs >>= \ msg ->
modifyIORef rf (msg:) >>
return 0
in
withMsgFunc onMsg $ \ pMsgFunc ->
_mdb_reader_list (_env_ptr env) pMsgFunc nullPtr >>= \ rc ->
if (0 == rc) then L.reverse <$> readIORef rf else
_throwLMDBErrNum "mdb_reader_list" rc
withMsgFunc :: MDB_msg_func -> (FunPtr MDB_msg_func -> IO a) -> IO a
withMsgFunc f = bracket (wrapMsgFunc f) freeHaskellFunPtr
mdb_txn_begin :: MDB_env -> Maybe MDB_txn -> Bool -> IO MDB_txn
mdb_txn_begin env parent bReadOnly = mask_ $
let bWriteTxn = not bReadOnly in
let bLockForWrite = bWriteTxn && isNothing parent in
when bLockForWrite (_lockEnv env) >>
let pEnv = _env_ptr env in
let pParent = maybe nullPtr _txn_ptr parent in
let iFlags = if bReadOnly then (131072) else 0 in
let onFailure rc =
when bLockForWrite (_unlockEnv env) >>
_throwLMDBErrNum "mdb_txn_begin" rc
in
alloca $ \ ppChildTxn ->
_mdb_txn_begin pEnv pParent iFlags ppChildTxn >>= \ rc ->
if (0 /= rc) then onFailure rc else
peek ppChildTxn >>= \ pChildTxn ->
return $! MDB_txn { _txn_ptr = pChildTxn
, _txn_env = env
, _txn_rw = bWriteTxn
, _txn_p = parent
}
_lockEnv, _unlockEnv :: MDB_env -> IO ()
_lockErr, _unlockErr :: LMDB_Error
_lockErr = LMDB_Error
{ e_context = "locking LMDB for write in Haskell layer"
, e_description = "must lock from a 'bound' thread!"
, e_code = Right MDB_PANIC
}
_unlockErr = LMDB_Error
{ e_context = "unlock Haskell layer LMDB after write"
, e_description = "calling thread does not own the lock!"
, e_code = Right MDB_PANIC
}
_lockEnv env =
isCurrentThreadBound >>= \ bBound ->
let bBoundFailure = not bBound && rtsSupportsBoundThreads in
if bBoundFailure then throwIO _lockErr else
putMVar (_env_wlock env) =<< myThreadId
_unlockEnv env =
myThreadId >>= \ self ->
let m = (_env_wlock env) in
mask_ $
takeMVar m >>= \ owner ->
unless (self == owner) $
putMVar m owner >>
throwIO _unlockErr
_unlockTxn :: MDB_txn -> IO ()
_unlockTxn txn =
let bHasLock = _txn_rw txn && isNothing (_txn_p txn) in
when bHasLock (_unlockEnv (_txn_env txn))
mdb_txn_env :: MDB_txn -> MDB_env
mdb_txn_env = _txn_env
mdb_txn_commit :: MDB_txn -> IO ()
mdb_txn_commit txn = mask_ $
_mdb_txn_commit (_txn_ptr txn) >>= \ rc ->
_unlockTxn txn >>
unless (0 == rc) (_throwLMDBErrNum "mdb_txn_commit" rc)
mdb_txn_abort :: MDB_txn -> IO ()
mdb_txn_abort txn = mask_ $
_mdb_txn_abort (_txn_ptr txn) >>
_unlockTxn txn
mdb_dbi_open :: MDB_txn -> String -> [MDB_DbFlag] -> IO MDB_dbi
mdb_dbi_open txn dbName flags = MDB_dbi <$> mdb_dbi_open_t txn dbName flags
mdb_stat :: MDB_txn -> MDB_dbi -> IO MDB_stat
mdb_stat txn = mdb_stat_t txn . _dbi
mdb_dbi_flags :: MDB_txn -> MDB_dbi -> IO [MDB_DbFlag]
mdb_dbi_flags txn = mdb_dbi_flags_t txn . _dbi
mdb_dbi_close :: MDB_env -> MDB_dbi -> IO ()
mdb_dbi_close env = mdb_dbi_close_t env . _dbi
mdb_drop :: MDB_txn -> MDB_dbi -> IO ()
mdb_drop txn = mdb_drop_t txn . _dbi
mdb_clear :: MDB_txn -> MDB_dbi -> IO ()
mdb_clear txn = mdb_clear_t txn . _dbi
mdb_dbi_open' :: MDB_txn -> String -> [MDB_DbFlag] -> IO MDB_dbi'
mdb_dbi_open' txn dbName flags = MDB_dbi' <$> mdb_dbi_open_t txn dbName flags
mdb_stat' :: MDB_txn -> MDB_dbi' -> IO MDB_stat
mdb_stat' txn = mdb_stat_t txn . _dbi'
mdb_dbi_flags' :: MDB_txn -> MDB_dbi' -> IO [MDB_DbFlag]
mdb_dbi_flags' txn = mdb_dbi_flags_t txn . _dbi'
mdb_dbi_close' :: MDB_env -> MDB_dbi' -> IO ()
mdb_dbi_close' txn = mdb_dbi_close_t txn . _dbi'
mdb_drop' :: MDB_txn -> MDB_dbi' -> IO ()
mdb_drop' txn = mdb_drop_t txn . _dbi'
mdb_clear' :: MDB_txn -> MDB_dbi' -> IO ()
mdb_clear' txn = mdb_clear_t txn . _dbi'
mdb_dbi_open_t :: MDB_txn -> String -> [MDB_DbFlag] -> IO MDB_dbi_t
mdb_dbi_open_t txn dbName flags =
let cdbFlags = compileDBFlags flags in
withCString dbName $ \ cdbName ->
alloca $ \ pDBI ->
_mdb_dbi_open (_txn_ptr txn) cdbName cdbFlags pDBI >>= \ rc ->
if (0 == rc) then peek pDBI else
_throwLMDBErrNum "mdb_dbi_open" rc
mdb_stat_t :: MDB_txn -> MDB_dbi_t -> IO MDB_stat
mdb_stat_t txn dbi =
alloca $ \ pStat ->
_mdb_stat (_txn_ptr txn) dbi pStat >>= \ rc ->
if (0 == rc) then peek pStat else
_throwLMDBErrNum "mdb_stat" rc
mdb_dbi_flags_t :: MDB_txn -> MDB_dbi_t -> IO [MDB_DbFlag]
mdb_dbi_flags_t txn dbi =
alloca $ \ pFlags ->
_mdb_dbi_flags (_txn_ptr txn) dbi pFlags >>= \ rc ->
if (0 == rc) then decompileDBFlags <$> peek pFlags else
_throwLMDBErrNum "mdb_dbi_flags" rc
mdb_dbi_close_t :: MDB_env -> MDB_dbi_t -> IO ()
mdb_dbi_close_t env dbi = _mdb_dbi_close (_env_ptr env) dbi
mdb_drop_t :: MDB_txn -> MDB_dbi_t -> IO ()
mdb_drop_t txn dbi =
_mdb_drop (_txn_ptr txn) dbi 1 >>= \ rc ->
unless (0 == rc) (_throwLMDBErrNum "mdb_drop" rc)
mdb_clear_t :: MDB_txn -> MDB_dbi_t -> IO ()
mdb_clear_t txn dbi =
_mdb_drop (_txn_ptr txn) dbi 0 >>= \ rc ->
unless (0 == rc) (_throwLMDBErrNum "mdb_clear" rc)
mdb_set_compare :: MDB_txn -> MDB_dbi -> FunPtr MDB_cmp_func -> IO ()
mdb_set_compare txn dbi fcmp =
_mdb_set_compare (_txn_ptr txn) dbi fcmp >>= \ rc ->
unless (0 == rc) (_throwLMDBErrNum "mdb_set_compare" rc)
mdb_set_dupsort :: MDB_txn -> MDB_dbi -> FunPtr MDB_cmp_func -> IO ()
mdb_set_dupsort txn dbi fcmp =
_mdb_set_dupsort (_txn_ptr txn) dbi fcmp >>= \ rc ->
unless (0 == rc) (_throwLMDBErrNum "mdb_set_dupsort" rc)
zed :: MDB_val
zed = MDB_val 0 nullPtr
mdb_get :: MDB_txn -> MDB_dbi -> MDB_val -> IO (Maybe MDB_val)
mdb_get txn dbi key =
withKVPtrs key zed $ \ pKey pVal ->
_mdb_get (_txn_ptr txn) dbi pKey pVal >>= \ rc ->
r_get rc pVal
r_get :: CInt -> Ptr MDB_val -> IO (Maybe MDB_val)
r_get rc pVal =
if (0 == rc) then Just <$> peek pVal else
if ((30798) == rc) then return Nothing else
_throwLMDBErrNum "mdb_get" rc
withKVPtrs :: MDB_val -> MDB_val -> (Ptr MDB_val -> Ptr MDB_val -> IO a) -> IO a
withKVPtrs k v fn =
allocaBytes (2 * sizeOf k) $ \ pK ->
let pV = pK `plusPtr` sizeOf k in
do poke pK k
poke pV v
fn pK pV
mdb_put :: MDB_WriteFlags -> MDB_txn -> MDB_dbi -> MDB_val -> MDB_val -> IO Bool
mdb_put wf txn dbi key val =
withKVPtrs key val $ \ pKey pVal ->
_mdb_put (_txn_ptr txn) dbi pKey pVal wf >>= \ rc ->
r_put rc
r_put :: CInt -> IO Bool
r_put rc =
if (0 == rc) then return True else
if ((30799) == rc) then return False else
_throwLMDBErrNum "mdb_put" rc
mdb_reserve :: MDB_WriteFlags -> MDB_txn -> MDB_dbi -> MDB_val -> Int -> IO MDB_val
mdb_reserve wf txn dbi key szBytes =
withKVPtrs key (reserveData szBytes) $ \ pKey pVal ->
_mdb_put (_txn_ptr txn) dbi pKey pVal (wfReserve wf) >>= \ rc ->
if (0 == rc) then peek pVal else
_throwLMDBErrNum "mdb_reserve" rc
wfReserve :: MDB_WriteFlags -> MDB_WriteFlags
wfReserve (MDB_WriteFlags wf) = MDB_WriteFlags ((65536) .|. wf)
reserveData :: Int -> MDB_val
reserveData szBytes = MDB_val (fromIntegral szBytes) nullPtr
mdb_del :: MDB_txn -> MDB_dbi -> MDB_val -> Maybe MDB_val -> IO Bool
mdb_del txn dbi key Nothing =
alloca $ \ pKey ->
poke pKey key >>
_mdb_del (_txn_ptr txn) dbi pKey nullPtr >>= \ rc ->
r_del rc
mdb_del txn dbi key (Just val) =
withKVPtrs key val $ \ pKey pVal ->
_mdb_del (_txn_ptr txn) dbi pKey pVal >>= \ rc ->
r_del rc
r_del :: CInt -> IO Bool
r_del rc =
if (0 == rc) then return True else
if ((30798) == rc) then return False else
_throwLMDBErrNum "mdb_del" rc
mdb_get' :: MDB_txn -> MDB_dbi' -> MDB_val -> IO (Maybe MDB_val)
mdb_get' txn dbi key =
withKVPtrs key zed $ \ pKey pVal ->
_mdb_get' (_txn_ptr txn) dbi pKey pVal >>= \ rc ->
r_get rc pVal
mdb_put' :: MDB_WriteFlags -> MDB_txn -> MDB_dbi' -> MDB_val -> MDB_val -> IO Bool
mdb_put' wf txn dbi key val =
withKVPtrs key val $ \ pKey pVal ->
_mdb_put' (_txn_ptr txn) dbi pKey pVal wf >>= \ rc ->
r_put rc
mdb_reserve' :: MDB_WriteFlags -> MDB_txn -> MDB_dbi' -> MDB_val -> Int -> IO MDB_val
mdb_reserve' wf txn dbi key szBytes =
withKVPtrs key (reserveData szBytes) $ \ pKey pVal ->
_mdb_put' (_txn_ptr txn) dbi pKey pVal (wfReserve wf) >>= \ rc ->
if (0 == rc) then peek pVal else
_throwLMDBErrNum "mdb_reserve" rc
mdb_del' :: MDB_txn -> MDB_dbi' -> MDB_val -> Maybe MDB_val -> IO Bool
mdb_del' txn dbi key Nothing =
allocaBytes (sizeOf key) $ \ pKey ->
poke pKey key >>
_mdb_del' (_txn_ptr txn) dbi pKey nullPtr >>= \ rc ->
r_del rc
mdb_del' txn dbi key (Just val) =
allocaBytes (2 * sizeOf key) $ \ pKey ->
let pVal = pKey `plusPtr` sizeOf key in
poke pKey key >> poke pVal val >>
_mdb_del' (_txn_ptr txn) dbi pKey pVal >>= \rc ->
r_del rc
mdb_cmp :: MDB_txn -> MDB_dbi -> MDB_val -> MDB_val -> IO Ordering
mdb_cmp txn dbi a b =
withKVPtrs a b $ \ pA pB ->
_mdb_cmp (_txn_ptr txn) dbi pA pB >>= \ rc ->
return (compare rc 0)
mdb_dcmp :: MDB_txn -> MDB_dbi -> MDB_val -> MDB_val -> IO Ordering
mdb_dcmp txn dbi a b =
withKVPtrs a b $ \ pA pB ->
_mdb_dcmp (_txn_ptr txn) dbi pA pB >>= \ rc ->
return (compare rc 0)
mdb_cmp' :: MDB_txn -> MDB_dbi' -> MDB_val -> MDB_val -> IO Ordering
mdb_cmp' txn dbi a b =
withKVPtrs a b $ \ pA pB ->
_mdb_cmp' (_txn_ptr txn) dbi pA pB >>= \ rc ->
return (compare rc 0)
mdb_dcmp' :: MDB_txn -> MDB_dbi' -> MDB_val -> MDB_val -> IO Ordering
mdb_dcmp' txn dbi a b =
withKVPtrs a b $ \ pA pB ->
_mdb_dcmp' (_txn_ptr txn) dbi pA pB >>= \ rc ->
return (compare rc 0)
mdb_cursor_open :: MDB_txn -> MDB_dbi -> IO MDB_cursor
mdb_cursor_open txn dbi =
alloca $ \ ppCursor ->
_mdb_cursor_open (_txn_ptr txn) dbi ppCursor >>= \ rc ->
if (0 /= rc) then _throwLMDBErrNum "mdb_cursor_open" rc else
peek ppCursor >>= \ pCursor ->
return $! MDB_cursor
{ _crs_ptr = pCursor
, _crs_dbi = dbi
, _crs_txn = txn
}
mdb_cursor_open' :: MDB_txn -> MDB_dbi' -> IO MDB_cursor'
mdb_cursor_open' txn dbi =
alloca $ \ ppCursor ->
_mdb_cursor_open' (_txn_ptr txn) dbi ppCursor >>= \ rc ->
if (0 /= rc) then _throwLMDBErrNum "mdb_cursor_open" rc else
peek ppCursor >>= \ pCursor ->
return $! MDB_cursor'
{ _crs_ptr' = pCursor
, _crs_dbi' = dbi
, _crs_txn' = txn
}
mdb_cursor_get :: MDB_cursor_op -> MDB_cursor -> Ptr MDB_val -> Ptr MDB_val -> IO Bool
mdb_cursor_get op crs pKey pData = _mdb_cursor_get (_crs_ptr crs) pKey pData (cursorOp op) >>= r_cursor_get
r_cursor_get :: CInt -> IO Bool
r_cursor_get rc =
if(0 == rc) then return True else
if((30798) == rc) then return False else
_throwLMDBErrNum "mdb_cursor_get" rc
mdb_cursor_get' :: MDB_cursor_op -> MDB_cursor' -> Ptr MDB_val -> Ptr MDB_val -> IO Bool
mdb_cursor_get' op crs pKey pData = _mdb_cursor_get' (_crs_ptr' crs) pKey pData (cursorOp op) >>= r_cursor_get
mdb_cursor_put :: MDB_WriteFlags -> MDB_cursor -> MDB_val -> MDB_val -> IO Bool
mdb_cursor_put wf crs key val =
withKVPtrs key val $ \ pKey pVal ->
_mdb_cursor_put (_crs_ptr crs) pKey pVal wf >>= \ rc ->
r_cursor_put rc
r_cursor_put :: CInt -> IO Bool
r_cursor_put rc =
if(0 == rc) then return True else
if((30799) == rc) then return False else
_throwLMDBErrNum "mdb_cursor_put" rc
mdb_cursor_put' :: MDB_WriteFlags -> MDB_cursor' -> MDB_val -> MDB_val -> IO Bool
mdb_cursor_put' wf crs key val =
withKVPtrs key val $ \ pKey pVal ->
_mdb_cursor_put' (_crs_ptr' crs) pKey pVal wf >>= \ rc ->
r_cursor_put rc
mdb_cursor_del :: MDB_WriteFlags -> MDB_cursor -> IO ()
mdb_cursor_del wf crs = _mdb_cursor_del (_crs_ptr crs) wf >>= r_cursor_del
r_cursor_del :: CInt -> IO ()
r_cursor_del rc = unless (0 == rc) (_throwLMDBErrNum "mdb_cursor_del" rc)
mdb_cursor_del' :: MDB_WriteFlags -> MDB_cursor' -> IO ()
mdb_cursor_del' wf crs = _mdb_cursor_del' (_crs_ptr' crs) wf >>= r_cursor_del
mdb_cursor_close :: MDB_cursor -> IO ()
mdb_cursor_close crs = _mdb_cursor_close (_crs_ptr crs)
mdb_cursor_close' :: MDB_cursor' -> IO ()
mdb_cursor_close' crs = _mdb_cursor_close' (_crs_ptr' crs)
mdb_cursor_txn :: MDB_cursor -> MDB_txn
mdb_cursor_txn = _crs_txn
mdb_cursor_txn' :: MDB_cursor' -> MDB_txn
mdb_cursor_txn' = _crs_txn'
mdb_cursor_dbi :: MDB_cursor -> MDB_dbi
mdb_cursor_dbi = _crs_dbi
mdb_cursor_dbi' :: MDB_cursor' -> MDB_dbi'
mdb_cursor_dbi' = _crs_dbi'
mdb_cursor_count :: MDB_cursor -> IO Int
mdb_cursor_count crs =
alloca $ \ pCount ->
_mdb_cursor_count (_crs_ptr crs) pCount >>= \ rc ->
if (0 == rc) then fromIntegral <$> _peekSize pCount else
_throwLMDBErrNum "mdb_cursor_count" rc
_peekSize :: Ptr CSize -> IO CSize
_peekSize = peek
mdb_cursor_count' :: MDB_cursor' -> IO Int
mdb_cursor_count' crs =
alloca $ \ pCount ->
_mdb_cursor_count' (_crs_ptr' crs) pCount >>= \ rc ->
if (0 == rc) then fromIntegral <$> _peekSize pCount else
_throwLMDBErrNum "mdb_cursor_count" rc
instance Storable MDB_val where
alignment _ = 8
sizeOf _ = (16)
peek ptr = do
sz <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
pd <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
return $! MDB_val sz pd
poke ptr (MDB_val sz pd) = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr sz
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr pd
instance Storable MDB_stat where
alignment _ = 8
sizeOf _ = (40)
peek ptr = do
psize <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
depth <- (\hsc_ptr -> peekByteOff hsc_ptr 4) ptr
branch_pages <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
leaf_pages <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
overflow_pages <- (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
entries <- (\hsc_ptr -> peekByteOff hsc_ptr 32) ptr
return $! MDB_stat
{ ms_psize = psize
, ms_depth = depth
, ms_branch_pages = branch_pages
, ms_leaf_pages = leaf_pages
, ms_overflow_pages = overflow_pages
, ms_entries = entries
}
poke ptr val = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (ms_psize val)
(\hsc_ptr -> pokeByteOff hsc_ptr 4) ptr (ms_depth val)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (ms_branch_pages val)
(\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr (ms_leaf_pages val)
(\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr (ms_overflow_pages val)
(\hsc_ptr -> pokeByteOff hsc_ptr 32) ptr (ms_entries val)
instance Storable MDB_envinfo where
alignment _ = 8
sizeOf _ = (40)
peek ptr = do
mapaddr <- (\hsc_ptr -> peekByteOff hsc_ptr 0) ptr
mapsize <- (\hsc_ptr -> peekByteOff hsc_ptr 8) ptr
last_pgno <- (\hsc_ptr -> peekByteOff hsc_ptr 16) ptr
last_txnid <- (\hsc_ptr -> peekByteOff hsc_ptr 24) ptr
maxreaders <- (\hsc_ptr -> peekByteOff hsc_ptr 32) ptr
numreaders <- (\hsc_ptr -> peekByteOff hsc_ptr 36) ptr
return $! MDB_envinfo
{ me_mapaddr = mapaddr
, me_mapsize = mapsize
, me_last_pgno = last_pgno
, me_last_txnid = MDB_txnid last_txnid
, me_maxreaders = maxreaders
, me_numreaders = numreaders
}
poke ptr val = do
(\hsc_ptr -> pokeByteOff hsc_ptr 0) ptr (me_mapaddr val)
(\hsc_ptr -> pokeByteOff hsc_ptr 8) ptr (me_mapsize val)
(\hsc_ptr -> pokeByteOff hsc_ptr 16) ptr (me_last_pgno val)
(\hsc_ptr -> pokeByteOff hsc_ptr 24) ptr (_txnid $ me_last_txnid val)
(\hsc_ptr -> pokeByteOff hsc_ptr 32) ptr (me_maxreaders val)
(\hsc_ptr -> pokeByteOff hsc_ptr 36) ptr (me_numreaders val)