module Database.TokyoCabinet.FDB
(
FDB
, ECODE(..)
, OpenMode(..)
, ID(..)
, new
, delete
, ecode
, errmsg
, tune
, open
, close
, put
, putkeep
, putcat
, out
, get
, vsiz
, iterinit
, iternext
, range
, fwmkeys
, addint
, adddouble
, sync
, optimize
, vanish
, copy
, path
, rnum
, fsiz
) where
import Database.TokyoCabinet.Error
import Database.TokyoCabinet.FDB.C
import Database.TokyoCabinet.FDB.Key
import Database.TokyoCabinet.Internal
import Database.TokyoCabinet.Sequence
import Database.TokyoCabinet.Storable
import Foreign.Ptr
import Foreign.ForeignPtr
import Foreign.C.Types
import Foreign.Storable (peek)
import Foreign.Marshal (alloca, free)
import Foreign.Marshal.Array (peekArray)
import Foreign.Marshal.Utils (maybePeek)
import Data.Int
import Data.Word
import Control.Exception
data FDB = FDB { unTCFDB :: !(ForeignPtr FDB') }
new :: IO FDB
new = FDB `fmap` (c_tcfdbnew >>= newForeignPtr tcfdbFinalizer)
delete :: FDB -> IO ()
delete fdb = finalizeForeignPtr $ unTCFDB fdb
ecode :: FDB -> IO ECODE
ecode fdb =
withForeignPtr (unTCFDB fdb) $ \fdb' ->
cintToError `fmap` c_tcfdbecode fdb'
tune :: FDB
-> Int32
-> Int64
-> IO Bool
tune fdb width limsiz =
withForeignPtr (unTCFDB fdb) $ \fdb' -> c_tcfdbtune fdb' width limsiz
open :: FDB -> String -> [OpenMode] -> IO Bool
open = openHelper c_tcfdbopen unTCFDB combineOpenMode
close :: FDB -> IO Bool
close fdb = withForeignPtr (unTCFDB fdb) c_tcfdbclose
type FunPut' = Ptr FDB' -> Int64 -> Ptr Word8 -> CInt -> IO Bool
putHelper' :: (Key k, Storable v) => FunPut' -> FDB -> k -> v -> IO Bool
putHelper' func fdb key val =
withForeignPtr (unTCFDB fdb) $ \fdb' ->
withPtrLen val $ \(vbuf, vsize) -> do
key' <- keyToInt key
func fdb' key' vbuf vsize
put :: (Key k, Storable v) => FDB -> k -> v -> IO Bool
put = putHelper' c_tcfdbput
putkeep :: (Key k, Storable v) => FDB -> k -> v -> IO Bool
putkeep = putHelper' c_tcfdbputkeep
putcat :: (Key k, Storable v) => FDB -> k -> v -> IO Bool
putcat = putHelper' c_tcfdbputcat
out :: (Key k) => FDB -> k -> IO Bool
out fdb key =
withForeignPtr (unTCFDB fdb) $ \fdb' ->
c_tcfdbout fdb' =<< keyToInt key
get :: (Key k, Storable v) => FDB -> k -> IO (Maybe v)
get fdb key =
withForeignPtr (unTCFDB fdb) $ \fdb' ->
alloca $ \sizbuf -> do
key' <- keyToInt key
vbuf <- c_tcfdbget fdb' key' sizbuf
vsize <- peek sizbuf
flip maybePeek vbuf $ \vbuf' -> peekPtrLen (vbuf', vsize)
vsiz :: (Key k) => FDB -> k -> IO (Maybe Int)
vsiz fdb key =
withForeignPtr (unTCFDB fdb) $ \fdb' -> do
vsize <- c_tcfdbvsiz fdb' =<< keyToInt key
return $ if vsize == (1)
then Nothing
else Just (fromIntegral vsize)
iterinit :: FDB -> IO Bool
iterinit fdb = withForeignPtr (unTCFDB fdb) c_tcfdbiterinit
iternext :: (Key k) => FDB -> IO (Maybe k)
iternext fdb =
withForeignPtr (unTCFDB fdb) $ \fdb' -> do
i <- c_tcfdbiternext fdb'
return $ if i == 0
then Nothing
else Just (fromID $ ID i)
range :: (Key k1, Key k2) =>
FDB
-> k1
-> k1
-> Int
-> IO [k2]
range fdb lower upper maxn =
withForeignPtr (unTCFDB fdb) $ \fdb' ->
alloca $ \sizbuf -> do
[l, u] <- mapM keyToInt [lower, upper]
rp <- c_tcfdbrange fdb' l u (fromIntegral maxn) sizbuf
size <- fromIntegral `fmap` peek sizbuf
keys <- peekArray size rp
free rp
return $ map (fromID . ID) keys
fwmkeys :: (Storable k1, Storable k2, Sequence q) =>
FDB -> k1 -> Int -> IO (q k2)
fwmkeys fdb k maxn = smap fromString =<< fwmkeys' fdb k maxn
where fwmkeys' = fwmHelper c_tcfdbrange4 unTCFDB
addint :: (Key k) => FDB -> k -> Int -> IO (Maybe Int)
addint fdb key num =
withForeignPtr (unTCFDB fdb) $ \fdb' -> do
key' <- keyToInt key
sumval <- c_tcfdbaddint fdb' key' (fromIntegral num)
return $ if sumval == cINT_MIN
then Nothing
else Just $ fromIntegral sumval
adddouble :: (Key k) => FDB -> k -> Double -> IO (Maybe Double)
adddouble fdb key num =
withForeignPtr (unTCFDB fdb) $ \fdb' -> do
key' <- keyToInt key
sumval <- c_tcfdbadddouble fdb' key' (realToFrac num)
return $ if isNaN sumval
then Nothing
else Just $ realToFrac sumval
sync :: FDB -> IO Bool
sync fdb = withForeignPtr (unTCFDB fdb) c_tcfdbsync
optimize :: FDB -> Int32 -> Int64 -> IO Bool
optimize fdb width limsiz =
withForeignPtr (unTCFDB fdb) $ \fdb' -> c_tcfdboptimize fdb' width limsiz
vanish :: FDB -> IO Bool
vanish fdb = withForeignPtr (unTCFDB fdb) c_tcfdbvanish
copy :: FDB -> String -> IO Bool
copy = copyHelper c_tcfdbcopy unTCFDB
path :: FDB -> IO (Maybe String)
path = pathHelper c_tcfdbpath unTCFDB
rnum :: FDB -> IO Word64
rnum fdb = withForeignPtr (unTCFDB fdb) c_tcfdbrnum
fsiz :: FDB -> IO Word64
fsiz fdb = withForeignPtr (unTCFDB fdb) c_tcfdbfsiz
keyToInt :: (Key k) => k -> IO Int64
keyToInt i = catchJust selector (evaluate (unID . toID $ i)) handler
where
selector :: ErrorCall -> Maybe ()
selector e = if show e == "Prelude.read: no parse"
then Just ()
else Nothing
handler _ = error "Database.TokyoCabinet.FDB: invalid key"