redis 0.7.2 → 0.8
raw patch · 4 files changed
+65/−33 lines, 4 files
Files
- Database/Redis/Internal.hs +4/−3
- Database/Redis/Monad.hs +11/−4
- Database/Redis/Redis.hs +45/−19
- redis.cabal +5/−7
Database/Redis/Internal.hs view
@@ -1,13 +1,13 @@ {-# LANGUAGE OverloadedStrings #-} module Database.Redis.Internal where -import Prelude hiding (putStrLn, catch)+import Prelude hiding (putStrLn, putStr, catch) import Control.Concurrent (ThreadId, myThreadId) import Control.Concurrent.MVar import Data.IORef import qualified Network.Socket as S import qualified System.IO as IO-import System.IO.UTF8 (putStrLn)+import System.IO.UTF8 (putStrLn, putStr) import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.ByteString.Char8 ()@@ -19,7 +19,8 @@ import Database.Redis.ByteStringClass -tracebs bs = putStrLn (U.toString bs)+tracebs = putStrLn . U.toString+tracebs' = putStr . U.toString data RedisState = RedisState { server :: (String, String), -- ^ hostname and port pair database :: Int, -- ^ currently selected database
Database/Redis/Monad.hs view
@@ -49,7 +49,7 @@ multi, exec, discard, run_multi, exists, del, getType, keys, randomKey, rename, renameNx, dbsize, expire, expireAt,- ttl, select, move, flushDb,+ persist, ttl, select, move, flushDb, flushAll, info, -- ** Strings@@ -57,6 +57,7 @@ get, getSet, mGet, incr, incrBy, decr, decrBy, append, substr,+ strlen, -- ** Lists rpush, lpush, llen, lrange, ltrim,@@ -208,6 +209,9 @@ expireAt key timestamp = do r <- getRedis liftIO $ R.expireAt r key timestamp +persist :: (WithRedis m, BS s) => s -> m (R.Reply Int)+persist key = getRedis >>= liftIO . flip R.persist key+ ttl :: (WithRedis m, BS s) => s -> m (R.Reply Int) ttl key = getRedis >>= liftIO . flip R.ttl key @@ -277,6 +281,9 @@ substr key range = do r <- getRedis liftIO $ R.substr r key range +strlen :: (WithRedis m, BS s) => s -> m (R.Reply Int)+strlen key = getRedis >>= liftIO . flip R.strlen key+ rpush :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int) rpush key val = do r <- getRedis liftIO $ R.rpush r key val@@ -395,9 +402,9 @@ zrevrange key limit withscores = do r <- getRedis liftIO $ R.zrevrange r key limit withscores -zrangebyscore :: (WithRedis m, IsInterval i Double, BS s1, BS s2) => s1 -> i -> Bool -> m (R.Reply s2)-zrangebyscore key limit withscores = do r <- getRedis- liftIO $ R.zrangebyscore r key limit withscores+zrangebyscore :: (WithRedis m, IsInterval i Double, BS s1, BS s2) => s1 -> i -> Maybe (Int, Int) -> Bool -> m (R.Reply s2)+zrangebyscore key i limit withscores = do r <- getRedis+ liftIO $ R.zrangebyscore r key i limit withscores zcount :: (WithRedis m, IsInterval i Double, BS s) => s -> i -> m (R.Reply Int) zcount key limit = do r <- getRedis
Database/Redis/Redis.hs view
@@ -49,7 +49,7 @@ watch, unwatch, run_cas, exists, del, getType, keys, randomKey, rename, renameNx, dbsize, expire, expireAt,- ttl, select, move, flushDb,+ persist, ttl, select, move, flushDb, flushAll, info, -- ** Strings@@ -57,6 +57,7 @@ get, getSet, mGet, incr, incrBy, decr, decrBy, append, substr,+ strlen, -- ** Lists rpush, lpush, llen, lrange, ltrim,@@ -100,7 +101,9 @@ import qualified Data.ByteString as B import Data.ByteString (ByteString) import Data.Maybe (fromJust, isNothing)+import Data.List (intersperse) import Control.Monad (when)+import Control.Exception (onException) import Database.Redis.ByteStringClass import Database.Redis.Internal@@ -281,11 +284,12 @@ -> [IO (Reply ())] -- ^ IO actions to run -> IO (Reply s) run_multi r cs = let cs' = map (>>= noError) cs- in withState' (\rs -> do sendCommand rs (CInline "MULTI")- (recv rs :: IO (Reply ())) >>= fromROk- sequence_ cs'- sendCommand rs (CInline "EXEC")- recv rs) r+ in withState r (\rs -> do sendCommand rs (CInline "MULTI")+ (recv rs :: IO (Reply ())) >>= fromROk+ (sequence_ cs') `onException` do sendCommand rs (CInline "DISCARD")+ recv rs :: IO (Reply ())+ sendCommand rs (CInline "EXEC")+ recv rs) -- | Add keys to a watch list for Check-and-Set operation. --@@ -321,7 +325,9 @@ run_cas r keys cs = let keys' = map toBS keys in withState r (\rs -> do sendCommand rs (CMBulk ("WATCH" : keys')) (recv rs :: IO (Reply ())) >>= fromROk- res <- cs+ res <- cs `onException` do sendCommand rs (CInline "DISCARD")+ sendCommand rs (CInline "UNWATCH")+ recv rs :: IO (Reply ()) sendCommand rs (CInline "UNWATCH") (recv rs :: IO (Reply ())) >>= fromROk return res)@@ -420,6 +426,15 @@ -> IO (Reply Int) expireAt r key timestamp = withState r (\rs -> sendCommand rs (CMBulk ["EXPIREAT", toBS key, toBS timestamp]) >> recv rs) +-- | Remove the timeout from a key+--+-- (RInt 1) returned if the timeout was removed and (RInt 0) otherwise+persist :: BS s =>+ Redis+ -> s -- ^ target key+ -> IO (Reply Int)+persist r key = withState r (\rs -> sendCommand rs (CMBulk ["PERSIST", toBS key]) >> recv rs)+ -- | Return the remining time to live of the key or -1 if key has no -- associated timeout --@@ -591,7 +606,7 @@ -- RInt returned with new key value decrBy :: BS s => Redis- -> s -- ^ target key+ -> s -- ^ target key -> Int -- ^ decrement -> IO (Reply Int) decrBy r key n = withState r (\rs -> sendCommand rs (CMBulk ["DECRBY", toBS key, toBS n]) >> recv rs)@@ -611,11 +626,20 @@ -- RBulk returned substr :: (BS s1, BS s2) => Redis- -> s1- -> (Int, Int)+ -> s1 -- ^ traget key+ -> (Int, Int) -- ^ (start, end) -> IO (Reply s2) substr r key (from, to) = withState r (\rs -> sendCommand rs (CMBulk ["SUBSTR", toBS key, toBS from, toBS to]) >> recv rs) +-- | Returns a length of a string-typed key+--+-- RInt returned+strlen :: BS s =>+ Redis+ -> s -- ^ target key+ -> IO (Reply Int)+strlen r key = withState r (\rs -> sendCommand rs (CMBulk ["STRLEN", toBS key]) >> recv rs)+ -- | Add string value to the head of the list-type key. New list -- length returned --@@ -1032,15 +1056,17 @@ -- RMulti filled with RBulk returned zrangebyscore :: (IsInterval i Double, BS s1, BS s2) => Redis- -> s1 -- ^ target key- -> i -- ^ scores interval- -> Bool -- ^ withscores option+ -> s1 -- ^ target key+ -> i -- ^ scores interval+ -> Maybe (Int, Int) -- ^ limits (offset, count)+ -> Bool -- ^ withscores option -> IO (Reply s2)-zrangebyscore r key i withscores = let cmd' = i' `seq` ["ZRANGEBYSCORE", toBS key, toBS (from i'), toBS (to i')]- cmd | withscores = cmd' ++ ["WITHSCORES"]- | otherwise = cmd'- i' = toInterval i- in cmd `seq` withState r (\rs -> sendCommand rs (CMBulk cmd) >> recv rs)+zrangebyscore r key i limit withscores = let cmd' = i' `seq` ["ZRANGEBYSCORE", toBS key, toBS (from i'), toBS (to i')]+ cmd'' = maybe cmd' (\(a, b) -> cmd' ++ ["LIMIT", toBS a, toBS b]) limit+ cmd | withscores = cmd'' ++ ["WITHSCORES"]+ | otherwise = cmd''+ i' = toInterval i+ in cmd `seq` withState r (\rs -> sendCommand rs (CMBulk cmd) >> recv rs) -- | Count a number of elements of the sorted set with a score that -- lays within a given interval@@ -1339,7 +1365,7 @@ | otherwise = ["BY",(toBS $ sort_by opt)] get_obj_s | null $ get_obj opt = []- | otherwise = "GET" : map toBS (get_obj opt)+ | otherwise = "GET" : (intersperse "GET" . map toBS $ get_obj opt) store_s | B.null $ toBS (store opt) = [] | otherwise = ["STORE", toBS $ store opt]
redis.cabal view
@@ -1,5 +1,5 @@ Name: redis-Version: 0.7.2+Version: 0.8 License: MIT Maintainer: Alexander Bogdanov <andorn@gmail.com> Author: Alexander Bogdanov <andorn@gmail.com>@@ -16,15 +16,13 @@ protocol. Most of the functions will work correctly with stable version but not all. .- Changes from v0.6:- .- - new commands added: watch, unwatch+ Changes from v0.7: .- - new batch command: run_cas+ - new commands added: strlen, persist .- - fixed bug with expireAt - thanks to Alex Suraci+ - zrangebyscore now supports LIMIT argument. Warning! Backward incompatible change! .- - fixed bug with sismember - thanks to Michael Snoyman+ - fixed behaviour of sort with multiple GET keys . Stability: beta