redis 0.5.2 → 0.6
raw patch · 4 files changed
+84/−41 lines, 4 files
Files
- Database/Redis/Internal.hs +16/−8
- Database/Redis/Monad.hs +18/−6
- Database/Redis/Redis.hs +43/−19
- redis.cabal +7/−8
Database/Redis/Internal.hs view
@@ -1,7 +1,7 @@ {-# LANGUAGE OverloadedStrings #-} module Database.Redis.Internal where -import Prelude hiding (putStrLn)+import Prelude hiding (putStrLn, catch) import Control.Concurrent (ThreadId, myThreadId) import Control.Concurrent.MVar import Data.IORef@@ -15,7 +15,7 @@ import Data.Maybe (fromJust, isNothing, isJust) import Data.List (intersperse) import Control.Monad (when)-import Control.Exception (block, bracket, bracketOnError)+import Control.Exception (block, bracket, bracketOnError, catch, SomeException) import Database.Redis.ByteStringClass @@ -41,6 +41,7 @@ -- | Redis reply variants data BS s => Reply s = RTimeout -- ^ Timeout. Currently unused+ | RParseError String -- ^ Error converting value from ByteString. It's a client-side error. | ROk -- ^ \"Ok\" reply | RPong -- ^ Reply for the ping command | RQueued -- ^ Used inside multi-exec block@@ -56,6 +57,7 @@ instance BS s => Show (Reply s) where show RTimeout = "RTimeout"+ show (RParseError msg) = "RParseError: " ++ msg show ROk = "ROk" show RPong = "RPong" show RQueued = "RQueued"@@ -73,6 +75,7 @@ | MPSubscribe s Int | MPUnsubscribe s Int | MMessage s s+ | MPMessage s s s deriving Show urn = U.fromString "\r\n"@@ -194,15 +197,20 @@ h = handle r trim = B.takeWhile (\c -> c /= 13 && c /= 10) + safeFromBS constructor bs = (return $! constructor $! fromBS bs)+ `catch`+ (\e -> let msg = show (e :: SomeException)+ in return $ RParseError msg)+ -- recv_err :: ByteString -> IO Reply recv_err rest = return $ RError $ U.toString rest -- recv_inline :: ByteString -> IO Reply- recv_inline rest = return $ case rest of- "OK" -> ROk- "PONG" -> RPong- "QUEUED" -> RQueued- _ -> RInline $ fromBS rest+ recv_inline rest = case rest of+ "OK" -> return ROk+ "PONG" -> return RPong+ "QUEUED" -> return RQueued+ _ -> safeFromBS RInline rest -- recv_int :: ByteString -> IO Reply recv_int rest = let reply = read (U.toString rest) :: Int@@ -211,7 +219,7 @@ -- recv_bulk :: ByteString -> IO Reply recv_bulk rest = let size = read (U.toString rest) :: Int in do body <- recv_bulk_body size- return $ RBulk (fromBS `fmap` body)+ maybe (return $ RBulk Nothing) (safeFromBS (RBulk . Just)) body -- recv_bulk_body :: Int -> IO (Maybe ByteString) recv_bulk_body (-1) = return Nothing
Database/Redis/Monad.hs view
@@ -53,7 +53,7 @@ flushAll, info, -- ** Strings- set, setNx, mSet, mSetNx,+ set, setNx,setEx, mSet, mSetNx, get, getSet, mGet, incr, incrBy, decr, decrBy, append, substr,@@ -73,7 +73,7 @@ zrevrange, zrangebyscore, zcount, zremrangebyscore, zcard, zscore, zrank, zrevrank, zremrangebyrank,- zunion, zinter,+ zunion, zinter, zunionStore, zinterStore, -- ** Hashes hset, hget, hdel, hmset, hmget,@@ -215,6 +215,10 @@ setNx key val = do r <- getRedis liftIO $ R.setNx r key val +setEx :: (WithRedis m, BS s1, BS s2) => s1 -> Int -> s2 -> m (R.Reply ())+setEx key seconds val = do r <- getRedis+ liftIO $ R.setEx r key seconds val+ mSet :: (WithRedis m, BS s1, BS s2) => [(s1, s2)] -> m (R.Reply ()) mSet ks = getRedis >>= liftIO . flip R.mSet ks @@ -401,13 +405,21 @@ zremrangebyrank key limit = do r <- getRedis liftIO $ R.zremrangebyrank r key limit +zunionStore :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> [Double] -> R.Aggregate -> m (R.Reply Int)+zunionStore dst src weights aggregate = do r <- getRedis+ liftIO $ R.zunionStore r dst src weights aggregate++{-# DEPRECATED zunion "ZUNION command was renamed to ZUNIONSTORE" #-} zunion :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> [Double] -> R.Aggregate -> m (R.Reply Int)-zunion dst src weights aggregate = do r <- getRedis- liftIO $ R.zunion r dst src weights aggregate+zunion = zunionStore +zinterStore :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> [Double] -> R.Aggregate -> m (R.Reply Int)+zinterStore dst src weights aggregate = do r <- getRedis+ liftIO $ R.zinterStore r dst src weights aggregate++{-# DEPRECATED zinter "ZINTER command was renamed to ZINTERSTORE" #-} zinter :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> [Double] -> R.Aggregate -> m (R.Reply Int)-zinter dst src weights aggregate = do r <- getRedis- liftIO $ R.zinter r dst src weights aggregate+zinter = zinterStore hset :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> s2 -> s3 -> m (R.Reply Int) hset key field value = do r <- getRedis
Database/Redis/Redis.hs view
@@ -52,7 +52,7 @@ flushAll, info, -- ** Strings- set, setNx, mSet, mSetNx,+ set, setNx, setEx, mSet, mSetNx, get, getSet, mGet, incr, incrBy, decr, decrBy, append, substr,@@ -72,7 +72,7 @@ zrevrange, zrangebyscore, zcount, zremrangebyscore, zcard, zscore, zrank, zrevrank, zremrangebyrank,- zunion, zinter,+ zunion, zinter, zunionStore, zinterStore, -- ** Hashes hset, hget, hdel, hmset, hmget,@@ -191,9 +191,11 @@ "psubscribe" -> mksub MPSubscribe $ tail rm' "punsubscribe" -> mksub MPUnsubscribe $ tail rm' "message" -> mkmsg $ tail rm'+ "pmessage" -> mkpmsg $ tail rm' where mksub f [RBulk (Just k), RInt n] = f (fromBS k) n mkmsg [RBulk (Just k), RBulk (Just msg)] = MMessage (fromBS k) (fromBS msg)+ mkpmsg [RBulk (Just p), RBulk (Just c), RBulk (Just msg)] = MPMessage (fromBS p) (fromBS c) (fromBS msg) -- | Conects to Redis server and returns connection descriptor connect :: String -> String -> IO Redis@@ -449,6 +451,20 @@ -> IO (Reply Int) setNx r key val = withState r (\rs -> sendCommand rs (CMBulk ["SETNX", toBS key, toBS val]) >> recv rs) +-- | Atomically sets target key value and assigns expiration time. The+-- same as /multi; set key val; expire key seconds; exec/ but faster.+--+-- Arguments order is the same as in Redis protocol.+--+-- ROk returned+setEx :: (BS s1, BS s2) =>+ Redis+ -> s1 -- ^ target key+ -> Int -- ^ timeout in seconds+ -> s2 -- ^ value+ -> IO (Reply ())+setEx r key seconds val = withState r (\rs -> sendCommand rs (CMBulk ["SETEX", toBS key, toBS seconds, toBS val]) >> recv rs)+ -- | Atomically set multiple keys -- -- ROk returned@@ -1075,14 +1091,14 @@ -- /Aggregate/ is an option how to aggregate resulting scores. -- -- RInt returned - the number of elements in the resulting set.-zunion :: (BS s1, BS s2) =>- Redis- -> s1 -- ^ destination key- -> [s2] -- ^ sources keys- -> [Double] -- ^ weights- -> Aggregate -- ^ aggregate- -> IO (Reply Int)-zunion r dst src weights aggregate =+zunionStore :: (BS s1, BS s2) =>+ Redis+ -> s1 -- ^ destination key+ -> [s2] -- ^ sources keys+ -> [Double] -- ^ weights+ -> Aggregate -- ^ aggregate+ -> IO (Reply Int)+zunionStore r dst src weights aggregate = let src_s = toBS (length src) : map toBS src weight_s | null weights = []@@ -1090,8 +1106,12 @@ aggr_s | aggregate == SUM = [] | otherwise = ["AGGREGATE", toBS (show aggregate)]- in withState r (\rs -> sendCommand rs (CMBulk (("ZUNION" : toBS dst : src_s) ++ weight_s ++ aggr_s)) >> recv rs)+ in withState r (\rs -> sendCommand rs (CMBulk (("ZUNIONSTORE" : toBS dst : src_s) ++ weight_s ++ aggr_s)) >> recv rs) +{-# DEPRECATED zunion "ZUNION command was renamed to ZUNIONSTORE" #-}+zunion :: (BS s1, BS s2) => Redis -> s1 -> [s2] -> [Double] -> Aggregate -> IO (Reply Int)+zunion = zunionStore+ -- | Create an intersectoin of provided sorted sets and store it at destination key -- -- If /weights/ is not null then scores of sorted sets used with@@ -1101,14 +1121,14 @@ -- Aggregate is an option how to aggregate resulting scores. -- -- RInt returned - the number of elements in the resulting set.-zinter :: (BS s1, BS s2) =>- Redis- -> s1 -- ^ destination key- -> [s2] -- ^ sources keys- -> [Double] -- ^ weights- -> Aggregate -- ^ aggregate- -> IO (Reply Int)-zinter r dst src weights aggregate =+zinterStore :: (BS s1, BS s2) =>+ Redis+ -> s1 -- ^ destination key+ -> [s2] -- ^ sources keys+ -> [Double] -- ^ weights+ -> Aggregate -- ^ aggregate+ -> IO (Reply Int)+zinterStore r dst src weights aggregate = let src_s = toBS (length src) : map toBS src weight_s | null weights = []@@ -1117,6 +1137,10 @@ aggr_s | aggregate == SUM = [] | otherwise = ["AGGREGATE", toBS (show aggregate)] in withState r (\rs -> sendCommand rs (CMBulk (("ZINTER" : toBS dst : src_s) ++ weight_s ++ aggr_s)) >> recv rs)++{-# DEPRECATED zinter "ZINTER command was renamed to ZINTERSTORE" #-}+zinter :: (BS s1, BS s2) => Redis -> s1 -> [s2] -> [Double] -> Aggregate -> IO (Reply Int)+zinter = zinterStore -- | Set the specified hash field to the specified value --
redis.cabal view
@@ -1,5 +1,5 @@ Name: redis-Version: 0.5.2+Version: 0.6 License: MIT Maintainer: Alexander Bogdanov <andorn@gmail.com> Author: Alexander Bogdanov <andorn@gmail.com>@@ -16,17 +16,16 @@ protocol. Most of the functions will work correctly with stable version but not all. .- Changes from v0.4:- .- - new hash commands added: hmset, hmget, hincrby+ Changes from v0.5: .- - initial support for (p)subscribe\/(p)unsubscribe\/publish+ - zunion and zinter was renamed to zunionstore and zinterstore.+ Important! It makes this version incompatible with older versions of Redis server. .- - getServer and getDatabase accessors added+ - new message type for pmessages: MPMessage .- New in this version:+ - new reply type RParseError used for replies that was failed to convert from ByteString .- - listen now have timeout argument+ - new command added: setEx Stability: beta Build-Type: Simple