{-# LINE 1 "Database/Berkeley/Db.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls, DeriveDataTypeable #-}
{-# LINE 2 "Database/Berkeley/Db.hsc" #-}
{-# CFILES Database/Berkeley/db_helper.c #-}

-- | Berkeley DB binding. All IO monad functions can throw DbException.
--
-- This documentation is not a complete description of the Berkeley DB interface.
-- You will need to refer to Berkeley DB's C or C++ API documentation for the details.


{-# LINE 10 "Database/Berkeley/Db.hsc" #-}

module Database.Berkeley.Db (
        -- * Common
        DbFlag(..),
        DbError(..),
        DbException(..),
        -- * DbEnv
        DbEnv,
        dbEnv_close,
        DbEnvCreateFlag,
        dbEnv_create,
        dbEnv_set_data_dir,
        dbEnv_set_lg_dir,
        dbEnv_get_cache_size,
        dbEnv_get_lk_max_lockers,
        dbEnv_get_lk_max_locks,
        dbEnv_get_lk_max_objects,
        dbEnv_get_tx_max,
        DbLock,
        DbLocker,
        DbLockMode(..),
        dbEnv_lock_get,
        dbEnv_lock_put,
        dbEnv_withLock,
        dbEnv_open,
        dbEnv_set_cache_size,
        DbLockFlag(..),
        dbEnv_set_lk_detect,
        dbEnv_set_lk_max_lockers,
        dbEnv_set_lk_max_locks,
        dbEnv_set_lk_max_objects,
        dbEnv_set_tx_max,
        dbEnv_txn_checkpoint,
        dbEnv_set_flags,
        -- * DbTxn
        dbEnv_withTxn,
        dbEnv_txn_begin,
        DbTxn,
        dbTxn_abort,
        dbTxn_commit,
        dbTxn_id,
        -- * Db
        Db,
        db_create,
        db_del,
        db_get,
        DbType(..),
        db_open,
        db_close,
        db_set_flags,
        db_put,
        db_set_pagesize,
        db_sync,
        -- * DbCursor
        db_withCursor,
        db_cursor,
        DbCursor,
        dbCursor_close,
        dbCursor_count,
        dbCursor_del,
        dbCursor_withCursor,
        dbCursor_dup,
        dbCursor_get,
        dbCursor_set,
        dbCursor_set_range,
        dbCursor_put,
        -- * Logging subsystem

{-# LINE 78 "Database/Berkeley/Db.hsc" #-}
        DbLogFlag(..),
        dbEnv_log_set_config,

{-# LINE 81 "Database/Berkeley/Db.hsc" #-}
        dbEnv_get_lg_regionmax,
        dbEnv_set_lg_regionmax,
        -- * Private
        dbToNum,
        dbErrFromNum,
        DbEnv_struct,
        DbTxn_struct,
        -- * C integration
        DbEnv_native,
        dbEnv_toNative
    ) where

import Foreign.C
import Foreign.Marshal.Alloc
import Foreign.Storable
import Foreign.Ptr
import Control.Applicative
import Control.Monad
import Data.Bits
import Data.Maybe
import System.IO.Error
import System.IO (FilePath)
import Foreign.ForeignPtr
import Data.ByteString (ByteString)
import qualified Data.ByteString.Internal as BSI
import Data.Word
import Control.Exception.Extensible
import Data.Typeable

{-
   DB (user visible) error return codes.

   !!!
   We don't want our error returns to conflict with other packages where
   possible, so pick a base error value that's hopefully not common.  We
   document that we own the error name space from -30,800 to -30,999.
 -}
data DbError =
    DB_BUFFER_SMALL         |    -- ^ User memory too small for return.
    DB_DONOTINDEX           |    -- ^ \"Null\" return from 2ndary callbk.
    DB_KEYEMPTY             |    -- ^ Key/data deleted or never created.
    DB_KEYEXIST             |    -- ^ The key/data pair already exists.
    DB_LOCK_DEADLOCK        |    -- ^ Deadlock.
    DB_LOCK_NOTGRANTED      |    -- ^ Lock unavailable.
    DB_LOG_BUFFER_FULL      |    -- ^ In-memory log buffer full.
    DB_NOSERVER             |    -- ^ Server panic return.

{-# LINE 131 "Database/Berkeley/Db.hsc" #-}
    DB_NOTFOUND             |    -- ^ Key/data pair not found (EOF).
    DB_OLD_VERSION          |    -- ^ Out-of-date version.
    DB_PAGE_NOTFOUND        |    -- ^ Requested page not found.
    DB_REP_DUPMASTER        |    -- ^ There are two masters.
    DB_REP_HANDLE_DEAD      |    -- ^ Rolled back a commit.
    DB_REP_HOLDELECTION     |    -- ^ Time to hold an election.
    DB_REP_IGNORE           |    -- ^ This msg should be ignored.
    DB_REP_ISPERM           |    -- ^ Cached not written perm written.
    DB_REP_JOIN_FAILURE     |    -- ^ Unable to join replication group.
    DB_REP_LEASE_EXPIRED    |    -- ^ Master lease has expired.
    DB_REP_LOCKOUT          |    -- ^ API/Replication lockout now.
    DB_REP_NEWSITE          |    -- ^ New site entered system.
    DB_REP_NOTPERM          |    -- ^ Permanent log record not written.
    DB_REP_UNAVAIL          |    -- ^ Site cannot currently be reached.
    DB_RUNRECOVERY          |    -- ^ Panic return.
    DB_SECONDARY_BAD        |    -- ^ Secondary index corrupt.
    DB_VERIFY_BAD           |    -- ^ Verify failed; bad format.
    DB_VERSION_MISMATCH     |    -- ^ Environment version mismatch.
    DB_ACCESSED_DB_ENV_AFTER_CLOSE |  -- ^ Haskell binding: Attempted to use a DbEnv handle after it was closed
    DB_ACCESSED_DB_AFTER_CLOSE |      -- ^ Haskell binding: Attempted to use a Db handle after it was closed
    DB_ACCESSED_DB_TXN_AFTER_CLOSE |  -- ^ Haskell binding: Attempted to use a DbTxn handle after it was closed
    DB_ACCESSED_DB_CURSOR_AFTER_CLOSE | -- ^ Haskell binding: Attempted to use a DbCursor handle after it was closed
    SYSTEM_ERROR Int             -- ^ An errno value returned by the operating system
    deriving (Eq,Show)

-- | Needed for BerkeleyDBXML: Convert an error code to a DbError
dbErrFromNum :: Int -> DbError
dbErrFromNum (-30999) = DB_BUFFER_SMALL
{-# LINE 159 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30998) = DB_DONOTINDEX
{-# LINE 160 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30996) = DB_KEYEMPTY
{-# LINE 161 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30995) = DB_KEYEXIST
{-# LINE 162 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30994) = DB_LOCK_DEADLOCK
{-# LINE 163 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30993) = DB_LOCK_NOTGRANTED
{-# LINE 164 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30992) = DB_LOG_BUFFER_FULL
{-# LINE 165 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30990) = DB_NOSERVER
{-# LINE 166 "Database/Berkeley/Db.hsc" #-}

{-# LINE 170 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30987) = DB_NOTFOUND
{-# LINE 171 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30986) = DB_OLD_VERSION
{-# LINE 172 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30985) = DB_PAGE_NOTFOUND
{-# LINE 173 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30984) = DB_REP_DUPMASTER
{-# LINE 174 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30983) = DB_REP_HANDLE_DEAD
{-# LINE 175 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30982) = DB_REP_HOLDELECTION
{-# LINE 176 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30981) = DB_REP_IGNORE
{-# LINE 177 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30980) = DB_REP_ISPERM
{-# LINE 178 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30979) = DB_REP_JOIN_FAILURE
{-# LINE 179 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30978) = DB_REP_LEASE_EXPIRED
{-# LINE 180 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30977) = DB_REP_LOCKOUT
{-# LINE 181 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30976) = DB_REP_NEWSITE
{-# LINE 182 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30975) = DB_REP_NOTPERM
{-# LINE 183 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30974) = DB_REP_UNAVAIL
{-# LINE 184 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30973) = DB_RUNRECOVERY
{-# LINE 185 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30972) = DB_SECONDARY_BAD
{-# LINE 186 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30970) = DB_VERIFY_BAD
{-# LINE 187 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-30969) = DB_VERSION_MISMATCH
{-# LINE 188 "Database/Berkeley/Db.hsc" #-}
dbErrFromNum (-20881) = DB_ACCESSED_DB_ENV_AFTER_CLOSE  -- specific to this binding
dbErrFromNum (-20882) = DB_ACCESSED_DB_AFTER_CLOSE  -- specific to this binding
dbErrFromNum (-20883) = DB_ACCESSED_DB_TXN_AFTER_CLOSE  -- specific to this binding
dbErrFromNum (-20884) = DB_ACCESSED_DB_CURSOR_AFTER_CLOSE  -- specific to this binding
dbErrFromNum n                        = (SYSTEM_ERROR n)

-- | An exception indicating an error in a Berkeley DB operation.
data DbException = DbException String DbError
    deriving (Eq, Show, Typeable)

instance Exception DbException where

throwDB :: String -> CInt -> IO a
throwDB func code =
    throwIO $ DbException func (dbErrFromNum $ fromIntegral code)


------ DbEnv ------------------------------------------------------------------

-- | Needed for BerkeleyDBXML: C pointer type for a DbEnv
data DbEnv_struct
type DbEnv = ForeignPtr DbEnv_struct

foreign import ccall safe "db_helper.h _dbenv_create" _dbenv_create
    :: Ptr (Ptr DbEnv_struct) -> CUInt -> IO CInt

data DbEnvCreateFlag = DB_RPCCLIENT

-- | Create a Berkeley DB environment handle.
dbEnv_create :: [DbEnvCreateFlag] -> IO DbEnv
dbEnv_create flags =
    alloca $ \ptr -> do
        ret <- _dbenv_create ptr orFlags
        if ret /= 0
            then throwDB "_dbenv_create" ret
            else do
                p <- peek ptr
                newForeignPtr finalizerFree p
    where
        orFlags = foldr (.|.) 0 $ map toNum flags
        toNum DB_RPCCLIENT = 0x0000002


foreign import ccall unsafe "db_helper.h _dbenv_set_data_dir" _dbenv_set_data_dir
    :: Ptr DbEnv_struct -> CString -> IO CInt

dbEnv_set_data_dir :: DbEnv -> FilePath -> IO ()
dbEnv_set_data_dir dbenv dir =
    withCString dir $ \c_str ->
    withForeignPtr dbenv $ \c_dbenv -> do
        ret <- _dbenv_set_data_dir c_dbenv c_str
        if ret /= 0
            then throwDB "dbEnv_set_data_dir" ret
            else return ()


foreign import ccall unsafe "db_helper.h _dbenv_set_lg_dir" _dbenv_set_lg_dir
    :: Ptr DbEnv_struct -> CString -> IO CInt

dbEnv_set_lg_dir :: DbEnv -> FilePath -> IO ()
dbEnv_set_lg_dir dbenv dir =
    withCString dir $ \c_str ->
    withForeignPtr dbenv $ \c_dbenv -> do
        ret <- _dbenv_set_lg_dir c_dbenv c_str
        if ret /= 0
            then throwDB "dbEnv_set_lg_dir" ret
            else return ()


foreign import ccall unsafe "db_helper.h _dbenv_toNative" _dbenv_toNative
    :: Ptr DbEnv_struct -> Ptr (Ptr DbEnv_native) -> IO CInt

data DbEnv_native
-- | Convert the Haskell handle into a native handle of type DB_ENV* which can be passed to C.
dbEnv_toNative :: DbEnv -> (Ptr DbEnv_native -> IO a) -> IO a
dbEnv_toNative dbenv code =
    alloca $ \pNative ->
    withForeignPtr dbenv $ \c_dbenv -> do
        ret <- _dbenv_toNative c_dbenv pNative
        if ret /= 0
            then throwDB "dbEnv_toNative" ret
            else code =<< peek pNative


foreign import ccall safe "db_helper.h _dbenv_get_lk_max_lockers" _dbenv_get_lk_max_lockers
    :: Ptr DbEnv_struct -> Ptr CUInt -> IO CInt

dbEnv_get_lk_max_lockers :: DbEnv -> IO Int
dbEnv_get_lk_max_lockers dbenv =
    withForeignPtr dbenv $ \c_dbenv ->
    alloca $ \ptr -> do
        ret <- _dbenv_get_lk_max_lockers c_dbenv ptr
        if ret /= 0
            then throwDB "dbEnv_get_lk_max_lockers" ret
            else do
                ci <- peek ptr
                return $ fromIntegral ci


foreign import ccall safe "db_helper.h _dbenv_set_lk_max_lockers" _dbenv_set_lk_max_lockers
    :: Ptr DbEnv_struct -> CUInt -> IO CInt

dbEnv_set_lk_max_lockers :: DbEnv -> Int -> IO ()
dbEnv_set_lk_max_lockers dbenv max =
    withForeignPtr dbenv $ \c_dbenv -> do
        ret <- _dbenv_set_lk_max_lockers c_dbenv (fromIntegral max)
        if ret /= 0
            then throwDB "dbEnv_set_lk_max_lockers" ret
            else return ()


foreign import ccall safe "db_helper.h _dbenv_get_lk_max_locks" _dbenv_get_lk_max_locks
    :: Ptr DbEnv_struct -> Ptr CUInt -> IO CInt

dbEnv_get_lk_max_locks :: DbEnv -> IO Int
dbEnv_get_lk_max_locks dbenv =
    withForeignPtr dbenv $ \c_dbenv ->
    alloca $ \ptr -> do
        ret <- _dbenv_get_lk_max_locks c_dbenv ptr
        if ret /= 0
            then throwDB "dbEnv_get_lk_max_locks" ret
            else do
                ci <- peek ptr
                return $ fromIntegral ci


foreign import ccall safe "db_helper.h _dbenv_set_lk_max_locks" _dbenv_set_lk_max_locks
    :: Ptr DbEnv_struct -> CUInt -> IO CInt

dbEnv_set_lk_max_locks :: DbEnv -> Int -> IO ()
dbEnv_set_lk_max_locks dbenv max =
    withForeignPtr dbenv $ \c_dbenv -> do
        ret <- _dbenv_set_lk_max_locks c_dbenv (fromIntegral max)
        if ret /= 0
            then throwDB "dbEnv_set_lk_max_locks" ret
            else return ()


foreign import ccall safe "db_helper.h _dbenv_get_lk_max_objects" _dbenv_get_lk_max_objects
    :: Ptr DbEnv_struct -> Ptr CUInt -> IO CInt

dbEnv_get_lk_max_objects :: DbEnv -> IO Int
dbEnv_get_lk_max_objects dbenv =
    withForeignPtr dbenv $ \c_dbenv ->
    alloca $ \ptr -> do
        ret <- _dbenv_get_lk_max_objects c_dbenv ptr
        if ret /= 0
            then throwDB "dbEnv_get_lk_max_objects" ret
            else do
                ci <- peek ptr
                return $ fromIntegral ci


foreign import ccall safe "db_helper.h _dbenv_set_lk_max_objects" _dbenv_set_lk_max_objects
    :: Ptr DbEnv_struct -> CUInt -> IO CInt

dbEnv_set_lk_max_objects :: DbEnv -> Int -> IO ()
dbEnv_set_lk_max_objects dbenv max =
    withForeignPtr dbenv $ \c_dbenv -> do
        ret <- _dbenv_set_lk_max_objects c_dbenv (fromIntegral max)
        if ret /= 0
            then throwDB "dbEnv_set_lk_max_objects" ret
            else return ()


foreign import ccall safe "db_helper.h _dbenv_get_tx_max" _dbenv_get_tx_max
    :: Ptr DbEnv_struct -> Ptr CUInt -> IO CInt

dbEnv_get_tx_max :: DbEnv -> IO Int
dbEnv_get_tx_max dbenv =
    withForeignPtr dbenv $ \c_dbenv ->
    alloca $ \ptr -> do
        ret <- _dbenv_get_tx_max c_dbenv ptr
        if ret /= 0
            then throwDB "dbEnv_get_tx_max" ret
            else do
                ci <- peek ptr
                return $ fromIntegral ci


foreign import ccall safe "db_helper.h _dbenv_set_tx_max" _dbenv_set_tx_max
    :: Ptr DbEnv_struct -> CUInt -> IO CInt

dbEnv_set_tx_max :: DbEnv -> Int -> IO ()
dbEnv_set_tx_max dbenv max =
    withForeignPtr dbenv $ \c_dbenv -> do
        ret <- _dbenv_set_tx_max c_dbenv (fromIntegral max)
        if ret /= 0
            then throwDB "dbEnv_set_tx_max" ret
            else return ()


foreign import ccall safe "db_helper.h _dbenv_get_cachesize" _dbenv_get_cachesize
    :: Ptr DbEnv_struct -> Ptr CUInt -> Ptr CUInt -> Ptr Int -> IO CInt

dbEnv_get_cache_size :: DbEnv -> IO (Int, Int, Int)
dbEnv_get_cache_size dbenv =
    withForeignPtr dbenv $ \c_dbenv ->
    alloca $ \ptr1 -> alloca $ \ptr2 -> alloca $ \ptr3 -> do
        ret <- _dbenv_get_cachesize c_dbenv ptr1 ptr2 ptr3
        if ret /= 0
            then throwDB "dbEnv_get_cache_size" ret
            else do
                c1 <- peek ptr1
                c2 <- peek ptr2
                c3 <- peek ptr3
                return $ (fromIntegral c1, fromIntegral c2, fromIntegral c3)


foreign import ccall safe "db_helper.h _dbenv_set_cachesize" _dbenv_set_cachesize
    :: Ptr DbEnv_struct -> CUInt -> CUInt -> CInt -> IO CInt

dbEnv_set_cache_size :: DbEnv -> Int -> Int -> Int -> IO ()
dbEnv_set_cache_size dbenv gbytes bytes ncache =
    withForeignPtr dbenv $ \c_dbenv -> do
        ret <- _dbenv_set_cachesize c_dbenv
                (fromIntegral gbytes) (fromIntegral bytes) (fromIntegral ncache)
        if ret /= 0
            then throwDB "dbEnv_set_cache_size" ret
            else return ()


data DbFlag =
    DB_CREATE |
    DB_DURABLE_UNKNOWN |
    DB_FORCE |
    DB_MULTIVERSION |
    DB_NOMMAP |
    DB_RDONLY |
    DB_RECOVER |
    DB_THREAD |
    DB_TRUNCATE |
    DB_TXN_NOSYNC |
    DB_TXN_NOWAIT |
    DB_TXN_NOT_DURABLE |
    DB_TXN_WRITE_NOSYNC |
    DB_TXN_SYNC |
    DB_TXN_WAIT |
    DB_IGNORE_LEASE |
    DB_AUTO_COMMIT |
    DB_READ_COMMITTED |
    DB_DEGREE_2 |
    DB_READ_UNCOMMITTED |
    DB_DIRTY_READ |
    DB_TXN_SNAPSHOT |
    DB_CXX_NO_EXCEPTIONS |
    DB_USE_ENVIRON |
    DB_USE_ENVIRON_ROOT |
    DB_INIT_CDB |
    DB_INIT_LOCK |
    DB_INIT_LOG |
    DB_INIT_MPOOL |
    DB_INIT_REP |
    DB_INIT_TXN |
    DB_LOCKDOWN |
    DB_PRIVATE |
    DB_RECOVER_FATAL |
    DB_REGISTER |
    DB_SYSTEM_MEM |
    DB_EXCL |
    DB_FCNTL_LOCKING |
    DB_NO_AUTO_COMMIT |
    DB_RDWRMASTER |
    DB_WRITEOPEN |
    DB_MULTIPLE |
    DB_MULTIPLE_KEY |
    DB_RMW |
    DB_LOCK_NOWAIT |
    DB_AFTER |
    DB_APPEND |
    DB_BEFORE |
    DB_CONSUME |
    DB_CONSUME_WAIT |
    DB_CURRENT |
    DB_FIRST |
    DB_GET_BOTH |
    DB_GET_BOTHC |
    DB_GET_BOTH_RANGE |
    DB_GET_RECNO |
    DB_JOIN_ITEM |
    DB_KEYFIRST |
    DB_KEYLAST |
    DB_LAST |
    DB_NEXT |
    DB_NEXT_DUP |
    DB_NEXT_NODUP |
    DB_NODUPDATA |
    DB_NOOVERWRITE |
    DB_NOSYNC |
    DB_POSITION |
    DB_PREV |
    DB_PREV_DUP |
    DB_PREV_NODUP |
    DB_SET |
    DB_SET_RANGE |
    DB_SET_RECNO |
    DB_UPDATE_SECONDARY |
    DB_WRITECURSOR |
    DB_WRITELOCK |
    DB_DUP |
    DB_DUPSORT


-- | Needed for BerkeleyDBXML: Binary representation of a DbFlag
dbToNum :: DbFlag -> Word32
dbToNum DB_CREATE = 1
{-# LINE 494 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_DURABLE_UNKNOWN = 32
{-# LINE 495 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_FORCE = 1
{-# LINE 496 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_MULTIVERSION = 4
{-# LINE 497 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_NOMMAP = 8
{-# LINE 498 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_RDONLY = 1024
{-# LINE 499 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_RECOVER = 2
{-# LINE 500 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_THREAD = 16
{-# LINE 501 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_TRUNCATE = 32768
{-# LINE 502 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_TXN_NOSYNC = 1
{-# LINE 503 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_TXN_NOWAIT = 2
{-# LINE 504 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_TXN_NOT_DURABLE = 2
{-# LINE 505 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_TXN_WRITE_NOSYNC = 32
{-# LINE 506 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_TXN_SYNC = 4
{-# LINE 507 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_TXN_WAIT = 128
{-# LINE 508 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_IGNORE_LEASE = 4096
{-# LINE 509 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_AUTO_COMMIT = 256
{-# LINE 510 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_READ_COMMITTED = 1024
{-# LINE 511 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_DEGREE_2 = 1024
{-# LINE 512 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_READ_UNCOMMITTED = 512
{-# LINE 513 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_DIRTY_READ = 512
{-# LINE 514 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_TXN_SNAPSHOT = 16
{-# LINE 515 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_CXX_NO_EXCEPTIONS = 2
{-# LINE 516 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_USE_ENVIRON = 4
{-# LINE 517 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_USE_ENVIRON_ROOT = 8
{-# LINE 518 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_INIT_CDB = 64
{-# LINE 519 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_INIT_LOCK = 128
{-# LINE 520 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_INIT_LOG = 256
{-# LINE 521 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_INIT_MPOOL = 512
{-# LINE 522 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_INIT_REP = 1024
{-# LINE 523 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_INIT_TXN = 2048
{-# LINE 524 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_LOCKDOWN = 4096
{-# LINE 525 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_PRIVATE = 16384
{-# LINE 526 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_RECOVER_FATAL = 32768
{-# LINE 527 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_REGISTER = 65536
{-# LINE 528 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_SYSTEM_MEM = 131072
{-# LINE 529 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_EXCL = 64
{-# LINE 530 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_FCNTL_LOCKING = 2048
{-# LINE 531 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_NO_AUTO_COMMIT = 8192
{-# LINE 532 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_RDWRMASTER = 16384
{-# LINE 533 "Database/Berkeley/Db.hsc" #-}
dbToNum	DB_WRITEOPEN = 65536
{-# LINE 534 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_MULTIPLE = 2048
{-# LINE 535 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_MULTIPLE_KEY = 16384
{-# LINE 536 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_RMW = 8192
{-# LINE 537 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_LOCK_NOWAIT = 2
{-# LINE 538 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_AFTER = (1)                   -- Dbc.put
{-# LINE 539 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_APPEND = (2)                 -- Db.put
{-# LINE 540 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_BEFORE = (3)                 -- Dbc.put
{-# LINE 541 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_CONSUME = (4)               -- Db.get
{-# LINE 542 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_CONSUME_WAIT = (5)     -- Db.get
{-# LINE 543 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_CURRENT = (6)               -- Dbc.get, Dbc.put, DbLogc.get
{-# LINE 544 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_FIRST = (7)                   -- Dbc.get, DbLogc->get
{-# LINE 545 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_GET_BOTH = (8)             -- Db.get, Dbc.get
{-# LINE 546 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_GET_BOTHC = (9)           -- Dbc.get (internal)
{-# LINE 547 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_GET_BOTH_RANGE = (10) -- Db.get, Dbc.get
{-# LINE 548 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_GET_RECNO = (11)           -- Dbc.get
{-# LINE 549 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_JOIN_ITEM = (12)           -- Dbc.get; don't do primary lookup
{-# LINE 550 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_KEYFIRST = (13)             -- Dbc.put
{-# LINE 551 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_KEYLAST = (14)               -- Dbc.put
{-# LINE 552 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_LAST = (15)                     -- Dbc.get, DbLogc->get
{-# LINE 553 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_NEXT = (16)                     -- Dbc.get, DbLogc->get
{-# LINE 554 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_NEXT_DUP = (17)             -- Dbc.get
{-# LINE 555 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_NEXT_NODUP = (18)         -- Dbc.get
{-# LINE 556 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_NODUPDATA = (19)           -- Db.put, Dbc.put
{-# LINE 557 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_NOOVERWRITE = (20)       -- Db.put
{-# LINE 558 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_NOSYNC = (1)                 -- Db.close
{-# LINE 559 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_POSITION = (22)             -- Dbc.dup
{-# LINE 560 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_PREV = (23)                     -- Dbc.get, DbLogc->get
{-# LINE 561 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_PREV_DUP = (24)             -- Dbc.get
{-# LINE 562 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_PREV_NODUP = (25)         -- Dbc.get
{-# LINE 563 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_SET = (26)                       -- Dbc.get, DbLogc->get
{-# LINE 564 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_SET_RANGE = (27)           -- Dbc.get
{-# LINE 565 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_SET_RECNO = (28)           -- Db.get, Dbc.get
{-# LINE 566 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_UPDATE_SECONDARY = (29) -- Dbc.get, Dbc.del (internal)
{-# LINE 567 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_WRITECURSOR = (8)       -- Db.cursor
{-# LINE 568 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_WRITELOCK = (32)           -- Db.cursor (internal)
{-# LINE 569 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_DUP = (16)                       -- Db.set_flags
{-# LINE 570 "Database/Berkeley/Db.hsc" #-}
dbToNum DB_DUPSORT = (4)               -- Db.set_flags
{-# LINE 571 "Database/Berkeley/Db.hsc" #-}

dbOrFlags :: [DbFlag] -> Word32
dbOrFlags flags = foldr (.|.) 0 $ map dbToNum flags


foreign import ccall safe "db_helper.h _dbenv_open" _dbenv_open
    :: Ptr DbEnv_struct -> CString -> Word32 -> CInt -> IO CInt

-- | Open the Berkeley DB environment, which must be done before 'db_open'.
dbEnv_open :: [DbFlag]
           -> Int        -- ^ UNIX file creation mode, or 0, meaning \"readable and writable by both owner and group\"
           -> DbEnv
           -> FilePath   -- ^ Database environment's home directory
           -> IO ()
dbEnv_open flags mode dbenv db_home =
    withForeignPtr dbenv $ \c_dbenv ->
    withCAString db_home $ \c_db_home -> do
        ret <- _dbenv_open c_dbenv c_db_home (dbOrFlags flags) (fromIntegral mode)
        if ret /= 0
            then throwDB "dbEnv_open" ret
            else return ()

foreign import ccall "db_helper.h _dbenv_close" _dbenv_close
    :: Ptr DbEnv_struct -> Word32 -> IO CInt

-- | Close the Berkeley DB environment.
dbEnv_close :: [DbFlag] -> DbEnv -> IO ()
dbEnv_close flags dbenv =
    withForeignPtr dbenv $ \c_dbenv -> do
        ret <- _dbenv_close c_dbenv (dbOrFlags flags)
        if ret /= 0
            then throwDB "dbEnv_close" ret
            else return ()


data DbLockFlag =
    DB_LOCK_NORUN |
    DB_LOCK_DEFAULT |
    DB_LOCK_EXPIRE |
    DB_LOCK_MAXLOCKS |
    DB_LOCK_MAXWRITE |
    DB_LOCK_MINLOCKS |
    DB_LOCK_MINWRITE |
    DB_LOCK_OLDEST |
    DB_LOCK_RANDOM |
    DB_LOCK_YOUNGEST

dbLockToNum DB_LOCK_NORUN = 0
{-# LINE 619 "Database/Berkeley/Db.hsc" #-}
dbLockToNum DB_LOCK_DEFAULT = 1
{-# LINE 620 "Database/Berkeley/Db.hsc" #-}
dbLockToNum DB_LOCK_EXPIRE = 2
{-# LINE 621 "Database/Berkeley/Db.hsc" #-}
dbLockToNum DB_LOCK_MAXLOCKS = 3
{-# LINE 622 "Database/Berkeley/Db.hsc" #-}
dbLockToNum DB_LOCK_MAXWRITE = 4
{-# LINE 623 "Database/Berkeley/Db.hsc" #-}
dbLockToNum DB_LOCK_MINLOCKS = 5
{-# LINE 624 "Database/Berkeley/Db.hsc" #-}
dbLockToNum DB_LOCK_MINWRITE = 6
{-# LINE 625 "Database/Berkeley/Db.hsc" #-}
dbLockToNum DB_LOCK_OLDEST = 7
{-# LINE 626 "Database/Berkeley/Db.hsc" #-}
dbLockToNum DB_LOCK_RANDOM = 8
{-# LINE 627 "Database/Berkeley/Db.hsc" #-}
dbLockToNum DB_LOCK_YOUNGEST = 9
{-# LINE 628 "Database/Berkeley/Db.hsc" #-}

foreign import ccall "db_helper.h _dbenv_set_lk_detect" _dbenv_set_lk_detect
    :: Ptr DbEnv_struct -> CUInt -> IO CInt

-- | Start the Berkeley DB lock detector.
dbEnv_set_lk_detect :: DbEnv -> DbLockFlag -> IO ()
dbEnv_set_lk_detect dbenv flag =
    withForeignPtr dbenv $ \c_dbenv -> do
        ret <- _dbenv_set_lk_detect c_dbenv (dbLockToNum flag)
        if ret /= 0
            then throwDB "dbEnv_set_lk_detect" ret
            else return ()

foreign import ccall "db_helper.h _dbenv_set_flags" _dbenv_set_flags
    :: Ptr DbEnv_struct -> Word32 -> CInt -> IO CInt

dbEnv_set_flags :: DbEnv
                -> [DbFlag]   -- ^ environment flags
                -> Bool       -- ^ onoff: False to clear the specified flags, True to set them
                -> IO ()
dbEnv_set_flags dbenv flags onoff =
    withForeignPtr dbenv $ \c_dbenv -> do
        ret <- _dbenv_set_flags c_dbenv (dbOrFlags flags) (if onoff then 1 else 0)
        if ret /= 0
            then throwDB "dbEnv_set_flags" ret
            else return ()


------ Logging subsystem -------------------------------------------------------


{-# LINE 659 "Database/Berkeley/Db.hsc" #-}
data DbLogFlag
    = DB_LOG_DIRECT
    | DB_LOG_DSYNC
    | DB_LOG_AUTO_REMOVE
    | DB_LOG_IN_MEMORY
    | DB_LOG_ZERO
dbLogToNum :: DbLogFlag -> Word32
dbLogToNum DB_LOG_DIRECT = (2)
{-# LINE 667 "Database/Berkeley/Db.hsc" #-}
dbLogToNum DB_LOG_DSYNC = (4)
{-# LINE 668 "Database/Berkeley/Db.hsc" #-}
dbLogToNum DB_LOG_AUTO_REMOVE = (1)
{-# LINE 669 "Database/Berkeley/Db.hsc" #-}
dbLogToNum DB_LOG_IN_MEMORY = (8)
{-# LINE 670 "Database/Berkeley/Db.hsc" #-}
dbLogToNum DB_LOG_ZERO = (16)
{-# LINE 671 "Database/Berkeley/Db.hsc" #-}

dbLogOrFlags :: [DbLogFlag] -> Word32
dbLogOrFlags flags = foldr (.|.) 0 $ map dbLogToNum flags

foreign import ccall "db_helper.h _dbenv_log_set_config" _dbenv_log_set_config
    :: Ptr DbEnv_struct -> Word32 -> CInt -> IO CInt

dbEnv_log_set_config :: DbEnv
                     -> [DbLogFlag]
                     -> Bool       -- ^ onoff: False to clear the specified flags, True to set them
                     -> IO ()
dbEnv_log_set_config dbenv flags onoff =
    withForeignPtr dbenv $ \c_dbenv -> do
        ret <- _dbenv_log_set_config c_dbenv (dbLogOrFlags flags) (if onoff then 1 else 0)
        if ret /= 0
            then throwDB "dbEnv_log_set_config" ret
            else return ()

{-# LINE 689 "Database/Berkeley/Db.hsc" #-}

foreign import ccall safe "db_helper.h _dbenv_get_lg_regionmax" _dbenv_get_lg_regionmax
    :: Ptr DbEnv_struct -> Ptr CUInt -> IO CInt

dbEnv_get_lg_regionmax :: DbEnv -> IO Int
dbEnv_get_lg_regionmax dbenv =
    withForeignPtr dbenv $ \c_dbenv ->
    alloca $ \ptr -> do
        ret <- _dbenv_get_lg_regionmax c_dbenv ptr
        if ret /= 0
            then throwDB "dbEnv_get_lg_regionmax" ret
            else do
                ci <- peek ptr
                return $ fromIntegral ci

foreign import ccall safe "db_helper.h _dbenv_set_lg_regionmax" _dbenv_set_lg_regionmax
    :: Ptr DbEnv_struct -> CUInt -> IO CInt

dbEnv_set_lg_regionmax :: DbEnv -> Int -> IO ()
dbEnv_set_lg_regionmax dbenv max =
    withForeignPtr dbenv $ \c_dbenv -> do
        ret <- _dbenv_set_lg_regionmax c_dbenv (fromIntegral max)
        if ret /= 0
            then throwDB "dbEnv_set_lg_regionmax" ret
            else return ()


------ Db ----------------------------------------------------------------------

data Db_struct
type Db = ForeignPtr Db_struct
foreign import ccall "db_helper.h &_db_delete" _db_delete
    :: FunPtr (Ptr Db_struct -> IO ())


foreign import ccall safe "db_helper.h _db_create" _db_create
    ::  Ptr (Ptr Db_struct) -> Ptr DbEnv_struct -> Word32 -> IO CInt

-- | Create a database handle.
db_create :: [DbFlag] -> DbEnv -> IO Db
db_create flags dbenv =
    withForeignPtr dbenv $ \c_dbenv ->
    alloca $ \ptr -> do
        ret <- _db_create ptr c_dbenv (dbOrFlags flags)
        if ret /= 0
            then throwDB "db_create" ret
            else do
                p <- peek ptr
                newForeignPtr _db_delete p


foreign import ccall safe "db_helper.h _db_set_pagesize" _db_set_pagesize
    :: Ptr Db_struct -> CUInt -> IO CInt

db_set_pagesize :: Db -> Int -> IO ()
db_set_pagesize db size =
    withForeignPtr db $ \c_db -> do
        ret <- _db_set_pagesize c_db (fromIntegral size)
        if ret /= 0
            then throwDB "db_set_pagesize" ret
            else return ()

data DbType = DB_BTREE | DB_HASH | DB_RECNO | DB_QUEUE | DB_UNKNOWN

dbTypeToNum DB_BTREE = 1
dbTypeToNum DB_HASH = 2
dbTypeToNum DB_RECNO = 3
dbTypeToNum DB_QUEUE = 4
dbTypeToNum DB_UNKNOWN = 5

-- | Needed for BerkeleyDBXML: C pointer type for a DbTxn
data DbTxn_struct
type DbTxn = ForeignPtr DbTxn_struct
foreign import ccall "db_helper.h &_dbtxn_delete" _dbtxn_delete
    :: FunPtr (Ptr DbTxn_struct -> IO ())


foreign import ccall "db_helper.h _db_open" _db_open
    :: Ptr Db_struct -> Ptr DbTxn_struct -> CString -> CString -> CInt -> Word32 -> CInt -> IO CInt

-- | Open a database.
db_open :: [DbFlag]
        -> DbType
        -> Int          -- ^ Unix file creation mode, or 0, meaning \"readable and writable by both owner and group\"
        -> Db
        -> Maybe DbTxn
        -> FilePath     -- ^ Filename
        -> Maybe String -- ^ Optional name of database within the file
        -> IO ()
db_open flags typ mode db mTxn file mDatabase =
    withCAString file$ \c_file ->
    withForeignPtr db $ \c_db -> do
        ret <- case mTxn of
            Just dbtxn ->
                withForeignPtr dbtxn$ \c_dbtxn ->
                case mDatabase of
                    Just database ->
                        withCAString database$ \c_database ->
                        _db_open c_db c_dbtxn c_file c_database
                            (dbTypeToNum typ) (dbOrFlags flags) (fromIntegral mode)
                    Nothing ->
                        _db_open c_db c_dbtxn c_file nullPtr
                            (dbTypeToNum typ) (dbOrFlags flags) (fromIntegral mode)
            Nothing ->
                case mDatabase of
                    Just database ->
                        withCAString database$ \c_database ->
                        _db_open c_db nullPtr c_file c_database
                            (dbTypeToNum typ) (dbOrFlags flags) (fromIntegral mode)
                    Nothing ->
                        _db_open c_db nullPtr c_file nullPtr
                            (dbTypeToNum typ) (dbOrFlags flags) (fromIntegral mode)
        if ret /= 0
            then throwDB ("db_open file="++(show file)++" database="++(show mDatabase)) ret
            else return ()


foreign import ccall "db_helper.h _dbenv_txn_begin" _dbenv_txn_begin
    :: Ptr DbEnv_struct -> Ptr DbTxn_struct -> Ptr (Ptr DbTxn_struct) -> Word32 -> IO CInt

-- | Create a new transaction. You are recommended to use 'dbEnv_withTxn'
-- instead of this function.
dbEnv_txn_begin :: [DbFlag]
                -> DbEnv
                -> Maybe DbTxn -- ^ Optional parent transaction
                -> IO DbTxn
dbEnv_txn_begin flags dbenv mParent =
    withForeignPtr dbenv $ \c_dbenv ->
    alloca $ \ptr -> do
        ret <- case mParent of
            Nothing -> do
                _dbenv_txn_begin c_dbenv nullPtr ptr (dbOrFlags flags)
            Just parent ->
                withForeignPtr parent$ \c_parent -> do
                    _dbenv_txn_begin c_dbenv c_parent ptr (dbOrFlags flags)
        if ret /= 0
            then throwDB "dbEnv_txn_begin" ret
            else do
                p <- peek ptr
                newForeignPtr _dbtxn_delete p

-- | An exception-safe helper that runs an action inside a transaction.
-- It will commit on completion, or abort if an exception is thrown.
dbEnv_withTxn :: [DbFlag]     -- ^ 'dbEnv_txn_begin' flags
              -> [DbFlag]     -- ^ 'dbTxn_commit' flags
              -> DbEnv
              -> Maybe DbTxn  -- ^ Parent transaction
              -> (DbTxn -> IO a)  -- ^ The action to run inside a transaction
              -> IO a
dbEnv_withTxn flags1 flags2 env mTxn action = do
    bracketOnError
        (dbEnv_txn_begin flags1 env mTxn)
        dbTxn_abort
        $ \txn -> do
            retValue <- action txn
            dbTxn_commit flags2 txn
            return retValue

foreign import ccall "db_helper.h _dbenv_txn_checkpoint" _dbenv_txn_checkpoint
    :: Ptr DbEnv_struct -> CUInt -> CUInt -> Word32 -> IO CInt

-- | Checkpoint the transaction subsystem.
dbEnv_txn_checkpoint :: [DbFlag]
                     -> DbEnv
                     -> Word -- ^ kbyte
                     -> Word -- ^ minutes
                     -> IO ()
dbEnv_txn_checkpoint flags dbenv kbyte min =
    withForeignPtr dbenv $ \c_dbenv -> do
        ret <- _dbenv_txn_checkpoint c_dbenv (fromIntegral kbyte) (fromIntegral min) (dbOrFlags flags)
        if ret /= 0
            then throwDB "dbEnv_txn_checkpoint" ret
            else return ()


foreign import ccall "db_helper.h _dbtxn_abort" _dbtxn_abort
    :: Ptr DbTxn_struct -> IO CInt

-- | Abort a transaction, rolling back any writes that were made. You are
-- recommended to use 'dbEnv_withTxn' instead of this function.
dbTxn_abort :: DbTxn -> IO ()
dbTxn_abort dbtxn = do
    withForeignPtr dbtxn $ \c_dbtxn -> do
        ret <- _dbtxn_abort c_dbtxn
        if ret /= 0
            then throwDB "dbTxn_abort" ret
            else return ()


foreign import ccall "db_helper.h _dbtxn_commit" _dbtxn_commit
    :: Ptr DbTxn_struct -> Word32 -> IO CInt

-- | Commit a transaction. You are recommended to use 'dbEnv_withTxn'
-- instead of this function.
dbTxn_commit :: [DbFlag] -> DbTxn -> IO ()
dbTxn_commit flags dbtxn = do
    withForeignPtr dbtxn $ \c_dbtxn -> do
        ret <- _dbtxn_commit c_dbtxn (dbOrFlags flags)
        if ret /= 0
            then throwDB "dbTxn_commit" ret
            else return ()

newtype DbLocker = DbLocker CUInt


foreign import ccall "db_helper.h _dbtxn_id" _dbtxn_id
    :: Ptr DbTxn_struct -> Ptr CUInt -> IO CInt

-- | Get the locker ID for a transaction, which can be used with 'dbEnv_withLock'.
dbTxn_id :: DbTxn -> IO DbLocker
dbTxn_id dbtxn =
    withForeignPtr dbtxn $ \c_dbtxn ->
    alloca $ \ptr -> do
        ret <- _dbtxn_id c_dbtxn ptr
        if ret /= 0
            then throwDB "dbTxn_id" ret
            else DbLocker <$> peek ptr

data DbLockMode = DB_LOCK_READ | DB_LOCK_WRITE | DB_LOCK_IWRITE | DB_LOCK_IREAD | DB_LOCK_IWR

dbLockModeToNum DB_LOCK_READ = 1
{-# LINE 910 "Database/Berkeley/Db.hsc" #-}
dbLockModeToNum DB_LOCK_WRITE = 2
{-# LINE 911 "Database/Berkeley/Db.hsc" #-}
dbLockModeToNum DB_LOCK_IWRITE = 4
{-# LINE 912 "Database/Berkeley/Db.hsc" #-}
dbLockModeToNum DB_LOCK_IREAD = 5
{-# LINE 913 "Database/Berkeley/Db.hsc" #-}
dbLockModeToNum DB_LOCK_IWR = 6
{-# LINE 914 "Database/Berkeley/Db.hsc" #-}

data DbLock_struct
type DbLock = ForeignPtr DbLock_struct
foreign import ccall "db_helper.h &_dblock_delete" _dblock_delete
    :: FunPtr (Ptr DbLock_struct -> IO ())


foreign import ccall "db_helper.h _dbenv_lock_get" _dbenv_lock_get
    :: Ptr DbEnv_struct -> CUInt -> Word32 -> Ptr Word8 -> CUInt -> Word32 -> Ptr (Ptr DbLock_struct) -> IO CInt

-- | Acquire a DbLock. 'dbTxn_id' converts a DbTxn to a DbLocker.
dbEnv_lock_get :: [DbFlag]
               -> DbLockMode
               -> ByteString  -- ^ Object, which is a key that identifies this lock
               -> DbEnv
               -> DbLocker    -- ^ The identity of the locker.
               -> IO DbLock
dbEnv_lock_get flags lockMode object dbenv (DbLocker locker) =
    withForeignPtr dbenv $ \c_dbenv ->
    alloca $ \ptr ->
    withByteString object$ \c_object object_len -> do
        ret <- _dbenv_lock_get c_dbenv locker (dbOrFlags flags) c_object
                    (fromIntegral object_len) (dbLockModeToNum lockMode) ptr
        if ret /= 0
            then throwDB "dbEnv_lock_get" ret
            else do
                p <- peek ptr
                newForeignPtr _dblock_delete p


foreign import ccall "db_helper.h _dbenv_lock_put" _dbenv_lock_put
    :: Ptr DbLock_struct -> IO CInt

-- | Release a DbLock acquired by dbEnv_lock_get.
dbEnv_lock_put :: DbLock -> IO ()
dbEnv_lock_put dblock =
    withForeignPtr dblock$ \c_dblock -> do
        ret <- _dbenv_lock_put c_dblock
        if ret /= 0
            then throwDB "dbEnv_lock_put" ret
            else return ()


-- | Wrap dbEnv_lock_get / dbEnv_lock_put around the specified computation.
--  'dbTxn_id' converts a DbTxn to a DbLocker.
dbEnv_withLock :: [DbFlag]
               -> DbLockMode
               -> ByteString -- ^ Object, which is an environment-wide key that identifies this lock
               -> DbEnv
               -> DbLocker   -- ^ The identity of the locker.
               -> IO a      -- ^ Computation to perform under lock
               -> IO a
dbEnv_withLock flags lockMode object dbEnv locker computation = do
    bracket
        (dbEnv_lock_get flags lockMode object dbEnv locker)  -- acquire
        dbEnv_lock_put                                       -- release
        (\_ -> computation)


foreign import ccall unsafe "db_helper.h _freeString" _freeString
    :: CString -> IO ()

foreign import ccall unsafe "db_helper.h &_freeString" _freeString_finalizer
    :: FunPtr (Ptr Word8 -> IO ())

foreign import ccall "db_helper.h _db_get" _db_get
    :: Ptr Db_struct -> Ptr DbTxn_struct -> Ptr Word8 -> CUInt -> Ptr (Ptr Word8) -> Ptr CUInt -> Word32 -> IO CInt

-- | Look the key up in the database, and return Just the stored value, or Nothing
-- if it was not found.
db_get :: [DbFlag]
       -> Db
       -> Maybe DbTxn
       -> ByteString    -- ^ Key
       -> IO (Maybe ByteString)
db_get flags db mTxn key =
    alloca $ \ptr1 ->
    alloca $ \ptr2 ->
    withByteString key $ \c_key key_len ->
    withForeignPtr db $ \c_db -> do
        ret <- case mTxn of
            Nothing ->
                _db_get c_db nullPtr c_key (fromIntegral key_len) ptr1 ptr2 (dbOrFlags flags)
            Just txn ->
                withForeignPtr txn$ \c_txn ->
                _db_get c_db c_txn   c_key (fromIntegral key_len) ptr1 ptr2 (dbOrFlags flags)
        if ret /= 0
            then
                if (dbErrFromNum$ fromIntegral ret) == DB_NOTFOUND
                    then return Nothing
                    else throwDB "db_get" ret
            else do
                c_value <- peek ptr1
                value_len <- peek ptr2
                str <- newForeignPtr _freeString_finalizer c_value
                return $ Just $ BSI.fromForeignPtr str 0 (fromIntegral value_len)


foreign import ccall "db_helper.h _db_put" _db_put
    :: Ptr Db_struct -> Ptr DbTxn_struct -> Ptr Word8 -> CUInt -> Ptr Word8 -> CUInt -> Word32 -> IO CInt

-- | Store the specified value into the database under the specified key.
db_put :: [DbFlag]
       -> Db
       -> Maybe DbTxn
       -> ByteString    -- ^ Key
       -> ByteString    -- ^ Value
       -> IO ()
db_put flags db mTxn key value =
    withByteString key $ \c_key key_len ->
    withByteString value $ \c_value value_len ->
    withForeignPtr db $ \c_db -> do
        ret <- case mTxn of
            Nothing ->
                _db_put c_db nullPtr c_key (fromIntegral key_len)
                    c_value (fromIntegral value_len) (dbOrFlags flags)
            Just txn ->
                withForeignPtr txn$ \c_txn ->
                _db_put c_db c_txn   c_key (fromIntegral key_len)
                    c_value (fromIntegral value_len) (dbOrFlags flags)
        if ret /= 0
            then throwDB "db_put" ret
            else return ()

withByteString :: ByteString -> (Ptr Word8 -> Int -> IO a) -> IO a
withByteString bs code = do
    let (fp, fp_offset, length) = BSI.toForeignPtr bs
    withForeignPtr fp $ \c_fp ->
        code (c_fp `plusPtr` fp_offset) length


foreign import ccall "db_helper.h _db_del" _db_del
    :: Ptr Db_struct -> Ptr DbTxn_struct -> Ptr Word8 -> CUInt -> Word32 -> IO CInt

db_del :: [DbFlag] -> Db -> Maybe DbTxn -> ByteString -> IO ()
db_del flags db mTxn key =
    withByteString key $ \c_key key_len ->
    withForeignPtr db $ \c_db -> do
        ret <- case mTxn of
            Nothing ->
                _db_del c_db nullPtr c_key (fromIntegral key_len) (dbOrFlags flags)
            Just txn ->
                withForeignPtr txn$ \c_txn ->
                _db_del c_db c_txn   c_key (fromIntegral key_len) (dbOrFlags flags)
        if ret /= 0
            then throwDB "db_del" ret
            else return ()


foreign import ccall "db_helper.h _db_close" _db_close
    :: Ptr Db_struct -> Word32 -> IO CInt

db_close :: [DbFlag] -> Db -> IO ()
db_close flags db =
    withForeignPtr db $ \c_db -> do
        ret <- _db_close c_db (dbOrFlags flags)
        if ret /= 0
            then throwDB "db_close" ret
            else return ()

foreign import ccall "db_helper.h _db_set_flags" _db_set_flags
    :: Ptr Db_struct -> Word32 -> IO CInt

db_set_flags :: [DbFlag] -> Db -> IO ()
db_set_flags flags db =
    withForeignPtr db $ \c_db -> do
        ret <- _db_set_flags c_db (dbOrFlags flags)
        if ret /= 0
            then throwDB "db_set_flags" ret
            else return ()

foreign import ccall "db_helper.h _db_sync" _db_sync
    :: Ptr Db_struct -> Word32 -> IO CInt

db_sync :: [DbFlag] -> Db -> IO ()
db_sync flags db = do
    withForeignPtr db $ \c_db -> do
        ret <- _db_sync c_db (dbOrFlags flags)
        if ret /= 0
            then throwDB "db_sync" ret
            else return ()

------ DbCursor ----------------------------------------------------------------

data DbCursor_struct
type DbCursor = ForeignPtr DbCursor_struct
foreign import ccall "db_helper.h &_dbcursor_delete" _dbcursor_delete
    :: FunPtr (Ptr DbCursor_struct -> IO ())

-- | An exception-safe helper that creates a cursor, passes it to an action, and
-- cleans up afterwards.
db_withCursor :: [DbFlag]            -- ^ 'db_cursor' flags
              -> Db
              -> Maybe DbTxn         -- ^ Optional tansaction
              -> (DbCursor -> IO a)  -- ^ The action that operates on the cursor
              -> IO a
db_withCursor flags db mTxn action = do
    bracket
        (db_cursor flags db mTxn)
        dbCursor_close
        action

foreign import ccall "db_helper.h _db_cursor" _db_cursor
    :: Ptr Db_struct -> Ptr DbTxn_struct -> Ptr (Ptr DbCursor_struct) -> Word32 -> IO CInt

-- | Open a DbCursor.  You are recommended to use 'db_withCursor' instead of this
-- function.
db_cursor :: [DbFlag] -> Db -> Maybe DbTxn -> IO DbCursor
db_cursor flags db mTxn =
    withForeignPtr db $ \c_db ->
    alloca $ \pc_cursor -> do
        ret <- case mTxn of
            Nothing ->
                _db_cursor c_db nullPtr pc_cursor (dbOrFlags flags)
            Just txn ->
                withForeignPtr txn $ \c_txn ->
                _db_cursor c_db c_txn   pc_cursor (dbOrFlags flags)
        if ret /= 0
            then throwDB "db_cursor" ret
            else newForeignPtr _dbcursor_delete =<< peek pc_cursor

foreign import ccall "db_helper.h _dbCursor_close" _dbCursor_close
    :: Ptr DbCursor_struct -> IO CInt

-- | Close a DBCursor. You are recommended to use 'db_withCursor' instead of this
-- function.
dbCursor_close :: DbCursor -> IO ()
dbCursor_close dbc =
    withForeignPtr dbc $ \c_dbc -> do
        ret <- _dbCursor_close c_dbc
        if ret /= 0
            then throwDB "dbCursor_close" ret
            else return ()

foreign import ccall "db_helper.h _dbCursor_count" _dbCursor_count
    :: Ptr DbCursor_struct -> Ptr CUInt -> Word32 -> IO CInt

-- | Count the number of duplicates at the cursor position.
dbCursor_count :: [DbFlag] -> DbCursor -> IO Int
dbCursor_count flags dbc =
    withForeignPtr dbc $ \c_dbc ->
    alloca $ \p_count -> do
        ret <- _dbCursor_count c_dbc p_count (dbOrFlags flags)
        if ret /= 0
            then throwDB "dbCursor_count" ret
            else fromIntegral <$> peek p_count

foreign import ccall "db_helper.h _dbCursor_del" _dbCursor_del
    :: Ptr DbCursor_struct -> Word32 -> IO CInt

-- | Delete the record at the cursor position.
dbCursor_del :: [DbFlag] -> DbCursor -> IO ()
dbCursor_del flags dbc =
    withForeignPtr dbc $ \c_dbc -> do
        ret <- _dbCursor_del c_dbc (dbOrFlags flags)
        if ret /= 0
            then throwDB "dbCursor_del" ret
            else return ()

-- | An exception-safe helper that duplicates a cursor using 'dbCursor_dup',
-- passes it to an action, and cleans up afterwards.
dbCursor_withCursor :: [DbFlag]           -- ^ 'db_cursor' flags
                    -> DbCursor           -- ^ The source cursor
                    -> (DbCursor -> IO a) -- ^ The action that operates on the cursor
                    -> IO a
dbCursor_withCursor flags cur action = do
    bracket
        (dbCursor_dup flags cur)
        dbCursor_close
        action

foreign import ccall "db_helper.h _dbCursor_dup" _dbCursor_dup
    :: Ptr DbCursor_struct -> Ptr (Ptr DbCursor_struct) -> Word32 -> IO CInt

-- | Create a duplicate of the specified cursor.
dbCursor_dup :: [DbFlag] -> DbCursor -> IO DbCursor
dbCursor_dup flags dbc =
    withForeignPtr dbc $ \c_dbc ->
    alloca $ \pc_cursor -> do
        ret <- _dbCursor_dup c_dbc pc_cursor (dbOrFlags flags)
        if ret /= 0
            then throwDB "dbCursor_dup" ret
            else newForeignPtr _dbcursor_delete =<< peek pc_cursor

foreign import ccall "db_helper.h _dbCursor_get" _dbCursor_get
    :: Ptr DbCursor_struct -> Ptr (Ptr Word8) -> Ptr CUInt -> Ptr (Ptr Word8) -> Ptr CUInt -> Word32 -> IO CInt

-- | Fetch the record pointed at by the cursor (modified by the flags - see the
-- Berkeley DB documentation), and return Just the (key, value) pair at the cursor
-- position, or Nothing if no record was found.
dbCursor_get :: [DbFlag] -> DbCursor -> IO (Maybe (ByteString, ByteString))
dbCursor_get flags cur =
    alloca $ \ptr1 ->
    alloca $ \ptr2 ->
    alloca $ \ptr3 ->
    alloca $ \ptr4 ->
    withForeignPtr cur $ \c_cur -> do
        ret <- _dbCursor_get c_cur ptr1 ptr2 ptr3 ptr4 (dbOrFlags flags)
        if ret /= 0
            then
                if (dbErrFromNum$ fromIntegral ret) == DB_NOTFOUND
                    then return Nothing
                    else throwDB "dbCursor_get" ret
            else do
                c_key <- peek ptr1
                key_len <- peek ptr2
                key <- newForeignPtr _freeString_finalizer c_key
                c_value <- peek ptr3
                value_len <- peek ptr4
                value <- newForeignPtr _freeString_finalizer c_value
                return $ Just
                    (BSI.fromForeignPtr key 0 (fromIntegral key_len),
                     BSI.fromForeignPtr value 0 (fromIntegral value_len))

foreign import ccall "db_helper.h _dbCursor_set" _dbCursor_set
    :: Ptr DbCursor_struct -> Ptr Word8 -> CUInt -> Ptr (Ptr Word8) -> Ptr CUInt -> Ptr (Ptr Word8) -> Ptr CUInt -> Word32 -> IO CInt

-- | Move the cursor to the specified key/data pair of the database, and return
-- the datum associated with the given key, or Nothing if it wasn't matched.
-- (This is DBC->get with the DB_SET flag. The DB_SET flag is implied.)
dbCursor_set :: [DbFlag] -> DbCursor -> ByteString -> IO (Maybe ByteString)
dbCursor_set flags cur key =
    withByteString key $ \c_key key_len ->
    alloca $ \ptr1 ->
    alloca $ \ptr2 ->
    withForeignPtr cur $ \c_cur -> do
        ret <- _dbCursor_set c_cur c_key (fromIntegral key_len) nullPtr nullPtr ptr1 ptr2 (dbOrFlags (DB_SET:flags))
        if ret /= 0
            then
                if (dbErrFromNum$ fromIntegral ret) == DB_NOTFOUND
                    then return Nothing
                    else throwDB "dbCursor_set" ret
            else do
                c_value <- peek ptr1
                value_len <- peek ptr2
                str <- newForeignPtr _freeString_finalizer c_value
                return $ Just $ BSI.fromForeignPtr str 0 (fromIntegral value_len)

-- | Move the cursor to the specified key/data pair of the database, and return
-- the next record (key, value) where the key is greater than or equal to
-- the specified key, or Nothing if no such record was found.
-- (This is DBC->get with the DB_SET_RANGE flag. The DB_SET_RANGE flag is implied.)
dbCursor_set_range :: [DbFlag] -> DbCursor -> ByteString -> IO (Maybe (ByteString, ByteString))
dbCursor_set_range flags cur key =
    withByteString key $ \c_key key_len ->
    alloca $ \ptr1 ->
    alloca $ \ptr2 ->
    alloca $ \ptr3 ->
    alloca $ \ptr4 ->
    withForeignPtr cur $ \c_cur -> do
        ret <- _dbCursor_set c_cur c_key (fromIntegral key_len) ptr1 ptr2 ptr3 ptr4 (dbOrFlags (DB_SET_RANGE:flags))
        if ret /= 0
            then
                if (dbErrFromNum$ fromIntegral ret) == DB_NOTFOUND
                    then return Nothing
                    else throwDB "dbCursor_set" ret
            else do
                c_key <- peek ptr1
                key_len <- peek ptr2
                key_str <- newForeignPtr _freeString_finalizer c_key
                c_value <- peek ptr3
                value_len <- peek ptr4
                value_str <- newForeignPtr _freeString_finalizer c_value
                return $ Just (BSI.fromForeignPtr key_str 0 (fromIntegral key_len),
                               BSI.fromForeignPtr value_str 0 (fromIntegral value_len))

foreign import ccall "db_helper.h _dbCursor_put" _dbCursor_put
    :: Ptr DbCursor_struct -> Ptr Word8 -> CUInt -> Ptr Word8 -> CUInt -> Word32 -> IO CInt

-- | stores key/data pairs into the database in the context of the cursor.
dbCursor_put :: [DbFlag] -> DbCursor -> ByteString -> ByteString -> IO ()
dbCursor_put flags cur key value =
    withByteString key $ \c_key key_len ->
    withByteString value $ \c_value value_len ->
    withForeignPtr cur $ \c_cur -> do
        ret <- _dbCursor_put c_cur c_key (fromIntegral key_len)
            c_value (fromIntegral value_len) (dbOrFlags flags)
        if ret /= 0
            then throwDB "dbCursor_put" ret
            else return ()