{-# LINE 1 "Database/TokyoCabinet/HDB/C.hsc" #-}
{-# LANGUAGE ForeignFunctionInterface, EmptyDataDecls #-}
{-# LINE 2 "Database/TokyoCabinet/HDB/C.hsc" #-}
module Database.TokyoCabinet.HDB.C where

import Foreign.Ptr
import Foreign.C.Types
import Foreign.C.String

import Data.Int
import Data.Word
import Data.Bits

import Database.TokyoCabinet.List.C (LIST)


{-# LINE 15 "Database/TokyoCabinet/HDB/C.hsc" #-}

data OpenMode =
    OREADER |
    OWRITER |
    OCREAT  |
    OTRUNC  |
    ONOLCK  |
    OLCKNB  |
    OTSYNC
    deriving (Eq, Ord, Show)

openModeToCInt :: OpenMode -> CInt
openModeToCInt OREADER = 1
{-# LINE 28 "Database/TokyoCabinet/HDB/C.hsc" #-}
openModeToCInt OWRITER = 2
{-# LINE 29 "Database/TokyoCabinet/HDB/C.hsc" #-}
openModeToCInt OCREAT  = 4
{-# LINE 30 "Database/TokyoCabinet/HDB/C.hsc" #-}
openModeToCInt OTRUNC  = 8
{-# LINE 31 "Database/TokyoCabinet/HDB/C.hsc" #-}
openModeToCInt ONOLCK  = 16
{-# LINE 32 "Database/TokyoCabinet/HDB/C.hsc" #-}
openModeToCInt OLCKNB  = 32
{-# LINE 33 "Database/TokyoCabinet/HDB/C.hsc" #-}
openModeToCInt OTSYNC  = 64
{-# LINE 34 "Database/TokyoCabinet/HDB/C.hsc" #-}

combineOpenMode :: [OpenMode] -> CInt
combineOpenMode = foldr ((.|.) . openModeToCInt) 0

data TuningOption =
    TLARGE   |
    TDEFLATE |
    TBZIP    |
    TTCBS    |
    TEXCODEC
    deriving (Eq, Ord, Show)

tuningOptionToWord8 :: TuningOption -> Word8
tuningOptionToWord8 TLARGE   = 1
{-# LINE 48 "Database/TokyoCabinet/HDB/C.hsc" #-}
tuningOptionToWord8 TDEFLATE = 2
{-# LINE 49 "Database/TokyoCabinet/HDB/C.hsc" #-}
tuningOptionToWord8 TBZIP    = 4
{-# LINE 50 "Database/TokyoCabinet/HDB/C.hsc" #-}
tuningOptionToWord8 TTCBS    = 8
{-# LINE 51 "Database/TokyoCabinet/HDB/C.hsc" #-}
tuningOptionToWord8 TEXCODEC = 16
{-# LINE 52 "Database/TokyoCabinet/HDB/C.hsc" #-}

combineTuningOption :: [TuningOption] -> Word8
combineTuningOption = foldr ((.|.) . tuningOptionToWord8) 0

data HDB'

foreign import ccall "&tchdbdel"
  tchdbFinalizer :: FunPtr (Ptr HDB' -> IO ())

foreign import ccall safe "tchdbnew"
  c_tchdbnew :: IO (Ptr HDB')

foreign import ccall safe "tchdbdel"
  c_tchdbdel :: Ptr HDB' -> IO ()

foreign import ccall safe "tchdbecode"
  c_tchdbecode :: Ptr HDB' -> IO CInt

foreign import ccall safe "tchdbtune"
  c_tchdbtune :: Ptr HDB' -> Int64 -> Int8 -> Int8 -> Word8 -> IO Bool

foreign import ccall safe "tchdbsetcache"
  c_tchdbsetcache :: Ptr HDB' -> Int32 -> IO Bool

foreign import ccall safe "tchdbsetxmsiz"
  c_tchdbsetxmsiz :: Ptr HDB' -> Int64 -> IO Bool

foreign import ccall safe "tchdbopen"
  c_tchdbopen :: Ptr HDB' -> CString -> CInt -> IO Bool

foreign import ccall safe "tchdbclose"
  c_tchdbclose :: Ptr HDB' -> IO Bool

foreign import ccall safe "tchdbput"
  c_tchdbput :: Ptr HDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool

foreign import ccall safe "tchdbput2"
  c_tchdbput2 :: Ptr HDB' -> CString -> CString -> IO Bool

foreign import ccall safe "tchdbputkeep"
  c_tchdbputkeep :: Ptr HDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool

foreign import ccall safe "tchdbputkeep2"
  c_tchdbputkeep2 :: Ptr HDB' -> CString -> CString -> IO Bool

foreign import ccall safe "tchdbputcat"
  c_tchdbputcat :: Ptr HDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool

foreign import ccall safe "tchdbputcat2"
  c_tchdbputcat2 :: Ptr HDB' -> CString -> CString -> IO Bool

foreign import ccall safe "tchdbputasync"
  c_tchdbputasync :: Ptr HDB' -> Ptr Word8 -> CInt -> Ptr Word8 -> CInt -> IO Bool

foreign import ccall safe "tchdbout"
  c_tchdbout :: Ptr HDB' -> Ptr Word8 -> CInt -> IO Bool

foreign import ccall safe "tchdbout2"
  c_tchdbout2 :: Ptr HDB' -> CString -> IO Bool

foreign import ccall safe "tchdbget"
  c_tchdbget :: Ptr HDB' -> Ptr Word8 -> CInt -> Ptr CInt -> IO (Ptr Word8)

foreign import ccall safe "tchdbget2"
  c_tchdbget2 :: Ptr HDB' -> CString -> IO CString

foreign import ccall safe "tchdbvsiz"
  c_tchdbvsiz :: Ptr HDB' -> Ptr Word8 -> CInt -> IO CInt

foreign import ccall safe "tchdbiterinit"
  c_tchdbiterinit :: Ptr HDB' -> IO Bool

foreign import ccall safe "tchdbiternext"
  c_tchdbiternext :: Ptr HDB' -> Ptr CInt -> IO (Ptr Word8)

foreign import ccall safe "tchdbiternext2"
  c_tchdbiternext2 :: Ptr HDB' -> IO CString

foreign import ccall safe "tchdbfwmkeys"
  c_tchdbfwmkeys :: Ptr HDB' -> Ptr Word8 -> CInt -> CInt -> IO (Ptr LIST)

foreign import ccall safe "tchdbaddint"
  c_tchdbaddint :: Ptr HDB' -> Ptr Word8 -> CInt -> CInt -> IO CInt

foreign import ccall safe "tchdbadddouble"
  c_tchdbadddouble :: Ptr HDB' -> Ptr Word8 -> CInt -> CDouble -> IO CDouble

foreign import ccall safe "tchdbsync"
  c_tchdbsync :: Ptr HDB' -> IO Bool

foreign import ccall safe "tchdboptimize"
  c_tchdboptimize :: Ptr HDB' -> Int64 -> Int8 -> Int8 -> Word8 -> IO Bool

foreign import ccall safe "tchdbvanish"
  c_tchdbvanish :: Ptr HDB' -> IO Bool

foreign import ccall safe "tchdbcopy"
  c_tchdbcopy :: Ptr HDB' -> CString -> IO Bool

foreign import ccall safe "tchdbtranbegin"
  c_tchdbtranbegin :: Ptr HDB' -> IO Bool

foreign import ccall safe "tchdbtrancommit"
  c_tchdbtrancommit :: Ptr HDB' -> IO Bool

foreign import ccall safe "tchdbtranabort"
  c_tchdbtranabort :: Ptr HDB' -> IO Bool

foreign import ccall safe "tchdbpath"
  c_tchdbpath :: Ptr HDB' -> IO CString

foreign import ccall safe "tchdbrnum"
  c_tchdbrnum :: Ptr HDB' -> IO Word64

foreign import ccall safe "tchdbfsiz"
  c_tchdbfsiz :: Ptr HDB' -> IO Word64