rocksdb-query 0.5.0 → 0.6.0

raw patch · 4 files changed

+259/−247 lines, 4 filesdep −resourcetdep ~rocksdb-haskell-jpruppPVP ok

version bump matches the API change (PVP)

Dependencies removed: resourcet

Dependency ranges changed: rocksdb-haskell-jprupp

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• rocksdb-query.cabal +3/−4
• src/Database/RocksDB/Query.hs +183/−178
• test/Spec.hs +69/−65

@@ -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.6.0+### Changed+- Get rid of MonadIO and operate directly on IO monad.+ ## 0.5.0 ### Changed - Improvements to rocksdb-haskell-jprupp package.

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           rocksdb-query-version:        0.5.0+version:        0.6.0 synopsis:       RocksDB database querying library for Haskell description:    Please see the README on GitHub at <https://github.com/jprupp/rocksdb-query#readme> category:       Database@@ -36,8 +36,7 @@     , bytestring     , cereal     , conduit-    , resourcet-    , rocksdb-haskell-jprupp >=2.1.1+    , rocksdb-haskell-jprupp >=2.3.0   default-language: Haskell2010  test-suite rocksdb-query-test@@ -53,7 +52,7 @@     , cereal     , data-default     , hspec-    , rocksdb-haskell-jprupp >=2.1.1+    , rocksdb-haskell-jprupp >=2.3.0     , rocksdb-query     , temporary   default-language: Haskell2010

@@ -1,22 +1,23 @@-{-# LANGUAGE LambdaCase            #-}+{-# LANGUAGE ImportQualifiedPost #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE MultiParamTypeClasses #-}-{-|-Module      : Database.RocksDB.Query-Copyright   : No rights reserved-License     : UNLICENSE-Maintainer  : xenog@protonmail.com-Stability   : experimental-Portability : POSIX -Query functions to make interaction with RocksDB stores easier and safer.--}+-- |+-- Module      : Database.RocksDB.Query+-- Copyright   : No rights reserved+-- License     : UNLICENSE+-- Maintainer  : xenog@protonmail.com+-- Stability   : experimental+-- Portability : POSIX+--+-- Query functions to make interaction with RocksDB stores easier and safer. 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+import Conduit+import Control.Monad+import Data.ByteString qualified as B+import Data.Serialize as S+import Database.RocksDB as R  -- | Class for types that are database keys. class Key key@@ -26,79 +27,80 @@  -- | Read a value from the database, or 'Nothing' if not found. retrieve ::-       (MonadIO m, KeyValue key value, Serialize key, Serialize value)-    => DB-    -> key-    -> m (Maybe value)+  (KeyValue key value, Serialize key, Serialize value) =>+  DB ->+  key ->+  IO (Maybe value) retrieve db = retrieveCommon db Nothing  retrieveCF ::-       (MonadIO m, KeyValue key value, Serialize key, Serialize value)-    => DB-    -> ColumnFamily-    -> key-    -> m (Maybe value)+  (KeyValue key value, Serialize key, Serialize value) =>+  DB ->+  ColumnFamily ->+  key ->+  IO (Maybe value) retrieveCF db cf = retrieveCommon db (Just cf)  -- | Read a value from the database, or 'Nothing' if not found. retrieveCommon ::-       (MonadIO m, KeyValue key value, Serialize key, Serialize value)-    => DB-    -> Maybe ColumnFamily-    -> key-    -> m (Maybe value)+  (KeyValue key value, Serialize key, Serialize value) =>+  DB ->+  Maybe ColumnFamily ->+  key ->+  IO (Maybe value) retrieveCommon db mcf key =-    f >>= \case-        Nothing -> return Nothing-        Just bytes ->-            case decode bytes of-                Left e  -> error e-                Right x -> return (Just x)+  f >>= \case+    Nothing -> return Nothing+    Just bytes ->+      case decode bytes of+        Left e -> error e+        Right x -> return (Just x)   where     f = case mcf of-        Just cf -> R.getCF db cf (encode key)-        Nothing -> R.get db (encode key)+      Just cf -> R.getCF db cf (encode key)+      Nothing -> R.get db (encode key)  matchRecursiveList ::-     (KeyValue key value, Serialize key, Serialize value)-  => key-  -> Iterator-  -> IO [(key, value)]+  (KeyValue key value, Serialize key, Serialize value) =>+  key ->+  Iterator ->+  IO [(key, value)] matchRecursiveList base it = go   where-    go = iterEntry it >>= \case+    go =+      iterEntry it >>= \case         Nothing -> return []         Just (key_bytes, value_bytes) ->           if base_bytes `B.isPrefixOf` key_bytes-              then do-                  key <- either error return (decode key_bytes)-                  value <- either error return (decode value_bytes)-                  iterNext it-                  ((key, value) :) <$> go-              else return []+            then do+              key <- either error return (decode key_bytes)+              value <- either error return (decode value_bytes)+              iterNext it+              ((key, value) :) <$> go+            else return []     base_bytes = encode base  -- | Internal function for recursively matching a key. matchRecursive ::-       ( KeyValue key value-       , Serialize key-       , Serialize value-       )-    => key-    -> Iterator-    -> ConduitT i (key, value) IO ()+  ( KeyValue key value,+    Serialize key,+    Serialize value+  ) =>+  key ->+  Iterator ->+  ConduitT i (key, value) IO () matchRecursive base it = go   where     go =       liftIO (iterEntry it) >>= \case         Nothing -> return ()         Just (key_bytes, value_bytes) ->-            when (base_bytes `B.isPrefixOf` key_bytes) $ do-                key <- either error return (decode key_bytes)-                value <- either error return (decode value_bytes)-                yield (key, value)-                liftIO (iterNext it)-                go+          when (base_bytes `B.isPrefixOf` key_bytes) $ do+            key <- either error return (decode key_bytes)+            value <- either error return (decode value_bytes)+            yield (key, value)+            liftIO (iterNext it)+            go     base_bytes = encode base  -- | Pass a short key to filter all the elements whose key prefix match it. Use@@ -124,75 +126,76 @@ -- the 'Serialize' instance for @MyKey@ only understands how to deserialize a -- @FullKey@, then that is what is returned. matching ::-       ( KeyValue key value-       , Serialize key-       , Serialize value-       )-    => Iterator-    -> key-    -> ConduitT i (key, value) IO ()+  ( KeyValue key value,+    Serialize key,+    Serialize value+  ) =>+  Iterator ->+  key ->+  ConduitT i (key, value) IO () matching it base = do-    liftIO (iterSeek it (encode base))-    matchRecursive base it+  liftIO (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 ::-       ( KeyValue key value-       , Serialize key-       , Serialize value-       )-    => Iterator-    -> key-    -> key-    -> ConduitT i (key, value) IO ()+  ( KeyValue key value,+    Serialize key,+    Serialize value+  ) =>+  Iterator ->+  key ->+  key ->+  ConduitT i (key, value) IO () matchingSkip it base start = do-    liftIO (iterSeek it (encode start))-    matchRecursive base it+  liftIO (iterSeek it (encode start))+  matchRecursive base it  -- | Insert a record into the database. insert ::-       (MonadIO m, KeyValue key value, Serialize key, Serialize value)-    => DB-    -> key-    -> value-    -> m ()+  (KeyValue key value, Serialize key, Serialize value) =>+  DB ->+  key ->+  value ->+  IO () insert db key value = R.put db (encode key) (encode value)  -- | Insert a record into the database. insertCF ::-       (MonadIO m, KeyValue key value, Serialize key, Serialize value)-    => DB-    -> ColumnFamily-    -> key-    -> value-    -> m ()+  (KeyValue key value, Serialize key, Serialize value) =>+  DB ->+  ColumnFamily ->+  key ->+  value ->+  IO () insertCF db cf key value = R.putCF db cf (encode key) (encode value)  -- | Delete a record from the database.-remove :: (MonadIO m, Key key, Serialize key) => DB -> key -> m ()+remove :: (Key key, Serialize key) => DB -> key -> IO () remove db key = delete db (encode key)  -- | Delete a record from the database.-removeCF :: (MonadIO m, Key key, Serialize key)-         => DB -> ColumnFamily -> key -> m ()+removeCF ::+  (Key key, Serialize key) =>+  DB -> ColumnFamily -> key -> IO () removeCF db cf key = deleteCF db cf (encode key)  -- | Get the 'BatchOp' to insert a record in the database. insertOp ::-       (KeyValue key value, Serialize key, Serialize value)-    => key-    -> value-    -> BatchOp+  (KeyValue key value, Serialize key, Serialize value) =>+  key ->+  value ->+  BatchOp insertOp key value = R.Put (encode key) (encode value)  -- | Get the 'BatchOp' to insert a record in the database. insertOpCF ::-       (KeyValue key value, Serialize key, Serialize value)-    => ColumnFamily-    -> key-    -> value-    -> BatchOp+  (KeyValue key value, Serialize key, Serialize value) =>+  ColumnFamily ->+  key ->+  value ->+  BatchOp insertOpCF cf key value = R.PutCF cf (encode key) (encode value)  -- | Get the 'BatchOp' to delete a record from the database.@@ -204,119 +207,121 @@ deleteOpCF cf key = DelCF cf (encode key)  -- | Write a batch to the database.-writeBatch :: MonadIO m => DB -> [BatchOp] -> m ()+writeBatch :: DB -> [BatchOp] -> IO () writeBatch = write  -- | Like 'matching' but return the first element only. firstMatching ::-       ( KeyValue key value-       , Serialize key-       , Serialize value-       )-    => DB-    -> key-    -> IO (Maybe (key, value))+  ( KeyValue key value,+    Serialize key,+    Serialize value+  ) =>+  DB ->+  key ->+  IO (Maybe (key, value)) firstMatching db base =-    withIter db $ \it -> runConduit $ matching it base .| headC+  withIter db $ \it -> runConduit $ matching it base .| headC  -- | Like 'matching' but return the first element only. firstMatchingCF ::-       ( KeyValue key value-       , Serialize key-       , Serialize value-       )-    => DB-    -> ColumnFamily-    -> key-    -> IO (Maybe (key, value))+  ( KeyValue key value,+    Serialize key,+    Serialize value+  ) =>+  DB ->+  ColumnFamily ->+  key ->+  IO (Maybe (key, value)) firstMatchingCF db cf base =-    withIterCF db cf $ \it -> runConduit $ matching it base .| headC+  withIterCF db cf $ \it -> runConduit $ matching it base .| headC  -- | Like 'matchingSkip', but return the first element only. firstMatchingSkip ::-       ( KeyValue key value-       , Serialize key-       , Serialize value-       )-    => DB-    -> key-    -> key-    -> IO (Maybe (key, value))+  ( KeyValue key value,+    Serialize key,+    Serialize value+  ) =>+  DB ->+  key ->+  key ->+  IO (Maybe (key, value)) firstMatchingSkip db base start =-    withIter db $ \it -> runConduit $-    matchingSkip it base start .| headC+  withIter db $ \it ->+    runConduit $+      matchingSkip it base start .| headC  -- | Like 'matchingSkip', but return the first element only. firstMatchingSkipCF ::-       ( KeyValue key value-       , Serialize key-       , Serialize value-       )-    => DB-    -> ColumnFamily-    -> key-    -> key-    -> IO (Maybe (key, value))+  ( KeyValue key value,+    Serialize key,+    Serialize value+  ) =>+  DB ->+  ColumnFamily ->+  key ->+  key ->+  IO (Maybe (key, value)) firstMatchingSkipCF db cf base start =-    withIterCF db cf $ \it -> runConduit $-    matchingSkip it base start .| headC+  withIterCF db cf $ \it ->+    runConduit $+      matchingSkip it base start .| headC  -- | Like 'matching' but return a list. matchingAsList ::-       ( KeyValue key value-       , Serialize key-       , Serialize value-       )-    => DB-    -> key-    -> IO [(key, value)]+  ( KeyValue key value,+    Serialize key,+    Serialize value+  ) =>+  DB ->+  key ->+  IO [(key, value)] matchingAsList db base =-    withIter db $ \it -> do+  withIter db $ \it -> do     iterSeek it (encode base)     matchRecursiveList base it  -- | Like 'matching' but return a list. matchingAsListCF ::-       ( KeyValue key value-       , Serialize key-       , Serialize value-       )-    => DB-    -> ColumnFamily-    -> key-    -> IO [(key, value)]+  ( KeyValue key value,+    Serialize key,+    Serialize value+  ) =>+  DB ->+  ColumnFamily ->+  key ->+  IO [(key, value)] matchingAsListCF db cf base =-    withIterCF db cf $ \it -> do+  withIterCF db cf $ \it -> do     iterSeek it (encode base)     matchRecursiveList base it  -- | Like 'matchingSkip', but return a list. matchingSkipAsList ::-       ( KeyValue key value-       , Serialize key-       , Serialize value-       )-    => DB-    -> key-    -> key-    -> IO [(key, value)]+  ( KeyValue key value,+    Serialize key,+    Serialize value+  ) =>+  DB ->+  key ->+  key ->+  IO [(key, value)] matchingSkipAsList db base start =-    withIter db $ \it -> do+  withIter db $ \it -> do     iterSeek it (encode start)     matchRecursiveList base it  -- | Like 'matchingSkip', but return a list. matchingSkipAsListCF ::-       ( KeyValue key value-       , Serialize key-       , Serialize value-       )-    => DB-    -> ColumnFamily-    -> key-    -> key-    -> IO [(key, value)]+  ( KeyValue key value,+    Serialize key,+    Serialize value+  ) =>+  DB ->+  ColumnFamily ->+  key ->+  key ->+  IO [(key, value)] matchingSkipAsListCF db cf base start =-    withIterCF db cf $ \it -> do+  withIterCF db cf $ \it -> do     iterSeek it (encode start)     matchRecursiveList base it

@@ -1,84 +1,88 @@-{-# LANGUAGE FlexibleInstances     #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-}-import           Control.Applicative-import           Control.Monad-import           Data.Default-import           Data.Serialize         as S-import           Data.Word-import           Database.RocksDB       as R-import           Database.RocksDB.Query-import           Test.Hspec-import           System.IO.Temp +import Control.Applicative+import Control.Monad+import Data.Default+import Data.Serialize as S+import Data.Word+import Database.RocksDB as R+import Database.RocksDB.Query+import System.IO.Temp+import Test.Hspec+ newtype KeyOne = KeyOne Word32 deriving (Show, Eq)+ data KeyTwo-    = KeyTwo Word32-             Word32-    | KeyTwoBase Word32-    deriving (Show, Eq)+  = KeyTwo+      Word32+      Word32+  | KeyTwoBase Word32+  deriving (Show, Eq)  instance KeyValue KeyTwo String+ instance KeyValue KeyOne String  instance Serialize KeyOne where-    put (KeyOne x) = do-        putWord8 0x01-        S.put x-    get = do-        getWord8 >>= guard . (== 0x01)-        KeyOne <$> S.get+  put (KeyOne x) = do+    putWord8 0x01+    S.put x+  get = do+    getWord8 >>= guard . (== 0x01)+    KeyOne <$> S.get  instance Serialize KeyTwo where-    put k = do-        putWord8 0x02-        case k of-            KeyTwoBase x -> S.put x-            KeyTwo x y   -> S.put x >> S.put y-    get =-        (guard . (== 0x02) =<< getWord8) >>-        KeyTwo <$> S.get <*> S.get <|> KeyTwoBase <$> S.get+  put k = do+    putWord8 0x02+    case k of+      KeyTwoBase x -> S.put x+      KeyTwo x y -> S.put x >> S.put y+  get =+    (guard . (== 0x02) =<< getWord8)+      >> KeyTwo <$> S.get <*> S.get <|> KeyTwoBase <$> S.get  main :: IO () main =-    setup $ \db ->-        describe "database" $ do-            it "reads a record" $ do-                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 (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 (KeyTwoBase 1)-                rs `shouldBe` ls-            it "query and skip" $ do-                let ex = (KeyTwo 2 2, "Hello Second World Again!")-                rs <--                    matchingSkipAsList-                        db-                        (KeyTwoBase 2)-                        (KeyTwo 2 2)-                rs `shouldBe` [ex]+  setup $ \db ->+    describe "database" $ do+      it "reads a record" $ do+        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 (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 (KeyTwoBase 1)+        rs `shouldBe` ls+      it "query and skip" $ do+        let ex = (KeyTwo 2 2, "Hello Second World Again!")+        rs <-+          matchingSkipAsList+            db+            (KeyTwoBase 2)+            (KeyTwo 2 2)+        rs `shouldBe` [ex]   where     setup f =-        withSystemTempDirectory "rocksdb-query-test-" $ \d ->-        withDB d def{createIfMissing = True} $ \db -> do-            insertTestRecords db-            hspec $ f db+      withSystemTempDirectory "rocksdb-query-test-" $ \d ->+        withDB d def {createIfMissing = True} $ \db -> do+          insertTestRecords db+          hspec $ f db  insertTestRecords :: DB -> IO () insertTestRecords db = do-    insert db (KeyOne 1) "Hello World!"-    insert db (KeyOne 2) "Hello World Again!"-    insert db (KeyTwo 1 1) "Hello First World!"-    insert db (KeyTwo 1 2) "Hello First World Again!"-    insert db (KeyTwo 2 1) "Hello Second World!"-    insert db (KeyTwo 2 2) "Hello Second World Again!"+  insert db (KeyOne 1) "Hello World!"+  insert db (KeyOne 2) "Hello World Again!"+  insert db (KeyTwo 1 1) "Hello First World!"+  insert db (KeyTwo 1 2) "Hello First World Again!"+  insert db (KeyTwo 2 1) "Hello Second World!"+  insert db (KeyTwo 2 2) "Hello Second World Again!"