rocksdb-haskell (empty) → 0.1.0
raw patch · 12 files changed
+1769/−0 lines, 12 filesdep +basedep +bytestringdep +data-defaultsetup-changed
Dependencies added: base, bytestring, data-default, filepath, resourcet, transformers
Files
- AUTHORS +9/−0
- LICENSE +31/−0
- Readme.md +47/−0
- Setup.hs +2/−0
- rocksdb-haskell.cabal +55/−0
- src/Database/RocksDB.hs +17/−0
- src/Database/RocksDB/Base.hs +245/−0
- src/Database/RocksDB/C.hsc +344/−0
- src/Database/RocksDB/Internal.hs +294/−0
- src/Database/RocksDB/Iterator.hs +228/−0
- src/Database/RocksDB/MonadResource.hs +279/−0
- src/Database/RocksDB/Types.hs +218/−0
+ AUTHORS view
@@ -0,0 +1,9 @@+# The following people, listed in alphabetical order, contributed to the+# rocksdb-haskell library:++Austin Seipp+Alexander Thiemann+Kim Altintop+Michael Lazarev+Nicolas Trangez+Will Moss
+ LICENSE view
@@ -0,0 +1,31 @@+Copyright (c) 2011, Kim Altintop+Copyright (c) 2014, Alexander Thiemann++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Kim Altintop nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Readme.md view
@@ -0,0 +1,47 @@+This library provides Haskell bindings to+[RocksDB](http://rocksdb.org)++[](https://drone.io/github.com/agrafix/rocksdb-haskell/latest)++## History++Version 0.1.x:++* initial fork of leveldb-haskell++## Installation++Prerequisites:++* [GHC 7.*](http://www.haskell.org/ghc)+* [Cabal](http://www.haskell.org/cabal), version 1.3 or higher+* [RocksDB](http://rocksdb.org)+* Optional: [Snappy](http://code.google.com/p/snappy),+ if compression support is desired++To install the latest version from hackage:++```shell+$ cabal install rocksdb-haskell+```++To install from checked-out source:++```shell+$ cabal install+```++## Notes++This library is in very early stage and has seen very limited testing. Comments+and contributions are welcome.++## Bugs and Contributing++Please report issues via http://github.com/agrafix/rocksdb-haskell/issues.<br />+Patches are best submitted as pull requests, or via email+(mail@agrafix.net).++## License++BSD 3, see LICENSE file.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ rocksdb-haskell.cabal view
@@ -0,0 +1,55 @@+name: rocksdb-haskell+version: 0.1.0+synopsis: Haskell bindings to RocksDB+homepage: http://github.com/agrafix/rocksdb-haskell+bug-reports: http://github.com/agrafix/rocksdb-haskell/issues+license: BSD3+license-file: LICENSE+author: Kim Altintop, Alexander Thiemann et.al. (see AUTHORS file)+maintainer: mail@agrafix.net+copyright: Copyright (c) 2012-2014 The leveldb-haskell Authors, Copyright (c) 2014 The rocksdb-haskell Authors+category: Database, FFI+stability: Experimental+build-type: Simple+cabal-version: >=1.10+tested-with: GHC == 7.2.2, GHC == 7.4.1+description:+ From <http://rocksdb.org>:+ .+ RocksDB is an embeddable persistent key-value store for fast storage. RocksDB can also be the foundation for a client-server database but our current focus is on embedded workloads.+ .+ RocksDB builds on LevelDB to be scalable to run on servers with many CPU cores, to efficiently use fast storage, to support IO-bound, in-memory and write-once workloads, and to be flexible to allow for innovation.+extra-source-files: Readme.md, AUTHORS++source-repository head+ type: git+ location: git://github.com/agrafix/rocksdb-haskell.git++library+ exposed-modules: Database.RocksDB+ , Database.RocksDB.Base+ , Database.RocksDB.C+ , Database.RocksDB.Internal+ , Database.RocksDB.Iterator+ , Database.RocksDB.MonadResource+ , Database.RocksDB.Types++ default-language: Haskell2010+ other-extensions: CPP+ , ForeignFunctionInterface+ , EmptyDataDecls+ , RecordWildCards++ build-depends: base >= 3 && < 5+ , bytestring+ , data-default+ , filepath+ , resourcet > 0.3.2+ , transformers++ ghc-options: -Wall -rtsopts -funbox-strict-fields+ ghc-prof-options: -prof -auto-all++ hs-source-dirs: src++ extra-libraries: rocksdb
+ src/Database/RocksDB.hs view
@@ -0,0 +1,17 @@+-- |+-- Module : Database.RocksDB+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors+-- (c) 2014 The rocksdb-haskell Authors+-- License : BSD3+-- Maintainer : mail@agrafix.net+-- Stability : experimental+-- Portability : non-portable+--+-- RocksDB Haskell binding.+--+-- The API closely follows the C-API of RocksDB.+-- For more information, see: <http://rocksdb.org>++module Database.RocksDB (module R) where++import Database.RocksDB.MonadResource as R
+ src/Database/RocksDB/Base.hs view
@@ -0,0 +1,245 @@+-- |+-- Module : Database.RocksDB.Base+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors+-- (c) 2014 The rocksdb-haskell Authors+-- License : BSD3+-- Maintainer : mail@agrafix.net+-- Stability : experimental+-- Portability : non-portable+--+-- RocksDB Haskell binding.+--+-- The API closely follows the C-API of RocksDB.+-- For more information, see: <http://agrafix.net>++module Database.RocksDB.Base+ ( -- * Exported Types+ DB+ , BatchOp (..)+ , Comparator (..)+ , Compression (..)+ , Options (..)+ , ReadOptions (..)+ , Snapshot+ , WriteBatch+ , WriteOptions (..)+ , Range++ -- * Defaults+ , defaultOptions+ , defaultReadOptions+ , defaultWriteOptions++ -- * Basic Database Manipulations+ , open+ , close+ , put+ , delete+ , write+ , get+ , withSnapshot+ , createSnapshot+ , releaseSnapshot++ -- * Filter Policy / Bloom Filter+ , FilterPolicy (..)+ , BloomFilter+ , createBloomFilter+ , releaseBloomFilter++ -- * Administrative Functions+ , Property (..), getProperty+ , destroy+ , repair+ , approximateSize++ -- * Iteration+ , module Database.RocksDB.Iterator+ )+where++import Control.Applicative ((<$>))+import Control.Exception (bracket, bracketOnError, finally)+import Control.Monad (liftM)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Data.ByteString (ByteString)+import Data.ByteString.Internal (ByteString (..))+import Foreign+import Foreign.C.String (withCString)++import Database.RocksDB.C+import Database.RocksDB.Internal+import Database.RocksDB.Iterator+import Database.RocksDB.Types++import qualified Data.ByteString as BS+import qualified Data.ByteString.Unsafe as BU+++-- | Open a database.+--+-- The returned handle should be released with 'close'.+open :: MonadIO m => FilePath -> Options -> m DB+open path opts = liftIO $ bracketOnError (mkOpts opts) freeOpts mkDB+ where+ mkDB opts'@(Options' opts_ptr _ _ _) =+ withCString path $ \path_ptr ->+ liftM (`DB` opts')+ $ throwIfErr "open"+ $ c_rocksdb_open opts_ptr path_ptr++-- | Close a database.+--+-- The handle will be invalid after calling this action and should no+-- longer be used.+close :: MonadIO m => DB -> m ()+close (DB db_ptr opts_ptr) = liftIO $+ c_rocksdb_close db_ptr `finally` freeOpts opts_ptr+++-- | Run an action with a 'Snapshot' of the database.+withSnapshot :: MonadIO m => DB -> (Snapshot -> IO a) -> m a+withSnapshot db act = liftIO $+ bracket (createSnapshot db) (releaseSnapshot db) act++-- | Create a snapshot of the database.+--+-- The returned 'Snapshot' should be released with 'releaseSnapshot'.+createSnapshot :: MonadIO m => DB -> m Snapshot+createSnapshot (DB db_ptr _) = liftIO $+ Snapshot <$> c_rocksdb_create_snapshot db_ptr++-- | Release a snapshot.+--+-- The handle will be invalid after calling this action and should no+-- longer be used.+releaseSnapshot :: MonadIO m => DB -> Snapshot -> m ()+releaseSnapshot (DB db_ptr _) (Snapshot snap) = liftIO $+ c_rocksdb_release_snapshot db_ptr snap++-- | Get a DB property.+getProperty :: MonadIO m => DB -> Property -> m (Maybe ByteString)+getProperty (DB db_ptr _) p = liftIO $+ withCString (prop p) $ \prop_ptr -> do+ val_ptr <- c_rocksdb_property_value db_ptr prop_ptr+ if val_ptr == nullPtr+ then return Nothing+ else do res <- Just <$> BS.packCString val_ptr+ free val_ptr+ return res+ where+ prop (NumFilesAtLevel i) = "rocksdb.num-files-at-level" ++ show i+ prop Stats = "rocksdb.stats"+ prop SSTables = "rocksdb.sstables"++-- | Destroy the given RocksDB database.+destroy :: MonadIO m => FilePath -> Options -> m ()+destroy path opts = liftIO $ bracket (mkOpts opts) freeOpts destroy'+ where+ destroy' (Options' opts_ptr _ _ _) =+ withCString path $ \path_ptr ->+ throwIfErr "destroy" $ c_rocksdb_destroy_db opts_ptr path_ptr++-- | Repair the given RocksDB database.+repair :: MonadIO m => FilePath -> Options -> m ()+repair path opts = liftIO $ bracket (mkOpts opts) freeOpts repair'+ where+ repair' (Options' opts_ptr _ _ _) =+ withCString path $ \path_ptr ->+ throwIfErr "repair" $ c_rocksdb_repair_db opts_ptr path_ptr+++-- TODO: support [Range], like C API does+type Range = (ByteString, ByteString)++-- | Inspect the approximate sizes of the different levels.+approximateSize :: MonadIO m => DB -> Range -> m Int64+approximateSize (DB db_ptr _) (from, to) = liftIO $+ BU.unsafeUseAsCStringLen from $ \(from_ptr, flen) ->+ BU.unsafeUseAsCStringLen to $ \(to_ptr, tlen) ->+ withArray [from_ptr] $ \from_ptrs ->+ withArray [intToCSize flen] $ \flen_ptrs ->+ withArray [to_ptr] $ \to_ptrs ->+ withArray [intToCSize tlen] $ \tlen_ptrs ->+ allocaArray 1 $ \size_ptrs -> do+ c_rocksdb_approximate_sizes db_ptr 1+ from_ptrs flen_ptrs+ to_ptrs tlen_ptrs+ size_ptrs+ liftM head $ peekArray 1 size_ptrs >>= mapM toInt64++ where+ toInt64 = return . fromIntegral+++-- | Write a key/value pair.+put :: MonadIO m => DB -> WriteOptions -> ByteString -> ByteString -> m ()+put (DB db_ptr _) opts key value = liftIO $ withCWriteOpts opts $ \opts_ptr ->+ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+ BU.unsafeUseAsCStringLen value $ \(val_ptr, vlen) ->+ throwIfErr "put"+ $ c_rocksdb_put db_ptr opts_ptr+ key_ptr (intToCSize klen)+ val_ptr (intToCSize vlen)++-- | Read a value by key.+get :: MonadIO m => DB -> ReadOptions -> ByteString -> m (Maybe ByteString)+get (DB db_ptr _) opts key = liftIO $ withCReadOpts opts $ \opts_ptr ->+ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+ alloca $ \vlen_ptr -> do+ val_ptr <- throwIfErr "get" $+ c_rocksdb_get db_ptr opts_ptr key_ptr (intToCSize klen) vlen_ptr+ vlen <- peek vlen_ptr+ if val_ptr == nullPtr+ then return Nothing+ else do+ res' <- Just <$> BS.packCStringLen (val_ptr, cSizeToInt vlen)+ free val_ptr+ return res'++-- | Delete a key/value pair.+delete :: MonadIO m => DB -> WriteOptions -> ByteString -> m ()+delete (DB db_ptr _) opts key = liftIO $ withCWriteOpts opts $ \opts_ptr ->+ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+ throwIfErr "delete"+ $ c_rocksdb_delete db_ptr opts_ptr key_ptr (intToCSize klen)++-- | Perform a batch mutation.+write :: MonadIO m => DB -> WriteOptions -> WriteBatch -> m ()+write (DB db_ptr _) opts batch = liftIO $ withCWriteOpts opts $ \opts_ptr ->+ bracket c_rocksdb_writebatch_create c_rocksdb_writebatch_destroy $ \batch_ptr -> do++ mapM_ (batchAdd batch_ptr) batch++ throwIfErr "write" $ c_rocksdb_write db_ptr opts_ptr batch_ptr++ -- ensure @ByteString@s (and respective shared @CStringLen@s) aren't GC'ed+ -- until here+ mapM_ (liftIO . touch) batch++ where+ batchAdd batch_ptr (Put key val) =+ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+ BU.unsafeUseAsCStringLen val $ \(val_ptr, vlen) ->+ c_rocksdb_writebatch_put batch_ptr+ key_ptr (intToCSize klen)+ val_ptr (intToCSize vlen)++ batchAdd batch_ptr (Del key) =+ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+ c_rocksdb_writebatch_delete batch_ptr key_ptr (intToCSize klen)++ touch (Put (PS p _ _) (PS p' _ _)) = do+ touchForeignPtr p+ touchForeignPtr p'++ touch (Del (PS p _ _)) = touchForeignPtr p++createBloomFilter :: MonadIO m => Int -> m BloomFilter+createBloomFilter i = do+ let i' = fromInteger . toInteger $ i+ fp_ptr <- liftIO $ c_rocksdb_filterpolicy_create_bloom i'+ return $ BloomFilter fp_ptr++releaseBloomFilter :: MonadIO m => BloomFilter -> m ()+releaseBloomFilter (BloomFilter fp) = liftIO $ c_rocksdb_filterpolicy_destroy fp
+ src/Database/RocksDB/C.hsc view
@@ -0,0 +1,344 @@+{-# LANGUAGE CPP, ForeignFunctionInterface, EmptyDataDecls #-}+-- |+-- Module : Database.RocksDB.C+-- Copyright : (c) 2012-2013 The rocksdb-haskell Authors+-- License : BSD3+-- Maintainer : kim.altintop@gmail.com+-- Stability : experimental+-- Portability : non-portable+--++module Database.RocksDB.C where++import Foreign+import Foreign.C.Types+import Foreign.C.String++#include <rocksdb/c.h>++data RocksDB+data LCache+data LComparator+data LIterator+data LLogger+data LOptions+data LReadOptions+data LSnapshot+data LWriteBatch+data LWriteOptions+data LFilterPolicy++type RocksDBPtr = Ptr RocksDB+type CachePtr = Ptr LCache+type ComparatorPtr = Ptr LComparator+type IteratorPtr = Ptr LIterator+type LoggerPtr = Ptr LLogger+type OptionsPtr = Ptr LOptions+type ReadOptionsPtr = Ptr LReadOptions+type SnapshotPtr = Ptr LSnapshot+type WriteBatchPtr = Ptr LWriteBatch+type WriteOptionsPtr = Ptr LWriteOptions+type FilterPolicyPtr = Ptr LFilterPolicy++type DBName = CString+type ErrPtr = Ptr CString+type Key = CString+type Val = CString++newtype CompressionOpt = CompressionOpt { compressionOpt :: CInt }+ deriving (Eq, Show)+#{enum CompressionOpt, CompressionOpt+ , noCompression = 0+ , enableCompression = 1+ }+++foreign import ccall safe "rocksdb/c.h rocksdb_open"+ c_rocksdb_open :: OptionsPtr -> DBName -> ErrPtr -> IO RocksDBPtr++foreign import ccall safe "rocksdb/c.h rocksdb_close"+ c_rocksdb_close :: RocksDBPtr -> IO ()+++foreign import ccall safe "rocksdb/c.h rocksdb_put"+ c_rocksdb_put :: RocksDBPtr+ -> WriteOptionsPtr+ -> Key -> CSize+ -> Val -> CSize+ -> ErrPtr+ -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_delete"+ c_rocksdb_delete :: RocksDBPtr+ -> WriteOptionsPtr+ -> Key -> CSize+ -> ErrPtr+ -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_write"+ c_rocksdb_write :: RocksDBPtr+ -> WriteOptionsPtr+ -> WriteBatchPtr+ -> ErrPtr+ -> IO ()++-- | Returns NULL if not found. A malloc()ed array otherwise. Stores the length+-- of the array in *vallen.+foreign import ccall safe "rocksdb/c.h rocksdb_get"+ c_rocksdb_get :: RocksDBPtr+ -> ReadOptionsPtr+ -> Key -> CSize+ -> Ptr CSize -- ^ value length+ -> ErrPtr+ -> IO CString++foreign import ccall safe "rocksdb/c.h rocksdb_create_snapshot"+ c_rocksdb_create_snapshot :: RocksDBPtr -> IO SnapshotPtr++foreign import ccall safe "rocksdb/c.h rocksdb_release_snapshot"+ c_rocksdb_release_snapshot :: RocksDBPtr -> SnapshotPtr -> IO ()++-- | Returns NULL if property name is unknown. Else returns a pointer to a+-- malloc()-ed null-terminated value.+foreign import ccall safe "rocksdb/c.h rocksdb_property_value"+ c_rocksdb_property_value :: RocksDBPtr -> CString -> IO CString++foreign import ccall safe "rocksdb/c.h rocksdb_approximate_sizes"+ c_rocksdb_approximate_sizes :: RocksDBPtr+ -> CInt -- ^ num ranges+ -> Ptr CString -> Ptr CSize -- ^ range start keys (array)+ -> Ptr CString -> Ptr CSize -- ^ range limit keys (array)+ -> Ptr Word64 -- ^ array of approx. sizes of ranges+ -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_destroy_db"+ c_rocksdb_destroy_db :: OptionsPtr -> DBName -> ErrPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_repair_db"+ c_rocksdb_repair_db :: OptionsPtr -> DBName -> ErrPtr -> IO ()+++--+-- Iterator+--++foreign import ccall safe "rocksdb/c.h rocksdb_create_iterator"+ c_rocksdb_create_iterator :: RocksDBPtr -> ReadOptionsPtr -> IO IteratorPtr++foreign import ccall safe "rocksdb/c.h rocksdb_iter_destroy"+ c_rocksdb_iter_destroy :: IteratorPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_iter_valid"+ c_rocksdb_iter_valid :: IteratorPtr -> IO CUChar++foreign import ccall safe "rocksdb/c.h rocksdb_iter_seek_to_first"+ c_rocksdb_iter_seek_to_first :: IteratorPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_iter_seek_to_last"+ c_rocksdb_iter_seek_to_last :: IteratorPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_iter_seek"+ c_rocksdb_iter_seek :: IteratorPtr -> Key -> CSize -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_iter_next"+ c_rocksdb_iter_next :: IteratorPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_iter_prev"+ c_rocksdb_iter_prev :: IteratorPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_iter_key"+ c_rocksdb_iter_key :: IteratorPtr -> Ptr CSize -> IO Key++foreign import ccall safe "rocksdb/c.h rocksdb_iter_value"+ c_rocksdb_iter_value :: IteratorPtr -> Ptr CSize -> IO Val++foreign import ccall safe "rocksdb/c.h rocksdb_iter_get_error"+ c_rocksdb_iter_get_error :: IteratorPtr -> ErrPtr -> IO ()+++--+-- Write batch+--++foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_create"+ c_rocksdb_writebatch_create :: IO WriteBatchPtr++foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_destroy"+ c_rocksdb_writebatch_destroy :: WriteBatchPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_clear"+ c_rocksdb_writebatch_clear :: WriteBatchPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_put"+ c_rocksdb_writebatch_put :: WriteBatchPtr+ -> Key -> CSize+ -> Val -> CSize+ -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_delete"+ c_rocksdb_writebatch_delete :: WriteBatchPtr -> Key -> CSize -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_iterate"+ c_rocksdb_writebatch_iterate :: WriteBatchPtr+ -> Ptr () -- ^ state+ -> FunPtr (Ptr () -> Key -> CSize -> Val -> CSize) -- ^ put+ -> FunPtr (Ptr () -> Key -> CSize) -- ^ delete+ -> IO ()+++--+-- Options+--++foreign import ccall safe "rocksdb/c.h rocksdb_options_create"+ c_rocksdb_options_create :: IO OptionsPtr++foreign import ccall safe "rocksdb/c.h rocksdb_options_destroy"+ c_rocksdb_options_destroy :: OptionsPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_options_set_comparator"+ c_rocksdb_options_set_comparator :: OptionsPtr -> ComparatorPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_options_set_filter_policy"+ c_rocksdb_options_set_filter_policy :: OptionsPtr -> FilterPolicyPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_options_set_create_if_missing"+ c_rocksdb_options_set_create_if_missing :: OptionsPtr -> CUChar -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_options_set_error_if_exists"+ c_rocksdb_options_set_error_if_exists :: OptionsPtr -> CUChar -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_options_set_paranoid_checks"+ c_rocksdb_options_set_paranoid_checks :: OptionsPtr -> CUChar -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_options_set_info_log"+ c_rocksdb_options_set_info_log :: OptionsPtr -> LoggerPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_options_set_write_buffer_size"+ c_rocksdb_options_set_write_buffer_size :: OptionsPtr -> CSize -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_options_set_max_open_files"+ c_rocksdb_options_set_max_open_files :: OptionsPtr -> CInt -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_options_set_block_size"+ c_rocksdb_options_set_block_size :: OptionsPtr -> CSize -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_options_set_block_restart_interval"+ c_rocksdb_options_set_block_restart_interval :: OptionsPtr -> CInt -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_options_set_compression"+ c_rocksdb_options_set_compression :: OptionsPtr -> CompressionOpt -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_options_set_cache"+ c_rocksdb_options_set_cache :: OptionsPtr -> CachePtr -> IO ()+++--+-- Comparator+--++type StatePtr = Ptr ()+type Destructor = StatePtr -> ()+type CompareFun = StatePtr -> CString -> CSize -> CString -> CSize -> IO CInt+type NameFun = StatePtr -> CString++-- | Make a FunPtr to a user-defined comparator function+foreign import ccall "wrapper" mkCmp :: CompareFun -> IO (FunPtr CompareFun)++-- | Make a destructor FunPtr+foreign import ccall "wrapper" mkDest :: Destructor -> IO (FunPtr Destructor)++-- | Make a name FunPtr+foreign import ccall "wrapper" mkName :: NameFun -> IO (FunPtr NameFun)++foreign import ccall safe "rocksdb/c.h rocksdb_comparator_create"+ c_rocksdb_comparator_create :: StatePtr+ -> FunPtr Destructor+ -> FunPtr CompareFun+ -> FunPtr NameFun+ -> IO ComparatorPtr++foreign import ccall safe "rocksdb/c.h rocksdb_comparator_destroy"+ c_rocksdb_comparator_destroy :: ComparatorPtr -> IO ()+++--+-- Filter Policy+--++type CreateFilterFun = StatePtr+ -> Ptr CString -- ^ key array+ -> Ptr CSize -- ^ key length array+ -> CInt -- ^ num keys+ -> Ptr CSize -- ^ filter length+ -> IO CString -- ^ the filter+type KeyMayMatchFun = StatePtr+ -> CString -- ^ key+ -> CSize -- ^ key length+ -> CString -- ^ filter+ -> CSize -- ^ filter length+ -> IO CUChar -- ^ whether key is in filter++-- | Make a FunPtr to a user-defined create_filter function+foreign import ccall "wrapper" mkCF :: CreateFilterFun -> IO (FunPtr CreateFilterFun)++-- | Make a FunPtr to a user-defined key_may_match function+foreign import ccall "wrapper" mkKMM :: KeyMayMatchFun -> IO (FunPtr KeyMayMatchFun)++foreign import ccall safe "rocksdb/c.h rocksdb_filterpolicy_create"+ c_rocksdb_filterpolicy_create :: StatePtr+ -> FunPtr Destructor+ -> FunPtr CreateFilterFun+ -> FunPtr KeyMayMatchFun+ -> FunPtr NameFun+ -> IO FilterPolicyPtr++foreign import ccall safe "rocksdb/c.h rocksdb_filterpolicy_destroy"+ c_rocksdb_filterpolicy_destroy :: FilterPolicyPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_filterpolicy_create_bloom"+ c_rocksdb_filterpolicy_create_bloom :: CInt -> IO FilterPolicyPtr++--+-- Read options+--++foreign import ccall safe "rocksdb/c.h rocksdb_readoptions_create"+ c_rocksdb_readoptions_create :: IO ReadOptionsPtr++foreign import ccall safe "rocksdb/c.h rocksdb_readoptions_destroy"+ c_rocksdb_readoptions_destroy :: ReadOptionsPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_readoptions_set_verify_checksums"+ c_rocksdb_readoptions_set_verify_checksums :: ReadOptionsPtr -> CUChar -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_readoptions_set_fill_cache"+ c_rocksdb_readoptions_set_fill_cache :: ReadOptionsPtr -> CUChar -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_readoptions_set_snapshot"+ c_rocksdb_readoptions_set_snapshot :: ReadOptionsPtr -> SnapshotPtr -> IO ()+++--+-- Write options+--++foreign import ccall safe "rocksdb/c.h rocksdb_writeoptions_create"+ c_rocksdb_writeoptions_create :: IO WriteOptionsPtr++foreign import ccall safe "rocksdb/c.h rocksdb_writeoptions_destroy"+ c_rocksdb_writeoptions_destroy :: WriteOptionsPtr -> IO ()++foreign import ccall safe "rocksdb/c.h rocksdb_writeoptions_set_sync"+ c_rocksdb_writeoptions_set_sync :: WriteOptionsPtr -> CUChar -> IO ()+++--+-- Cache+--++foreign import ccall safe "rocksdb/c.h rocksdb_cache_create_lru"+ c_rocksdb_cache_create_lru :: CSize -> IO CachePtr++foreign import ccall safe "rocksdb/c.h rocksdb_cache_destroy"+ c_rocksdb_cache_destroy :: CachePtr -> IO ()
+ src/Database/RocksDB/Internal.hs view
@@ -0,0 +1,294 @@+{-# LANGUAGE RecordWildCards #-}+-- |+-- Module : Database.RocksDB.Internal+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors+-- (c) 2014 The rocksdb-haskell Authors+-- License : BSD3+-- Maintainer : mail@agrafix.net+-- Stability : experimental+-- Portability : non-portable+--++module Database.RocksDB.Internal+ ( -- * Types+ DB (..)+ , Comparator'+ , FilterPolicy'+ , Options' (..)++ -- * "Smart" constructors and deconstructors+ , freeCReadOpts+ , freeComparator+ , freeFilterPolicy+ , freeOpts+ , mkCReadOpts+ , mkComparator+ , mkCompareFun+ , mkCreateFilterFun+ , mkFilterPolicy+ , mkKeyMayMatchFun+ , mkOpts++ -- * combinators+ , withCWriteOpts+ , withCReadOpts++ -- * Utilities+ , throwIfErr+ , cSizeToInt+ , intToCSize+ , intToCInt+ , cIntToInt+ , boolToNum+ )+where++import Control.Applicative ((<$>))+import Control.Exception (bracket, onException, throwIO)+import Control.Monad (when)+import Data.ByteString (ByteString)+import Foreign+import Foreign.C.String (peekCString, withCString)+import Foreign.C.Types (CInt, CSize)++import Database.RocksDB.C+import Database.RocksDB.Types++import qualified Data.ByteString as BS+++-- | Database handle+data DB = DB RocksDBPtr Options'++instance Eq DB where+ (DB pt1 _) == (DB pt2 _) = pt1 == pt2++-- | Internal representation of a 'Comparator'+data Comparator' = Comparator' (FunPtr CompareFun)+ (FunPtr Destructor)+ (FunPtr NameFun)+ ComparatorPtr++-- | Internal representation of a 'FilterPolicy'+data FilterPolicy' = FilterPolicy' (FunPtr CreateFilterFun)+ (FunPtr KeyMayMatchFun)+ (FunPtr Destructor)+ (FunPtr NameFun)+ FilterPolicyPtr++-- | Internal representation of the 'Options'+data Options' = Options'+ { _optsPtr :: !OptionsPtr+ , _cachePtr :: !(Maybe CachePtr)+ , _comp :: !(Maybe Comparator')+ , _fpPtr :: !(Maybe (Either FilterPolicyPtr FilterPolicy'))+ }+++mkOpts :: Options -> IO Options'+mkOpts Options{..} = do+ opts_ptr <- c_rocksdb_options_create++ c_rocksdb_options_set_block_restart_interval opts_ptr+ $ intToCInt blockRestartInterval+ c_rocksdb_options_set_block_size opts_ptr+ $ intToCSize blockSize+ c_rocksdb_options_set_compression opts_ptr+ $ ccompression compression+ c_rocksdb_options_set_create_if_missing opts_ptr+ $ boolToNum createIfMissing+ c_rocksdb_options_set_error_if_exists opts_ptr+ $ boolToNum errorIfExists+ c_rocksdb_options_set_max_open_files opts_ptr+ $ intToCInt maxOpenFiles+ c_rocksdb_options_set_paranoid_checks opts_ptr+ $ boolToNum paranoidChecks+ c_rocksdb_options_set_write_buffer_size opts_ptr+ $ intToCSize writeBufferSize++ cache <- maybeSetCache opts_ptr cacheSize+ cmp <- maybeSetCmp opts_ptr comparator+ fp <- maybeSetFilterPolicy opts_ptr filterPolicy++ return (Options' opts_ptr cache cmp fp)++ where+ ccompression NoCompression =+ noCompression+ ccompression EnableCompression =+ enableCompression++ maybeSetCache :: OptionsPtr -> Int -> IO (Maybe CachePtr)+ maybeSetCache opts_ptr size =+ if size <= 0+ then return Nothing+ else do+ cache_ptr <- c_rocksdb_cache_create_lru $ intToCSize size+ c_rocksdb_options_set_cache opts_ptr cache_ptr+ return . Just $ cache_ptr++ maybeSetCmp :: OptionsPtr -> Maybe Comparator -> IO (Maybe Comparator')+ maybeSetCmp opts_ptr (Just mcmp) = Just <$> setcmp opts_ptr mcmp+ maybeSetCmp _ Nothing = return Nothing++ setcmp :: OptionsPtr -> Comparator -> IO Comparator'+ setcmp opts_ptr (Comparator cmp) = do+ cmp'@(Comparator' _ _ _ cmp_ptr) <- mkComparator "user-defined" cmp+ c_rocksdb_options_set_comparator opts_ptr cmp_ptr+ return cmp'++ maybeSetFilterPolicy :: OptionsPtr+ -> Maybe (Either BloomFilter FilterPolicy)+ -> IO (Maybe (Either FilterPolicyPtr FilterPolicy'))+ maybeSetFilterPolicy _ Nothing =+ return Nothing+ maybeSetFilterPolicy opts_ptr (Just (Left (BloomFilter bloom_ptr))) = do+ c_rocksdb_options_set_filter_policy opts_ptr bloom_ptr+ return Nothing -- bloom filter is freed automatically+ maybeSetFilterPolicy opts_ptr (Just (Right fp)) = do+ fp'@(FilterPolicy' _ _ _ _ fp_ptr) <- mkFilterPolicy fp+ c_rocksdb_options_set_filter_policy opts_ptr fp_ptr+ return . Just . Right $ fp'++freeOpts :: Options' -> IO ()+freeOpts (Options' opts_ptr mcache_ptr mcmp_ptr mfp) = do+ c_rocksdb_options_destroy opts_ptr+ maybe (return ()) c_rocksdb_cache_destroy mcache_ptr+ maybe (return ()) freeComparator mcmp_ptr+ maybe (return ())+ (either c_rocksdb_filterpolicy_destroy freeFilterPolicy)+ mfp++ return ()++withCWriteOpts :: WriteOptions -> (WriteOptionsPtr -> IO a) -> IO a+withCWriteOpts WriteOptions{..} = bracket mkCWriteOpts freeCWriteOpts+ where+ mkCWriteOpts = do+ opts_ptr <- c_rocksdb_writeoptions_create+ onException+ (c_rocksdb_writeoptions_set_sync opts_ptr $ boolToNum sync)+ (c_rocksdb_writeoptions_destroy opts_ptr)+ return opts_ptr++ freeCWriteOpts = c_rocksdb_writeoptions_destroy++mkCompareFun :: (ByteString -> ByteString -> Ordering) -> CompareFun+mkCompareFun cmp = cmp'+ where+ cmp' _ a alen b blen = do+ a' <- BS.packCStringLen (a, fromInteger . toInteger $ alen)+ b' <- BS.packCStringLen (b, fromInteger . toInteger $ blen)+ return $ case cmp a' b' of+ EQ -> 0+ GT -> 1+ LT -> -1++mkComparator :: String -> (ByteString -> ByteString -> Ordering) -> IO Comparator'+mkComparator name f =+ withCString name $ \cs -> do+ ccmpfun <- mkCmp . mkCompareFun $ f+ cdest <- mkDest $ const ()+ cname <- mkName $ const cs+ ccmp <- c_rocksdb_comparator_create nullPtr cdest ccmpfun cname+ return $ Comparator' ccmpfun cdest cname ccmp+++freeComparator :: Comparator' -> IO ()+freeComparator (Comparator' ccmpfun cdest cname ccmp) = do+ c_rocksdb_comparator_destroy ccmp+ freeHaskellFunPtr ccmpfun+ freeHaskellFunPtr cdest+ freeHaskellFunPtr cname++mkCreateFilterFun :: ([ByteString] -> ByteString) -> CreateFilterFun+mkCreateFilterFun f = f'+ where+ f' _ ks ks_lens n_ks flen = do+ let n_ks' = fromInteger . toInteger $ n_ks+ ks' <- peekArray n_ks' ks+ ks_lens' <- peekArray n_ks' ks_lens+ keys <- mapM bstr (zip ks' ks_lens')+ let res = f keys+ poke flen (fromIntegral . BS.length $ res)+ BS.useAsCString res $ \cstr -> return cstr++ bstr (x,len) = BS.packCStringLen (x, fromInteger . toInteger $ len)++mkKeyMayMatchFun :: (ByteString -> ByteString -> Bool) -> KeyMayMatchFun+mkKeyMayMatchFun g = g'+ where+ g' _ k klen f flen = do+ k' <- BS.packCStringLen (k, fromInteger . toInteger $ klen)+ f' <- BS.packCStringLen (f, fromInteger . toInteger $ flen)+ return . boolToNum $ g k' f'+++mkFilterPolicy :: FilterPolicy -> IO FilterPolicy'+mkFilterPolicy FilterPolicy{..} =+ withCString fpName $ \cs -> do+ cname <- mkName $ const cs+ cdest <- mkDest $ const ()+ ccffun <- mkCF . mkCreateFilterFun $ createFilter+ ckmfun <- mkKMM . mkKeyMayMatchFun $ keyMayMatch+ cfp <- c_rocksdb_filterpolicy_create nullPtr cdest ccffun ckmfun cname++ return $ FilterPolicy' ccffun ckmfun cdest cname cfp++freeFilterPolicy :: FilterPolicy' -> IO ()+freeFilterPolicy (FilterPolicy' ccffun ckmfun cdest cname cfp) = do+ c_rocksdb_filterpolicy_destroy cfp+ freeHaskellFunPtr ccffun+ freeHaskellFunPtr ckmfun+ freeHaskellFunPtr cdest+ freeHaskellFunPtr cname++mkCReadOpts :: ReadOptions -> IO ReadOptionsPtr+mkCReadOpts ReadOptions{..} = do+ opts_ptr <- c_rocksdb_readoptions_create+ flip onException (c_rocksdb_readoptions_destroy opts_ptr) $ do+ c_rocksdb_readoptions_set_verify_checksums opts_ptr $ boolToNum verifyCheckSums+ c_rocksdb_readoptions_set_fill_cache opts_ptr $ boolToNum fillCache++ case useSnapshot of+ Just (Snapshot snap_ptr) -> c_rocksdb_readoptions_set_snapshot opts_ptr snap_ptr+ Nothing -> return ()++ return opts_ptr++freeCReadOpts :: ReadOptionsPtr -> IO ()+freeCReadOpts = c_rocksdb_readoptions_destroy++withCReadOpts :: ReadOptions -> (ReadOptionsPtr -> IO a) -> IO a+withCReadOpts opts = bracket (mkCReadOpts opts) freeCReadOpts++throwIfErr :: String -> (ErrPtr -> IO a) -> IO a+throwIfErr s f = alloca $ \err_ptr -> do+ poke err_ptr nullPtr+ res <- f err_ptr+ erra <- peek err_ptr+ when (erra /= nullPtr) $ do+ err <- peekCString erra+ throwIO $ userError $ s ++ ": " ++ err+ return res++cSizeToInt :: CSize -> Int+cSizeToInt = fromIntegral+{-# INLINE cSizeToInt #-}++intToCSize :: Int -> CSize+intToCSize = fromIntegral+{-# INLINE intToCSize #-}++intToCInt :: Int -> CInt+intToCInt = fromIntegral+{-# INLINE intToCInt #-}++cIntToInt :: CInt -> Int+cIntToInt = fromIntegral+{-# INLINE cIntToInt #-}++boolToNum :: Num b => Bool -> b+boolToNum True = fromIntegral (1 :: Int)+boolToNum False = fromIntegral (0 :: Int)+{-# INLINE boolToNum #-}
+ src/Database/RocksDB/Iterator.hs view
@@ -0,0 +1,228 @@+-- |+-- Module : Database.RocksDB.Iterator+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors+-- (c) 2014 The rocksdb-haskell Authors+-- License : BSD3+-- Maintainer : mail@agrafix.net+-- Stability : experimental+-- Portability : non-portable+--+-- Iterating over key ranges.+--++module Database.RocksDB.Iterator+ ( Iterator+ , createIter+ , iterEntry+ , iterFirst+ , iterGetError+ , iterItems+ , iterKey+ , iterKeys+ , iterLast+ , iterNext+ , iterPrev+ , iterSeek+ , iterValid+ , iterValue+ , iterValues+ , mapIter+ , releaseIter+ , withIter+ )+where++import Control.Applicative ((<$>), (<*>))+import Control.Exception (bracket, finally, onException)+import Control.Monad (when)+import Control.Monad.IO.Class (MonadIO (liftIO))+import Data.ByteString (ByteString)+import Data.Maybe (catMaybes)+import Foreign+import Foreign.C.Error (throwErrnoIfNull)+import Foreign.C.String (CString, peekCString)+import Foreign.C.Types (CSize)++import Database.RocksDB.C+import Database.RocksDB.Internal+import Database.RocksDB.Types++import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BC+import qualified Data.ByteString.Unsafe as BU++-- | Iterator handle+--+-- Note that an 'Iterator' requires external synchronization if it is shared+-- between multiple threads which mutate it's state. See+-- @examples/iterforkio.hs@ for a simple example of how to do that.+data Iterator = Iterator !IteratorPtr !ReadOptionsPtr deriving (Eq)++-- | Create an 'Iterator'.+--+-- The iterator should be released with 'releaseIter'.+--+-- Note that an 'Iterator' creates a snapshot of the database implicitly, so+-- updates written after the iterator was created are not visible. You may,+-- however, specify an older 'Snapshot' in the 'ReadOptions'.+createIter :: MonadIO m => DB -> ReadOptions -> m Iterator+createIter (DB db_ptr _) opts = liftIO $ do+ opts_ptr <- mkCReadOpts opts+ flip onException (freeCReadOpts opts_ptr) $ do+ iter_ptr <- throwErrnoIfNull "create_iterator" $+ c_rocksdb_create_iterator db_ptr opts_ptr+ return $ Iterator iter_ptr opts_ptr++-- | Release an 'Iterator'.+--+-- The handle will be invalid after calling this action and should no+-- longer be used. Calling this function with an already released 'Iterator'+-- will cause a double-free error!+releaseIter :: MonadIO m => Iterator -> m ()+releaseIter (Iterator iter_ptr opts) = liftIO $+ c_rocksdb_iter_destroy iter_ptr `finally` freeCReadOpts opts++-- | Run an action with an 'Iterator'+withIter :: MonadIO m => DB -> ReadOptions -> (Iterator -> IO a) -> m a+withIter db opts = liftIO . bracket (createIter db opts) releaseIter++-- | An iterator is either positioned at a key/value pair, or not valid. This+-- function returns /true/ iff the iterator is valid.+iterValid :: MonadIO m => Iterator -> m Bool+iterValid (Iterator iter_ptr _) = liftIO $ do+ x <- c_rocksdb_iter_valid iter_ptr+ return (x /= 0)++-- | Position at the first key in the source that is at or past target. The+-- iterator is /valid/ after this call iff the source contains an entry that+-- comes at or past target.+iterSeek :: MonadIO m => Iterator -> ByteString -> m ()+iterSeek (Iterator iter_ptr _) key = liftIO $+ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+ c_rocksdb_iter_seek iter_ptr key_ptr (intToCSize klen)++-- | Position at the first key in the source. The iterator is /valid/ after this+-- call iff the source is not empty.+iterFirst :: MonadIO m => Iterator -> m ()+iterFirst (Iterator iter_ptr _) = liftIO $ c_rocksdb_iter_seek_to_first iter_ptr++-- | Position at the last key in the source. The iterator is /valid/ after this+-- call iff the source is not empty.+iterLast :: MonadIO m => Iterator -> m ()+iterLast (Iterator iter_ptr _) = liftIO $ c_rocksdb_iter_seek_to_last iter_ptr++-- | Moves to the next entry in the source. After this call, 'iterValid' is+-- /true/ iff the iterator was not positioned at the last entry in the source.+--+-- If the iterator is not valid, this function does nothing. Note that this is a+-- shortcoming of the C API: an 'iterPrev' might still be possible, but we can't+-- determine if we're at the last or first entry.+iterNext :: MonadIO m => Iterator -> m ()+iterNext (Iterator iter_ptr _) = liftIO $ do+ valid <- c_rocksdb_iter_valid iter_ptr+ when (valid /= 0) $ c_rocksdb_iter_next iter_ptr++-- | Moves to the previous entry in the source. After this call, 'iterValid' is+-- /true/ iff the iterator was not positioned at the first entry in the source.+--+-- If the iterator is not valid, this function does nothing. Note that this is a+-- shortcoming of the C API: an 'iterNext' might still be possible, but we can't+-- determine if we're at the last or first entry.+iterPrev :: MonadIO m => Iterator -> m ()+iterPrev (Iterator iter_ptr _) = liftIO $ do+ valid <- c_rocksdb_iter_valid iter_ptr+ when (valid /= 0) $ c_rocksdb_iter_prev iter_ptr++-- | Return the key for the current entry if the iterator is currently+-- positioned at an entry, ie. 'iterValid'.+iterKey :: MonadIO m => Iterator -> m (Maybe ByteString)+iterKey = liftIO . flip iterString c_rocksdb_iter_key++-- | Return the value for the current entry if the iterator is currently+-- positioned at an entry, ie. 'iterValid'.+iterValue :: MonadIO m => Iterator -> m (Maybe ByteString)+iterValue = liftIO . flip iterString c_rocksdb_iter_value++-- | Return the current entry as a pair, if the iterator is currently positioned+-- at an entry, ie. 'iterValid'.+iterEntry :: MonadIO m => Iterator -> m (Maybe (ByteString, ByteString))+iterEntry iter = liftIO $ do+ mkey <- iterKey iter+ mval <- iterValue iter+ return $ (,) <$> mkey <*> mval++-- | Check for errors+--+-- Note that this captures somewhat severe errors such as a corrupted database.+iterGetError :: MonadIO m => Iterator -> m (Maybe ByteString)+iterGetError (Iterator iter_ptr _) = liftIO $+ alloca $ \err_ptr -> do+ poke err_ptr nullPtr+ c_rocksdb_iter_get_error iter_ptr err_ptr+ erra <- peek err_ptr+ if erra == nullPtr+ then return Nothing+ else do+ err <- peekCString erra+ return . Just . BC.pack $ err++-- | Map a function over an iterator, advancing the iterator forward and+-- returning the value. The iterator should be put in the right position prior+-- to calling the function.+--+-- Note that this function accumulates the result strictly, ie. it reads all+-- values into memory until the iterator is exhausted. This is most likely not+-- what you want for large ranges. You may consider using conduits instead, for+-- an example see: <https://gist.github.com/adc8ec348f03483446a5>+mapIter :: MonadIO m => (Iterator -> m a) -> Iterator -> m [a]+mapIter f iter@(Iterator iter_ptr _) = go []+ where+ go acc = do+ valid <- liftIO $ c_rocksdb_iter_valid iter_ptr+ if valid == 0+ then return acc+ else do+ val <- f iter+ () <- liftIO $ c_rocksdb_iter_next iter_ptr+ go (val : acc)++-- | Return a list of key and value tuples from an iterator. The iterator+-- should be put in the right position prior to calling this with the iterator.+--+-- See strictness remarks on 'mapIter'.+iterItems :: (Functor m, MonadIO m) => Iterator -> m [(ByteString, ByteString)]+iterItems iter = catMaybes <$> mapIter iterEntry iter++-- | Return a list of key from an iterator. The iterator should be put+-- in the right position prior to calling this with the iterator.+--+-- See strictness remarks on 'mapIter'+iterKeys :: (Functor m, MonadIO m) => Iterator -> m [ByteString]+iterKeys iter = catMaybes <$> mapIter iterKey iter++-- | Return a list of values from an iterator. The iterator should be put+-- in the right position prior to calling this with the iterator.+--+-- See strictness remarks on 'mapIter'+iterValues :: (Functor m, MonadIO m) => Iterator -> m [ByteString]+iterValues iter = catMaybes <$> mapIter iterValue iter+++--+-- Internal+--++iterString :: Iterator+ -> (IteratorPtr -> Ptr CSize -> IO CString)+ -> IO (Maybe ByteString)+iterString (Iterator iter_ptr _) f = do+ valid <- c_rocksdb_iter_valid iter_ptr+ if valid == 0+ then return Nothing+ else alloca $ \len_ptr -> do+ ptr <- f iter_ptr len_ptr+ if ptr == nullPtr+ then return Nothing+ else do+ len <- peek len_ptr+ Just <$> BS.packCStringLen (ptr, cSizeToInt len)
+ src/Database/RocksDB/MonadResource.hs view
@@ -0,0 +1,279 @@+-- |+-- Module : Database.RocksDB.MonadResource+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors+-- (c) 2014 The rocksdb-haskell Authors+-- License : BSD3+-- Maintainer : mail@agrafix.net+-- Stability : experimental+-- Portability : non-portable+--++module Database.RocksDB.MonadResource+ ( -- * Exported Types+ DB+ , BatchOp(..)+ , Comparator(..)+ , Compression(..)+ , Options(..)+ , ReadOptions(..)+ , Snapshot+ , WriteBatch+ , WriteOptions(..)+ , Range++ -- * Defaults+ , defaultOptions+ , defaultWriteOptions+ , defaultReadOptions++ -- * Basic Database Manipulation+ , withSnapshot+ , open+ , put+ , delete+ , write+ , get+ , createSnapshot+ , createSnapshot'++ -- * Filter Policy / Bloom Filter+ , FilterPolicy(..)+ , bloomFilter++ -- * Administrative Functions+ , Property(..), getProperty+ , destroy+ , repair+ , approximateSize++ -- * Iteration+ , Iterator+ , withIterator+ , iterOpen+ , iterOpen'+ , iterValid+ , iterSeek+ , iterFirst+ , iterLast+ , iterNext+ , iterPrev+ , iterKey+ , iterValue+ , iterGetError+ , mapIter+ , iterItems+ , iterKeys+ , iterValues++ -- * Re-exports+ , MonadResource (..)+ , runResourceT+ , resourceForkIO+ )+where++import Control.Applicative ((<$>))+import Control.Monad.Trans.Resource+import Data.ByteString (ByteString)+import Data.Int (Int64)++import Database.RocksDB.Base (BatchOp, BloomFilter, Comparator,+ Compression, DB, FilterPolicy,+ Iterator, Options, Property,+ Range, ReadOptions, Snapshot,+ WriteBatch, WriteOptions,+ defaultOptions,+ defaultReadOptions,+ defaultWriteOptions)+import qualified Database.RocksDB.Base as Base+++-- | Create a 'BloomFilter'+bloomFilter :: MonadResource m => Int -> m BloomFilter+bloomFilter i =+ snd <$> allocate (Base.createBloomFilter i)+ Base.releaseBloomFilter++-- | Open a database+--+-- The returned handle will automatically be released when the enclosing+-- 'runResourceT' terminates.+open :: MonadResource m => FilePath -> Options -> m DB+open path opts = snd <$> open' path opts++open' :: MonadResource m => FilePath -> Options -> m (ReleaseKey, DB)+open' path opts = allocate (Base.open path opts) Base.close+{-# INLINE open' #-}++-- | Run an action with a snapshot of the database.+--+-- The snapshot will be released when the action terminates or throws an+-- exception. Note that this function is provided for convenience and does not+-- prevent the 'Snapshot' handle to escape. It will, however, be invalid after+-- this function returns and should not be used anymore.+withSnapshot :: MonadResource m => DB -> (Snapshot -> m a) -> m a+withSnapshot db f = do+ (rk, snap) <- createSnapshot' db+ res <- f snap+ release rk+ return res++-- | Create a snapshot of the database.+--+-- The returned 'Snapshot' will be released automatically when the enclosing+-- 'runResourceT' terminates. It is recommended to use 'createSnapshot'' instead+-- and release the resource manually as soon as possible.+createSnapshot :: MonadResource m => DB -> m Snapshot+createSnapshot db = snd <$> createSnapshot' db++-- | Create a snapshot of the database which can (and should) be released early.+createSnapshot' :: MonadResource m => DB -> m (ReleaseKey, Snapshot)+createSnapshot' db = allocate (Base.createSnapshot db) (Base.releaseSnapshot db)++-- | Get a DB property+getProperty :: MonadResource m => DB -> Property -> m (Maybe ByteString)+getProperty = Base.getProperty++-- | Destroy the given rocksdb database.+destroy :: MonadResource m => FilePath -> Options -> m ()+destroy = Base.destroy++-- | Repair the given rocksdb database.+repair :: MonadResource m => FilePath -> Options -> m ()+repair = Base.repair+++-- | Inspect the approximate sizes of the different levels+approximateSize :: MonadResource m => DB -> Range -> m Int64+approximateSize = Base.approximateSize++-- | Write a key/value pair+put :: MonadResource m => DB -> WriteOptions -> ByteString -> ByteString -> m ()+put = Base.put++-- | Read a value by key+get :: MonadResource m => DB -> ReadOptions -> ByteString -> m (Maybe ByteString)+get = Base.get++-- | Delete a key/value pair+delete :: MonadResource m => DB -> WriteOptions -> ByteString -> m ()+delete = Base.delete++-- | Perform a batch mutation+write :: MonadResource m => DB -> WriteOptions -> WriteBatch -> m ()+write = Base.write+++-- | Run an action with an Iterator. The iterator will be closed after the+-- action returns or an error is thrown. Thus, the iterator will /not/ be valid+-- after this function terminates.+withIterator :: MonadResource m => DB -> ReadOptions -> (Iterator -> m a) -> m a+withIterator db opts f = do+ (rk, iter) <- iterOpen' db opts+ res <- f iter+ release rk+ return res++-- | Create an 'Iterator'.+--+-- The iterator will be released when the enclosing 'runResourceT' terminates.+-- You may consider to use 'iterOpen'' instead and manually release the iterator+-- as soon as it is no longer needed (alternatively, use 'withIterator').+--+-- Note that an 'Iterator' creates a snapshot of the database implicitly, so+-- updates written after the iterator was created are not visible. You may,+-- however, specify an older 'Snapshot' in the 'ReadOptions'.+iterOpen :: MonadResource m => DB -> ReadOptions -> m Iterator+iterOpen db opts = snd <$> iterOpen' db opts++-- | Create an 'Iterator' which can be released early.+iterOpen' :: MonadResource m => DB -> ReadOptions -> m (ReleaseKey, Iterator)+iterOpen' db opts = allocate (Base.createIter db opts) Base.releaseIter++-- | An iterator is either positioned at a key/value pair, or not valid. This+-- function returns /true/ iff the iterator is valid.+iterValid :: MonadResource m => Iterator -> m Bool+iterValid = Base.iterValid++-- | Position at the first key in the source that is at or past target. The+-- iterator is /valid/ after this call iff the source contains an entry that+-- comes at or past target.+iterSeek :: MonadResource m => Iterator -> ByteString -> m ()+iterSeek = Base.iterSeek++-- | Position at the first key in the source. The iterator is /valid/ after this+-- call iff the source is not empty.+iterFirst :: MonadResource m => Iterator -> m ()+iterFirst = Base.iterFirst++-- | Position at the last key in the source. The iterator is /valid/ after this+-- call iff the source is not empty.+iterLast :: MonadResource m => Iterator -> m ()+iterLast = Base.iterLast++-- | Moves to the next entry in the source. After this call, 'iterValid' is+-- /true/ iff the iterator was not positioned at the last entry in the source.+--+-- If the iterator is not valid, this function does nothing. Note that this is a+-- shortcoming of the C API: an 'iterPrev' might still be possible, but we can't+-- determine if we're at the last or first entry.+iterNext :: MonadResource m => Iterator -> m ()+iterNext = Base.iterNext++-- | Moves to the previous entry in the source. After this call, 'iterValid' is+-- /true/ iff the iterator was not positioned at the first entry in the source.+--+-- If the iterator is not valid, this function does nothing. Note that this is a+-- shortcoming of the C API: an 'iterNext' might still be possible, but we can't+-- determine if we're at the last or first entry.+iterPrev :: MonadResource m => Iterator -> m ()+iterPrev = Base.iterPrev++-- | Return the key for the current entry if the iterator is currently+-- positioned at an entry, ie. 'iterValid'.+iterKey :: MonadResource m => Iterator -> m (Maybe ByteString)+iterKey = Base.iterKey++-- | Return the value for the current entry if the iterator is currently+-- positioned at an entry, ie. 'iterValid'.+iterValue :: MonadResource m => Iterator -> m (Maybe ByteString)+iterValue = Base.iterValue++-- | Check for errors+--+-- Note that this captures somewhat severe errors such as a corrupted database.+iterGetError :: MonadResource m => Iterator -> m (Maybe ByteString)+iterGetError = Base.iterGetError+++-- | Map a function over an iterator, advancing the iterator forward and+-- returning the value. The iterator should be put in the right position prior+-- to calling the function.+--+-- Note that this function accumulates the result strictly, ie. it reads all+-- values into memory until the iterator is exhausted. This is most likely not+-- what you want for large ranges. You may consider using conduits instead, for+-- an example see: <https://gist.github.com/adc8ec348f03483446a5>+mapIter :: MonadResource m => (Iterator -> m a) -> Iterator -> m [a]+mapIter = Base.mapIter++-- | Return a list of key and value tuples from an iterator. The iterator+-- should be put in the right position prior to calling this with the iterator.+--+-- See strictness remarks on 'mapIter'.+iterItems :: MonadResource m => Iterator -> m [(ByteString, ByteString)]+iterItems = Base.iterItems++-- | Return a list of key from an iterator. The iterator should be put+-- in the right position prior to calling this with the iterator.+--+-- See strictness remarks on 'mapIter'+iterKeys :: MonadResource m => Iterator -> m [ByteString]+iterKeys = Base.iterKeys++-- | Return a list of values from an iterator. The iterator should be put+-- in the right position prior to calling this with the iterator.+--+-- See strictness remarks on 'mapIter'+iterValues :: MonadResource m => Iterator -> m [ByteString]+iterValues = Base.iterValues
+ src/Database/RocksDB/Types.hs view
@@ -0,0 +1,218 @@+-- |+-- Module : Database.RocksDB.Types+-- Copyright : (c) 2012-2013 The leveldb-haskell Authors+-- (c) 2014 The rocksdb-haskell Authors+-- License : BSD3+-- Maintainer : mail@agrafix.net+-- Stability : experimental+-- Portability : non-portable+--++module Database.RocksDB.Types+ ( BatchOp (..)+ , BloomFilter (..)+ , Comparator (..)+ , Compression (..)+ , FilterPolicy (..)+ , Options (..)+ , Property (..)+ , ReadOptions (..)+ , Snapshot (..)+ , WriteBatch+ , WriteOptions (..)++ , defaultOptions+ , defaultReadOptions+ , defaultWriteOptions+ )+where++import Data.ByteString (ByteString)+import Data.Default+import Foreign++import Database.RocksDB.C++-- | Snapshot handle+newtype Snapshot = Snapshot SnapshotPtr deriving (Eq)++-- | Compression setting+data Compression = NoCompression | EnableCompression deriving (Eq, Show)++-- | User-defined comparator+newtype Comparator = Comparator (ByteString -> ByteString -> Ordering)++-- | User-defined filter policy+data FilterPolicy = FilterPolicy+ { fpName :: String+ , createFilter :: [ByteString] -> ByteString+ , keyMayMatch :: ByteString -> ByteString -> Bool+ }++-- | Represents the built-in Bloom Filter+newtype BloomFilter = BloomFilter FilterPolicyPtr++-- | Options when opening a database+data Options = Options+ { blockRestartInterval :: !Int+ -- ^ Number of keys between restart points for delta encoding of keys.+ --+ -- This parameter can be changed dynamically. Most clients should leave+ -- this parameter alone.+ --+ -- Default: 16+ , blockSize :: !Int+ -- ^ Approximate size of user data packed per block.+ --+ -- Note that the block size specified here corresponds to uncompressed+ -- data. The actual size of the unit read from disk may be smaller if+ -- compression is enabled.+ --+ -- This parameter can be changed dynamically.+ --+ -- Default: 4k+ , cacheSize :: !Int+ -- ^ Control over blocks (user data is stored in a set of blocks, and a+ -- block is the unit of reading from disk).+ --+ -- If > 0, use the specified cache (in bytes) for blocks. If 0, rocksdb+ -- will automatically create and use an 8MB internal cache.+ --+ -- Default: 0+ , comparator :: !(Maybe Comparator)+ -- ^ Comparator used to defined the order of keys in the table.+ --+ -- If 'Nothing', the default comparator is used, which uses lexicographic+ -- bytes-wise ordering.+ --+ -- NOTE: the client must ensure that the comparator supplied here has the+ -- same name and orders keys /exactly/ the same as the comparator provided+ -- to previous open calls on the same DB.+ --+ -- Default: Nothing+ , compression :: !Compression+ -- ^ Compress blocks using the specified compression algorithm.+ --+ -- This parameter can be changed dynamically.+ --+ -- Default: 'EnableCompression'+ , createIfMissing :: !Bool+ -- ^ If true, the database will be created if it is missing.+ --+ -- Default: False+ , errorIfExists :: !Bool+ -- ^ It true, an error is raised if the database already exists.+ --+ -- Default: False+ , maxOpenFiles :: !Int+ -- ^ Number of open files that can be used by the DB.+ --+ -- You may need to increase this if your database has a large working set+ -- (budget one open file per 2MB of working set).+ --+ -- Default: 1000+ , paranoidChecks :: !Bool+ -- ^ If true, the implementation will do aggressive checking of the data+ -- it is processing and will stop early if it detects any errors.+ --+ -- This may have unforeseen ramifications: for example, a corruption of+ -- one DB entry may cause a large number of entries to become unreadable+ -- or for the entire DB to become unopenable.+ --+ -- Default: False+ , writeBufferSize :: !Int+ -- ^ Amount of data to build up in memory (backed by an unsorted log on+ -- disk) before converting to a sorted on-disk file.+ --+ -- Larger values increase performance, especially during bulk loads. Up to+ -- to write buffers may be held in memory at the same time, so you may+ -- with to adjust this parameter to control memory usage. Also, a larger+ -- write buffer will result in a longer recovery time the next time the+ -- database is opened.+ --+ -- Default: 4MB+ , filterPolicy :: !(Maybe (Either BloomFilter FilterPolicy))+ }++defaultOptions :: Options+defaultOptions = Options+ { blockRestartInterval = 16+ , blockSize = 4096+ , cacheSize = 0+ , comparator = Nothing+ , compression = EnableCompression+ , createIfMissing = False+ , errorIfExists = False+ , maxOpenFiles = 1000+ , paranoidChecks = False+ , writeBufferSize = 4 `shift` 20+ , filterPolicy = Nothing+ }++instance Default Options where+ def = defaultOptions++-- | Options for write operations+data WriteOptions = WriteOptions+ { sync :: !Bool+ -- ^ If true, the write will be flushed from the operating system buffer+ -- cache (by calling WritableFile::Sync()) before the write is considered+ -- complete. If this flag is true, writes will be slower.+ --+ -- If this flag is false, and the machine crashes, some recent writes may+ -- be lost. Note that if it is just the process that crashes (i.e., the+ -- machine does not reboot), no writes will be lost even if sync==false.+ --+ -- In other words, a DB write with sync==false has similar crash semantics+ -- as the "write()" system call. A DB write with sync==true has similar+ -- crash semantics to a "write()" system call followed by "fsync()".+ --+ -- Default: False+ } deriving (Eq, Show)++defaultWriteOptions :: WriteOptions+defaultWriteOptions = WriteOptions { sync = False }++instance Default WriteOptions where+ def = defaultWriteOptions++-- | Options for read operations+data ReadOptions = ReadOptions+ { verifyCheckSums :: !Bool+ -- ^ If true, all data read from underlying storage will be verified+ -- against corresponding checksuyms.+ --+ -- Default: False+ , fillCache :: !Bool+ -- ^ Should the data read for this iteration be cached in memory? Callers+ -- may with to set this field to false for bulk scans.+ --+ -- Default: True+ , useSnapshot :: !(Maybe Snapshot)+ -- ^ If 'Just', read as of the supplied snapshot (which must belong to the+ -- DB that is being read and which must not have been released). If+ -- 'Nothing', use an implicit snapshot of the state at the beginning of+ -- this read operation.+ --+ -- Default: Nothing+ } deriving (Eq)++defaultReadOptions :: ReadOptions+defaultReadOptions = ReadOptions+ { verifyCheckSums = False+ , fillCache = True+ , useSnapshot = Nothing+ }++instance Default ReadOptions where+ def = defaultReadOptions++type WriteBatch = [BatchOp]++-- | Batch operation+data BatchOp = Put ByteString ByteString | Del ByteString+ deriving (Eq, Show)++-- | Properties exposed by RocksDB+data Property = NumFilesAtLevel Int | Stats | SSTables+ deriving (Eq, Show)