-- | Interface to Fixed-length DBM. See also,
-- <http://tokyocabinet.sourceforge.net/spex-en.html#tcfdbapi> for details
module Database.TokyoCabinet.FDB
(
-- $doc
-- * Constructors
FDB
, ECODE(..)
, OpenMode(..)
, ID(..)
-- * Basic API (tokyocabinet.idl compliant)
, 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 qualified Database.TokyoCabinet.Storable as S
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
-- $doc
-- Example
--
-- @
-- import Control.Monad
-- import Database.TokyoCabinet.FDB
-- @
--
-- @
-- main = do fdb <- new
-- -- open the database
-- open fdb \"casket.tcf\" [OWRITER, OCREAT] >>= err fdb
-- -- store records
-- puts fdb [(1, \"one\"), (12, \"twelve\"), (144, \"one forty four\")] >>=
-- err fdb . (all id)
-- -- retrieve records
-- get fdb (1 :: Int) >>= maybe (error \"something goes wrong\") putStrLn
-- -- close the database
-- close fdb >>= err fdb
-- where
-- puts :: FDB -> [(Int, String)] -> IO [Bool]
-- puts fdb = mapM (uncurry $ put fdb)
-- @
--
-- @
-- err :: FDB -> Bool -> IO ()
-- err fdb = flip unless $ ecode fdb >>= error . show
-- @
--
data FDB = FDB { unTCFDB :: !(ForeignPtr FDB') }
-- | Create a Fixed-length database object.
new :: IO FDB
new = FDB `fmap` (c_tcfdbnew >>= newForeignPtr tcfdbFinalizer)
-- | Free FDB resource forcibly.
-- FDB is kept by ForeignPtr, so Haskell runtime GC cleans up memory for
-- almost situation. Most always, you don't need to call this.
-- After call this, you must not touch FDB object. Its behavior is undefined.
delete :: FDB -> IO ()
delete fdb = finalizeForeignPtr $ unTCFDB fdb
-- | Return the last happened error code.
ecode :: FDB -> IO ECODE
ecode fdb =
withForeignPtr (unTCFDB fdb) $ \fdb' ->
cintToError `fmap` c_tcfdbecode fdb'
-- | Set the tuning parameters.
tune :: FDB -- ^ FDB object.
-> Int32 -- ^ the width of the value of each record.
-> Int64 -- ^ the limit size of the database file.
-> IO Bool -- ^ if successful, the return value is True.
tune fdb width limsiz =
withForeignPtr (unTCFDB fdb) $ \fdb' -> c_tcfdbtune fdb' width limsiz
-- | Open FDB database file.
open :: FDB -> String -> [OpenMode] -> IO Bool
open = openHelper c_tcfdbopen unTCFDB combineOpenMode
-- | Close the database file.
close :: FDB -> IO Bool
close fdb = withForeignPtr (unTCFDB fdb) c_tcfdbclose
type FunPut' = Ptr FDB' -> Int64 -> Ptr Word8 -> CInt -> IO Bool
putHelper' :: (Key k, S.Storable v) => FunPut' -> FDB -> k -> v -> IO Bool
putHelper' func fdb key val =
withForeignPtr (unTCFDB fdb) $ \fdb' ->
S.withPtrLen val $ \(vbuf, vsize) -> do
key' <- keyToInt key
func fdb' key' vbuf vsize
-- | Stora a record (key-value pair) on FDB. Key type must be
-- instance of Key class. Value type must be instance of Storable.
put :: (Key k, S.Storable v) => FDB -> k -> v -> IO Bool
put = putHelper' c_tcfdbput
-- | Store a new record. If a record with the same key exists in the
-- database, this function has no effect.
putkeep :: (Key k, S.Storable v) => FDB -> k -> v -> IO Bool
putkeep = putHelper' c_tcfdbputkeep
-- | Concatenate a value at the end of the existing record.
putcat :: (Key k, S.Storable v) => FDB -> k -> v -> IO Bool
putcat = putHelper' c_tcfdbputcat
-- | Delete a record.
out :: (Key k) => FDB -> k -> IO Bool
out fdb key =
withForeignPtr (unTCFDB fdb) $ \fdb' ->
c_tcfdbout fdb' =<< keyToInt key
-- | Return the value of record.
get :: (Key k, S.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' -> S.peekPtrLen (vbuf', vsize)
-- | Return the byte size of value in a record.
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)
-- | Initialize the iterator of a FDB object.
iterinit :: FDB -> IO Bool
iterinit fdb = withForeignPtr (unTCFDB fdb) c_tcfdbiterinit
-- | Return the next key of the iterator of a FDB object.
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)
-- | Return list of keys in the specified range.
range :: (Key k1, Key k2) =>
FDB -- ^ FDB object
-> k1 -- ^ the lower limit of the range.
-> k1 -- ^ the upper limit of the range.
-> Int -- ^ the maximum number of keys to be fetched.
-> IO [k2] -- ^ keys in the specified range.
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
-- | Return list of forward matched keys.
fwmkeys :: (S.Storable k1, S.Storable k2) => FDB -> k1 -> Int -> IO [k2]
fwmkeys fdb k maxn = map S.fromString `fmap` fwmkeys' fdb k maxn
where fwmkeys' = fwmHelper c_tcfdbrange4 unTCFDB
-- | Increment the corresponding value. (The value specified by a key
-- is treated as integer.)
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
-- | Increment the corresponding value. (The value specified by a key
-- is treated as double.)
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
-- | Synchronize updated contents of a database object with the file
-- and the device.
sync :: FDB -> IO Bool
sync fdb = withForeignPtr (unTCFDB fdb) c_tcfdbsync
-- | Optimize the file of a Hash database object.
optimize :: FDB -> Int32 -> Int64 -> IO Bool
optimize fdb width limsiz =
withForeignPtr (unTCFDB fdb) $ \fdb' -> c_tcfdboptimize fdb' width limsiz
-- | Delete all records.
vanish :: FDB -> IO Bool
vanish fdb = withForeignPtr (unTCFDB fdb) c_tcfdbvanish
-- | Copy the database file.
copy :: FDB -> String -> IO Bool
copy = copyHelper c_tcfdbcopy unTCFDB
-- | Return the file path of currentry opened database.
path :: FDB -> IO (Maybe String)
path = pathHelper c_tcfdbpath unTCFDB
-- | Return the number of records in the database.
rnum :: FDB -> IO Int64
rnum fdb = withForeignPtr (unTCFDB fdb) c_tcfdbrnum
-- | Return the size of the database file.
fsiz :: FDB -> IO Int64
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"