/Database/TokyoCabinet/FDB.hs
Haskell | 268 lines | 167 code | 34 blank | 67 comment | 14 complexity | e6b1bf250577c81673a6dce2af486df2 MD5 | raw file
Possible License(s): BSD-3-Clause
- -- | 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"