diff --git a/CHANGELOG b/CHANGELOG --- a/CHANGELOG +++ b/CHANGELOG @@ -1,5 +1,10 @@ # Changelog for Hedis +## 0.9.0 + +* Merge in a fresh commands.json and a set of new commands + implemented. See PR #52 for more info + ## 0.8.3 * Export MonadRedis methods diff --git a/hedis.cabal b/hedis.cabal --- a/hedis.cabal +++ b/hedis.cabal @@ -1,5 +1,5 @@ name: hedis -version: 0.8.3 +version: 0.9.1 synopsis: Client library for the Redis datastore: supports full command set, pipelining. @@ -105,3 +105,7 @@ time -- We use -O0 here, since GHC takes *very* long to compile so many constants ghc-options: -O0 -Wall -rtsopts -fno-warn-unused-do-bind + if flag(dev) + ghc-options: -Werror + if flag(dev) + ghc-prof-options: -auto-all diff --git a/src/Database/Redis/Commands.hs b/src/Database/Redis/Commands.hs --- a/src/Database/Redis/Commands.hs +++ b/src/Database/Redis/Commands.hs @@ -18,7 +18,10 @@ expire, -- |Set a key's time to live in seconds (). Since Redis 1.0.0 expireat, -- |Set the expiration for a key as a UNIX timestamp (). Since Redis 1.2.0 keys, -- |Find all keys matching the given pattern (). Since Redis 1.0.0 -migrate, -- |Atomically transfer a key from a Redis instance to another one (). Since Redis 2.6.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 objectRefcount, -- |Inspect the internals of Redis objects (). The Redis command @OBJECT@ is split up into 'objectRefcount', 'objectEncoding', 'objectIdletime'. Since Redis 2.2.3 objectEncoding, -- |Inspect the internals of Redis objects (). The Redis command @OBJECT@ is split up into 'objectRefcount', 'objectEncoding', 'objectIdletime'. Since Redis 2.2.3 @@ -30,7 +33,14 @@ randomkey, -- |Return a random key from the keyspace (). Since Redis 1.0.0 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 (). Since Redis 2.6.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(..), @@ -39,6 +49,7 @@ ttl, -- |Get the time to live for a key (). Since Redis 1.0.0 RedisType(..), getType, -- |Determine the type stored at key (). Since Redis 1.0.0 +wait, -- |Wait for the synchronous replication of all the write commands sent in the context of the current connection (). Since Redis 3.0.0 -- ** Hashes hdel, -- |Delete one or more hash fields (). Since Redis 2.0.0 @@ -51,14 +62,17 @@ 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 hvals, -- |Get all the values in a hash (). Since Redis 2.0.0 -- ** HyperLogLogs pfadd, -- |Adds all the elements arguments to the HyperLogLog data structure stored at the variable name specified as first argument (). Since Redis 2.8.9 -pfcount, -- |Returns the approximated cardinality for the union of the HyperLogLogs stored in the specified keys (). Since Redis 2.8.9 -pfmerge, -- |Merge multiple HyperLogLog values into an unique value that will approximate the cardinality of the union of the observed Sets of the source HyperLogLog structures (). Since Redis 2.8.9 +pfcount, -- |Return the approximated cardinality of the set(s) observed by the HyperLogLog at key(s) (). Since Redis 2.8.9 +pfmerge, -- |Merge N different HyperLogLogs into a single one (). Since Redis 2.8.9 -- ** Lists blpop, -- |Remove and get the first element in a list, or block until one is available (). Since Redis 2.0.0 @@ -76,13 +90,15 @@ lset, -- |Set the value of an element in a list by its index (). Since Redis 1.0.0 ltrim, -- |Trim a list to the specified range (). Since Redis 1.0.0 rpop, -- |Remove and get the last element in a list (). Since Redis 1.0.0 -rpoplpush, -- |Remove the last element in a list, append it to another list and return it (). Since Redis 1.2.0 +rpoplpush, -- |Remove the last element in a list, prepend it to another list and return it (). Since Redis 1.2.0 rpush, -- |Append one or multiple values to a list (). Since Redis 1.0.0 rpushx, -- |Append a value to a list, only if the list exists (). Since Redis 2.2.0 -- ** Scripting eval, -- |Execute a Lua script server side (). Since Redis 2.6.0 evalsha, -- |Execute a Lua script server side (). Since Redis 2.6.0 +DebugMode, +scriptDebug, -- |Set the debug mode for executed scripts (). Since Redis 3.2.0 scriptExists, -- |Check existence of scripts in the script cache (). Since Redis 2.6.0 scriptFlush, -- |Remove all the scripts from the script cache (). Since Redis 2.6.0 scriptKill, -- |Kill the script currently in execution (). Since Redis 2.6.0 @@ -91,14 +107,24 @@ -- ** Server bgrewriteaof, -- |Asynchronously rewrite the append-only file (). Since Redis 1.0.0 bgsave, -- |Asynchronously save the dataset to disk (). Since Redis 1.0.0 +clientGetname, -- |Get the current connection name (). Since Redis 2.6.9 +clientList, -- |Get the list of client connections (). Since Redis 2.4.0 +clientPause, -- |Stop processing commands from clients for some time (). Since Redis 2.9.50 +ReplyMode, +clientReply, -- |Instruct the server whether to reply to commands (). Since Redis 3.2 +clientSetname, -- |Set the current connection name (). Since Redis 2.6.9 +commandCount, -- |Get total number of Redis commands (). Since Redis 2.8.13 +commandInfo, -- |Get array of specific Redis command details (). Since Redis 2.8.13 configGet, -- |Get the value of a configuration parameter (). Since Redis 2.0.0 configResetstat, -- |Reset the stats returned by INFO (). Since Redis 2.0.0 +configRewrite, -- |Rewrite the configuration file with the in memory configuration (). Since Redis 2.8.0 configSet, -- |Set a configuration parameter to the given value (). Since Redis 2.0.0 dbsize, -- |Return the number of keys in the selected database (). Since Redis 1.0.0 debugObject, -- |Get debugging information about a key (). Since Redis 1.0.0 flushall, -- |Remove all keys from all databases (). Since Redis 1.0.0 flushdb, -- |Remove all keys from the current database (). Since Redis 1.0.0 -info, -- |Get information and statistics about the server (). Since Redis 1.0.0 +info, -- |Get information and statistics about the server (). The Redis command @INFO@ is split up into 'info', 'infoSection'. Since Redis 1.0.0 +infoSection, -- |Get information and statistics about the server (). The Redis command @INFO@ is split up into 'info', 'infoSection'. Since Redis 1.0.0 lastsave, -- |Get the UNIX time stamp of the last successful save to disk (). Since Redis 1.0.0 save, -- |Synchronously save the dataset to disk (). Since Redis 1.0.0 slaveof, -- |Make the server a slave of another instance, or promote it as master (). Since Redis 1.0.0 @@ -118,28 +144,38 @@ sismember, -- |Determine if a given value is a member of a set (). Since Redis 1.0.0 smembers, -- |Get all the members in a set (). Since Redis 1.0.0 smove, -- |Move a member from one set to another (). Since Redis 1.0.0 -spop, -- |Remove and return a random member from a set (). Since Redis 1.0.0 -srandmember, -- |Get a random member from a set (). Since Redis 1.0.0 +spop, -- |Remove and return one or multiple random members from a set (). Since Redis 1.0.0 +srandmember, -- |Get 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 -zadd, -- |Add one or more members to a sorted set, or update its score if it already exists (). Since Redis 1.2.0 +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 zcount, -- |Count the members in a sorted set with scores within the given values (). Since Redis 2.0.0 zincrby, -- |Increment the score of a member in a sorted set (). Since Redis 1.2.0 Aggregate(..), zinterstore, -- |Intersect multiple sorted sets and store the resulting sorted set in a new key (). The Redis command @ZINTERSTORE@ is split up into 'zinterstore', 'zinterstoreWeights'. Since Redis 2.0.0 zinterstoreWeights, -- |Intersect multiple sorted sets and store the resulting sorted set in a new key (). The Redis command @ZINTERSTORE@ is split up into 'zinterstore', 'zinterstoreWeights'. Since Redis 2.0.0 +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 zrangebyscoreWithscoresLimit, -- |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 zrank, -- |Determine the index of a member in a sorted set (). Since Redis 2.0.0 zrem, -- |Remove one or more members from a sorted set (). Since Redis 1.2.0 +zremrangebylex, -- |Remove all members in a sorted set between the given lexicographical range (). Since Redis 2.8.9 zremrangebyrank, -- |Remove all members in a sorted set within the given indexes (). Since Redis 2.0.0 zremrangebyscore, -- |Remove all members in a sorted set within the given scores (). Since Redis 1.2.0 zrevrange, -- |Return a range of members in a sorted set, by index, with scores ordered from high to low (). The Redis command @ZREVRANGE@ is split up into 'zrevrange', 'zrevrangeWithscores'. Since Redis 1.2.0 @@ -149,6 +185,8 @@ 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 @@ -161,6 +199,7 @@ bitopOr, -- |Perform bitwise operations between strings (). The Redis command @BITOP@ is split up into 'bitopAnd', 'bitopOr', 'bitopXor', 'bitopNot'. Since Redis 2.6.0 bitopXor, -- |Perform bitwise operations between strings (). The Redis command @BITOP@ is split up into 'bitopAnd', 'bitopOr', 'bitopXor', 'bitopNot'. Since Redis 2.6.0 bitopNot, -- |Perform bitwise operations between strings (). The Redis command @BITOP@ is split up into 'bitopAnd', 'bitopOr', 'bitopXor', 'bitopNot'. Since Redis 2.6.0 +bitpos, -- |Find first bit set or clear in a string (). Since Redis 2.8.7 decr, -- |Decrement the integer value of a key by one (). Since Redis 1.0.0 decrby, -- |Decrement the integer value of a key by the given number (). Since Redis 1.0.0 get, -- |Get the value of a key (). Since Redis 1.0.0 @@ -174,7 +213,10 @@ mset, -- |Set multiple keys to multiple values (). Since Redis 1.0.1 msetnx, -- |Set multiple keys to multiple values, only if none of the keys exist (). Since Redis 1.0.1 psetex, -- |Set the value and expiration in milliseconds of a key (). Since Redis 2.6.0 -set, -- |Set the string value of a key (). Since Redis 1.0.0 +Condition, +SetOpts(..), +set, -- |Set the string value of a key (). The Redis command @SET@ is split up into 'set', 'setOpts'. Since Redis 1.0.0 +setOpts, -- |Set the string value of a key (). The Redis command @SET@ is split up into 'set', 'setOpts'. Since Redis 1.0.0 setbit, -- |Sets or clears the bit at offset in the string value stored at key (). Since Redis 2.2.0 setex, -- |Set the value and expiration of a key (). Since Redis 2.0.0 setnx, -- |Set the value of a key, only if the key does not exist (). Since Redis 1.0.0 @@ -187,6 +229,27 @@ -- experimental Redis versions by using the 'sendRequest' -- function. -- +-- * COMMAND () +-- +-- +-- * COMMAND GETKEYS () +-- +-- +-- * ROLE () +-- +-- +-- * CLIENT KILL () +-- +-- +-- * ZREVRANGEBYLEX () +-- +-- +-- * ZRANGEBYSCORE () +-- +-- +-- * ZREVRANGEBYSCORE () +-- +-- -- * MONITOR () -- -- @@ -225,6 +288,17 @@ -> m (f Integer) pttl key = sendRequest (["PTTL"] ++ [encode key] ) +commandCount + :: (RedisCtx m f) + => m (f Integer) +commandCount = sendRequest (["COMMAND","COUNT"] ) + +clientSetname + :: (RedisCtx m f) + => ByteString -- ^ connectionName + -> m (f ByteString) +clientSetname connectionName = sendRequest (["CLIENT","SETNAME"] ++ [encode connectionName] ) + zrank :: (RedisCtx m f) => ByteString -- ^ key @@ -246,12 +320,6 @@ -> m (f [ByteString]) hkeys key = sendRequest (["HKEYS"] ++ [encode key] ) -spop - :: (RedisCtx m f) - => ByteString -- ^ key - -> m (f (Maybe ByteString)) -spop key = sendRequest (["SPOP"] ++ [encode key] ) - slaveof :: (RedisCtx m f) => ByteString -- ^ host @@ -363,13 +431,6 @@ -> m (f (Maybe ByteString)) lindex key index = sendRequest (["LINDEX"] ++ [encode key] ++ [encode index] ) -set - :: (RedisCtx m f) - => ByteString -- ^ key - -> ByteString -- ^ value - -> m (f Status) -set key value = sendRequest (["SET"] ++ [encode key] ++ [encode value] ) - lpush :: (RedisCtx m f) => ByteString -- ^ key @@ -377,6 +438,13 @@ -> m (f Integer) lpush key value = sendRequest (["LPUSH"] ++ [encode key] ++ map encode value ) +hstrlen + :: (RedisCtx m f) + => ByteString -- ^ key + -> ByteString -- ^ field + -> m (f Integer) +hstrlen key field = sendRequest (["HSTRLEN"] ++ [encode key] ++ [encode field] ) + smove :: (RedisCtx m f) => ByteString -- ^ source @@ -448,11 +516,13 @@ -> m (f [ByteString]) smembers key = sendRequest (["SMEMBERS"] ++ [encode key] ) -exists +zlexcount :: (RedisCtx m f) => ByteString -- ^ key - -> m (f Bool) -exists key = sendRequest (["EXISTS"] ++ [encode key] ) + -> ByteString -- ^ min + -> ByteString -- ^ max + -> m (f Integer) +zlexcount key min max = sendRequest (["ZLEXCOUNT"] ++ [encode key] ++ [encode min] ++ [encode max] ) sunion :: (RedisCtx m f) @@ -485,14 +555,6 @@ -> m (f Status) configSet parameter value = sendRequest (["CONFIG","SET"] ++ [encode parameter] ++ [encode value] ) -restore - :: (RedisCtx m f) - => ByteString -- ^ key - -> Integer -- ^ timeToLive - -> ByteString -- ^ serializedValue - -> m (f Status) -restore key timeToLive serializedValue = sendRequest (["RESTORE"] ++ [encode key] ++ [encode timeToLive] ++ [encode serializedValue] ) - scriptFlush :: (RedisCtx m f) => m (f Status) @@ -503,12 +565,25 @@ => m (f Integer) dbsize = sendRequest (["DBSIZE"] ) +wait + :: (RedisCtx m f) + => Integer -- ^ numslaves + -> Integer -- ^ timeout + -> m (f Integer) +wait numslaves timeout = sendRequest (["WAIT"] ++ [encode numslaves] ++ [encode timeout] ) + lpop :: (RedisCtx m f) => ByteString -- ^ key -> m (f (Maybe ByteString)) lpop key = sendRequest (["LPOP"] ++ [encode key] ) +clientPause + :: (RedisCtx m f) + => Integer -- ^ timeout + -> m (f Status) +clientPause timeout = sendRequest (["CLIENT","PAUSE"] ++ [encode timeout] ) + expire :: (RedisCtx m f) => ByteString -- ^ key @@ -522,18 +597,20 @@ -> m (f [Maybe ByteString]) mget key = sendRequest (["MGET"] ++ map encode key ) +bitpos + :: (RedisCtx m f) + => ByteString -- ^ key + -> Integer -- ^ bit + -> Integer -- ^ start + -> Integer -- ^ end + -> m (f Integer) +bitpos key bit start end = sendRequest (["BITPOS"] ++ [encode key] ++ [encode bit] ++ [encode start] ++ [encode end] ) + lastsave :: (RedisCtx m f) => m (f Integer) lastsave = sendRequest (["LASTSAVE"] ) -zadd - :: (RedisCtx m f) - => ByteString -- ^ key - -> [(Double,ByteString)] -- ^ scoreMember - -> m (f Integer) -zadd key scoreMember = sendRequest (["ZADD"] ++ [encode key] ++ concatMap (\(x,y) -> [encode x,encode y])scoreMember ) - pexpire :: (RedisCtx m f) => ByteString -- ^ key @@ -541,6 +618,11 @@ -> m (f Bool) pexpire key milliseconds = sendRequest (["PEXPIRE"] ++ [encode key] ++ [encode milliseconds] ) +clientList + :: (RedisCtx m f) + => m (f [ByteString]) +clientList = sendRequest (["CLIENT","LIST"] ) + renamenx :: (RedisCtx m f) => ByteString -- ^ key @@ -709,12 +791,6 @@ -> m (f Integer) lpushx key value = sendRequest (["LPUSHX"] ++ [encode key] ++ [encode value] ) -srandmember - :: (RedisCtx m f) - => ByteString -- ^ key - -> m (f (Maybe ByteString)) -srandmember key = sendRequest (["SRANDMEMBER"] ++ [encode key] ) - hset :: (RedisCtx m f) => ByteString -- ^ key @@ -773,6 +849,14 @@ -> m (f Integer) hincrby key field increment = sendRequest (["HINCRBY"] ++ [encode key] ++ [encode field] ++ [encode increment] ) +zremrangebylex + :: (RedisCtx m f) + => ByteString -- ^ key + -> ByteString -- ^ min + -> ByteString -- ^ max + -> m (f Integer) +zremrangebylex key min max = sendRequest (["ZREMRANGEBYLEX"] ++ [encode key] ++ [encode min] ++ [encode max] ) + rpop :: (RedisCtx m f) => ByteString -- ^ key @@ -800,6 +884,16 @@ -> m (f Bool) hexists key field = sendRequest (["HEXISTS"] ++ [encode key] ++ [encode field] ) +clientGetname + :: (RedisCtx m f) + => m (f Status) +clientGetname = sendRequest (["CLIENT","GETNAME"] ) + +configRewrite + :: (RedisCtx m f) + => m (f Status) +configRewrite = sendRequest (["CONFIG","REWRITE"] ) + decr :: (RedisCtx m f) => ByteString -- ^ key @@ -869,11 +963,6 @@ -> m (f Status) ltrim key start stop = sendRequest (["LTRIM"] ++ [encode key] ++ [encode start] ++ [encode stop] ) -info - :: (RedisCtx m f) - => m (f ByteString) -info = sendRequest (["INFO"] ) - zcard :: (RedisCtx m f) => ByteString -- ^ key @@ -920,6 +1009,12 @@ -> m (f Bool) msetnx keyValue = sendRequest (["MSETNX"] ++ concatMap (\(x,y) -> [encode x,encode y])keyValue ) +commandInfo + :: (RedisCtx m f) + => [ByteString] -- ^ commandName + -> m (f [ByteString]) +commandInfo commandName = sendRequest (["COMMAND","INFO"] ++ map encode commandName ) + quit :: (RedisCtx m f) => m (f Status) @@ -951,16 +1046,6 @@ -> ByteString -- ^ member -> m (f Bool) sismember key member = sendRequest (["SISMEMBER"] ++ [encode key] ++ [encode member] ) - -migrate - :: (RedisCtx m f) - => ByteString -- ^ host - -> ByteString -- ^ port - -> ByteString -- ^ key - -> Integer -- ^ destinationDb - -> Integer -- ^ timeout - -> m (f Status) -migrate host port key destinationDb timeout = sendRequest (["MIGRATE"] ++ [encode host] ++ [encode port] ++ [encode key] ++ [encode destinationDb] ++ [encode timeout] ) diff --git a/src/Database/Redis/ManualCommands.hs b/src/Database/Redis/ManualCommands.hs --- a/src/Database/Redis/ManualCommands.hs +++ b/src/Database/Redis/ManualCommands.hs @@ -2,8 +2,9 @@ module Database.Redis.ManualCommands where -import Prelude hiding (min,max) -import Data.ByteString (ByteString) +import Prelude hiding (min, max) +import Data.ByteString (ByteString, empty, append) +import Data.Maybe (maybeToList) import Database.Redis.Core import Database.Redis.Protocol import Database.Redis.Types @@ -267,7 +268,7 @@ limit = let (off,cnt) = sortLimit in ["LIMIT", encode off, encode cnt] get = concatMap (\pattern -> ["GET", pattern]) sortGet order = case sortOrder of Desc -> ["DESC"]; Asc -> ["ASC"] - alpha = ["ALPHA" | sortAlpha] + alpha = ["ALPHA" | sortAlpha] store = maybe [] (\dest -> ["STORE", dest]) destination @@ -317,7 +318,7 @@ -> 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 @@ -401,3 +402,381 @@ -> [ByteString] -- ^ keys -> m (f Integer) bitop op ks = sendRequest $ "BITOP" : op : ks + +-- setRange +-- :: +-- setRange = sendRequest (["SET"] ++ [encode key] ++ [encode value] ++ ) + +migrate + :: (RedisCtx m f) + => ByteString -- ^ host + -> ByteString -- ^ port + -> ByteString -- ^ key + -> Integer -- ^ destinationDb + -> Integer -- ^ timeout + -> m (f Status) +migrate host port key destinationDb timeout = + sendRequest ["MIGRATE", host, port, key, encode destinationDb, encode timeout] + + +-- |Options for the 'migrate' command. +data MigrateOpts = MigrateOpts + { migrateCopy :: Bool + , migrateReplace :: Bool + } deriving (Show, Eq) + +-- |Redis default 'MigrateOpts'. Equivalent to omitting all optional parameters. +-- +-- @ +-- MigrateOpts +-- { migrateCopy = False -- remove the key from the local instance +-- , migrateReplace = False -- don't replace existing key on the remote instance +-- } +-- @ +-- +defaultMigrateOpts :: MigrateOpts +defaultMigrateOpts = MigrateOpts + { migrateCopy = False + , migrateReplace = False + } + +migrateMultiple + :: (RedisCtx m f) + => ByteString -- ^ host + -> ByteString -- ^ port + -> Integer -- ^ destinationDb + -> Integer -- ^ timeout + -> MigrateOpts + -> [ByteString] -- ^ keys + -> m (f Status) +migrateMultiple host port destinationDb timeout MigrateOpts{..} keys = + sendRequest $ + concat [["MIGRATE", host, port, empty, encode destinationDb, encode timeout], + copy, replace, keys] + where + copy = ["COPY" | migrateCopy] + replace = ["REPLACE" | migrateReplace] + + +restore + :: (RedisCtx m f) + => ByteString -- ^ key + -> Integer -- ^ timeToLive + -> ByteString -- ^ serializedValue + -> m (f Status) +restore key timeToLive serializedValue = + sendRequest ["RESTORE", key, encode timeToLive, serializedValue] + + +restoreReplace + :: (RedisCtx m f) + => ByteString -- ^ key + -> Integer -- ^ timeToLive + -> ByteString -- ^ serializedValue + -> m (f Status) +restoreReplace key timeToLive serializedValue = + sendRequest ["RESTORE", key, encode timeToLive, serializedValue, "REPLACE"] + + +set + :: (RedisCtx m f) + => ByteString -- ^ key + -> ByteString -- ^ value + -> m (f Status) +set key value = sendRequest ["SET", key, value] + + +data Condition = Nx | Xx deriving (Show, Eq) + + +instance RedisArg Condition where + encode Nx = "NX" + encode Xx = "XX" + + +data SetOpts = SetOpts + { setSeconds :: Maybe Integer + , setMilliseconds :: Maybe Integer + , setCondition :: Maybe Condition + } deriving (Show, Eq) + + +setOpts + :: (RedisCtx m f) + => ByteString -- ^ key + -> ByteString -- ^ value + -> SetOpts + -> m (f Status) +setOpts key value SetOpts{..} = + sendRequest $ concat [["SET", key, value], ex, px, condition] + where + ex = maybe [] (\s -> ["EX", encode s]) setSeconds + px = maybe [] (\s -> ["PX", encode s]) setMilliseconds + condition = map encode $ maybeToList setCondition + + +data DebugMode = Yes | Sync | No deriving (Show, Eq) + + +instance RedisArg DebugMode where + encode Yes = "YES" + encode Sync = "SYNC" + encode No = "NO" + + +scriptDebug + :: (RedisCtx m f) + => DebugMode + -> m (f Bool) +scriptDebug mode = + sendRequest ["SCRIPT DEBUG", encode mode] + + +zadd + :: (RedisCtx m f) + => ByteString -- ^ key + -> [(Double,ByteString)] -- ^ scoreMember + -> m (f Integer) +zadd key scoreMembers = + zaddOpts key scoreMembers defaultZaddOpts + + +data ZaddOpts = ZaddOpts + { zaddCondition :: Maybe Condition + , zaddChange :: Bool + , zaddIncrement :: Bool + } deriving (Show, Eq) + + +-- |Redis default 'ZaddOpts'. Equivalent to omitting all optional parameters. +-- +-- @ +-- ZaddOpts +-- { zaddCondition = Nothing -- omit NX and XX options +-- , zaddChange = False -- don't modify the return value from the number of new elements added, to the total number of elements changed +-- , zaddIncrement = False -- don't add like ZINCRBY +-- } +-- @ +-- +defaultZaddOpts :: ZaddOpts +defaultZaddOpts = ZaddOpts + { zaddCondition = Nothing + , zaddChange = False + , zaddIncrement = False + } + + +zaddOpts + :: (RedisCtx m f) + => ByteString -- ^ key + -> [(Double,ByteString)] -- ^ scoreMember + -> ZaddOpts -- ^ options + -> m (f Integer) +zaddOpts key scoreMembers ZaddOpts{..} = + sendRequest $ concat [["ZADD", key], condition, change, increment, scores] + where + scores = concatMap (\(x,y) -> [encode x,encode y]) scoreMembers + condition = map encode $ maybeToList zaddCondition + change = ["CH" | zaddChange] + increment = ["INCR" | zaddIncrement] + + +data ReplyMode = On | Off | Skip deriving (Show, Eq) + + +instance RedisArg ReplyMode where + encode On = "ON" + encode Off = "OFF" + encode Skip = "SKIP" + + +clientReply + :: (RedisCtx m f) + => ReplyMode + -> m (f Bool) +clientReply mode = + sendRequest ["CLIENT REPLY", encode mode] + + +srandmember + :: (RedisCtx m f) + => ByteString -- ^ key + -> m (f (Maybe ByteString)) +srandmember key = sendRequest ["SRANDMEMBER", key] + + +srandmemberN + :: (RedisCtx m f) + => ByteString -- ^ key + -> Integer -- ^ count + -> m (f (Maybe ByteString)) +srandmemberN key count = sendRequest ["SRANDMEMBER", key, encode count] + + +spop + :: (RedisCtx m f) + => ByteString -- ^ key + -> m (f (Maybe ByteString)) +spop key = sendRequest ["SPOP", key] + + +info + :: (RedisCtx m f) + => m (f ByteString) +info = sendRequest ["INFO"] + + +infoSection + :: (RedisCtx m f) + => ByteString -- ^ section + -> m (f ByteString) +infoSection section = sendRequest ["INFO", section] + + +exists + :: (RedisCtx m f) + => 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 --- a/test/Test.hs +++ b/test/Test.hs @@ -56,7 +56,9 @@ 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] ] ------------------------------------------------------------------------------ @@ -524,3 +526,23 @@ 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"]