{-# LINE 1 "Bindings/Sophia.hsc" #-}
--------------------------------------------------------------------------------
{-# LINE 2 "Bindings/Sophia.hsc" #-}


{-# LINE 4 "Bindings/Sophia.hsc" #-}

{-# LINE 5 "Bindings/Sophia.hsc" #-}

--------------------------------------------------------------------------------

module Bindings.Sophia where

import Foreign.Ptr      (FunPtr, Ptr)
import Foreign.C.Types  (CInt(..), CUInt(..), CSize(..), CDouble(..))
import Foreign.C.String (CString)
import Data.Word        (Word32)

type C'sporder = CUInt

{-# LINE 16 "Bindings/Sophia.hsc" #-}
c'SPGT = 0
c'SPGT :: (Num a) => a

{-# LINE 17 "Bindings/Sophia.hsc" #-}
c'SPGTE = 1
c'SPGTE :: (Num a) => a

{-# LINE 18 "Bindings/Sophia.hsc" #-}
c'SPLT = 2
c'SPLT :: (Num a) => a

{-# LINE 19 "Bindings/Sophia.hsc" #-}
c'SPLTE = 3
c'SPLTE :: (Num a) => a

{-# LINE 20 "Bindings/Sophia.hsc" #-}

c'SPO_RDWR = 2
c'SPO_RDWR :: (Num a) => a

{-# LINE 22 "Bindings/Sophia.hsc" #-}
c'SPO_RDONLY = 1
c'SPO_RDONLY :: (Num a) => a

{-# LINE 23 "Bindings/Sophia.hsc" #-}
c'SPO_CREAT = 4
c'SPO_CREAT :: (Num a) => a

{-# LINE 24 "Bindings/Sophia.hsc" #-}
-- Undocumented:
c'SPO_SYNC = 8
c'SPO_SYNC :: (Num a) => a

{-# LINE 26 "Bindings/Sophia.hsc" #-}

type Handle = Ptr ()

type Env = Handle
type Db = Handle
type Cursor = Handle

type Flags = Word32
type ErrorCode = CInt

type Key = Ptr ()
type Val = Ptr ()

foreign import ccall "sp_env" c'sp_env
  :: IO Env
foreign import ccall "&sp_env" p'sp_env
  :: FunPtr (IO Env)

{-# LINE 40 "Bindings/Sophia.hsc" #-}
foreign import ccall "sp_destroy" c'sp_destroy
  :: Handle -> IO ErrorCode
foreign import ccall "&sp_destroy" p'sp_destroy
  :: FunPtr (Handle -> IO ErrorCode)

{-# LINE 41 "Bindings/Sophia.hsc" #-}
foreign import ccall "sp_open" c'sp_open
  :: Env -> IO Db
foreign import ccall "&sp_open" p'sp_open
  :: FunPtr (Env -> IO Db)

{-# LINE 42 "Bindings/Sophia.hsc" #-}
foreign import ccall "sp_error" c'sp_error
  :: Handle -> IO CString
foreign import ccall "&sp_error" p'sp_error
  :: FunPtr (Handle -> IO CString)

{-# LINE 43 "Bindings/Sophia.hsc" #-}

foreign import ccall "sp_set" c'sp_set
  :: Db -> Key -> CSize -> Val -> CSize -> IO ErrorCode
foreign import ccall "&sp_set" p'sp_set
  :: FunPtr (Db -> Key -> CSize -> Val -> CSize -> IO ErrorCode)

{-# LINE 45 "Bindings/Sophia.hsc" #-}

-- Val output param must be free()'d (-1 for err, 0 not found, 1 found)
foreign import ccall "sp_get" c'sp_get
  :: Db -> Key -> CSize -> Ptr Val -> Ptr CSize -> IO ErrorCode
foreign import ccall "&sp_get" p'sp_get
  :: FunPtr (Db -> Key -> CSize -> Ptr Val -> Ptr CSize -> IO ErrorCode)

{-# LINE 48 "Bindings/Sophia.hsc" #-}
foreign import ccall "sp_delete" c'sp_delete
  :: Db -> Key -> CSize -> IO ErrorCode
foreign import ccall "&sp_delete" p'sp_delete
  :: FunPtr (Db -> Key -> CSize -> IO ErrorCode)

{-# LINE 49 "Bindings/Sophia.hsc" #-}

-- Key may or may not be supplied, result must be sp_destroy'd:
foreign import ccall "sp_cursor" c'sp_cursor
  :: Db -> C'sporder -> Key -> CSize -> IO Cursor
foreign import ccall "&sp_cursor" p'sp_cursor
  :: FunPtr (Db -> C'sporder -> Key -> CSize -> IO Cursor)

{-# LINE 52 "Bindings/Sophia.hsc" #-}

foreign import ccall "sp_fetch" c'sp_fetch
  :: Cursor -> IO CInt
foreign import ccall "&sp_fetch" p'sp_fetch
  :: FunPtr (Cursor -> IO CInt)

{-# LINE 54 "Bindings/Sophia.hsc" #-}

-- Apparently no need to free result key
foreign import ccall "sp_key" c'sp_key
  :: Cursor -> IO Key
foreign import ccall "&sp_key" p'sp_key
  :: FunPtr (Cursor -> IO Key)

{-# LINE 57 "Bindings/Sophia.hsc" #-}
-- 0 size on error:
foreign import ccall "sp_keysize" c'sp_keysize
  :: Cursor -> IO CSize
foreign import ccall "&sp_keysize" p'sp_keysize
  :: FunPtr (Cursor -> IO CSize)

{-# LINE 59 "Bindings/Sophia.hsc" #-}

-- Apparently no need to free result value
foreign import ccall "sp_value" c'sp_value
  :: Cursor -> IO Val
foreign import ccall "&sp_value" p'sp_value
  :: FunPtr (Cursor -> IO Val)

{-# LINE 62 "Bindings/Sophia.hsc" #-}
-- 0 size on error:
foreign import ccall "sp_valuesize" c'sp_valuesize
  :: Cursor -> IO CSize
foreign import ccall "&sp_valuesize" p'sp_valuesize
  :: FunPtr (Cursor -> IO CSize)

{-# LINE 64 "Bindings/Sophia.hsc" #-}

-- sp_ctl wrappers from wrappers.c:
foreign import ccall "sp_dir" c'sp_dir
  :: Env -> Flags -> CString -> IO ErrorCode
foreign import ccall "&sp_dir" p'sp_dir
  :: FunPtr (Env -> Flags -> CString -> IO ErrorCode)

{-# LINE 67 "Bindings/Sophia.hsc" #-}

type SpCmpF = FunPtr (CString -> CSize -> CString -> CSize -> Ptr () -> IO CInt)
foreign import ccall "sp_set_key_comparison" c'sp_set_key_comparison
  :: Env -> SpCmpF -> Ptr () -> IO ErrorCode
foreign import ccall "&sp_set_key_comparison" p'sp_set_key_comparison
  :: FunPtr (Env -> SpCmpF -> Ptr () -> IO ErrorCode)

{-# LINE 70 "Bindings/Sophia.hsc" #-}

foreign import ccall "sp_set_keys_per_page" c'sp_set_keys_per_page
  :: Env -> Word32 -> IO ErrorCode
foreign import ccall "&sp_set_keys_per_page" p'sp_set_keys_per_page
  :: FunPtr (Env -> Word32 -> IO ErrorCode)

{-# LINE 72 "Bindings/Sophia.hsc" #-}
foreign import ccall "sp_set_gc_enabled" c'sp_set_gc_enabled
  :: Env -> CInt -> IO ErrorCode
foreign import ccall "&sp_set_gc_enabled" p'sp_set_gc_enabled
  :: FunPtr (Env -> CInt -> IO ErrorCode)

{-# LINE 73 "Bindings/Sophia.hsc" #-}
foreign import ccall "sp_set_gcf" c'sp_set_gcf
  :: Env -> CDouble -> IO ErrorCode
foreign import ccall "&sp_set_gcf" p'sp_set_gcf
  :: FunPtr (Env -> CDouble -> IO ErrorCode)

{-# LINE 74 "Bindings/Sophia.hsc" #-}
foreign import ccall "sp_grow" c'sp_grow
  :: Env -> Word32 -> CDouble -> IO ErrorCode
foreign import ccall "&sp_grow" p'sp_grow
  :: FunPtr (Env -> Word32 -> CDouble -> IO ErrorCode)

{-# LINE 75 "Bindings/Sophia.hsc" #-}
foreign import ccall "sp_set_merge_enabled" c'sp_set_merge_enabled
  :: Env -> CInt -> IO ErrorCode
foreign import ccall "&sp_set_merge_enabled" p'sp_set_merge_enabled
  :: FunPtr (Env -> CInt -> IO ErrorCode)

{-# LINE 76 "Bindings/Sophia.hsc" #-}
foreign import ccall "sp_set_merge_watermark" c'sp_set_merge_watermark
  :: Env -> Word32 -> IO ErrorCode
foreign import ccall "&sp_set_merge_watermark" p'sp_set_merge_watermark
  :: FunPtr (Env -> Word32 -> IO ErrorCode)

{-# LINE 77 "Bindings/Sophia.hsc" #-}
foreign import ccall "sp_get_version" c'sp_get_version
  :: Env -> Ptr Word32 -> Ptr Word32 -> IO ErrorCode
foreign import ccall "&sp_get_version" p'sp_get_version
  :: FunPtr (Env -> Ptr Word32 -> Ptr Word32 -> IO ErrorCode)

{-# LINE 78 "Bindings/Sophia.hsc" #-}