rocksdb-haskell-jprupp 2.0.0 → 2.1.0
raw patch · 7 files changed
+307/−147 lines, 7 filesdep +string-conversions
Dependencies added: string-conversions
Files
- CHANGELOG.md +6/−1
- rocksdb-haskell-jprupp.cabal +3/−2
- src/Database/RocksDB/Base.hs +177/−82
- src/Database/RocksDB/C.hs +62/−55
- src/Database/RocksDB/Internal.hs +8/−0
- src/Database/RocksDB/Iterator.hs +15/−3
- test/tests.hs +36/−4
CHANGELOG.md view
@@ -1,4 +1,9 @@-## Unreleased+## 2.1.0++ * Add support for column families.+++## 2.0.0 * Fork into a different project * Rewrite most of the code to make it faster and easier to use
rocksdb-haskell-jprupp.cabal view
@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: 1a704ba0e05868931aaf7054fde4968c2fdba55b6f67f7d2b2e339c54cf4933d+-- hash: 62fe8cf396916c26c6c439df09d2a854536f6ffb8e85a514b87630010199c713 name: rocksdb-haskell-jprupp-version: 2.0.0+version: 2.1.0 synopsis: Haskell bindings for RocksDB description: See README at <https://github.com/jprupp/rocksdb-haskell#readme> category: Database, FFI@@ -64,5 +64,6 @@ , directory , hspec , rocksdb-haskell-jprupp+ , string-conversions , unliftio default-language: Haskell2010
src/Database/RocksDB/Base.hs view
@@ -1,4 +1,4 @@-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE LambdaCase #-} -- | -- Module : Database.RocksDB.Base -- Copyright : (c) 2012-2013 The leveldb-haskell Authors@@ -23,10 +23,14 @@ -- * Basic Database Manipulations , withDB+ , withDBCF , put+ , putCF , delete+ , deleteCF , write , get+ , getCF , withSnapshot -- * Filter Policy / Bloom Filter@@ -43,7 +47,7 @@ , module Database.RocksDB.Iterator ) where -import Control.Monad ((>=>))+import Control.Monad (when, (>=>), forM, forM_) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import Data.ByteString.Internal (ByteString (..))@@ -51,12 +55,9 @@ import Database.RocksDB.C import Database.RocksDB.Internal import Database.RocksDB.Iterator-import Foreign-import Foreign.C.String (CString, withCString)-import qualified GHC.Foreign as GHC-import qualified GHC.IO.Encoding as GHC-import System.Directory (createDirectoryIfMissing) import UnliftIO+import UnliftIO.Directory+import UnliftIO.Foreign -- | Properties exposed by RocksDB data Property = NumFilesAtLevel Int | Stats | SSTables@@ -89,14 +90,86 @@ where destroy_db db = liftIO $ c_rocksdb_close $ rocksDB db- create_db opts_ptr read_opts write_opts = liftIO $ do- createDirectoryIfMissing True path- withFilePath path $ \path_ptr -> do- db_ptr <- throwIfErr "open" $+ create_db opts_ptr read_opts write_opts = do+ when (createIfMissing config) $+ createDirectoryIfMissing True path+ withCString path $ \path_ptr -> do+ db_ptr <- liftIO . throwIfErr "open" $ c_rocksdb_open opts_ptr path_ptr- return $ DB db_ptr [] read_opts write_opts+ return DB { rocksDB = db_ptr+ , columnFamilies = []+ , readOpts = read_opts+ , writeOpts = write_opts+ } --- | Run an action with a 'Snapshot' of the database.+withDBCF :: MonadUnliftIO m+ => FilePath+ -> Config+ -> [(String, Config)]+ -> (DB -> m a)+ -> m a+withDBCF path config cf_cfgs f =+ withOptions config $ \opts_ptr ->+ withOptionsCF (map snd cf_cfgs) $ \cf_opts ->+ withReadOpts Nothing $ \read_opts ->+ withWriteOpts $ \write_opts ->+ withStrings (map fst cf_cfgs) $ \cf_names ->+ allocaArray (length cf_cfgs + 1) $ \cf_names_array ->+ allocaArray (length cf_cfgs + 1) $ \cf_opts_array ->+ allocaArray (length cf_cfgs + 1) $ \cf_ptrs_array ->+ bracket ( create_db opts_ptr+ cf_names+ cf_names_array+ cf_opts+ cf_opts_array+ read_opts+ cf_ptrs_array+ write_opts+ ) destroy_db f+ where+ create_new cf_names cf_opts = do+ createDirectoryIfMissing True path+ empty <- null <$> listDirectory path+ when empty $ withDB path config $ \db -> do+ cfs <- forM (zip cf_names cf_opts) $ \(n, o) ->+ throwIfErr "create_column_family" $+ c_rocksdb_create_column_family+ (rocksDB db) o n+ forM_ cfs c_rocksdb_column_family_handle_destroy+ destroy_db db = liftIO $ do+ mapM_ c_rocksdb_column_family_handle_destroy (columnFamilies db)+ c_rocksdb_close $ rocksDB db+ create_db opts_ptr+ cf_names+ cf_names_array+ cf_opts+ cf_opts_array+ read_opts+ cf_ptrs_array+ write_opts = liftIO $ do+ when (createIfMissing config) $+ create_new cf_names cf_opts+ withCString path $ \path_ptr ->+ withCString "default" $ \cf_deflt_name -> do+ pokeArray cf_names_array (cf_deflt_name : cf_names)+ pokeArray cf_opts_array (opts_ptr : cf_opts)+ db_ptr <- throwIfErr "open" $+ c_rocksdb_open_column_families+ opts_ptr+ path_ptr+ (intToCInt (length cf_cfgs + 1))+ cf_names_array+ cf_opts_array+ cf_ptrs_array+ cfs <- peekArray (length cf_cfgs + 1) cf_ptrs_array+ return DB { rocksDB = db_ptr+ , columnFamilies = tail cfs+ , readOpts = read_opts+ , writeOpts = write_opts+ }++-- | Run an action with a snapshot of the database.+-- The 'DB' object is not valid after the action ends. withSnapshot :: MonadUnliftIO m => DB -> (DB -> m a) -> m a withSnapshot db@DB{rocksDB = db_ptr} f = bracket create_snapshot release_snapshot (f . fst)@@ -125,13 +198,13 @@ -- | Destroy the given RocksDB database. destroy :: MonadIO m => FilePath -> Options -> m () destroy path opts_ptr = liftIO $- withFilePath path $ \path_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_ptr = liftIO $- withFilePath path $ \path_ptr ->+ withCString path $ \path_ptr -> throwIfErr "repair" $ c_rocksdb_repair_db opts_ptr path_ptr @@ -159,21 +232,44 @@ -- | Write a key/value pair. put :: MonadIO m => DB -> ByteString -> ByteString -> m ()-put DB{rocksDB = db_ptr, writeOpts = write_opts} key value = liftIO $+put db = putCommon db Nothing++putCF :: MonadIO m => DB -> ColumnFamily -> ByteString -> ByteString -> m ()+putCF db cf = putCommon db (Just cf)++putCommon :: MonadIO m => DB -> Maybe ColumnFamily -> ByteString -> ByteString -> m ()+putCommon DB{rocksDB = db_ptr, writeOpts = write_opts} mcf key value = liftIO $ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) -> BU.unsafeUseAsCStringLen value $ \(val_ptr, vlen) ->- throwIfErr "put"- $ c_rocksdb_put db_ptr write_opts- key_ptr (intToCSize klen)- val_ptr (intToCSize vlen)+ throwIfErr "put" $ case mcf of+ Just cf -> c_rocksdb_put_cf+ db_ptr write_opts cf+ key_ptr (intToCSize klen)+ val_ptr (intToCSize vlen)+ Nothing -> c_rocksdb_put+ db_ptr write_opts+ key_ptr (intToCSize klen)+ val_ptr (intToCSize vlen) -- | Read a value by key. get :: MonadIO m => DB -> ByteString -> m (Maybe ByteString)-get DB{rocksDB = db_ptr, readOpts = read_opts} key = liftIO $+get db = getCommon db Nothing++getCF :: MonadIO m => DB -> ColumnFamily -> ByteString -> m (Maybe ByteString)+getCF db cf = getCommon db (Just cf)++getCommon :: MonadIO m => DB -> Maybe ColumnFamily -> ByteString -> m (Maybe ByteString)+getCommon DB{rocksDB = db_ptr, readOpts = read_opts} mcf key = liftIO $ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) -> alloca $ \vlen_ptr -> do val_ptr <- throwIfErr "get" $- c_rocksdb_get db_ptr read_opts key_ptr (intToCSize klen) vlen_ptr+ case mcf of+ Just cf -> c_rocksdb_get_cf+ db_ptr read_opts cf+ key_ptr (intToCSize klen) vlen_ptr+ Nothing -> c_rocksdb_get+ db_ptr read_opts+ key_ptr (intToCSize klen) vlen_ptr vlen <- peek vlen_ptr if val_ptr == nullPtr then return Nothing@@ -182,12 +278,19 @@ freeCString val_ptr return res' --- | Delete a key/value pair. delete :: MonadIO m => DB -> ByteString -> m ()-delete DB{rocksDB = db_ptr, writeOpts = write_opts} key = liftIO $+delete db = deleteCommon db Nothing++deleteCF :: MonadIO m => DB -> ColumnFamily -> ByteString -> m ()+deleteCF db cf = deleteCommon db (Just cf)++-- | Delete a key/value pair.+deleteCommon :: MonadIO m => DB -> Maybe ColumnFamily -> ByteString -> m ()+deleteCommon DB{rocksDB = db_ptr, writeOpts = write_opts} mcf key = liftIO $ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->- throwIfErr "delete"- $ c_rocksdb_delete db_ptr write_opts key_ptr (intToCSize klen)+ throwIfErr "delete" $ case mcf of+ Just cf -> c_rocksdb_delete_cf db_ptr write_opts cf key_ptr (intToCSize klen)+ Nothing -> c_rocksdb_delete db_ptr write_opts key_ptr (intToCSize klen) -- | Perform a batch mutation. write :: MonadIO m => DB -> [BatchOp] -> m ()@@ -195,60 +298,52 @@ bracket c_rocksdb_writebatch_create c_rocksdb_writebatch_destroy $ \batch_ptr -> do-- mapM_ (batchAdd batch_ptr) batch-- throwIfErr "write" $ c_rocksdb_write db_ptr write_opts 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 (PutCF cf_ptr key val) =- BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->- BU.unsafeUseAsCStringLen val $ \(val_ptr, vlen) ->- c_rocksdb_writebatch_put_cf- batch_ptr- cf_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)-- batchAdd batch_ptr (DelCF cf_ptr key) =- BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->- c_rocksdb_writebatch_delete_cf- batch_ptr- cf_ptr- key_ptr (intToCSize klen)--- touch (Put (PS p _ _) (PS p' _ _)) = do- touchForeignPtr p- touchForeignPtr p'-- touch (PutCF _ (PS p _ _) (PS p' _ _)) = do- touchForeignPtr p- touchForeignPtr p'-- touch (Del (PS p _ _)) = touchForeignPtr p-- touch (DelCF _ (PS p _ _)) = touchForeignPtr p+ mapM_ (batchAdd batch_ptr) batch+ throwIfErr "write" $ c_rocksdb_write db_ptr write_opts 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 (PutCF cf_ptr key val) =+ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+ BU.unsafeUseAsCStringLen val $ \(val_ptr, vlen) ->+ c_rocksdb_writebatch_put_cf+ batch_ptr+ cf_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)+ batchAdd batch_ptr (DelCF cf_ptr key) =+ BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->+ c_rocksdb_writebatch_delete_cf+ batch_ptr+ cf_ptr+ key_ptr (intToCSize klen)+ touch (Put (PS p _ _) (PS p' _ _)) = do+ touchForeignPtr p+ touchForeignPtr p'+ touch (PutCF _ (PS p _ _) (PS p' _ _)) = do+ touchForeignPtr p+ touchForeignPtr p'+ touch (Del (PS p _ _)) =+ touchForeignPtr p+ touch (DelCF _ (PS p _ _)) =+ touchForeignPtr p --- | Marshal a 'FilePath' (Haskell string) into a `NUL` terminated C string using--- temporary storage.-withFilePath :: FilePath -> (CString -> IO a) -> IO a-withFilePath = GHC.withCString GHC.utf8+withStrings :: MonadUnliftIO m => [String] -> ([CString] -> m a) -> m a+withStrings ss f =+ go [] ss+ where+ go acc [] = f (reverse acc)+ go acc (x:xs) = withCString x $ \p -> go (p:acc) xs
src/Database/RocksDB/C.hs view
@@ -48,6 +48,7 @@ , c_rocksdb_destroy_db , c_rocksdb_repair_db , c_rocksdb_create_iterator+ , c_rocksdb_create_iterator_cf , c_rocksdb_iter_destroy , c_rocksdb_iter_valid , c_rocksdb_iter_seek_to_first@@ -116,10 +117,10 @@ type Key = CString type Val = CString -foreign import ccall unsafe "rocksdb/c.h rocksdb_open"+foreign import ccall safe "rocksdb/c.h rocksdb_open" c_rocksdb_open :: Options -> DBName -> ErrPtr -> IO RocksDB -foreign import ccall unsafe "rocksdb/c.h rocksdb_open_column_families"+foreign import ccall safe "rocksdb/c.h rocksdb_open_column_families" c_rocksdb_open_column_families :: Options -> DBName -> CInt@@ -129,26 +130,26 @@ -> ErrPtr -> IO RocksDB -foreign import ccall unsafe "rocksdb/c.h rocksdb_close"+foreign import ccall safe "rocksdb/c.h rocksdb_close" c_rocksdb_close :: RocksDB -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_create_column_family"+foreign import ccall safe "rocksdb/c.h rocksdb_create_column_family" c_rocksdb_create_column_family :: RocksDB -> Options -> CFName -> ErrPtr -> IO ColumnFamily -foreign import ccall unsafe "rocksdb/c.h rocksdb_drop_column_family"+foreign import ccall safe "rocksdb/c.h rocksdb_drop_column_family" c_rocksdb_drop_column_family :: RocksDB -> ColumnFamily -> ErrPtr -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_column_family_handle_destroy"+foreign import ccall safe "rocksdb/c.h rocksdb_column_family_handle_destroy" c_rocksdb_column_family_handle_destroy :: ColumnFamily -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_put"+foreign import ccall safe "rocksdb/c.h rocksdb_put" c_rocksdb_put :: RocksDB -> WriteOpts -> Key -> CSize@@ -156,7 +157,7 @@ -> ErrPtr -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_put_cf"+foreign import ccall safe "rocksdb/c.h rocksdb_put_cf" c_rocksdb_put_cf :: RocksDB -> WriteOpts -> ColumnFamily@@ -165,14 +166,14 @@ -> ErrPtr -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_delete"+foreign import ccall safe "rocksdb/c.h rocksdb_delete" c_rocksdb_delete :: RocksDB -> WriteOpts -> Key -> CSize -> ErrPtr -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_delete_cf"+foreign import ccall safe "rocksdb/c.h rocksdb_delete_cf" c_rocksdb_delete_cf :: RocksDB -> WriteOpts -> ColumnFamily@@ -180,7 +181,7 @@ -> ErrPtr -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_write"+foreign import ccall safe "rocksdb/c.h rocksdb_write" c_rocksdb_write :: RocksDB -> WriteOpts -> WriteBatch@@ -189,7 +190,7 @@ -- | Returns NULL if not found. A malloc()ed array otherwise. -- Stores the length of the array in *vallen.-foreign import ccall unsafe "rocksdb/c.h rocksdb_get"+foreign import ccall safe "rocksdb/c.h rocksdb_get" c_rocksdb_get :: RocksDB -> ReadOpts -> Key -> CSize@@ -197,7 +198,7 @@ -> ErrPtr -> IO CString -foreign import ccall unsafe "rocksdb/c.h rocksdb_get_cf"+foreign import ccall safe "rocksdb/c.h rocksdb_get_cf" c_rocksdb_get_cf :: RocksDB -> ReadOpts -> ColumnFamily@@ -206,7 +207,7 @@ -> ErrPtr -> IO CString -foreign import ccall unsafe "rocksdb/c.h rocksdb_multi_get"+foreign import ccall safe "rocksdb/c.h rocksdb_multi_get" c_rocksdb_multi_get :: RocksDB -> ReadOpts -> CSize -- ^ number of keys@@ -217,7 +218,7 @@ -> ErrPtr -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_multi_get_cf"+foreign import ccall safe "rocksdb/c.h rocksdb_multi_get_cf" c_rocksdb_multi_get_cf :: RocksDB -> ReadOpts -> Ptr ColumnFamily -- ^ column families@@ -229,18 +230,18 @@ -> ErrPtr -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_create_snapshot"+foreign import ccall safe "rocksdb/c.h rocksdb_create_snapshot" c_rocksdb_create_snapshot :: RocksDB -> IO Snapshot -foreign import ccall unsafe "rocksdb/c.h rocksdb_release_snapshot"+foreign import ccall safe "rocksdb/c.h rocksdb_release_snapshot" c_rocksdb_release_snapshot :: RocksDB -> Snapshot -> IO () -- | Returns NULL if property name is unknown. Else returns a pointer to a -- malloc()-ed null-terminated value.-foreign import ccall unsafe "rocksdb/c.h rocksdb_property_value"+foreign import ccall safe "rocksdb/c.h rocksdb_property_value" c_rocksdb_property_value :: RocksDB -> CString -> IO CString -foreign import ccall unsafe "rocksdb/c.h rocksdb_approximate_sizes"+foreign import ccall safe "rocksdb/c.h rocksdb_approximate_sizes" c_rocksdb_approximate_sizes :: RocksDB -> CInt -- ^ num ranges@@ -252,10 +253,10 @@ -- ^ array of approx. sizes of ranges -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_destroy_db"+foreign import ccall safe "rocksdb/c.h rocksdb_destroy_db" c_rocksdb_destroy_db :: Options -> DBName -> ErrPtr -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_repair_db"+foreign import ccall safe "rocksdb/c.h rocksdb_repair_db" c_rocksdb_repair_db :: Options -> DBName -> ErrPtr -> IO () @@ -263,39 +264,45 @@ -- Iterator -- -foreign import ccall unsafe "rocksdb/c.h rocksdb_create_iterator"+foreign import ccall safe "rocksdb/c.h rocksdb_create_iterator" c_rocksdb_create_iterator :: RocksDB -> ReadOpts -> IO Iterator -foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_destroy"+foreign import ccall safe "rocksdb/c.h rocksdb_create_iterator_cf"+ c_rocksdb_create_iterator_cf :: RocksDB+ -> ReadOpts+ -> ColumnFamily+ -> IO Iterator++foreign import ccall safe "rocksdb/c.h rocksdb_iter_destroy" c_rocksdb_iter_destroy :: Iterator -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_valid"+foreign import ccall safe "rocksdb/c.h rocksdb_iter_valid" c_rocksdb_iter_valid :: Iterator -> IO CUChar -foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_seek_to_first"+foreign import ccall safe "rocksdb/c.h rocksdb_iter_seek_to_first" c_rocksdb_iter_seek_to_first :: Iterator -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_seek_to_last"+foreign import ccall safe "rocksdb/c.h rocksdb_iter_seek_to_last" c_rocksdb_iter_seek_to_last :: Iterator -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_seek"+foreign import ccall safe "rocksdb/c.h rocksdb_iter_seek" c_rocksdb_iter_seek :: Iterator -> Key -> CSize -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_next"+foreign import ccall safe "rocksdb/c.h rocksdb_iter_next" c_rocksdb_iter_next :: Iterator -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_prev"+foreign import ccall safe "rocksdb/c.h rocksdb_iter_prev" c_rocksdb_iter_prev :: Iterator -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_key"+foreign import ccall safe "rocksdb/c.h rocksdb_iter_key" c_rocksdb_iter_key :: Iterator -> Ptr CSize -> IO Key -foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_value"+foreign import ccall safe "rocksdb/c.h rocksdb_iter_value" c_rocksdb_iter_value :: Iterator -> Ptr CSize -> IO Val -foreign import ccall unsafe "rocksdb/c.h rocksdb_iter_get_error"+foreign import ccall safe "rocksdb/c.h rocksdb_iter_get_error" c_rocksdb_iter_get_error :: Iterator -> ErrPtr -> IO () @@ -303,33 +310,33 @@ -- Write batch -- -foreign import ccall unsafe "rocksdb/c.h rocksdb_writebatch_create"+foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_create" c_rocksdb_writebatch_create :: IO WriteBatch -foreign import ccall unsafe "rocksdb/c.h rocksdb_writebatch_destroy"+foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_destroy" c_rocksdb_writebatch_destroy :: WriteBatch -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_writebatch_clear"+foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_clear" c_rocksdb_writebatch_clear :: WriteBatch -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_writebatch_put"+foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_put" c_rocksdb_writebatch_put :: WriteBatch -> Key -> CSize -> Val -> CSize -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_writebatch_put_cf"+foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_put_cf" c_rocksdb_writebatch_put_cf :: WriteBatch -> ColumnFamily -> Key -> CSize -> Val -> CSize -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_writebatch_delete"+foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_delete" c_rocksdb_writebatch_delete :: WriteBatch -> Key -> CSize -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_writebatch_delete_cf"+foreign import ccall safe "rocksdb/c.h rocksdb_writebatch_delete_cf" c_rocksdb_writebatch_delete_cf :: WriteBatch -> ColumnFamily -> Key@@ -340,25 +347,25 @@ -- Options -- -foreign import ccall unsafe "rocksdb/c.h rocksdb_options_create"+foreign import ccall safe "rocksdb/c.h rocksdb_options_create" c_rocksdb_options_create :: IO Options foreign import ccall "rocksdb/c.h rocksdb_options_destroy" c_rocksdb_options_destroy :: Options -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_options_set_create_if_missing"+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_create_if_missing" c_rocksdb_options_set_create_if_missing :: Options -> CBool -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_options_set_error_if_exists"+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_error_if_exists" c_rocksdb_options_set_error_if_exists :: Options -> CBool -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_options_set_paranoid_checks"+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_paranoid_checks" c_rocksdb_options_set_paranoid_checks :: Options -> CBool -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_options_set_max_open_files"+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_max_open_files" c_rocksdb_options_set_max_open_files :: Options -> CInt -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_options_set_prefix_extractor"+foreign import ccall safe "rocksdb/c.h rocksdb_options_set_prefix_extractor" c_rocksdb_options_set_prefix_extractor :: Options -> PrefixExtract -> IO ()@@ -367,33 +374,33 @@ -- Prefix Extractor -- -foreign import ccall unsafe "rocksdb/c.h rocksdb_slicetransform_create_fixed_prefix"+foreign import ccall safe "rocksdb/c.h rocksdb_slicetransform_create_fixed_prefix" c_rocksdb_slicetransform_create_fixed_prefix :: CSize -> IO PrefixExtract -foreign import ccall unsafe "rocksdb/c.h rocksdb_slicetransform_destroy"+foreign import ccall safe "rocksdb/c.h rocksdb_slicetransform_destroy" c_rocksdb_slicetransform_destroy :: PrefixExtract -> IO () -- -- Bloom Filter -- -foreign import ccall unsafe "rocksdb/c.h rocksdb_filterpolicy_destroy"+foreign import ccall safe "rocksdb/c.h rocksdb_filterpolicy_destroy" c_rocksdb_filterpolicy_destroy :: BloomFilter -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_filterpolicy_create_bloom"+foreign import ccall safe "rocksdb/c.h rocksdb_filterpolicy_create_bloom" c_rocksdb_filterpolicy_create_bloom :: CInt -> IO BloomFilter -- -- Read options -- -foreign import ccall unsafe "rocksdb/c.h rocksdb_readoptions_create"+foreign import ccall safe "rocksdb/c.h rocksdb_readoptions_create" c_rocksdb_readoptions_create :: IO ReadOpts -foreign import ccall unsafe "rocksdb/c.h rocksdb_readoptions_destroy"+foreign import ccall safe "rocksdb/c.h rocksdb_readoptions_destroy" c_rocksdb_readoptions_destroy :: ReadOpts -> IO () -foreign import ccall unsafe "rocksdb/c.h rocksdb_readoptions_set_snapshot"+foreign import ccall safe "rocksdb/c.h rocksdb_readoptions_set_snapshot" c_rocksdb_readoptions_set_snapshot :: ReadOpts -> Snapshot -> IO () @@ -401,15 +408,15 @@ -- Write options -- -foreign import ccall unsafe "rocksdb/c.h rocksdb_writeoptions_create"+foreign import ccall safe "rocksdb/c.h rocksdb_writeoptions_create" c_rocksdb_writeoptions_create :: IO WriteOpts -foreign import ccall unsafe "rocksdb/c.h rocksdb_writeoptions_destroy"+foreign import ccall safe "rocksdb/c.h rocksdb_writeoptions_destroy" c_rocksdb_writeoptions_destroy :: WriteOpts -> IO () -- -- Free -- -foreign import ccall unsafe "rocksdb/c.h rocksdb_free"+foreign import ccall safe "rocksdb/c.h rocksdb_free" c_rocksdb_free :: CString -> IO ()
src/Database/RocksDB/Internal.hs view
@@ -15,6 +15,7 @@ -- * Smart constructors & extractors , withOptions+ , withOptionsCF , withReadOpts , withWriteOpts @@ -82,6 +83,13 @@ (intToCSize n) return $ Just pfx_extract return (opts_ptr, maybe_pfx_extract)++withOptionsCF :: MonadUnliftIO m => [Config] -> ([Options] -> m a) -> m a+withOptionsCF cfgs f =+ go [] cfgs+ where+ go acc [] = f (reverse acc)+ go acc (c:cs) = withOptions c $ \o -> go (o:acc) cs withReadOpts :: MonadUnliftIO m => Maybe Snapshot -> (ReadOpts -> m a) -> m a withReadOpts maybe_snap_ptr =
src/Database/RocksDB/Iterator.hs view
@@ -14,6 +14,7 @@ module Database.RocksDB.Iterator ( Iterator , withIter+ , withIterCF , iterEntry , iterFirst , iterGetError@@ -47,13 +48,24 @@ -- -- Iterator should not be used after computation ends. withIter :: MonadUnliftIO m => DB -> (Iterator -> m a) -> m a-withIter DB{rocksDB = rocks_db, readOpts = read_opts} =+withIter db = withIterCommon db Nothing++withIterCF :: MonadUnliftIO m => DB -> ColumnFamily -> (Iterator -> m a) -> m a+withIterCF db cf = withIterCommon db (Just cf)++withIterCommon :: MonadUnliftIO m+ => DB+ -> Maybe ColumnFamily+ -> (Iterator -> m a)+ -> m a+withIterCommon DB{rocksDB = rocks_db, readOpts = read_opts} mcf = bracket create_iterator destroy_iterator where destroy_iterator = liftIO . c_rocksdb_iter_destroy create_iterator = liftIO $- throwErrnoIfNull "create_iterator" $- c_rocksdb_create_iterator rocks_db read_opts+ throwErrnoIfNull "create_iterator" $ case mcf of+ Just cf -> c_rocksdb_create_iterator_cf rocks_db read_opts cf+ Nothing -> c_rocksdb_create_iterator rocks_db read_opts -- | An iterator is either positioned at a key/value pair, or not valid. This -- function returns /true/ iff the iterator is valid.
test/tests.hs view
@@ -1,22 +1,54 @@ {-# LANGUAGE BinaryLiterals #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE TupleSections #-} module Main where -import Data.Default (def)+import Data.Default (def)+import Data.String.Conversions import Database.RocksDB-import Test.Hspec (describe, hspec, it, shouldReturn)+import Test.Hspec (describe, hspec, it, shouldReturn) import UnliftIO withTestDB :: MonadUnliftIO m => FilePath -> (DB -> m a) -> m a-withTestDB path = withDB path def{createIfMissing = True}+withTestDB path =+ withDB path def{createIfMissing = True} +withTestDBCF :: MonadUnliftIO m => FilePath -> [String] -> (DB -> m a) -> m a+withTestDBCF path cfs =+ withDBCF path def{createIfMissing = True} (map (,def) cfs)+ main :: IO () main = do hspec $ do describe "Database engine" $ do it "should put items into the database and retrieve them" $- withSystemTempDirectory "rocksdb" $ \path ->+ withSystemTempDirectory "rocksdb1" $ \path -> withTestDB path $ \db -> do put db "zzz" "zzz" get db "zzz" `shouldReturn` Just "zzz"+ it "should store and retrieve items from different column families" $+ withSystemTempDirectory "rocksdbcf1" $ \path ->+ withTestDBCF path ["two"] $ \db -> do+ let [two] = columnFamilies db+ put db "one" "one"+ get db "one" `shouldReturn` Just "one"+ getCF db two "one" `shouldReturn` Nothing+ putCF db two "two" "two"+ getCF db two "two" `shouldReturn` Just "two"+ get db "two" `shouldReturn` Nothing+ describe "Multiple concurrent threads" $ do+ it "should be able to put and retrieve items" $+ withSystemTempDirectory "rocksdb2" $ \path ->+ withTestDB path $ \db -> do+ let str = cs . show+ key i = "key" <> str i+ val i = "val" <> str i+ indices = [1..500] :: [Int]+ keys = map key indices+ vals = map val indices+ kvs = zip keys vals+ as1 <- mapM (\(k, v) -> async $ put db k v) kvs+ mapM_ wait as1+ as2 <- mapM (\k -> async $ get db k) keys+ mapM wait as2 `shouldReturn` map Just vals