diff --git a/CHANGELOG.md b/CHANGELOG.md --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -4,6 +4,10 @@ The format is based on [Keep a Changelog](http://keepachangelog.com/en/1.0.0/) and this project adheres to [Semantic Versioning](http://semver.org/spec/v2.0.0.html). +## 0.4.0 +### Changed +- Depend on my new Haskell bindings. + ## 0.3.2 ### Changed - Use MIT license. diff --git a/rocksdb-query.cabal b/rocksdb-query.cabal --- a/rocksdb-query.cabal +++ b/rocksdb-query.cabal @@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack -- --- hash: a8dbf838ee062e15b4adf8e1644fb580f07f2a0edd6d9a9a9459ebc56ec4a96a +-- hash: 9db21bfab84b1726ca28c3398842c81f3e8d774dd4d5cde2f5667f64a52b70c9 name: rocksdb-query -version: 0.3.2 +version: 0.4.0 synopsis: RocksDB database querying library for Haskell description: Please see the README on GitHub at category: Database @@ -39,7 +39,7 @@ , cereal , conduit , resourcet - , rocksdb-haskell + , rocksdb-haskell-jprupp , unliftio default-language: Haskell2010 @@ -56,7 +56,7 @@ , cereal , data-default , hspec - , rocksdb-haskell + , rocksdb-haskell-jprupp , rocksdb-query , unliftio default-language: Haskell2010 diff --git a/src/Database/RocksDB/Query.hs b/src/Database/RocksDB/Query.hs --- a/src/Database/RocksDB/Query.hs +++ b/src/Database/RocksDB/Query.hs @@ -13,6 +13,7 @@ module Database.RocksDB.Query where import Conduit +import Control.Monad import qualified Data.ByteString as B import Data.Serialize as S import Database.RocksDB as R @@ -28,11 +29,10 @@ retrieve :: (MonadIO m, KeyValue key value, Serialize key, Serialize value) => DB - -> ReadOptions -> key -> m (Maybe value) -retrieve db opts key = - R.get db opts (encode key) >>= \case +retrieve db key = + R.get db (encode key) >>= \case Nothing -> return Nothing Just bytes -> case decode bytes of @@ -46,17 +46,16 @@ -> m [(key, value)] matchRecursiveList base it = go where - go = - iterEntry it >>= \case + go = iterEntry it >>= \case Nothing -> return [] - Just (key_bytes, value_bytes) -> do + Just (key_bytes, value_bytes) -> if base_bytes `B.isPrefixOf` key_bytes - then do - key <- either throwString return (decode key_bytes) - value <- either throwString return (decode value_bytes) - iterNext it - ((key, value) :) <$> go - else return [] + then do + key <- either throwString return (decode key_bytes) + value <- either throwString return (decode value_bytes) + iterNext it + ((key, value) :) <$> go + else return [] base_bytes = encode base -- | Internal function for recursively matching a key. @@ -74,15 +73,13 @@ go = iterEntry it >>= \case Nothing -> return () - Just (key_bytes, value_bytes) -> do - if base_bytes `B.isPrefixOf` key_bytes - then do - key <- either throwString return (decode key_bytes) - value <- either throwString return (decode value_bytes) - yield (key, value) - iterNext it - go - else return () + Just (key_bytes, value_bytes) -> + when (base_bytes `B.isPrefixOf` key_bytes) $ do + key <- either throwString return (decode key_bytes) + value <- either throwString return (decode value_bytes) + yield (key, value) + iterNext it + go base_bytes = encode base -- | Pass a short key to filter all the elements whose key prefix match it. Use @@ -108,37 +105,33 @@ -- the 'Serialize' instance for @MyKey@ only understands how to deserialize a -- @FullKey@, then that is what is returned. matching :: - ( MonadResource m + ( MonadIO m , KeyValue key value , Serialize key , Serialize value ) - => DB - -> ReadOptions + => Iterator -> key -> ConduitT i (key, value) m () -matching db opts base = - withIterator db opts $ \it -> do - iterSeek it (encode base) - matchRecursive base it +matching it base = do + iterSeek it (encode base) + matchRecursive base it -- | Like 'matching', but skip to the second key passed as argument, or after if -- there is no entry for the second key. matchingSkip :: - ( MonadResource m + ( MonadIO m , KeyValue key value , Serialize key , Serialize value ) - => DB - -> ReadOptions + => Iterator -> key -> key -> ConduitT i (key, value) m () -matchingSkip db opts base start = - withIterator db opts $ \it -> do - iterSeek it (encode start) - matchRecursive base it +matchingSkip it base start = do + iterSeek it (encode start) + matchRecursive base it -- | Insert a record into the database. insert :: @@ -147,11 +140,11 @@ -> key -> value -> m () -insert db key value = R.put db defaultWriteOptions (encode key) (encode value) +insert db key value = R.put db (encode key) (encode value) -- | Delete a record from the database. remove :: (MonadIO m, Key key, Serialize key) => DB -> key -> m () -remove db key = delete db defaultWriteOptions (encode key) +remove db key = delete db (encode key) -- | Get the 'BatchOp' to insert a record in the database. insertOp :: @@ -166,8 +159,8 @@ deleteOp key = Del (encode key) -- | Write a batch to the database. -writeBatch :: MonadIO m => DB -> WriteBatch -> m () -writeBatch db = write db defaultWriteOptions +writeBatch :: MonadIO m => DB -> [BatchOp] -> m () +writeBatch = write -- | Like 'matching' but return the first element only. firstMatching :: @@ -177,11 +170,10 @@ , Serialize value ) => DB - -> ReadOptions -> key -> m (Maybe (key, value)) -firstMatching db opts base = - runResourceT . runConduit $ matching db opts base .| headC +firstMatching db base = + withIter db $ \it -> runConduit $ matching it base .| headC -- | Like 'matchingSkip', but return the first element only. firstMatchingSkip :: @@ -191,13 +183,12 @@ , Serialize value ) => DB - -> ReadOptions -> key -> key -> m (Maybe (key, value)) -firstMatchingSkip db opts base start = - runResourceT . runConduit $ - matchingSkip db opts base start .| headC +firstMatchingSkip db base start = + withIter db $ \it -> runConduit $ + matchingSkip it base start .| headC -- | Like 'matching' but return a list. matchingAsList :: @@ -207,11 +198,10 @@ , Serialize value ) => DB - -> ReadOptions -> key -> m [(key, value)] -matchingAsList db opts base = - runResourceT . withIterator db opts $ \it -> do +matchingAsList db base = + withIter db $ \it -> do iterSeek it (encode base) matchRecursiveList base it @@ -223,11 +213,10 @@ , Serialize value ) => DB - -> ReadOptions -> key -> key -> m [(key, value)] -matchingSkipAsList db opts base start = - runResourceT . withIterator db opts $ \it -> do +matchingSkipAsList db base start = + withIter db $ \it -> do iterSeek it (encode start) matchRecursiveList base it diff --git a/test/Spec.hs b/test/Spec.hs --- a/test/Spec.hs +++ b/test/Spec.hs @@ -43,35 +43,34 @@ setup $ \db -> describe "database" $ do it "reads a record" $ do - r <- retrieve db def (KeyTwo 1 2) + r <- retrieve db (KeyTwo 1 2) r `shouldBe` Just "Hello First World Again!" it "reads two records at the end" $ do let ls = [ (KeyTwo 2 1, "Hello Second World!") , (KeyTwo 2 2, "Hello Second World Again!") ] - rs <- matchingAsList db def (KeyTwoBase 2) + rs <- matchingAsList db (KeyTwoBase 2) rs `shouldBe` ls it "reads two records in the middle" $ do let ls = [ (KeyTwo 1 1, "Hello First World!") , (KeyTwo 1 2, "Hello First World Again!") ] - rs <- matchingAsList db def (KeyTwoBase 1) + rs <- matchingAsList db (KeyTwoBase 1) rs `shouldBe` ls it "query and skip" $ do let ex = (KeyTwo 2 2, "Hello Second World Again!") rs <- matchingSkipAsList db - def (KeyTwoBase 2) (KeyTwo 2 2) rs `shouldBe` [ex] where setup f = - withSystemTempDirectory "rocksdb-query-test-" $ \d -> do - db <- open d defaultOptions {createIfMissing = True} + withSystemTempDirectory "rocksdb-query-test-" $ \d -> + withDB d def{createIfMissing = True} $ \db -> do insertTestRecords db hspec $ f db