tokyocabinet-haskell-0.0.5: Haskell binding of Tokyo Cabinet

Database.TokyoCabinet.BDB

Contents

Description

Interface to B+ tree based DBM. See also, http://tokyocabinet.sourceforge.net/spex-en.html#tcbdbapi for details

Synopsis

Documentation

Example

    import Control.Monad
    import Database.TokyoCabinet.BDB
    import qualified Database.TokyoCabinet.BDB.Cursor as C
  
    main :: IO ()
    main =
        do bdb <- new
           -- open the database
           open bdb "casket.tcb" [OWRITER, OCREAT] >>= err bdb
           -- store records
           puts bdb [ ("foo", "hop"), ("bar", "step"), ("baz", "jump") ] >>=
                    err bdb . (all id)
           -- retrieve records
           get bdb "foo" >>= maybe (error "something goes wrong") putStrLn
           -- traverse records
           cur <- C.new bdb
           C.first cur >>= err bdb
           iter cur >>= putStrLn . show
           -- close the database
           close bdb >>= err bdb
        where
          puts :: BDB -> [(String, String)] -> IO [Bool]
          puts bdb = mapM (uncurry $ put bdb)
          err :: BDB -> Bool -> IO ()
          err bdb = flip unless $ ecode bdb >>= error . show
  
          iter :: C.BDBCUR -> IO [(String, String)]
          iter cur = do
            [key, value] <- sequence [C.key cur, C.val cur]
            case (key, value) of
              (Just k, Just v) -> C.next cur >> iter cur >>= return . ((k,v):)
              _ -> return []

data BDB Source

Instances

data ECODE Source

Represents error

Constructors

ESUCCESS

success

ETHREAD

threading error

EINVALID

invalid operation

ENOFILE

file not found

ENOPERM

no permission

EMETA

invalid meta data

ERHEAD

invalid record header

EOPEN

open error

ECLOSE

close error

ETRUNC

trunc error

ESYNC

sync error

ESTAT

stat error

ESEEK

seek error

EREAD

read error

EWRITE

write error

EMMAP

mmap error

ELOCK

lock error

EUNLINK

unlink error

ERENAME

rename error

EMKDIR

mkdir error

ERMDIR

rmdir error

EKEEP

existing record

ENOREC

no record found

EMISC

miscellaneous error

Instances

Basic API (tokyocabinet.idl compliant)

new :: IO BDBSource

Create a B+ tree database object.

delete :: BDB -> IO ()Source

Free BDB resource forcibly. BDB 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 BDB object. Its behavior is undefined.

ecode :: BDB -> IO ECODESource

Return the last happened error code.

errmsg :: ECODE -> StringSource

Convert error code to message string.

tuneSource

Arguments

:: BDB

BDB object

-> Int32

the number of members in each leaf page.

-> Int32

the number of members in each non-leaf page.

-> Int64

the number of elements of the bucket array.

-> Int8

the size of record alignment by power of 2.

-> Int8

the maximum number of elements of the free block pool by power of 2.

-> [TuningOption]

tuning options

-> IO Bool

if successful, the return value is True.

Set the tuning parameters.

setcacheSource

Arguments

:: BDB

BDB object

-> Int32

the maximum number of leaf nodes to be cached.

-> Int32

the maximum number of non-leaf nodes to be cached.

-> IO Bool

if successful, the return value is True.

Set the caching parameters.

setxmsiz :: BDB -> Int64 -> IO BoolSource

Set the size of extra mapped memory.

setcmpfunc :: BDB -> CMP -> IO BoolSource

Set the custom comparison function of a B+ tree database object.

open :: BDB -> String -> [OpenMode] -> IO BoolSource

Open BDB database file.

close :: BDB -> IO BoolSource

Close the database file.

put :: (Storable k, Storable v) => BDB -> k -> v -> IO BoolSource

Stora a record (key-value pair) on BDB. Key and value type must be instance of Storable class. Usually, we can use String, ByteString for key, String, ByteString, Int, Double for value.

putkeep :: (Storable k, Storable v) => BDB -> k -> v -> IO BoolSource

Store a new record. If a record with the same key exists in the database, this function has no effect.

putcat :: (Storable k, Storable v) => BDB -> k -> v -> IO BoolSource

Concatenate a value at the end of the existing record.

putdup :: (Storable k, Storable v) => BDB -> k -> v -> IO BoolSource

Store a record with allowing duplication of keys.

putlist :: (Storable k, Storable v, Sequence q) => BDB -> k -> q v -> IO BoolSource

Store records with allowing duplication of keys.

out :: Storable k => BDB -> k -> IO BoolSource

Delete a record. If the key of duplicated records is specified, the first one is deleted.

outlist :: Storable k => BDB -> k -> IO BoolSource

Delete records. If the key of duplicated records is specified, all of them are deleted.

get :: (Storable k, Storable v) => BDB -> k -> IO (Maybe v)Source

Return the value of record. If the key of duplicated records is specified, the first one is returned.

getlist :: (Storable k, Storable v, Sequence q) => BDB -> k -> IO (q v)Source

Retrieve records.

vnum :: Storable k => BDB -> k -> IO (Maybe Int)Source

Return the number of records corresponding to a key.

vsiz :: Storable k => BDB -> k -> IO (Maybe Int)Source

Return the size of the value of a record. If the key of duplicated records is specified, the first one is selected.

rangeSource

Arguments

:: (Storable k, Sequence q) 
=> BDB

BDB object

-> Maybe k

the key of the beginning border. If it is Nothing, the first record in the database is specified.

-> Bool

whether the beginning border is inclusive or not.

-> Maybe k

the key of the ending border. If it is Nothing, the last record is specified.

-> Bool

whether the ending border is inclusive or not.

-> Int

the maximum number of keys to be fetched. If it is negative value, no limit is specified.

-> IO (q k)

keys in the specified range.

Return list of keys in the specified range.

fwmkeysSource

Arguments

:: (Storable k1, Storable k2, Sequence q) 
=> BDB

BDB object

-> k1

search string

-> Int

the maximum number of keys to be fetched. If it is negative value, no limit is specified.

-> IO (q k2)

keys matches specified string (in forward matching).

Return list of forward matched keys.

addintSource

Arguments

:: Storable k 
=> BDB

BDB object.

-> k

Key.

-> Int

Amount of increment.

-> IO (Maybe Int)

If successful, a new value is returned.

Increment the corresponding value. (The value specified by a key is treated as integer.)

adddoubleSource

Arguments

:: Storable k 
=> BDB

BDB object.

-> k

Key.

-> Double

Amount of increment.

-> IO (Maybe Double)

If successful, a new value is returned.

Increment the corresponding value. (The value specified by a key is treated as double.)

sync :: BDB -> IO BoolSource

Synchronize updated contents of a database object with the file and the device.

optimizeSource

Arguments

:: BDB 
-> Int32

the number of members in each leaf page.

-> Int32

the number of members in each non-leaf page.

-> Int64

the number of elements of the bucket array.

-> Int8

the size of record alignment by power of 2.

-> Int8

the maximum number of elements of the free block pool by power of 2.

-> [TuningOption]

tuning options

-> IO Bool

if successful, the return value is True.

Optimize the file of a B+ tree database object.

vanish :: BDB -> IO BoolSource

Delete all records.

copy :: BDB -> String -> IO BoolSource

Copy the database file.

tranbegin :: BDB -> IO BoolSource

Begin the transaction.

trancommit :: BDB -> IO BoolSource

Commit the transaction.

tranabort :: BDB -> IO BoolSource

Abort the transaction.

path :: BDB -> IO (Maybe String)Source

Return the file path of currentry opened database.

rnum :: BDB -> IO Word64Source

Return the number of records in the database.

fsiz :: BDB -> IO Word64Source

Return the size of the database file.