rocksdb-haskell-jprupp 2.1.4 → 2.1.5
raw patch · 6 files changed
+40/−50 lines, 6 files
Files
- CHANGELOG.md +4/−0
- rocksdb-haskell-jprupp.cabal +3/−3
- src/Database/RocksDB/Base.hs +7/−7
- src/Database/RocksDB/C.hs +1/−1
- src/Database/RocksDB/Internal.hs +23/−37
- test/tests.hs +2/−2
CHANGELOG.md view
@@ -1,3 +1,7 @@+## 2.1.5++ * Fix errors not releasing memory.+ ## 2.1.4 * Add ResourceT support for snapshots and iterators.
rocksdb-haskell-jprupp.cabal view
@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.34.4.+-- This file has been generated from package.yaml by hpack version 0.35.2. -- -- see: https://github.com/sol/hpack ----- hash: 48b49def634c00156ec5f8bc2f4a8c92caf0aca334fca3cef6507f51febe9867+-- hash: 7e9a6be0b5ec766b502a4a03665778ca9fd0e9b17df4f5da3f902cb7631111be name: rocksdb-haskell-jprupp-version: 2.1.4+version: 2.1.5 synopsis: Haskell bindings for RocksDB description: See README at <https://github.com/jprupp/rocksdb-haskell#readme> category: Database, FFI
src/Database/RocksDB/Base.hs view
@@ -146,9 +146,9 @@ write_opts = liftIO $ do when (createIfMissing config) $ createDirectoryIfMissing True path- null <$> listDirectory path >>= \case- True -> create_new cf_names cf_opts opts_ptr read_opts write_opts- False -> withCString path $ \path_ptr ->+ listDirectory path >>= \case+ [] -> create_new cf_names cf_opts opts_ptr read_opts write_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)@@ -280,13 +280,13 @@ 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 else do- res' <- Just <$> BS.packCStringLen (val_ptr, cSizeToInt vlen)+ vlen <- peek vlen_ptr+ res <- Just <$> BS.packCStringLen (val_ptr, cSizeToInt vlen) freeCString val_ptr- return res'+ return res delete :: MonadIO m => DB -> ByteString -> m () delete db = deleteCommon db Nothing@@ -312,7 +312,7 @@ 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+ mapM_ touch batch where batchAdd batch_ptr (Put key val) = BU.unsafeUseAsCStringLen key $ \(key_ptr, klen) ->
src/Database/RocksDB/C.hs view
@@ -109,7 +109,7 @@ type ColumnFamily = Ptr LColumnFamily type Options = Ptr LOptions type WriteBatch = Ptr LWriteBatch-type SliceTransform = Ptr LSliceTransform+type SliceTransform = Ptr LSliceTransform type ReadOpts = Ptr LReadOpts type WriteOpts = Ptr LWriteOpts type Snapshot = Ptr LSnapshot
src/Database/RocksDB/Internal.hs view
@@ -59,45 +59,30 @@ } withOptions :: MonadUnliftIO m => Config -> (Options -> m a) -> m a-withOptions Config {..} f =- with_opts $ \opts -> do- liftIO $ do- slice <- bloom- block_opts opts slice- pfx_extract opts- max_files opts- c_rocksdb_options_set_create_if_missing- opts (boolToCBool createIfMissing)- c_rocksdb_options_set_error_if_exists- opts (boolToCBool errorIfExists)- c_rocksdb_options_set_paranoid_checks- opts (boolToCBool paranoidChecks)- f opts+withOptions Config {..} f = with_opts $ \opts -> do+ liftIO $ do+ when bloomFilter $ do+ fp <- c_rocksdb_filterpolicy_create_bloom_full 10+ bo <- c_rocksdb_block_based_options_create+ c_rocksdb_block_based_options_set_filter_policy bo fp+ c_rocksdb_options_set_block_based_table_factory opts bo+ forM_ prefixLength $ \l -> do+ t <- c_rocksdb_slicetransform_create_fixed_prefix (intToCSize l)+ c_rocksdb_options_set_prefix_extractor opts t+ forM_ maxFiles $+ c_rocksdb_options_set_max_open_files opts . intToCInt+ c_rocksdb_options_set_create_if_missing+ opts (boolToCBool createIfMissing)+ c_rocksdb_options_set_error_if_exists+ opts (boolToCBool errorIfExists)+ c_rocksdb_options_set_paranoid_checks+ opts (boolToCBool paranoidChecks)+ f opts where with_opts = bracket (liftIO c_rocksdb_options_create) (liftIO . c_rocksdb_options_destroy)- block_opts _ Nothing = return ()- block_opts opts (Just slice) = liftIO $ do- block <- c_rocksdb_block_based_options_create- c_rocksdb_block_based_options_set_filter_policy block slice- c_rocksdb_options_set_block_based_table_factory opts block- bloom =- if bloomFilter- then Just <$> c_rocksdb_filterpolicy_create_bloom_full 10- else return Nothing- pfx_extract opts =- case prefixLength of- Nothing -> return ()- Just len -> liftIO $ do- p <- c_rocksdb_slicetransform_create_fixed_prefix- (intToCSize len)- c_rocksdb_options_set_prefix_extractor opts p- max_files opts =- case maxFiles of- Nothing -> return ()- Just i -> c_rocksdb_options_set_max_open_files opts (intToCInt i) withOptionsCF :: MonadUnliftIO m => [Config] -> ([Options] -> m a) -> m a@@ -131,9 +116,10 @@ throwIfErr s f = alloca $ \err_ptr -> do liftIO $ poke err_ptr nullPtr res <- f err_ptr- erra <- liftIO $ peek err_ptr- when (erra /= nullPtr) $ do- err <- liftIO $ peekCString erra+ err_cstr <- liftIO $ peek err_ptr+ when (err_cstr /= nullPtr) $ do+ err <- liftIO $ peekCString err_cstr+ liftIO $ free err_cstr throwIO $ userError $ s ++ ": " ++ err return res
test/tests.hs view
@@ -37,7 +37,7 @@ it "should store and retrieve items from different column families" $ withSystemTempDirectory "rocksdbcf1" $ \path -> withTestDBCF path ["two"] $ \db -> do- let [two] = columnFamilies db+ let two = head $ columnFamilies db put db "one" "one" get db "one" `shouldReturn` Just "one" getCF db two "one" `shouldReturn` Nothing@@ -57,5 +57,5 @@ 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+ as2 <- mapM (async . get db) keys mapM wait as2 `shouldReturn` map Just vals