rocksdb-query (empty) → 0.1.0
raw patch · 7 files changed
+357/−0 lines, 7 filesdep +basedep +bytestringdep +cerealsetup-changed
Dependencies added: base, bytestring, cereal, conduit, hspec, resourcet, rocksdb-haskell, rocksdb-query, unliftio
Files
- CHANGELOG.md +12/−0
- README.md +3/−0
- Setup.hs +2/−0
- UNLICENSE +24/−0
- rocksdb-query.cabal +64/−0
- src/Database/RocksDB/Query.hs +168/−0
- test/Spec.hs +84/−0
+ CHANGELOG.md view
@@ -0,0 +1,12 @@+# Changelog+All notable changes to this project will be documented in this file.++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).++## [Unreleased]+### Added+- Typeclasses for key/value pairs, base keys and key seekers.+- Functions for creating, updating, deleting records.+- Functions for retrieving multiple records.+- Fuunctions for streaming records.
+ README.md view
@@ -0,0 +1,3 @@+# RocksDB Query++Helper functions to perform queries on RocksDB databases using serialized Haskell datatypes.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ UNLICENSE view
@@ -0,0 +1,24 @@+This is free and unencumbered software released into the public domain.++Anyone is free to copy, modify, publish, use, compile, sell, or+distribute this software, either in source code form or as a compiled+binary, for any purpose, commercial or non-commercial, and by any+means.++In jurisdictions that recognize copyright laws, the author or authors+of this software dedicate any and all copyright interest in the+software to the public domain. We make this dedication for the benefit+of the public at large and to the detriment of our heirs and+successors. We intend this dedication to be an overt act of+relinquishment in perpetuity of all present and future rights to this+software under copyright law.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS BE LIABLE FOR ANY CLAIM, DAMAGES OR+OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE,+ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR+OTHER DEALINGS IN THE SOFTWARE.++For more information, please refer to <http://unlicense.org/>
+ rocksdb-query.cabal view
@@ -0,0 +1,64 @@+-- This file has been generated from package.yaml by hpack version 0.28.2.+--+-- see: https://github.com/sol/hpack+--+-- hash: 22fa4385a9bbab4e0eb723156fce25ead14fbd6fd70ba1743a4d6895415b3062++name: rocksdb-query+version: 0.1.0+synopsis: RocksDB database querying library for Haskell+description: Please see the README on GitHub at <https://github.com/xenog/rocksdb-query#readme>+category: Database+homepage: https://github.com/xenog/rocksdb-query#readme+bug-reports: https://github.com/xenog/rocksdb-query/issues+author: Jean-Pierre Rupp+maintainer: xenog@protonmail.com+copyright: No Rights Reserved+license: PublicDomain+license-file: UNLICENSE+build-type: Simple+cabal-version: >= 1.10+extra-source-files:+ CHANGELOG.md+ README.md++source-repository head+ type: git+ location: https://github.com/xenog/rocksdb-query++library+ hs-source-dirs:+ src+ build-depends:+ base >=4.7 && <5+ , bytestring+ , cereal+ , conduit+ , resourcet+ , rocksdb-haskell+ , unliftio+ exposed-modules:+ Database.RocksDB.Query+ other-modules:+ Paths_rocksdb_query+ default-language: Haskell2010++test-suite rocksdb-query-test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ hs-source-dirs:+ test+ ghc-options: -threaded -rtsopts -with-rtsopts=-N+ build-depends:+ base >=4.7 && <5+ , bytestring+ , cereal+ , conduit+ , hspec+ , resourcet+ , rocksdb-haskell+ , rocksdb-query+ , unliftio+ other-modules:+ Paths_rocksdb_query+ default-language: Haskell2010
+ src/Database/RocksDB/Query.hs view
@@ -0,0 +1,168 @@+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE MultiParamTypeClasses #-}+module Database.RocksDB.Query where++import qualified Data.ByteString as B+import Data.Conduit+import qualified Data.Conduit.Combinators as CC+import Data.Serialize as S+import Database.RocksDB as R+import UnliftIO+import UnliftIO.Resource++class Key key+class KeyValue key value++retrieve ::+ (MonadIO m, KeyValue key value, Serialize key, Serialize value)+ => DB+ -> Maybe Snapshot+ -> key+ -> m (Maybe value)+retrieve db snapshot key = do+ let opts = defaultReadOptions {useSnapshot = snapshot}+ R.get db opts (encode key) >>= \case+ Nothing -> return Nothing+ Just bytes ->+ case decode bytes of+ Left e -> throwString e+ Right x -> return (Just x)++matchRecursive ::+ ( MonadIO m+ , KeyValue key value+ , Serialize key+ , Serialize value+ )+ => key+ -> Iterator+ -> ConduitT () (key, value) m ()+matchRecursive base it =+ iterEntry it >>= \case+ Nothing -> return ()+ Just (key_bytes, value_bytes) -> do+ let start_bytes = B.take (B.length base_bytes) key_bytes+ if start_bytes /= base_bytes+ then return ()+ else do+ key <- either throwString return (decode key_bytes)+ value <- either throwString return (decode value_bytes)+ yield (key, value)+ iterNext it+ matchRecursive base it+ where+ base_bytes = encode base++matching ::+ ( MonadResource m+ , KeyValue key value+ , Serialize key+ , Serialize value+ )+ => DB+ -> Maybe Snapshot+ -> key+ -> ConduitT () (key, value) m ()+matching db snapshot base = do+ let opts = defaultReadOptions {useSnapshot = snapshot}+ withIterator db opts $ \it -> do+ iterSeek it (encode base)+ matchRecursive base it++matchingSkip ::+ ( MonadResource m+ , KeyValue key value+ , Serialize key+ , Serialize value+ )+ => DB+ -> Maybe Snapshot+ -> key+ -> key+ -> ConduitT () (key, value) m ()+matchingSkip db snapshot base start = do+ let opts = defaultReadOptions {useSnapshot = snapshot}+ withIterator db opts $ \it -> do+ iterSeek it (encode start)+ matchRecursive base it++insert ::+ (MonadIO m, KeyValue key value, Serialize key, Serialize value)+ => DB+ -> key+ -> value+ -> m ()+insert db key value = R.put db defaultWriteOptions (encode key) (encode value)++remove :: (MonadIO m, Key key, Serialize key) => DB -> key -> m ()+remove db key = delete db defaultWriteOptions (encode key)++insertOp ::+ (KeyValue key value, Serialize key, Serialize value)+ => key+ -> value+ -> BatchOp+insertOp key value = R.Put (encode key) (encode value)++deleteOp :: (Key key, Serialize key) => key -> BatchOp+deleteOp key = Del (encode key)++writeBatch :: MonadIO m => DB -> WriteBatch -> m ()+writeBatch db = write db defaultWriteOptions++firstMatching ::+ ( MonadUnliftIO m+ , KeyValue key value+ , Serialize key+ , Serialize value+ )+ => DB+ -> Maybe Snapshot+ -> key+ -> m (Maybe (key, value))+firstMatching db snapshot base =+ runResourceT . runConduit $ matching db snapshot base .| CC.head++firstMatchingSkip ::+ ( MonadUnliftIO m+ , KeyValue key value+ , Serialize key+ , Serialize value+ )+ => DB+ -> Maybe Snapshot+ -> key+ -> key+ -> m (Maybe (key, value))+firstMatchingSkip db snapshot base start =+ runResourceT . runConduit $+ matchingSkip db snapshot base start .| CC.head++matchingAsList ::+ ( MonadUnliftIO m+ , KeyValue key value+ , Serialize key+ , Serialize value+ )+ => DB+ -> Maybe Snapshot+ -> key+ -> m [(key, value)]+matchingAsList db snapshot base =+ runResourceT . runConduit $+ matching db snapshot base .| CC.sinkList++matchingSkipAsList ::+ ( MonadUnliftIO m+ , KeyValue key value+ , Serialize key+ , Serialize value+ )+ => DB+ -> Maybe Snapshot+ -> key+ -> key+ -> m [(key, value)]+matchingSkipAsList db snapshot base start =+ runResourceT . runConduit $+ matchingSkip db snapshot base start .| CC.sinkList
+ test/Spec.hs view
@@ -0,0 +1,84 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE MultiParamTypeClasses #-}+import Control.Applicative+import Control.Monad+import Data.Serialize as S+import Data.Word+import Database.RocksDB as R+import Database.RocksDB.Query+import Test.Hspec+import UnliftIO++newtype KeyOne = KeyOne Word32 deriving (Show, Eq)+data KeyTwo+ = 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++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++main :: IO ()+main =+ setup $ \db ->+ describe "database" $ do+ it "reads a record" $ do+ r <- retrieve db Nothing (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 Nothing (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 Nothing (KeyTwoBase 1)+ rs `shouldBe` ls+ it "query and skip" $ do+ let ex = (KeyTwo 2 2, "Hello Second World Again!")+ rs <-+ matchingSkipAsList+ db+ Nothing+ (KeyTwoBase 2)+ (KeyTwo 2 2)+ rs `shouldBe` [ex]+ where+ setup f =+ withSystemTempDirectory "rocksdb-query-test-" $ \d -> do+ db <- open d defaultOptions {createIfMissing = True}+ insertTestRecords db+ hspec $ f db++insertTestRecords :: MonadIO m => DB -> m ()+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!"