-- | 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 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
-- $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, 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
-- | 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, 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, Storable v) => FDB -> k -> v -> IO Bool
putkeep = putHelper' c_tcfdbputkeep
-- | Concatenate a value at the end of the existing record.
putcat :: (Key k, 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, 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)
-- | 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 :: (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
-- | 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 Word64
rnum fdb = withForeignPtr (unTCFDB fdb) c_tcfdbrnum
-- | Return the size of the database file.
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"