diff --git a/codegen/GenCmds.hs b/codegen/GenCmds.hs index d8fab7bd..23e7401b 100644 --- a/codegen/GenCmds.hs +++ b/codegen/GenCmds.hs @@ -86,10 +86,10 @@ blacklist = [ manual "AUTH" ["auth"] ["Condition", "SetOpts(..)"] , manualWithType "ZADD" ["zadd", "zaddOpts"] - ["ZaddOpts(..)"] + ["ZaddOpts(..)", "defaultZaddOpts"] , manualWithType "MIGRATE" ["migrate", "migrateMultiple"] - ["MigrateOpts(..)"] + ["MigrateOpts(..)", "defaultMigrateOpts"] , manual "RESTORE" ["restore", "restoreReplace"] , manualWithType "CLIENT REPLY" @@ -102,15 +102,19 @@ blacklist = [ manual "AUTH" ["auth"] , manual "SPOP" ["spop"] , manual "INFO" ["info", "infoSection"] , manual "EXISTS" ["exists"] + , manualWithType "SCAN" + ["scan", "scanOpts"] + ["Cursor", "cursor0", "ScanOpts(..)", "defaultScanOpts"] + , manual "SSCAN" ["sscan", "sscanOpts"] + , manual "HSCAN" ["hscan", "hscanOpts"] + , manual "ZSCAN" ["zscan", "zscanOpts"] + , manualWithType "ZRANGEBYLEX" + ["zrangebylex, zrangebylexLimit"] + ["RangeLex(..)"] , unimplemented "COMMAND" , unimplemented "COMMAND GETKEYS" , unimplemented "ROLE" , unimplemented "CLIENT KILL" - , unimplemented "SCAN" - , unimplemented "SSCAN" - , unimplemented "HSCAN" - , unimplemented "ZSCAN" - , unimplemented "ZRANGEBYLEX" , unimplemented "ZREVRANGEBYLEX" , unimplemented "ZRANGEBYSCORE" , unimplemented "ZREVRANGEBYSCORE" diff --git a/src/Database/Redis/Commands.hs b/src/Database/Redis/Commands.hs index 98daf333..d5b99a43 100644 --- a/src/Database/Redis/Commands.hs +++ b/src/Database/Redis/Commands.hs @@ -19,6 +19,7 @@ expire, -- |Set a key's time to live in seconds (). Since Redis 1.2.0 keys, -- |Find all keys matching the given pattern (). Since Redis 1.0.0 MigrateOpts(..), +defaultMigrateOpts, migrate, -- |Atomically transfer a key from a Redis instance to another one (). The Redis command @MIGRATE@ is split up into 'migrate', 'migrateMultiple'. Since Redis 2.6.0 migrateMultiple, -- |Atomically transfer a key from a Redis instance to another one (). The Redis command @MIGRATE@ is split up into 'migrate', 'migrateMultiple'. Since Redis 2.6.0 move, -- |Move a key to another database (). Since Redis 1.0.0 @@ -34,6 +35,12 @@ rename, -- |Rename a key (). Since Redis 1.0.0 renamenx, -- |Rename a key, only if the new key does not exist (). Since Redis 1.0.0 restore, -- |Create a key using the provided serialized value, previously obtained using DUMP (). The Redis command @RESTORE@ is split up into 'restore', 'restoreReplace'. Since Redis 2.6.0 restoreReplace, -- |Create a key using the provided serialized value, previously obtained using DUMP (). The Redis command @RESTORE@ is split up into 'restore', 'restoreReplace'. Since Redis 2.6.0 +Cursor, +cursor0, +ScanOpts(..), +defaultScanOpts, +scan, -- |Incrementally iterate the keys space (). The Redis command @SCAN@ is split up into 'scan', 'scanOpts'. Since Redis 2.8.0 +scanOpts, -- |Incrementally iterate the keys space (). The Redis command @SCAN@ is split up into 'scan', 'scanOpts'. Since Redis 2.8.0 SortOpts(..), defaultSortOpts, SortOrder(..), @@ -55,6 +62,8 @@ hkeys, -- |Get all the fields in a hash (). Sinc hlen, -- |Get the number of fields in a hash (). Since Redis 2.0.0 hmget, -- |Get the values of all the given hash fields (). Since Redis 2.0.0 hmset, -- |Set multiple hash fields to multiple values (). Since Redis 2.0.0 +hscan, -- |Incrementally iterate hash fields and associated values (). The Redis command @HSCAN@ is split up into 'hscan', 'hscanOpts'. Since Redis 2.8.0 +hscanOpts, -- |Incrementally iterate hash fields and associated values (). The Redis command @HSCAN@ is split up into 'hscan', 'hscanOpts'. Since Redis 2.8.0 hset, -- |Set the string value of a hash field (). Since Redis 2.0.0 hsetnx, -- |Set the value of a hash field, only if the field does not exist (). Since Redis 2.0.0 hstrlen, -- |Get the length of the value of a hash field (). Since Redis 3.2.0 @@ -139,11 +148,14 @@ spop, -- |Remove and return one or multiple random members from a set (). The Redis command @SRANDMEMBER@ is split up into 'srandmember', 'srandmemberN'. Since Redis 1.0.0 srandmemberN, -- |Get one or multiple random members from a set (). The Redis command @SRANDMEMBER@ is split up into 'srandmember', 'srandmemberN'. Since Redis 1.0.0 srem, -- |Remove one or more members from a set (). Since Redis 1.0.0 +sscan, -- |Incrementally iterate Set elements (). The Redis command @SSCAN@ is split up into 'sscan', 'sscanOpts'. Since Redis 2.8.0 +sscanOpts, -- |Incrementally iterate Set elements (). The Redis command @SSCAN@ is split up into 'sscan', 'sscanOpts'. Since Redis 2.8.0 sunion, -- |Add multiple sets (). Since Redis 1.0.0 sunionstore, -- |Add multiple sets and store the resulting set in a key (). Since Redis 1.0.0 -- ** Sorted Sets ZaddOpts(..), +defaultZaddOpts, zadd, -- |Add one or more members to a sorted set, or update its score if it already exists (). The Redis command @ZADD@ is split up into 'zadd', 'zaddOpts'. Since Redis 1.2.0 zaddOpts, -- |Add one or more members to a sorted set, or update its score if it already exists (). The Redis command @ZADD@ is split up into 'zadd', 'zaddOpts'. Since Redis 1.2.0 zcard, -- |Get the number of members in a sorted set (). Since Redis 1.2.0 @@ -155,6 +167,8 @@ zinterstoreWeights, -- |Intersect multiple sorted sets and store the resulting s zlexcount, -- |Count the number of members in a sorted set between a given lexicographical range (). Since Redis 2.8.9 zrange, -- |Return a range of members in a sorted set, by index (). The Redis command @ZRANGE@ is split up into 'zrange', 'zrangeWithscores'. Since Redis 1.2.0 zrangeWithscores, -- |Return a range of members in a sorted set, by index (). The Redis command @ZRANGE@ is split up into 'zrange', 'zrangeWithscores'. Since Redis 1.2.0 +RangeLex(..), +zrangebylex, zrangebylexLimit, -- |Return a range of members in a sorted set, by lexicographical range (). Since Redis 2.8.9 zrangebyscore, -- |Return a range of members in a sorted set, by score (). The Redis command @ZRANGEBYSCORE@ is split up into 'zrangebyscore', 'zrangebyscoreWithscores', 'zrangebyscoreLimit', 'zrangebyscoreWithscoresLimit'. Since Redis 1.0.5 zrangebyscoreWithscores, -- |Return a range of members in a sorted set, by score (). The Redis command @ZRANGEBYSCORE@ is split up into 'zrangebyscore', 'zrangebyscoreWithscores', 'zrangebyscoreLimit', 'zrangebyscoreWithscoresLimit'. Since Redis 1.0.5 zrangebyscoreLimit, -- |Return a range of members in a sorted set, by score (). The Redis command @ZRANGEBYSCORE@ is split up into 'zrangebyscore', 'zrangebyscoreWithscores', 'zrangebyscoreLimit', 'zrangebyscoreWithscoresLimit'. Since Redis 1.0.5 @@ -171,6 +185,8 @@ zrevrangebyscoreWithscores, -- |Return a range of members in a sorted set, by sc zrevrangebyscoreLimit, -- |Return a range of members in a sorted set, by score, with scores ordered from high to low (). The Redis command @ZREVRANGEBYSCORE@ is split up into 'zrevrangebyscore', 'zrevrangebyscoreWithscores', 'zrevrangebyscoreLimit', 'zrevrangebyscoreWithscoresLimit'. Since Redis 2.2.0 zrevrangebyscoreWithscoresLimit, -- |Return a range of members in a sorted set, by score, with scores ordered from high to low (). The Redis command @ZREVRANGEBYSCORE@ is split up into 'zrevrangebyscore', 'zrevrangebyscoreWithscores', 'zrevrangebyscoreLimit', 'zrevrangebyscoreWithscoresLimit'. Since Redis 2.2.0 zrevrank, -- |Determine the index of a member in a sorted set, with scores ordered from high to low (). Since Redis 2.0.0 +zscan, -- |Incrementally iterate sorted sets elements and associated scores (). The Redis command @ZSCAN@ is split up into 'zscan', 'zscanOpts'. Since Redis 2.8.0 +zscanOpts, -- |Incrementally iterate sorted sets elements and associated scores (). The Redis command @ZSCAN@ is split up into 'zscan', 'zscanOpts'. Since Redis 2.8.0 zscore, -- |Get the score associated with the given member in a sorted set (). Since Redis 1.2.0 zunionstore, -- |Add multiple sorted sets and store the resulting sorted set in a new key (). The Redis command @ZUNIONSTORE@ is split up into 'zunionstore', 'zunionstoreWeights'. Since Redis 2.0.0 zunionstoreWeights, -- |Add multiple sorted sets and store the resulting sorted set in a new key (). The Redis command @ZUNIONSTORE@ is split up into 'zunionstore', 'zunionstoreWeights'. Since Redis 2.0.0 @@ -225,21 +241,6 @@ strlen, -- |Get the length of the value stored in a key () -- -- --- * SCAN () --- --- --- * SSCAN () --- --- --- * HSCAN () --- --- --- * ZSCAN () --- --- --- * ZRANGEBYLEX () --- --- -- * ZREVRANGEBYLEX () -- -- diff --git a/src/Database/Redis/ManualCommands.hs b/src/Database/Redis/ManualCommands.hs index 386dc011..17488c03 100644 --- a/src/Database/Redis/ManualCommands.hs +++ b/src/Database/Redis/ManualCommands.hs @@ -2,8 +2,8 @@ module Database.Redis.ManualCommands where -import Prelude hiding (min,max) -import Data.ByteString (ByteString, empty) +import Prelude hiding (min, max) +import Data.ByteString (ByteString, empty, append) import Data.Maybe (maybeToList) import Database.Redis.Core import Database.Redis.Protocol @@ -318,7 +318,7 @@ zstoreInternal -> ByteString -- ^ destination -> [ByteString] -- ^ keys -> [Double] -- ^ weights - -> Aggregate + -> Aggregate -> m (f Integer) zstoreInternal cmd dest keys weights aggregate = sendRequest $ concat [ [cmd, dest, encode . toInteger $ length keys], keys @@ -638,3 +638,145 @@ exists => ByteString -- ^ key -> m (f Bool) exists key = sendRequest ["EXISTS", key] + +newtype Cursor = Cursor ByteString deriving (Show, Eq) + + +instance RedisArg Cursor where + encode (Cursor c) = encode c + + +instance RedisResult Cursor where + decode (Bulk (Just s)) = Right $ Cursor s + decode r = Left r + + +cursor0 :: Cursor +cursor0 = Cursor "0" + + +scan + :: (RedisCtx m f) + => Cursor + -> m (f (Cursor, [ByteString])) -- ^ next cursor and values +scan cursor = scanOpts cursor defaultScanOpts + + +data ScanOpts = ScanOpts + { scanMatch :: Maybe ByteString + , scanCount :: Maybe Integer + } deriving (Show, Eq) + + +-- |Redis default 'ScanOpts'. Equivalent to omitting all optional parameters. +-- +-- @ +-- ScanOpts +-- { scanMatch = Nothing -- don't match any pattern +-- , scanCount = Nothing -- don't set any requirements on number elements returned (works like value @COUNT 10@) +-- } +-- @ +-- +defaultScanOpts :: ScanOpts +defaultScanOpts = ScanOpts + { scanMatch = Nothing + , scanCount = Nothing + } + + +scanOpts + :: (RedisCtx m f) + => Cursor + -> ScanOpts + -> m (f (Cursor, [ByteString])) -- ^ next cursor and values +scanOpts cursor opts = sendRequest $ addScanOpts ["SCAN", encode cursor] opts + + +addScanOpts + :: [ByteString] -- ^ main part of scan command + -> ScanOpts + -> [ByteString] +addScanOpts cmd ScanOpts{..} = + concat [cmd, match, count] + where + match = maybeToList scanMatch + count = map encode $ maybeToList scanCount + + +sscan + :: (RedisCtx m f) + => ByteString -- ^ key + -> Cursor + -> m (f (Cursor, [ByteString])) -- ^ next cursor and values +sscan key cursor = sscanOpts key cursor defaultScanOpts + + +sscanOpts + :: (RedisCtx m f) + => ByteString -- ^ key + -> Cursor + -> ScanOpts + -> m (f (Cursor, [ByteString])) -- ^ next cursor and values +sscanOpts key cursor opts = sendRequest $ addScanOpts ["SSCAN", key, encode cursor] opts + + +hscan + :: (RedisCtx m f) + => ByteString -- ^ key + -> Cursor + -> m (f (Cursor, [(ByteString, ByteString)])) -- ^ next cursor and values +hscan key cursor = hscanOpts key cursor defaultScanOpts + + +hscanOpts + :: (RedisCtx m f) + => ByteString -- ^ key + -> Cursor + -> ScanOpts + -> m (f (Cursor, [(ByteString, ByteString)])) -- ^ next cursor and values +hscanOpts key cursor opts = sendRequest $ addScanOpts ["HSCAN", key, encode cursor] opts + + +zscan + :: (RedisCtx m f) + => ByteString -- ^ key + -> Cursor + -> m (f (Cursor, [(ByteString, Double)])) -- ^ next cursor and values +zscan key cursor = zscanOpts key cursor defaultScanOpts + + +zscanOpts + :: (RedisCtx m f) + => ByteString -- ^ key + -> Cursor + -> ScanOpts + -> m (f (Cursor, [(ByteString, Double)])) -- ^ next cursor and values +zscanOpts key cursor opts = sendRequest $ addScanOpts ["ZSCAN", key, encode cursor] opts + +data RangeLex a = Incl a | Excl a | Minr | Maxr + +instance RedisArg a => RedisArg (RangeLex a) where + encode (Incl bs) = "[" `append` encode bs + encode (Excl bs) = "(" `append` encode bs + encode Minr = "-" + encode Maxr = "+" + +zrangebylex::(RedisCtx m f) => + ByteString -- ^ key + -> RangeLex ByteString -- ^ min + -> RangeLex ByteString -- ^ max + -> m (f [ByteString]) +zrangebylex key min max = + sendRequest ["ZRANGEBYLEX", encode key, encode min, encode max] + +zrangebylexLimit + ::(RedisCtx m f) + => ByteString -- ^ key + -> RangeLex ByteString -- ^ min + -> RangeLex ByteString -- ^ max + -> Integer -- ^ offset + -> Integer -- ^ count + -> m (f [ByteString]) +zrangebylexLimit key min max offset count = + sendRequest ["ZRANGEBYLEX", encode key, encode min, encode max, + "LIMIT", encode offset, encode count] diff --git a/test/Test.hs b/test/Test.hs index 59e4b2f3..9c7d6919 100644 --- a/test/Test.hs +++ b/test/Test.hs @@ -56,7 +56,9 @@ tests :: Connection -> [Test.Test] tests conn = map ($conn) $ concat [ testsMisc, testsKeys, testsStrings, [testHashes], testsLists, testsSets, [testHyperLogLog] , testsZSets, [testPubSub], [testTransaction], [testScripting] - , testsConnection, testsServer, [testQuit] + , testsConnection, testsServer, [testScans], [testZrangelex] + -- should always be run last as connection gets closed after it + , [testQuit] ] ------------------------------------------------------------------------------ @@ -521,3 +523,23 @@ testDebugObject = testCase "debugObject/debugSegfault" $ do set "key" "value" >>=? Ok Right _ <- debugObject "key" return () + +testScans :: Test +testScans = testCase "scans" $ do + set "key" "value" >>=? Ok + scan cursor0 >>=? (cursor0, ["key"]) + sadd "set" ["1"] >>=? 1 + sscan "set" cursor0 >>=? (cursor0, ["1"]) + hset "hash" "k" "v" >>=? True + hscan "hash" cursor0 >>=? (cursor0, [("k", "v")]) + zadd "zset" [(42, "2")] >>=? 1 + zscan "zset" cursor0 >>=? (cursor0, [("2", 42)]) + +testZrangelex ::Test +testZrangelex = testCase "zrangebylex" $ do + let testSet = [(10, "aaa"), (10, "abb"), (10, "ccc"), (10, "ddd")] + zadd "zrangebylex" testSet >>=? 4 + zrangebylex "zrangebylex" (Incl "aaa") (Incl "bbb") >>=? ["aaa","abb"] + zrangebylex "zrangebylex" (Excl "aaa") (Excl "ddd") >>=? ["abb","ccc"] + zrangebylex "zrangebylex" Minr Maxr >>=? ["aaa","abb","ccc","ddd"] + zrangebylexLimit "zrangebylex" Minr Maxr 2 1 >>=? ["ccc"]