module Database.KyotoCabinet.Db (
KcDb,
KcCur,
KcError(..),
KcTune(..),
KcTuneType(..),
KcLogger(..),
KcLogLevel(..),
KcOption(..),
KcCompressor(..),
KcComparator(..),
KcOpenMode(..),
KcMergeMode(..),
KcException(..),
KcVisitAction(..),
KcVisitFull,
KcVisitEmpty,
KcFileProc,
kcversion,
kcmalloc,
kcfree,
kctime,
kcatoi,
kcatoix,
kcatof,
kchashmurmur,
kchashfnv,
kcnan,
kcinf,
kcchknan,
kcchkinf,
kcecodename,
kcdbnew,
kcdbdel,
kcdbopen,
kcdbclose,
kcdbecode,
kcdbemsg,
kcdbaccept,
kcdbacceptbulk,
kcdbiterate,
kcdbset,
kcdbadd,
kcdbreplace,
kcdbappend,
kcdbincrint,
kcdbincrdouble,
kcdbcas,
kcdbremove,
kcdbget,
kcdbgetbuf,
kcdbsetbulk,
kcdbremovebulk,
kcdbgetbulk,
kcdbclear,
kcdbsync,
kcdbcopy,
kcdbbegintran,
kcdbbegintrantry,
kcdbendtran,
kcdbdumpsnap,
kcdbloadsnap,
kcdbcount,
kcdbsize,
kcdbpath,
kcdbstatus,
kcdbmatchprefix,
kcdbmatchregex,
kcdbmerge,
kcdbcursor,
kccurdel,
kccuraccept,
kccurremove,
kccurgetkey,
kccurgetvalue,
kccurget,
kccurjump,
kccurjumpkey,
kccurjumpback,
kccurjumpbackkey,
kccurstep,
kccurstepback,
kccurdb,
kccurecode,
kccuremsg,
kcwithdbopen,
kcwithdbcursor,
kcwithdbtran
) where
import Control.Applicative
import Control.Exception
import Data.Bits
import qualified Data.ByteString as BS
import qualified Data.ByteString.Internal as BS
import qualified Data.ByteString.Unsafe as BS
import Data.Typeable
import Data.Int
import Foreign.C
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Storable
import Foreign.Ptr
import Foreign.ForeignPtr
import Prelude hiding (catch)
newtype KcStr = KcStr BS.ByteString
instance Storable KcStr where
sizeOf _ = ((16))
alignment _ = alignment (undefined :: CSize)
peek ptr = do
b <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
s <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
KcStr <$> BS.unsafePackCStringFinalizer b s (kcfree b)
poke ptr (KcStr bs) = do
BS.unsafeUseAsCStringLen bs $ \(b, s) -> do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr b
((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr s
withKcStrArray :: [BS.ByteString] -> (Ptr KcStr -> IO a) -> IO a
withKcStrArray strs f = do
allocaArray (length strs) $ \arr -> do
pokeArray arr (map KcStr strs)
f arr
newtype KcRec = KcRec (BS.ByteString, BS.ByteString)
instance Storable KcRec where
sizeOf _ = ((32))
alignment _ = alignment (undefined :: KcStr)
peek ptr = do
KcStr k <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
KcStr v <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
return $ KcRec (k, v)
poke ptr (KcRec (k, v)) = do
((\hsc_ptr -> pokeByteOff hsc_ptr 0)) ptr (KcStr k)
((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr (KcStr v)
withKcRecArray :: [(BS.ByteString, BS.ByteString)] -> (Ptr KcRec -> IO a) -> IO a
withKcRecArray recs f = do
allocaArray (length recs) $ \arr -> do
pokeArray arr (map KcRec recs)
f arr
bsListOfCStringArr :: Ptr CString -> CLLong -> IO [BS.ByteString]
bsListOfCStringArr strarr n = do
strlist <- peekArray (fromIntegral n) strarr
bssOfCstrs strlist
bssOfCstrs :: [CString] -> IO [BS.ByteString]
bssOfCstrs [] = return []
bssOfCstrs (h:t) = do
hLen <- BS.c_strlen h
bs' <- BS.unsafePackCStringFinalizer (castPtr h) (fromIntegral hLen) (kcfree h)
rest <- bssOfCstrs t
return $ bs' `seq` (bs':rest)
data KcError = KCESUCCESS
| KCENOIMPL
| KCEINVALID
| KCENOREPOS
| KCENOPERM
| KCEBROKEN
| KCEDUPREC
| KCENOREC
| KCELOGIC
| KCESYSTEM
| KCEMISC
| KCUNKNOWNERROR Int
deriving (Eq, Show)
kcErrorOfNum :: CInt -> KcError
kcErrorOfNum (0) = KCESUCCESS
kcErrorOfNum (1) = KCENOIMPL
kcErrorOfNum (2) = KCEINVALID
kcErrorOfNum (3) = KCENOREPOS
kcErrorOfNum (4) = KCENOPERM
kcErrorOfNum (5) = KCEBROKEN
kcErrorOfNum (6) = KCEDUPREC
kcErrorOfNum (7) = KCENOREC
kcErrorOfNum (8) = KCELOGIC
kcErrorOfNum (9) = KCESYSTEM
kcErrorOfNum (15) = KCEMISC
kcErrorOfNum n = KCUNKNOWNERROR (fromIntegral n)
data KcOpenMode = KCOREADER
| KCOWRITER
| KCOCREATE
| KCOTRUNCATE
| KCOAUTOTRAN
| KCOAUTOSYNC
| KCONOLOCK
| KCOTRYLOCK
| KCONOREPAIR
deriving (Eq, Show)
numOfKcOpenMode :: KcOpenMode -> Int
numOfKcOpenMode KCOREADER = (1)
numOfKcOpenMode KCOWRITER = (2)
numOfKcOpenMode KCOCREATE = (4)
numOfKcOpenMode KCOTRUNCATE = (8)
numOfKcOpenMode KCOAUTOTRAN = (16)
numOfKcOpenMode KCOAUTOSYNC = (32)
numOfKcOpenMode KCONOLOCK = (64)
numOfKcOpenMode KCOTRYLOCK = (128)
numOfKcOpenMode KCONOREPAIR = (256)
numOfOpenModes :: [KcOpenMode] -> CUInt
numOfOpenModes mode = fromIntegral $ foldr (\m acc -> numOfKcOpenMode m .|. acc) 0 mode
data KcMergeMode = KCMSET
| KCMADD
| KCMREPLACE
| KCMAPPEND
deriving (Eq, Show)
numOfKcMergeMode :: KcMergeMode -> Int
numOfKcMergeMode KCMSET = (0)
numOfKcMergeMode KCMADD = (1)
numOfKcMergeMode KCMREPLACE = (2)
numOfKcMergeMode KCMAPPEND = (3)
kcversion :: IO String
kcversion = kcVERSION >>= peekCAString
foreign import ccall safe "kclangc.h getKCVERSION" kcVERSION
:: IO CString
foreign import ccall safe "kclangc.h getKCVISNOP" kcVISNOP
:: IO CString
foreign import ccall safe "kclangc.h getKCVISREMOVE" kcVISREMOVE
:: IO CString
data KcVisitAction = KCVISNOP | KCVISSET BS.ByteString | KCVISREMOVE
type KcVisitFull = BS.ByteString -> BS.ByteString -> IO KcVisitAction
callVisitFull :: KcVisitFull -> KCVISITFULL
callVisitFull visitFull kbuf ksiz vbuf vsiz sp _ = do
key <- BS.unsafePackCStringLen (kbuf, fromIntegral ksiz)
val <- BS.unsafePackCStringLen (vbuf, fromIntegral vsiz)
rv <- visitFull key val
case rv of
KCVISNOP -> kcVISNOP
KCVISSET newVal ->
BS.unsafeUseAsCStringLen newVal $ \(cstr, clen) -> do
poke sp (fromIntegral clen)
return cstr
KCVISREMOVE -> kcVISREMOVE
type KCVISITFULL =
CString -> CSize -> CString -> CSize -> Ptr CSize -> Ptr () -> IO CString
foreign import ccall "wrapper" wrapKCVISITFULL
:: KCVISITFULL -> IO (FunPtr KCVISITFULL)
type KcVisitEmpty = BS.ByteString -> IO KcVisitAction
callVisitEmpty :: KcVisitEmpty -> KCVISITEMPTY
callVisitEmpty visitEmpty kbuf ksiz sp _ = do
key <- BS.unsafePackCStringLen (kbuf, fromIntegral ksiz)
rv <- visitEmpty key
case rv of
KCVISNOP -> kcVISNOP
KCVISSET newVal ->
BS.unsafeUseAsCStringLen newVal $ \(cstr, clen) -> do
poke sp (fromIntegral clen)
return cstr
KCVISREMOVE -> kcVISREMOVE
type KCVISITEMPTY = CString -> CSize -> Ptr CSize -> Ptr () -> IO CString
foreign import ccall "wrapper" wrapKCVISITEMPTY
:: KCVISITEMPTY -> IO (FunPtr KCVISITEMPTY)
type KcFileProc = FilePath -> Int64 -> Int64 -> IO Bool
callFileProc :: KcFileProc -> KCFILEPROC
callFileProc fileProc path count size _ = do
filePath <- peekCAString path
rv <- fileProc filePath (fromIntegral count) (fromIntegral size)
if rv then return 1 else return 0
type KCFILEPROC = CString -> CLLong -> CLLong -> Ptr () -> IO CInt
foreign import ccall "wrapper" wrapKCFILEPROC
:: KCFILEPROC -> IO (FunPtr KCFILEPROC)
int64_min :: CLLong
int64_min = 9223372036854775808
kcmalloc :: Int -> IO (Ptr a)
kcmalloc sz = _kcmalloc (fromIntegral sz)
foreign import ccall safe "kclangc.h kcmalloc" _kcmalloc
:: CSize -> IO (Ptr a)
foreign import ccall safe "kclangc.h kcfree" kcfree
:: Ptr a -> IO ()
kctime :: IO Double
kctime = _kctime >>= return . realToFrac
foreign import ccall safe "kclangc.h kctime" _kctime
:: IO CDouble
kcatoi :: String -> IO Int64
kcatoi str =
withCAString str $ \cstr ->
_kcatoi cstr >>= return . fromIntegral
foreign import ccall unsafe "kclangc.h kcatoi" _kcatoi
:: CString -> IO CLLong
kcatoix :: String -> IO Int64
kcatoix str =
withCAString str $ \cstr ->
_kcatoix cstr >>= return . fromIntegral
foreign import ccall unsafe "kclangc.h kcatoix" _kcatoix
:: CString -> IO CLLong
kcatof :: String -> IO Double
kcatof str =
withCAString str $ \cstr ->
_kcatof cstr >>= return . realToFrac
foreign import ccall unsafe "kclangc.h kcatof" _kcatof
:: CString -> IO CDouble
kchashmurmur :: BS.ByteString -> IO Int64
kchashmurmur buff =
BS.unsafeUseAsCStringLen buff $ \(b, n) ->
_kchashmurmur b (fromIntegral n) >>= return . fromIntegral
foreign import ccall unsafe "kclangc.h kchashmurmur" _kchashmurmur
:: CString -> CSize -> IO CLLong
kchashfnv :: BS.ByteString -> IO Int64
kchashfnv buff =
BS.unsafeUseAsCStringLen buff $ \(b, n) ->
_kchashfnv b (fromIntegral n) >>= return . fromIntegral
foreign import ccall unsafe "kclangc.h kchashfnv" _kchashfnv
:: CString -> CSize -> IO CLLong
kcnan :: IO Double
kcnan = _kcnan >>= return . realToFrac
foreign import ccall unsafe "kclangc.h kcnan" _kcnan
:: IO CDouble
kcinf :: IO Double
kcinf = _kcinf >>= return . realToFrac
foreign import ccall unsafe "kclangc.h kcinf" _kcinf
:: IO CDouble
kcchknan :: Double -> IO Bool
kcchknan num = do rv <- _kcchknan (realToFrac num)
if rv == 0 then return False else return True
foreign import ccall unsafe "kclangc.h kcchknan" _kcchknan
:: CDouble -> IO CInt
kcchkinf :: Double -> IO Bool
kcchkinf num = do rv <- _kcchkinf (realToFrac num)
if rv == 0 then return False else return True
foreign import ccall unsafe "kclangc.h kcchkinf" _kcchkinf
:: CDouble -> IO CInt
kcecodename :: Int -> IO String
kcecodename code = do rv <- _kcecodename (fromIntegral code); peekCAString rv
foreign import ccall unsafe "kclangc.h kcecodename" _kcecodename
:: CInt -> IO CString
data KcException = KcException String KcError String
deriving (Eq, Show, Typeable)
instance Exception KcException
kcThrow :: KcDb -> String -> IO a
kcThrow db fname = do
err <- kcdbecode db
msg <- kcdbemsg db
throwIO $ KcException fname err msg
handleBoolResult :: KcDb -> String -> CInt -> IO ()
handleBoolResult db fname status =
if status == 0 then kcThrow db fname else return ()
newtype KcDb = KcDb { unKcDb :: ForeignPtr KCDB }
data KCDB
kcdbnew :: IO KcDb
kcdbnew = _kcdbnew >>= wrapdb
wrapdb :: Ptr KCDB -> IO KcDb
wrapdb db = do
fp <- newForeignPtr_ db
return $ KcDb fp
foreign import ccall safe "kclangc.h kcdbnew" _kcdbnew
:: IO (Ptr KCDB)
foreign import ccall safe "kclangc.h &kcdbdel" _kcdbdelFunPtr
:: FunPtr (Ptr KCDB -> IO ())
kcdbdel :: KcDb -> IO ()
kcdbdel db = do withForeignPtr (unKcDb db) _kcdbdel; return ()
foreign import ccall safe "kclangc.h kcdbdel" _kcdbdel
:: Ptr KCDB -> IO ()
data KcTune = KcTuneType KcTuneType
| KcTuneLogger KcLogger
| KcTuneLogKinds KcLogLevel
| KcTuneLogPx String
| KcTuneOptions [KcOption]
| KcTuneBuckets Int
| KcTuneCompressor KcCompressor
| KcTuneZkey String
| KcTuneCapCount Int
| KcTuneCapSize Int
| KcTunePage Int
| KcTuneComparator KcComparator
| KcTunePageCache Int
| KcTuneAlignment Int
| KcTuneFbp Int
| KcTuneMap Int
| KcTuneDefrag Int
data KcTuneType = KcTypePrototypeHashDb | KcTypePrototypeTreeDb
| KcTypeCacheHashDb | KcTypeCacheTreeDb
| KcTypeFileHashDb | KcTypeFileTreeDb
| KcTypeDirectoryHashDb | KcTypeDirectoryTreeDb
data KcLogger = KcLoggerStdout | KcLoggerStderr
data KcLogLevel = KcLogDebug | KcLogInfo | KcLogWarn | KcLogError
data KcOption = KcOptionSmall | KcOptionLinear | KcOptionCompress
data KcCompressor = KcCompressorZlib | KcCompressorDeflate
| KcCompressorGzip | KcCompressorLzo
| KcCompressorLzma | KcCompressorArc
data KcComparator = KcComparatorLexical | KcComparatorDecimal
instance Show KcTune where
show (KcTuneType t) = "type=" ++ show t
show (KcTuneLogger l) = "log=" ++ show l
show (KcTuneLogKinds l) = "logkinds=" ++ show l
show (KcTuneLogPx s) = "logpx=" ++ s
show (KcTuneOptions opts) = "opts=" ++ foldr (\o r -> show o ++ r) "" opts
show (KcTuneBuckets n) = "bnum=" ++ show n
show (KcTuneCompressor c) = "zcomp=" ++ show c
show (KcTuneZkey s) = "zkey=" ++ show s
show (KcTuneCapCount c) = "capcount=" ++ show c
show (KcTuneCapSize n) = "capsize=" ++ show n
show (KcTunePage n) = "psiz=" ++ show n
show (KcTuneComparator c) = "rcomp=" ++ show c
show (KcTunePageCache n) = "pccap=" ++ show n
show (KcTuneAlignment n) = "apow=" ++ show n
show (KcTuneFbp n) = "fpow=" ++ show n
show (KcTuneMap n) = "msiz=" ++ show n
show (KcTuneDefrag n) = "dfunit=" ++ show n
instance Show KcTuneType where
show KcTypePrototypeHashDb = "-"
show KcTypePrototypeTreeDb = "+"
show KcTypeCacheHashDb = "*"
show KcTypeCacheTreeDb = "%"
show KcTypeFileHashDb = "kch"
show KcTypeFileTreeDb = "kct"
show KcTypeDirectoryHashDb = "kcd"
show KcTypeDirectoryTreeDb = "kcf"
instance Show KcLogger where
show KcLoggerStdout = "-"
show KcLoggerStderr = "+"
instance Show KcLogLevel where
show KcLogDebug = "debug"
show KcLogInfo = "info"
show KcLogWarn = "warn"
show KcLogError = "error"
instance Show KcOption where
show KcOptionSmall = "s"
show KcOptionLinear = "l"
show KcOptionCompress = "c"
instance Show KcCompressor where
show KcCompressorZlib = "zlib"
show KcCompressorDeflate = "def"
show KcCompressorGzip = "gz"
show KcCompressorLzo = "lzo"
show KcCompressorLzma = "lzma"
show KcCompressorArc = "arc"
instance Show KcComparator where
show KcComparatorLexical = "lex"
show KcComparatorDecimal = "dec"
kcdbopen ::
KcDb
-> String
-> [KcTune]
-> [KcOpenMode]
-> IO ()
kcdbopen db path tune mode =
let tunePath = foldl (\prev t -> prev ++ "#" ++ show t) path tune in
withForeignPtr (unKcDb db) $ \c_db ->
withCAString tunePath $ \c_path ->
_kcdbopen c_db c_path (numOfOpenModes mode) >>= handleBoolResult db "kcdbopen"
foreign import ccall safe "kclangc.h kcdbopen" _kcdbopen
:: Ptr KCDB -> CString -> CUInt -> IO CInt
kcdbclose :: KcDb -> IO ()
kcdbclose db =
withForeignPtr (unKcDb db) $ \c_db -> do
_kcdbclose c_db >>= handleBoolResult db "kcdbclose"
foreign import ccall safe "kclangc.h kcdbclose" _kcdbclose
:: Ptr KCDB -> IO CInt
kcdbecode :: KcDb -> IO KcError
kcdbecode db =
withForeignPtr (unKcDb db) $ \c_db -> do
code <- _kcdbecode c_db
return $ kcErrorOfNum code
foreign import ccall unsafe "kclangc.h kcdbecode" _kcdbecode
:: Ptr KCDB -> IO CInt
kcdbemsg :: KcDb -> IO String
kcdbemsg db =
withForeignPtr (unKcDb db) $ \c_db -> do
msg <- _kcdbemsg c_db
peekCAString msg
foreign import ccall unsafe "kclangc.h kcdbemsg" _kcdbemsg
:: Ptr KCDB -> IO CString
kcdbaccept :: KcDb
-> BS.ByteString
-> KcVisitFull -> KcVisitEmpty
-> Bool
-> IO ()
kcdbaccept db key visitFull visitEmpty writable =
withForeignPtr (unKcDb db) $ \c_db -> do
BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do
vf <- wrapKCVISITFULL $ callVisitFull visitFull
ve <- wrapKCVISITEMPTY $ callVisitEmpty visitEmpty
rv <- _kcdbaccept c_db kbuf (fromIntegral ksiz) vf ve
nullPtr (if writable then 1 else 0)
freeHaskellFunPtr ve
freeHaskellFunPtr vf
handleBoolResult db "kcdbaccept" rv
foreign import ccall safe "kclangc.h kcdbaccept" _kcdbaccept
:: Ptr KCDB -> CString -> CSize -> FunPtr KCVISITFULL -> FunPtr KCVISITEMPTY ->
Ptr () -> CInt -> IO CInt
kcdbacceptbulk :: KcDb
-> [BS.ByteString]
-> KcVisitFull -> KcVisitEmpty
-> Bool
-> IO ()
kcdbacceptbulk db keys visitFull visitEmpty writable = do
withForeignPtr (unKcDb db) $ \c_db -> do
let nkeys = length keys
withKcStrArray keys $ \keyArr -> do
vf <- wrapKCVISITFULL $ callVisitFull visitFull
ve <- wrapKCVISITEMPTY $ callVisitEmpty visitEmpty
rv <- _kcdbacceptbulk c_db keyArr (fromIntegral nkeys) vf ve
nullPtr (if writable then 1 else 0)
freeHaskellFunPtr ve
freeHaskellFunPtr vf
handleBoolResult db "kcdbacceptbulk" rv
foreign import ccall safe "kclangc.h kcdbacceptbulk" _kcdbacceptbulk
:: Ptr KCDB -> Ptr KcStr -> CSize -> FunPtr KCVISITFULL -> FunPtr KCVISITEMPTY ->
Ptr () -> CInt -> IO CInt
kcdbiterate :: KcDb -> KcVisitFull
-> Bool
-> IO ()
kcdbiterate db visitFull writable = do
withForeignPtr (unKcDb db) $ \c_db -> do
vf <- wrapKCVISITFULL $ callVisitFull visitFull
rv <- _kcdbiterate c_db vf nullPtr (if writable then 1 else 0)
freeHaskellFunPtr vf
handleBoolResult db "kcdbiterate" rv
foreign import ccall safe "kclangc.h kcdbiterate" _kcdbiterate
:: Ptr KCDB -> FunPtr KCVISITFULL -> Ptr () -> CInt -> IO CInt
kcdbset :: KcDb
-> BS.ByteString
-> BS.ByteString
-> IO ()
kcdbset db key val =
withForeignPtr (unKcDb db) $ \c_db -> do
BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) ->
BS.unsafeUseAsCStringLen val $ \(vbuf, vsiz) -> do
_kcdbset c_db kbuf (fromIntegral ksiz) vbuf (fromIntegral vsiz)
>>= handleBoolResult db "kcdbset"
foreign import ccall safe "kclangc.h kcdbset" _kcdbset
:: Ptr KCDB -> CString -> CSize -> CString -> CSize -> IO CInt
kcdbadd :: KcDb
-> BS.ByteString
-> BS.ByteString
-> IO ()
kcdbadd db key val =
withForeignPtr (unKcDb db) $ \c_db -> do
BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) ->
BS.unsafeUseAsCStringLen val $ \(vbuf, vsiz) -> do
_kcdbadd c_db kbuf (fromIntegral ksiz) vbuf (fromIntegral vsiz)
>>= handleBoolResult db "kcdbadd"
foreign import ccall safe "kclangc.h kcdbadd" _kcdbadd
:: Ptr KCDB -> CString -> CSize -> CString -> CSize -> IO CInt
kcdbreplace :: KcDb
-> BS.ByteString
-> BS.ByteString
-> IO ()
kcdbreplace db key val =
withForeignPtr (unKcDb db) $ \c_db -> do
BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) ->
BS.unsafeUseAsCStringLen val $ \(vbuf, vsiz) ->
_kcdbreplace c_db kbuf (fromIntegral ksiz) vbuf (fromIntegral vsiz)
>>= handleBoolResult db "kcdbreplace"
foreign import ccall safe "kclangc.h kcdbreplace" _kcdbreplace
:: Ptr KCDB -> CString -> CSize -> CString -> CSize -> IO CInt
kcdbappend :: KcDb
-> BS.ByteString
-> BS.ByteString
-> IO ()
kcdbappend db key val =
withForeignPtr (unKcDb db) $ \c_db -> do
BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) ->
BS.unsafeUseAsCStringLen val $ \(vbuf, vsiz) ->
_kcdbappend c_db kbuf (fromIntegral ksiz) vbuf (fromIntegral vsiz)
>>= handleBoolResult db "kcdbappend"
foreign import ccall safe "kclangc.h kcdbappend" _kcdbappend
:: Ptr KCDB -> CString -> CSize -> CString -> CSize -> IO CInt
kcdbincrint :: KcDb
-> BS.ByteString
-> Int64
-> IO Int64
kcdbincrint db key num =
withForeignPtr (unKcDb db) $ \c_db -> do
BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do
rv <- _kcdbincrint c_db kbuf (fromIntegral ksiz) (fromIntegral num)
if rv == int64_min then kcThrow db "kcdbincrint"
else return (fromIntegral rv)
foreign import ccall safe "kclangc.h kcdbincrint" _kcdbincrint
:: Ptr KCDB -> CString -> CSize -> CLLong -> IO CLLong
kcdbincrdouble :: KcDb
-> BS.ByteString
-> Double
-> IO Double
kcdbincrdouble db key num =
withForeignPtr (unKcDb db) $ \c_db -> do
BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do
rv <- _kcdbincrdouble c_db kbuf (fromIntegral ksiz) (realToFrac num)
nan <- _kcnan
if rv == nan then kcThrow db "kcdbincrdouble"
else return (realToFrac rv)
foreign import ccall safe "kclangc.h kcdbincrdouble" _kcdbincrdouble
:: Ptr KCDB -> CString -> CSize -> CDouble -> IO CDouble
kcdbcas :: KcDb
-> BS.ByteString
-> BS.ByteString
-> BS.ByteString
-> IO ()
kcdbcas db key nv ov =
withForeignPtr (unKcDb db) $ \c_db -> do
BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do
BS.unsafeUseAsCStringLen nv $ \(nvbuf, nvsiz) -> do
BS.unsafeUseAsCStringLen ov $ \(ovbuf, ovsiz) -> do
_kcdbcas c_db kbuf (fromIntegral ksiz) nvbuf (fromIntegral nvsiz)
ovbuf (fromIntegral ovsiz)
>>= handleBoolResult db "kcdbcas"
foreign import ccall safe "kclangc.h kcdbcas" _kcdbcas
:: Ptr KCDB -> CString -> CSize -> CString -> CSize ->
CString -> CSize -> IO CInt
kcdbremove :: KcDb
-> BS.ByteString
-> IO ()
kcdbremove db key =
withForeignPtr (unKcDb db) $ \c_db -> do
BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do
_kcdbremove c_db kbuf (fromIntegral ksiz) >>= handleBoolResult db "kcdbremove"
foreign import ccall safe "kclangc.h kcdbremove" _kcdbremove
:: Ptr KCDB -> CString -> CSize -> IO CInt
kcdbget :: KcDb
-> BS.ByteString
-> IO (Maybe BS.ByteString)
kcdbget db key =
withForeignPtr (unKcDb db) $ \c_db -> do
BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do
alloca $ \ptr -> do
cstr <- _kcdbget c_db kbuf (fromIntegral ksiz) ptr
if cstr == nullPtr then return Nothing
else do
csiz <- peek ptr
bs <- BS.unsafePackCStringFinalizer (castPtr cstr) (fromIntegral csiz)
(kcfree cstr)
return $ Just bs
foreign import ccall safe "kclangc.h kcdbget" _kcdbget
:: Ptr KCDB -> CString -> CSize -> Ptr CSize -> IO CString
kcdbgetbuf :: KcDb
-> BS.ByteString
-> Int
-> IO (Maybe BS.ByteString)
kcdbgetbuf db key maxElts =
withForeignPtr (unKcDb db) $ \c_db -> do
BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do
vbuf <- mallocArray maxElts
n <- _kcdbgetbuf c_db kbuf (fromIntegral ksiz) vbuf (fromIntegral maxElts)
if n == 1 then return Nothing
else do
bs <- BS.unsafePackCStringFinalizer (castPtr vbuf) (fromIntegral n)
(kcfree vbuf)
return $ Just bs
foreign import ccall safe "kclangc.h kcdbgetbuf" _kcdbgetbuf
:: Ptr KCDB -> CString -> CSize -> CString -> CSize -> IO CInt
kcdbsetbulk :: KcDb
-> [(BS.ByteString, BS.ByteString)]
-> Bool
-> IO Int64
kcdbsetbulk db recs atomic =
withForeignPtr (unKcDb db) $ \c_db -> do
let nrecs = length recs
withKcRecArray recs $ \keyArr -> do
n <- _kcdbsetbulk c_db keyArr (fromIntegral nrecs) (if atomic then 1 else 0)
if n == 1 then kcThrow db "kcdbsetbulk" else return (fromIntegral n)
foreign import ccall safe "kclangc.h kcdbsetbulk" _kcdbsetbulk
:: Ptr KCDB -> Ptr KcRec -> CSize -> CInt -> IO CLLong
kcdbremovebulk :: KcDb
-> [BS.ByteString]
-> Bool
-> IO Int64
kcdbremovebulk db keys atomic =
withForeignPtr (unKcDb db) $ \c_db -> do
let nrecs = length keys
withKcStrArray keys $ \keyArr -> do
n <- _kcdbremovebulk c_db keyArr (fromIntegral nrecs) (if atomic then 1 else 0)
if n == 1 then kcThrow db "kcdbremovebulk" else return (fromIntegral n)
foreign import ccall safe "kclangc.h kcdbremovebulk" _kcdbremovebulk
:: Ptr KCDB -> Ptr KcStr -> CSize -> CInt -> IO CLLong
kcdbgetbulk :: KcDb
-> [BS.ByteString]
-> Bool
-> IO [(BS.ByteString, BS.ByteString)]
kcdbgetbulk db keys atomic =
withForeignPtr (unKcDb db) $ \c_db -> do
let nkeys = length keys
withKcStrArray keys $ \keyArr -> do
allocaArray nkeys $ \recArr -> do
n <- _kcdbgetbulk c_db keyArr (fromIntegral nkeys) recArr
(if atomic then 1 else 0)
if n == 1 then kcThrow db "kcdbgetbulk"
else do
recList <- peekArray (fromIntegral n) recArr
return $ map (\(KcRec p) -> p) recList
foreign import ccall safe "kclangc.h kcdbgetbulk" _kcdbgetbulk
:: Ptr KCDB -> Ptr KcStr -> CSize -> Ptr KcRec -> CInt -> IO CLLong
kcdbclear :: KcDb -> IO ()
kcdbclear db =
withForeignPtr (unKcDb db) $ \c_db -> do
_kcdbclear c_db >>= handleBoolResult db "kcdbclear"
foreign import ccall safe "kclangc.h kcdbclear" _kcdbclear
:: Ptr KCDB -> IO CInt
kcdbsync :: KcDb
-> Bool
-> KcFileProc
-> IO ()
kcdbsync db hard fileProc = do
withForeignPtr (unKcDb db) $ \c_db -> do
fp <- wrapKCFILEPROC $ callFileProc fileProc
rv <- _kcdbsync c_db (if hard then 1 else 0) fp nullPtr
freeHaskellFunPtr fp
handleBoolResult db "kcdbsync" rv
foreign import ccall safe "kclangc.h kcdbsync" _kcdbsync
:: Ptr KCDB -> CInt -> FunPtr KCFILEPROC -> Ptr () -> IO CInt
kcdbcopy :: KcDb
-> FilePath
-> IO ()
kcdbcopy db dest =
withForeignPtr (unKcDb db) $ \c_db -> do
withCAString dest $ \c_dest -> do
_kcdbcopy c_db c_dest >>= handleBoolResult db "kcdbcopy"
foreign import ccall safe "kclangc.h kcdbcopy" _kcdbcopy
:: Ptr KCDB -> CString -> IO CInt
kcdbbegintran :: KcDb
-> Bool
-> IO ()
kcdbbegintran db hard =
withForeignPtr (unKcDb db) $ \c_db -> do
_kcdbbegintran c_db (if hard then 1 else 0)
>>= handleBoolResult db "kcdbbegintran"
foreign import ccall safe "kclangc.h kcdbbegintran" _kcdbbegintran
:: Ptr KCDB -> CInt -> IO CInt
kcdbbegintrantry :: KcDb
-> Bool
-> IO ()
kcdbbegintrantry db hard =
withForeignPtr (unKcDb db) $ \c_db -> do
_kcdbbegintrantry c_db (if hard then 1 else 0)
>>= handleBoolResult db "kcdbbegintrantry"
foreign import ccall safe "kclangc.h kcdbbegintrantry" _kcdbbegintrantry
:: Ptr KCDB -> CInt -> IO CInt
kcdbendtran :: KcDb
-> Bool
-> IO ()
kcdbendtran db commit =
withForeignPtr (unKcDb db) $ \c_db -> do
_kcdbendtran c_db (if commit then 1 else 0)
>>= handleBoolResult db "kcdbendtran"
foreign import ccall safe "kclangc.h kcdbendtran" _kcdbendtran
:: Ptr KCDB -> CInt -> IO CInt
kcdbdumpsnap :: KcDb
-> FilePath
-> IO ()
kcdbdumpsnap db dest =
withForeignPtr (unKcDb db) $ \c_db -> do
withCAString dest $ \c_dest -> do
_kcdbdumpsnap c_db c_dest >>= handleBoolResult db "kcdbdumpsnap"
foreign import ccall safe "kclangc.h kcdbdumpsnap" _kcdbdumpsnap
:: Ptr KCDB -> CString -> IO CInt
kcdbloadsnap :: KcDb
-> FilePath
-> IO ()
kcdbloadsnap db src =
withForeignPtr (unKcDb db) $ \c_db -> do
withCAString src $ \c_src -> do
_kcdbloadsnap c_db c_src >>= handleBoolResult db "kcdbloadsnap"
foreign import ccall safe "kclangc.h kcdbloadsnap" _kcdbloadsnap
:: Ptr KCDB -> CString -> IO CInt
kcdbcount :: KcDb -> IO Int64
kcdbcount db =
withForeignPtr (unKcDb db) $ \c_db -> do
n <- _kcdbcount c_db
if n == 1 then kcThrow db "kcdbcount" else return (fromIntegral n)
foreign import ccall safe "kclangc.h kcdbcount" _kcdbcount
:: Ptr KCDB -> IO CLLong
kcdbsize :: KcDb -> IO Int64
kcdbsize db =
withForeignPtr (unKcDb db) $ \c_db -> do
n <- _kcdbsize c_db
if n == 1 then kcThrow db "kcdbsize" else return (fromIntegral n)
foreign import ccall unsafe "kclangc.h kcdbsize" _kcdbsize
:: Ptr KCDB -> IO CLLong
kcdbpath :: KcDb -> IO String
kcdbpath db =
withForeignPtr (unKcDb db) $ \c_db -> do
cstr <- _kcdbpath c_db
if cstr == nullPtr then kcThrow db "kcdbpath"
else do rv <- peekCAString cstr
kcfree cstr
return rv
foreign import ccall safe "kclangc.h kcdbpath" _kcdbpath
:: Ptr KCDB -> IO CString
kcdbstatus :: KcDb -> IO String
kcdbstatus db =
withForeignPtr (unKcDb db) $ \c_db -> do
cstr <- _kcdbstatus c_db
if cstr == nullPtr then kcThrow db "kcdbstatus"
else do rv <- peekCAString cstr
kcfree cstr
return rv
foreign import ccall safe "kclangc.h kcdbstatus" _kcdbstatus
:: Ptr KCDB -> IO CString
kcdbmatchprefix :: KcDb
-> BS.ByteString
-> Int
-> IO [BS.ByteString]
kcdbmatchprefix db prefix maxElts = do
withForeignPtr (unKcDb db) $ \c_db -> do
BS.unsafeUseAsCString prefix $ \pre -> do
allocaArray maxElts $ \strarr -> do
n <- _kcdbmatchprefix c_db pre strarr (fromIntegral maxElts)
if n == 1 then kcThrow db "kcdbmatchprefix"
else bsListOfCStringArr strarr n
foreign import ccall safe "kclangc.h kcdbmatchprefix" _kcdbmatchprefix
:: Ptr KCDB -> CString -> Ptr CString -> CSize -> IO CLLong
kcdbmatchregex :: KcDb
-> BS.ByteString
-> Int
-> IO [BS.ByteString]
kcdbmatchregex db regexp maxElts = do
withForeignPtr (unKcDb db) $ \c_db -> do
BS.unsafeUseAsCString regexp $ \pre -> do
allocaArray maxElts $ \strarr -> do
n <- _kcdbmatchregex c_db pre strarr (fromIntegral maxElts)
if n == 1 then kcThrow db "kcdbmatchregex"
else bsListOfCStringArr strarr n
foreign import ccall safe "kclangc.h kcdbmatchregex" _kcdbmatchregex
:: Ptr KCDB -> CString -> Ptr CString -> CSize -> IO CLLong
kcdbmerge :: KcDb
-> [KcDb]
-> KcMergeMode
-> IO ()
kcdbmerge db srcs mode = do
withForeignPtr (unKcDb db) $ \c_db -> do
let elts = length srcs
allocaArray elts $ \srcarr -> do
pokeArray srcarr (map (unsafeForeignPtrToPtr . unKcDb) srcs)
let m = fromIntegral $ numOfKcMergeMode mode
_kcdbmerge c_db srcarr (fromIntegral elts) m
>>= handleBoolResult db "kcdbmerge"
foreign import ccall safe "kclangc.h kcdbmerge" _kcdbmerge
:: Ptr KCDB -> Ptr (Ptr KCDB) -> CSize -> CUInt -> IO CInt
newtype KcCur = KcCur { unKcCur :: ForeignPtr KCCUR } deriving (Eq)
data KCCUR
kcdbcursor :: KcDb -> IO KcCur
kcdbcursor db =
withForeignPtr (unKcDb db) $ \c_db -> do
cur <- _kcdbcursor c_db
fp <- newForeignPtr_ cur
return $ KcCur fp
foreign import ccall safe "kclangc.h kcdbcursor" _kcdbcursor
:: Ptr KCDB -> IO (Ptr KCCUR)
foreign import ccall safe "kclangc.h &kccurdel" _kccurdelFunPtr
:: FunPtr (Ptr KCCUR -> IO ())
kccurdel :: KcCur -> IO ()
kccurdel cur =
withForeignPtr (unKcCur cur) $ \c_cur -> do
_kccurdel c_cur
foreign import ccall safe "kclangc.h kccurdel" _kccurdel
:: Ptr KCCUR -> IO ()
kccuraccept :: KcCur
-> KcVisitFull
-> Bool
-> Bool
-> IO ()
kccuraccept cur visitFull writable step = do
withForeignPtr (unKcCur cur) $ \c_cur -> do
vf <- wrapKCVISITFULL $ callVisitFull visitFull
rv <- _kccuraccept c_cur vf nullPtr (if writable then 1 else 0)
(if step then 1 else 0)
freeHaskellFunPtr vf
db <- kccurdb cur
handleBoolResult db "kccuraccept" rv
foreign import ccall safe "kclangc.h kccuraccept" _kccuraccept
:: Ptr KCCUR -> FunPtr KCVISITFULL -> Ptr () -> CInt -> CInt -> IO CInt
kccurremove :: KcCur -> IO ()
kccurremove cur = do
withForeignPtr (unKcCur cur) $ \c_cur -> do
rv <- _kccurremove c_cur
db <- kccurdb cur
handleBoolResult db "kccurremove" rv
foreign import ccall safe "kclangc.h kccurremove" _kccurremove
:: Ptr KCCUR -> IO CInt
kccurgetkey :: KcCur
-> Bool
-> IO BS.ByteString
kccurgetkey cur step = do
withForeignPtr (unKcCur cur) $ \c_cur -> do
alloca $ \ptr -> do
cstr <- _kccurgetkey c_cur ptr (if step then 1 else 0)
if cstr == nullPtr then kccurdb cur >>= flip kcThrow "kccurgetkey"
else do
len <- peek ptr
BS.unsafePackCStringFinalizer (castPtr cstr) (fromIntegral len) (kcfree cstr)
foreign import ccall safe "kclangc.h kccurgetkey" _kccurgetkey
:: Ptr KCCUR -> Ptr CSize -> CInt -> IO CString
kccurgetvalue :: KcCur
-> Bool
-> IO BS.ByteString
kccurgetvalue cur step = do
withForeignPtr (unKcCur cur) $ \c_cur -> do
alloca $ \ptr -> do
cstr <- _kccurgetvalue c_cur ptr (if step then 1 else 0)
if cstr == nullPtr then kccurdb cur >>= flip kcThrow "kccurgetkey"
else do
len <- peek ptr
BS.unsafePackCStringFinalizer (castPtr cstr) (fromIntegral len) (kcfree cstr)
foreign import ccall safe "kclangc.h kccurgetvalue" _kccurgetvalue
:: Ptr KCCUR -> Ptr CSize -> CInt -> IO CString
kccurget :: KcCur
-> Bool
-> IO (BS.ByteString, BS.ByteString)
kccurget cur step = do
withForeignPtr (unKcCur cur) $ \c_cur -> do
alloca $ \ksp -> do
alloca $ \vbp -> do
alloca $ \vsp -> do
cstr <- _kccurget c_cur ksp vbp vsp (if step then 1 else 0)
if cstr == nullPtr then kccurdb cur >>= flip kcThrow "kccurget"
else do
ks <- peek ksp
key <- BS.unsafePackCStringFinalizer (castPtr cstr) (fromIntegral ks)
(kcfree cstr)
vb <- peek vbp
vs <- peek vsp
val <- BS.packCStringLen (vb, fromIntegral vs)
return (key, val)
foreign import ccall safe "kclangc.h kccurget" _kccurget
:: Ptr KCCUR -> Ptr CSize -> Ptr CString -> Ptr CSize -> CInt ->
IO CString
kccurjump :: KcCur -> IO ()
kccurjump cur =
withForeignPtr (unKcCur cur) $ \c_cur -> do
rv <- _kccurjump c_cur
db <- kccurdb cur
handleBoolResult db "kccurjump" rv
foreign import ccall safe "kclangc.h kccurjump" _kccurjump
:: Ptr KCCUR -> IO CInt
kccurjumpkey :: KcCur -> BS.ByteString -> IO ()
kccurjumpkey cur key =
withForeignPtr (unKcCur cur) $ \c_cur -> do
BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do
rv <- _kccurjumpkey c_cur kbuf (fromIntegral ksiz)
db <- kccurdb cur
handleBoolResult db "kccurjumpkey" rv
foreign import ccall safe "kclangc.h kccurjumpkey" _kccurjumpkey
:: Ptr KCCUR -> CString -> CSize -> IO CInt
kccurjumpback :: KcCur -> IO ()
kccurjumpback cur =
withForeignPtr (unKcCur cur) $ \c_cur -> do
rv <- _kccurjumpback c_cur
db <- kccurdb cur
handleBoolResult db "kccurjumpback" rv
foreign import ccall safe "kclangc.h kccurjumpback" _kccurjumpback
:: Ptr KCCUR -> IO CInt
kccurjumpbackkey :: KcCur -> BS.ByteString -> IO ()
kccurjumpbackkey cur key =
withForeignPtr (unKcCur cur) $ \c_cur -> do
BS.unsafeUseAsCStringLen key $ \(kbuf, ksiz) -> do
rv <- _kccurjumpbackkey c_cur kbuf (fromIntegral ksiz)
db <- kccurdb cur
handleBoolResult db "kccurjumpbackkey" rv
foreign import ccall safe "kclangc.h kccurjumpbackkey" _kccurjumpbackkey
:: Ptr KCCUR -> CString -> CSize -> IO CInt
kccurstep :: KcCur -> IO ()
kccurstep cur =
withForeignPtr (unKcCur cur) $ \c_cur -> do
rv <- _kccurstep c_cur
db <- kccurdb cur
handleBoolResult db "kccurstep" rv
foreign import ccall safe "kclangc.h kccurstep" _kccurstep
:: Ptr KCCUR -> IO CInt
kccurstepback :: KcCur -> IO ()
kccurstepback cur =
withForeignPtr (unKcCur cur) $ \c_cur -> do
rv <- _kccurstepback c_cur
db <- kccurdb cur
handleBoolResult db "kccurstepback" rv
foreign import ccall safe "kclangc.h kccurstepback" _kccurstepback
:: Ptr KCCUR -> IO CInt
kccurdb :: KcCur -> IO KcDb
kccurdb cur =
withForeignPtr (unKcCur cur) $ \c_cur -> do
_kccurdb c_cur >>= wrapdb
foreign import ccall unsafe "kclangc.h kccurdb" _kccurdb
:: Ptr KCCUR -> IO (Ptr KCDB)
kccurecode :: KcCur -> IO KcError
kccurecode cur =
withForeignPtr (unKcCur cur) $ \c_cur -> do
code <- _kccurecode c_cur
return $ kcErrorOfNum code
foreign import ccall unsafe "kclangc.h kccurecode" _kccurecode
:: Ptr KCCUR -> IO CInt
kccuremsg :: KcCur -> IO String
kccuremsg cur =
withForeignPtr (unKcCur cur) $ \c_cur -> do
msg <- _kccuremsg c_cur
peekCAString msg
foreign import ccall unsafe "kclangc.h kccuremsg" _kccuremsg
:: Ptr KCCUR -> IO CString
kcwithdbopen :: FilePath -> [KcTune] -> [KcOpenMode] -> (KcDb -> IO a) -> IO a
kcwithdbopen path tune mode action =
bracket
(do db <- kcdbnew
kcdbopen db path tune mode
return db)
(\db -> do kcdbclose db
kcdbdel db)
action
kcwithdbcursor :: KcDb -> (KcCur -> IO a) -> IO a
kcwithdbcursor db action = bracket (kcdbcursor db) kccurdel action
kcwithdbtran :: KcDb
-> Bool
-> IO a
-> IO a
kcwithdbtran db hard action =
bracketOnError (kcdbbegintran db hard)
(const $ kcdbendtran db False)
(const $ do rv <- action; kcdbendtran db True; return rv)