redis 0.11 → 0.12
raw patch · 28 files changed
+467/−215 lines, 28 filesdep −parsec
Dependencies removed: parsec
Files
- Benchmark.hs +19/−7
- Database/Redis/ByteStringClass.hs +5/−0
- Database/Redis/Info.hs +24/−24
- Database/Redis/Internal.hs +24/−19
- Database/Redis/Monad.hs +51/−29
- Database/Redis/Monad/State.hs +3/−20
- Database/Redis/Redis.hs +124/−43
- Database/Redis/Utils/Lock.hs +2/−19
- Database/Redis/Utils/Monad/Lock.hs +2/−19
- LICENSE +19/−0
- Test.hs +14/−2
- Test/CASCommands.hs +5/−0
- Test/Connection.hs +5/−0
- Test/GenericCommands.hs +15/−1
- Test/HashCommands.hs +32/−4
- Test/ListCommands.hs +14/−1
- Test/Lock.hs +5/−1
- Test/Monad/CASCommands.hs +5/−0
- Test/Monad/MultiCommands.hs +5/−0
- Test/MultiCommands.hs +5/−0
- Test/PubSubCommands.hs +5/−0
- Test/SetCommands.hs +22/−1
- Test/Setup.hs +8/−3
- Test/SortCommands.hs +5/−0
- Test/StringCommands.hs +13/−2
- Test/Utils.hs +5/−0
- Test/ZSetCommands.hs +17/−1
- redis.cabal +14/−19
Benchmark.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ import System (getArgs) import System.Exit (exitFailure, exitSuccess) import System.Console.GetOpt@@ -18,12 +23,16 @@ -- runWorkers :: Redis -> total loops count -> Worker -> IO time passed runWorkers :: [Redis] -> Int -> Worker -> IO NominalDiffTime-runWorkers rs loops worker =- do mvs <- mapM fork $ zip [0 .. (workers - 1)] rs- t <- getCurrentTime- mapM_ (flip putMVar () . fst) mvs- mapM_ (takeMVar . snd ) mvs- flip diffUTCTime t `fmap` getCurrentTime+runWorkers rs loops worker+ | workers > 1 = do mvs <- mapM fork $ zip [0 .. (workers - 1)] rs+ t <- getCurrentTime+ mapM_ (flip putMVar () . fst) mvs+ mapM_ (takeMVar . snd ) mvs+ flip diffUTCTime t `fmap` getCurrentTime+ | otherwise = do mv <- newMVar ()+ t <- getCurrentTime+ worker (head rs) (prefix 0) loops mv mv+ flip diffUTCTime t `fmap` getCurrentTime where fork (n, r) = do lock <- newEmptyMVar unlock <- newEmptyMVar if n < workers - 1@@ -90,7 +99,10 @@ main :: IO () main = do args <- getArgs- opts <- case getOpt RequireOrder options args of+ when (length args == 0) $ do putStrLn $ usageInfo "Usage: " options+ exitSuccess++ opts <- case getOpt Permute options args of (o, [], []) -> return $ foldl (flip id) defaultOpts o (_, n, []) -> do putStrLn $ "Unrecognized arguments: " ++ concat n ++ usageInfo "\nUsage: " options exitFailure
Database/Redis/ByteStringClass.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ {-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-} module Database.Redis.ByteStringClass where
Database/Redis/Info.hs view
@@ -1,35 +1,35 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ module Database.Redis.Info ( RedisInfo, parseInfo ) where -import Text.Parsec-import Data.Map--import Database.Redis.ByteStringClass+import Data.Map (Map(..), fromList)+import Data.Char type RedisInfo = Map String String -parseInfo :: String -> Either ParseError RedisInfo-parseInfo = runParser infoP empty "info"- -infoP :: Parsec String RedisInfo RedisInfo-infoP = do skipMany infoLine- getState+parseInfo :: String -> RedisInfo+parseInfo = fromList . parsePairs . filterComments . filterEmptyLines . lines -infoLine :: Parsec String RedisInfo ()-infoLine = emptyLine <|> commentLine <|> keyLine+filterEmptyLines :: [String] -> [String]+filterEmptyLines = filter $ not . all isSpace -emptyLine :: Parsec String RedisInfo ()-emptyLine = skipMany (oneOf [' ', '\t', '\r']) >> newline >> return ()+startsWith :: Char -> String -> Bool+startsWith c (s:ls) | c == s = True+ | isSpace s = startsWith c ls+ | otherwise = False+startsWith _ _ = False -commentLine :: Parsec String RedisInfo ()-commentLine = char '#' >> skipMany (noneOf ['\n']) >> newline >> return ()+trim = takeWhile (not . isSpace) . dropWhile isSpace -keyLine :: Parsec String RedisInfo ()-keyLine = do key <- many1 (noneOf [':'])- char ':'- val <- many1 (noneOf [' ', '\t', '\r', '\n'])- skipMany (oneOf [' ', '\t', '\r'])- newline- m <- getState- setState $ insert key val m+filterComments :: [String] -> [String]+filterComments = filter $ not . startsWith '#'++parsePairs :: [String] -> [(String, String)]+parsePairs = map parsePair+ where parsePair ls = let (a, b) = break (== ':') ls+ in (a, trim $ tail b)
Database/Redis/Internal.hs view
@@ -1,4 +1,9 @@-{-# LANGUAGE CPP, OverloadedStrings #-}+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}++{-# LANGUAGE CPP, OverloadedStrings, BangPatterns #-} module Database.Redis.Internal where import Prelude hiding (putStrLn, putStr, catch)@@ -56,17 +61,17 @@ | CMBulk [ByteString] -- | 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- | RError String -- ^ Some kind of server-side error- | RInline s -- ^ Simple oneline reply- | RInt Int -- ^ Integer reply- | RBulk (Maybe s) -- ^ Multiline reply- | RMulti (Maybe [Reply s]) -- ^ Complex reply. It may consists of various type of replys- deriving Eq+data 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+ | RError String -- ^ Some kind of server-side error+ | RInline s -- ^ Simple oneline reply+ | RInt Int -- ^ Integer reply+ | RBulk (Maybe s) -- ^ Multiline reply+ | RMulti (Maybe [Reply s]) -- ^ Complex reply. It may consists of various type of replys+ deriving Eq showbs :: BS s => s -> String showbs = U.toString . toBS@@ -86,13 +91,13 @@ where join = concat . intersperse ", " . map show show (RMulti Nothing) = "RMulti Nil" -data (BS s) => Message s = MSubscribe s Int -- ^ subscribed- | MUnsubscribe s Int -- ^ unsubscribed- | MPSubscribe s Int -- ^ pattern subscribed- | MPUnsubscribe s Int -- ^ pattern unsubscribed- | MMessage s s -- ^ message recieved- | MPMessage s s s -- ^ message recieved by pattern- deriving (Eq, Show)+data Message s = MSubscribe s Int -- ^ subscribed+ | MUnsubscribe s Int -- ^ unsubscribed+ | MPSubscribe s Int -- ^ pattern subscribed+ | MPUnsubscribe s Int -- ^ pattern unsubscribed+ | MMessage s s -- ^ message recieved+ | MPMessage s s s -- ^ message recieved by pattern+ deriving (Eq, Show) urn = U.fromString "\r\n" uspace = U.fromString " "
Database/Redis/Monad.hs view
@@ -1,23 +1,6 @@ {--Copyright (c) 2010 Alexander Bogdanov <andorn@gmail.com>--Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:--The above copyright notice and this permission notice shall be included in-all copies or substantial portions of the Software.--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 OR COPYRIGHT HOLDERS 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.+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT -} {-# LANGUAGE FlexibleContexts, OverloadedStrings, PackageImports #-}@@ -51,7 +34,7 @@ ping, auth, echo, quit, shutdown, multi, exec, discard, run_multi, watch, unwatch, run_cas, exists,- del, getType, keys, randomKey, rename,+ del, del_, getType, keys, randomKey, rename, renameNx, dbsize, expire, expireAt, persist, ttl, select, move, flushDb, flushAll, info,@@ -59,32 +42,32 @@ -- ** Strings set, setNx,setEx, mSet, mSetNx, get, getSet, mGet,- incr, incrBy, decr,+ incr, incrBy, incrByFloat, decr, decrBy, append, substr, getrange, setrange, getbit, setbit,strlen, -- ** Lists- rpush, lpush, rpushx, lpushx,+ rpush, rpush_, lpush, rpushx, lpushx, llen, lrange, ltrim, lindex, lset, lrem, lpop, rpop, rpoplpush, blpop, brpop, brpoplpush, -- ** Sets- sadd, srem, spop, smove, scard, sismember,+ sadd, sadd_, srem, srem_, spop, smove, scard, sismember, smembers, srandmember, sinter, sinterStore, sunion, sunionStore, sdiff, sdiffStore, -- ** Sorted sets- zadd, zrem, zincrBy, zrange,+ zadd, zadd_, zrem, zrem_, zincrBy, zrange, zrevrange, zrangebyscore, zrevrangebyscore, zcount, zremrangebyscore, zcard, zscore, zrank, zrevrank, zremrangebyrank, zunion, zinter, zunionStore, zinterStore, -- ** Hashes- hset, hget, hdel, hmset, hmget,- hincrby, hexists, hlen,+ hset, hget, hdel, hdel_, hmset, hmget,+ hincrBy, hincrByFloat, hexists, hlen, hkeys, hvals, hgetall, -- ** Sorting@@ -195,6 +178,9 @@ del :: (WithRedis m, BS s) => s -> m (R.Reply Int) del key = getRedis >>= liftIO . flip R.del key +del_ :: (WithRedis m, BS s) => [s] -> m (R.Reply Int)+del_ keys = getRedis >>= liftIO . flip R.del_ keys+ getType :: (WithRedis m, BS s1) => s1 -> m R.RedisKeyType getType key = getRedis >>= liftIO . flip R.getType key @@ -280,6 +266,10 @@ incrBy key n = do r <- getRedis liftIO $ R.incrBy r key n +incrByFloat :: (WithRedis m, BS s) => s -> Double -> m (R.Reply Double)+incrByFloat key n = do r <- getRedis+ liftIO $ R.incrByFloat r key n+ decr :: (WithRedis m, BS s) => s -> m (R.Reply Int) decr key = getRedis >>= liftIO . flip R.decr key @@ -318,10 +308,18 @@ rpush key val = do r <- getRedis liftIO $ R.rpush r key val +rpush_ :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> m (R.Reply Int)+rpush_ key vals = do r <- getRedis+ liftIO $ R.rpush_ r key vals+ lpush :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int) lpush key val = do r <- getRedis liftIO $ R.lpush r key val +lpush_ :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> m (R.Reply Int)+lpush_ key vals = do r <- getRedis+ liftIO $ R.lpush_ r key vals+ rpushx :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int) rpushx key val = do r <- getRedis liftIO $ R.rpushx r key val@@ -383,10 +381,18 @@ sadd key val = do r <- getRedis liftIO $ R.sadd r key val +sadd_ :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> m (R.Reply Int)+sadd_ key vals = do r <- getRedis+ liftIO $ R.sadd_ r key vals+ srem :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int) srem key val = do r <- getRedis liftIO $ R.srem r key val +srem_ :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> m (R.Reply Int)+srem_ key vals = do r <- getRedis+ liftIO $ R.srem_ r key vals+ spop :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2) spop key = getRedis >>= liftIO . flip R.spop key @@ -432,10 +438,18 @@ zadd key score member = do r <- getRedis liftIO $ R.zadd r key score member +zadd_ :: (WithRedis m, BS s1, BS s2) => s1 -> [(Double, s2)] -> m (R.Reply Int)+zadd_ key elements = do r <- getRedis+ liftIO $ R.zadd_ r key elements+ zrem :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int) zrem key member = do r <- getRedis liftIO $ R.zrem r key member +zrem_ :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> m (R.Reply Int)+zrem_ key members = do r <- getRedis+ liftIO $ R.zrem_ r key members+ zincrBy :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> Double -> s2 -> m (R.Reply s3) zincrBy key score member = do r <- getRedis liftIO $ R.zincrBy r key score member@@ -511,6 +525,10 @@ hdel key field = do r <- getRedis liftIO $ R.hdel r key field +hdel_ :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> m (R.Reply Int)+hdel_ key fields = do r <- getRedis+ liftIO $ R.hdel_ r key fields+ hmset :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> [(s2, s3)] -> m (R.Reply ()) hmset key fields = do r <- getRedis liftIO $ R.hmset r key fields@@ -519,9 +537,13 @@ hmget key fields = do r <- getRedis liftIO $ R.hmget r key fields -hincrby :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> Int -> m (R.Reply Int)-hincrby key field n = do r <- getRedis- liftIO $ R.hincrby r key field n+hincrBy :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> Int -> m (R.Reply Int)+hincrBy key field n = do r <- getRedis+ liftIO $ R.hincrBy r key field n++hincrByFloat :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> Double -> m (R.Reply Double)+hincrByFloat key field n = do r <- getRedis+ liftIO $ R.hincrByFloat r key field n hexists :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int) hexists key field = do r <- getRedis
Database/Redis/Monad/State.hs view
@@ -1,26 +1,9 @@ {--Copyright (c) 2010 Alexander Bogdanov <andorn@gmail.com>--Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:--The above copyright notice and this permission notice shall be included in-all copies or substantial portions of the Software.--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 OR COPYRIGHT HOLDERS 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.+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT -} -{-# LANGUAGE PackageImports, TypeSynonymInstances #-}+{-# LANGUAGE PackageImports, TypeSynonymInstances, FlexibleInstances #-} -- | This module is mainly an example of posible 'WithRedis' -- implementation module Database.Redis.Monad.State where
Database/Redis/Redis.hs view
@@ -1,27 +1,10 @@ {--Copyright (c) 2010 Alexander Bogdanov <andorn@gmail.com>--Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:--The above copyright notice and this permission notice shall be included in-all copies or substantial portions of the Software.--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 OR COPYRIGHT HOLDERS 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.+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT -} {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies,- FlexibleContexts, OverloadedStrings #-}+ FlexibleContexts, OverloadedStrings, BangPatterns #-} -- | Main Redis API and protocol implementation module Database.Redis.Redis (@@ -51,7 +34,7 @@ ping, auth, echo, quit, shutdown, multi, exec, discard, run_multi, watch, unwatch, run_cas, exists,- del, getType, keys, randomKey, rename,+ del, del_, getType, keys, randomKey, rename, renameNx, dbsize, expire, expireAt, persist, ttl, select, move, flushDb, flushAll, info,@@ -59,32 +42,32 @@ -- ** Strings set, setNx, setEx, mSet, mSetNx, get, getSet, mGet,- incr, incrBy, decr,+ incr, incrBy, incrByFloat, decr, decrBy, append, substr, getrange, setrange, getbit, setbit, strlen, -- ** Lists- rpush, lpush, rpushx, lpushx,+ rpush, rpush_, lpush, lpush_, rpushx, lpushx, linsert, llen, lrange, ltrim, lindex, lset, lrem, lpop, rpop, rpoplpush, blpop, brpop, brpoplpush, -- ** Sets- sadd, srem, spop, smove, scard, sismember,+ sadd, sadd_, srem, srem_, spop, smove, scard, sismember, smembers, srandmember, sinter, sinterStore, sunion, sunionStore, sdiff, sdiffStore, -- ** Sorted sets- zadd, zrem, zincrBy, zrange,+ zadd, zadd_, zrem, zrem_, zincrBy, zrange, zrevrange, zrangebyscore, zrevrangebyscore, zcount, zremrangebyscore, zcard, zscore, zrank, zrevrank, zremrangebyrank, zunion, zinter, zunionStore, zinterStore, -- ** Hashes- hset, hget, hdel, hmset, hmget,- hincrby, hexists, hlen,+ hset, hget, hdel, hdel_, hmset, hmget,+ hincrBy, hincrByFloat, hexists, hlen, hkeys, hvals, hgetall, -- ** Sorting@@ -319,7 +302,7 @@ -- | Execute queued commands ----- RMulti returned - replys for all executed commands+-- RMulti returned - replies for all executed commands exec :: BS s => Redis -> IO (Reply s) exec = withState' (\rs -> sendCommand rs (CInline "EXEC") >> recv rs) @@ -331,7 +314,7 @@ -- | Run commands within multi-exec block ----- RMulti returned - replys for all executed commands+-- RMulti returned - replies for all executed commands run_multi :: (BS s) => Redis -> (Redis -> IO ()) -- ^ IO action to run@@ -403,6 +386,14 @@ -> IO (Reply Int) del r key = withState r (\rs -> sendCommand rs (CMBulk ["DEL", toBS key]) >> recv rs) +-- | Variadic form of DEL+--+-- RInt returned - number of deleted keys+del_ :: BS s =>+ Redis+ -> [s] -- ^ target keys list+ -> IO (Reply Int)+del_ r keys = withState r (\rs -> sendCommand rs (CMBulk ("DEL" : map toBS keys)) >> recv rs) data RedisKeyType = RTNone | RTString | RTList | RTSet | RTZSet | RTHash deriving (Show, Eq)@@ -554,9 +545,7 @@ -- 'RedisInfo' returned info :: Redis -> IO RedisInfo info r = withState r (\rs -> sendCommand rs (CInline "INFO") >> recv rs- >>= fromRBulk >>= return . fromRight . parseInfo . fromJust)- where fromRight (Right a) = a- fromRight _ = error "fromRight"+ >>= fromRBulk >>= return . parseInfo . fromJust) -- | Set the string value as value of the key --@@ -637,7 +626,7 @@ -- | Get the values of all specified keys ----- RMulti filled with RBulk replys returned+-- RMulti filled with RBulk replies returned mGet :: (BS s1, BS s2) => Redis -> [s1] -- ^ target keys@@ -663,6 +652,16 @@ -> IO (Reply Int) incrBy r key n = withState r (\rs -> sendCommand rs (CMBulk ["INCRBY", toBS key, toBS n]) >> recv rs) +-- | Increment the key value by N+--+-- (RBulk Double) returned with new key value+incrByFloat :: BS s =>+ Redis+ -> s -- ^ target key+ -> Double -- ^ increment+ -> IO (Reply Double)+incrByFloat r key n = withState r (\rs -> sendCommand rs (CMBulk ["INCRBYFLOAT", toBS key, toBS n]) >> recv rs)+ -- | Decrement the key value by one -- -- RInt returned with new key value@@ -780,6 +779,16 @@ -> IO (Reply Int) rpush r key val = withState r (\rs -> sendCommand rs (CMBulk ["RPUSH", toBS key, toBS val]) >> recv rs) +-- | Variadic form of rpush+--+-- RInt returned+rpush_ :: (BS s1, BS s2) =>+ Redis+ -> s1 -- ^ target key+ -> [s2] -- ^ values list+ -> IO (Reply Int)+rpush_ r key vals = withState r (\rs -> sendCommand rs (CMBulk ("RPUSH" : toBS key : map toBS vals)) >> recv rs)+ -- | Add string value to the head of the list-type key. New list -- length returned --@@ -791,6 +800,15 @@ -> IO (Reply Int) lpush r key val = withState r (\rs -> sendCommand rs (CMBulk ["LPUSH", toBS key, toBS val]) >> recv rs) +-- | Variadic form of LPUSH+--+-- RInt returned+lpush_ :: (BS s1, BS s2) =>+ Redis+ -> s1 -- ^ target key+ -> [s2] -- ^ values list+ -> IO (Reply Int)+lpush_ r key vals = withState r (\rs -> sendCommand rs (CMBulk ("LPUSH" : toBS key : map toBS vals)) >> recv rs) -- | Add string value to the head of existing list-type key. New list -- length returned. If such a key was not exists, list is not created@@ -993,6 +1011,16 @@ -> IO (Reply Int) sadd r key val = withState r (\rs -> sendCommand rs (CMBulk ["SADD", toBS key, toBS val]) >> recv rs) +-- | Variadic form of SADD+--+-- RInt returned - number of actualy added elements+sadd_ :: (BS s1, BS s2) =>+ Redis+ -> s1 -- ^ target key+ -> [s2] -- ^ values list+ -> IO (Reply Int)+sadd_ r key vals = withState r (\rs -> sendCommand rs (CMBulk ("SADD" : toBS key : map toBS vals)) >> recv rs)+ -- | Remove the specified member from the set value stored at key -- -- (RInt 1) returned if element was removed and (RInt 0) if element@@ -1004,6 +1032,16 @@ -> IO (Reply Int) srem r key val = withState r (\rs -> sendCommand rs (CMBulk ["SREM", toBS key, toBS val]) >> recv rs) +-- | Variadic form of SREM+--+-- RInt returned - number of removed values+srem_ :: (BS s1, BS s2) =>+ Redis+ -> s1 -- ^ target key+ -> [s2] -- ^ values list+ -> IO (Reply Int)+srem_ r key vals = withState r (\rs -> sendCommand rs (CMBulk ("SREM" : toBS key : map toBS vals)) >> recv rs)+ -- | Remove a random element from a Set returning it as return value -- -- RBulk returned@@ -1141,6 +1179,18 @@ -> IO (Reply Int) zadd r key score member = withState r (\rs -> sendCommand rs (CMBulk ["ZADD", toBS key, toBS score, toBS member]) >> recv rs) +-- | Variadic form of zadd+--+-- RInt returned - the number of elements actually added. Not+-- including elements which scores was just updated.+zadd_ :: (BS s1, BS s2) =>+ Redis+ -> s1 -- ^ target key+ -> [(Double, s2)] -- ^ list of score-value pairs+ -> IO (Reply Int)+zadd_ r key elements = withState r (\rs -> sendCommand rs (CMBulk ("ZADD" : toBS key : concatMap unpair elements)) >> recv rs)+ where unpair (score, element) = [toBS score, toBS element]+ -- | Remove the specified member from the sorted set -- -- (RInt 1) returned if element was removed and (RInt 0) if element@@ -1152,6 +1202,15 @@ -> IO (Reply Int) zrem r key member = withState r (\rs -> sendCommand rs (CMBulk ["ZREM", toBS key, toBS member]) >> recv rs) +-- | Variadic form of zrem+-- RInt returned - the number of removed elements+zrem_ :: (BS s1, BS s2) =>+ Redis+ -> s1 -- ^ target key+ -> [s2] -- ^ values list+ -> IO (Reply Int)+zrem_ r key members = withState r (\rs -> sendCommand rs (CMBulk ("ZREM" : toBS key : map toBS members)) >> recv rs)+ -- | If /member/ already in the sorted set adds the /increment/ to its -- score and updates the position of the element in the sorted set -- accordingly. If member does not exist in the sorted set it is added@@ -1457,6 +1516,16 @@ -> IO (Reply Int) hdel r key field = withState r (\rs -> sendCommand rs (CMBulk ["HDEL", toBS key, toBS field]) >> recv rs) +-- | Variadic form of HDEL+--+-- RInt returned - number of fields deleted+hdel_ :: (BS s1, BS s2) =>+ Redis+ -> s1 -- ^ key+ -> [s2] -- ^ field name+ -> IO (Reply Int)+hdel_ r key fields = withState r (\rs -> sendCommand rs (CMBulk ("HDEL" : toBS key : map toBS fields)) >> recv rs)+ -- | Atomically sets multiple fields within a hash-typed key -- -- ROk returned@@ -1472,7 +1541,7 @@ -- | Get the values of all specified fields from the hash-typed key ----- RMulti filled with RBulk replys returned+-- RMulti filled with RBulk replies returned hmget :: (BS s1, BS s2, BS s3) => Redis -> s1 -- ^ target key@@ -1483,14 +1552,26 @@ -- | Increment the field value within a hash by N -- -- RInt returned with new key value-hincrby :: (BS s1, BS s2) =>+hincrBy :: (BS s1, BS s2) => Redis -> s1 -- ^ target key -> s2 -- ^ field name -> Int -- ^ increment -> IO (Reply Int)-hincrby r key field n = withState r (\rs -> sendCommand rs (CMBulk ["HINCRBY", toBS key, toBS field, toBS n]) >> recv rs)+hincrBy r key field n = withState r (\rs -> sendCommand rs (CMBulk ["HINCRBY", toBS key, toBS field, toBS n]) >> recv rs) +-- | Increment the field value within a hash by N+--+-- (RBulk Double) returned with new key value+hincrByFloat :: (BS s1, BS s2) =>+ Redis+ -> s1 -- ^ target key+ -> s2 -- ^ field name+ -> Double -- ^ increment+ -> IO (Reply Double)+hincrByFloat r key field n = withState r (\rs -> sendCommand rs (CMBulk ["HINCRBYFLOAT", toBS key, toBS field, toBS n]) >> recv rs)++ -- | Test if hash contains the specified field -- -- (RInt 1) returned if fiels exists and (RInt 0) otherwise@@ -1539,13 +1620,13 @@ hgetall r key = withState r (\rs -> sendCommand rs (CMBulk ["HGETALL", toBS key]) >> recv rs) -- | Options data type for the 'sort' command-data BS s => SortOptions s = SortOptions { desc :: Bool, -- ^ sort with descending order- limit :: (Int, Int), -- ^ return (from, to) elements- alpha :: Bool, -- ^ sort alphabetically- sort_by :: s, -- ^ sort by value from this key- get_obj :: [s], -- ^ return this keys values- store :: s -- ^ store result to this key- }+data SortOptions s = SortOptions { desc :: Bool, -- ^ sort with descending order+ limit :: (Int, Int), -- ^ return (from, to) elements+ alpha :: Bool, -- ^ sort alphabetically+ sort_by :: s, -- ^ sort by value from this key+ get_obj :: [s], -- ^ return this keys values+ store :: s -- ^ store result to this key+ } -- | Default options for the 'sort' command sortDefaults :: SortOptions ByteString
Database/Redis/Utils/Lock.hs view
@@ -1,23 +1,6 @@ {--Copyright (c) 2010 Alexander Bogdanov <andorn@gmail.com>--Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:--The above copyright notice and this permission notice shall be included in-all copies or substantial portions of the Software.--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 OR COPYRIGHT HOLDERS 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.+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT -} -- | Emulating locking primitives
Database/Redis/Utils/Monad/Lock.hs view
@@ -1,23 +1,6 @@ {--Copyright (c) 2010 Alexander Bogdanov <andorn@gmail.com>--Permission is hereby granted, free of charge, to any person obtaining a copy-of this software and associated documentation files (the "Software"), to deal-in the Software without restriction, including without limitation the rights-to use, copy, modify, merge, publish, distribute, sublicense, and/or sell-copies of the Software, and to permit persons to whom the Software is-furnished to do so, subject to the following conditions:--The above copyright notice and this permission notice shall be included in-all copies or substantial portions of the Software.--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 OR COPYRIGHT HOLDERS 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.+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT -} -- | Same as "Database.Redis.Utils.Lock" but with monadic wrapped
+ LICENSE view
@@ -0,0 +1,19 @@+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>++Permission is hereby granted, free of charge, to any person obtaining a copy+of this software and associated documentation files (the "Software"), to deal+in the Software without restriction, including without limitation the rights+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell+copies of the Software, and to permit persons to whom the Software is+furnished to do so, subject to the following conditions:++The above copyright notice and this permission notice shall be included in+all copies or substantial portions of the Software.++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 OR COPYRIGHT HOLDERS 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.
Test.hs view
@@ -1,6 +1,16 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}++{-# LANGUAGE CPP #-} module Test where +#if __GLASGOW_HASKELL__ < 702 import System (getArgs)+#else+import System.Environment (getArgs)+#endif import System.Exit (exitFailure, exitSuccess) import System.Environment import System.Console.GetOpt@@ -59,8 +69,10 @@ main :: IO () main = do args <- getArgs+ when (length args == 0) $ do putStrLn $ usageInfo "Usage: " options+ exitSuccess - (opts, label) <- case getOpt RequireOrder options args of+ (opts, label) <- case getOpt Permute options args of (o, l, []) -> let opts = foldl (flip id) defaultOpts o label | null l = Nothing | otherwise = Just $ head l@@ -79,4 +91,4 @@ when (isJust (optBinary opts)) $ startRedis (fromJust $ optBinary opts) (fromJust $ optConfig opts) runTestTT $ toHUnit $ pushParam opts $ mkTests label- when (isJust (optBinary opts)) shutdownRedis+ when (isJust (optBinary opts)) $ shutdownRedis (optHost opts) (optPort opts)
Test/CASCommands.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ module Test.CASCommands where import Test.Setup
Test/Connection.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ module Test.Connection where import Test.Setup
Test/GenericCommands.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ module Test.GenericCommands where import Test.Setup@@ -16,7 +21,8 @@ TLabel "ttl and persist" test_ttl_persist, TLabel "move" test_move, TLabel "flushDb" test_flushDb,- TLabel "flushAll" test_flushAll]+ TLabel "flushAll" test_flushAll,+ TLabel "variadic del" test_variadic_del] test_unwrap_reply = TCase $ const $ let inline = return $ RInline "foo"@@ -160,3 +166,11 @@ dbsize r >>= fromRInt >>= assertEqual "first database was flushed" 0 select r 1 dbsize r >>= fromRInt >>= assertEqual "and the second database too" 0+++test_variadic_del = TCase $ testRedis $+ do r <- ask+ liftIO $ do mSet r [("a", "a"), ("b", "b"), ("c", "c")]+ del_ r ["a", "c"] >>= fromRInt >>= assertEqual "" 2+ Just k <- keys r "*" >>= fromRMultiBulk+ assertEqual "" [Just "b"] k
Test/HashCommands.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ {-# LANGUAGE PackageImports #-} module Test.HashCommands where @@ -13,7 +18,9 @@ TLabel "hlen" test_hlen, TLabel "hexists, hset, hget and hdel" test_hexists_hset_hget_hdel, TLabel "hmset and hmget" test_hmset_hmget,- TLabel "hincrby" test_hincrby]+ TLabel "hincrBy" test_hincrBy,+ TLabel "variadic hdel" test_variadic_hdel,+ TLabel "hincrByFloat" test_hincrByFloat] asHash :: Reply String -> IO (Map String String) asHash r = fromRMultiBulk r >>= return . M.fromList . build . map fromJust . fromJust@@ -85,13 +92,34 @@ h' <- hgetall r "hash" >>= asHash assertEqual "" expected h' -test_hincrby = TCase $ testRedis $+test_hincrBy = TCase $ testRedis $ do r <- ask addHash liftIO $ do h <- hgetall r "hash" >>= asHash >>= return . M.map read :: IO (Map String Int)- res <- hincrby r "hash" "foo" 2 >>= fromRInt+ res <- hincrBy r "hash" "foo" 2 >>= fromRInt assertEqual "" (h ! "foo" + 2) res hget r "hash" "foo" >>= fromRBulk >>= assertEqual "" (Just res)- res <- hincrby r "hash" "foo" (-2) >>= fromRInt+ res <- hincrBy r "hash" "foo" (-2) >>= fromRInt+ assertEqual "" (h ! "foo") res+ hget r "hash" "foo" >>= fromRBulk >>= assertEqual "" (Just res)++test_variadic_hdel = TCase $ testRedis $+ do r <- ask+ addHash+ liftIO $ do res <- hdel_ r "hash" ["foo", "bar", "nope"] >>= fromRInt+ assertEqual "2 fields deleted" 2 res+ res <- hkeys r "hash" >>= fromRMultiBulk >>= return . fromJust+ assertEqual "Only baz field remains" [Just "baz"] res+ res <- hdel_ r "hash" ([] :: [String])+ assertRError "Empty field list leads to error" res++test_hincrByFloat = TCase $ testRedis $+ do r <- ask+ addHash+ liftIO $ do h <- hgetall r "hash" >>= asHash >>= return . M.map read :: IO (Map String Double)+ res <- hincrByFloat r "hash" "foo" 0.2 >>= fromRBulk >>= return . fromJust+ assertEqual "" (h ! "foo" + 0.2) res+ hget r "hash" "foo" >>= fromRBulk >>= assertEqual "" (Just res)+ res <- hincrByFloat r "hash" "foo" (-0.2) >>= fromRBulk >>= return . fromJust assertEqual "" (h ! "foo") res hget r "hash" "foo" >>= fromRBulk >>= assertEqual "" (Just res)
Test/ListCommands.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ module Test.ListCommands where import Prelude hiding ((!!))@@ -16,7 +21,8 @@ TLabel "rpoplpush" test_rpoplpush, TLabel "blpop" test_blpop, TLabel "brpop" test_brpop,- TLabel "brpoplpush" test_brpoplpush]+ TLabel "brpoplpush" test_brpoplpush,+ TLabel "variadic lpush and rpush" test_variadic_lpush_rpush] test_lrange = TCase $ testRedis $ do r <- ask@@ -183,3 +189,10 @@ exists r1 "zap" >>= fromRInt >>= assertEqual "" 0 (brpoplpush r1 "zap" "list" 1 :: IO (Maybe (Maybe String))) >>= assertEqual "" Nothing++test_variadic_lpush_rpush = TCase $ testRedis $+ do r <- ask+ liftIO $ do lpush_ r "list" ["1", "2"]+ rpush_ r "list" ["3", "4"]+ Just list <- lrange r "list" takeAll >>= fromRMultiBulk+ assertEqual "" [Just "2", Just "1", Just "3", Just "4"] list
Test/Lock.hs view
@@ -1,6 +1,10 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ module Test.Lock where import Test.Setup- tests = TList [TLabel "acquire and release" test_acquire_release, TLabel "acquire timeout" test_acquire_timeout]
Test/Monad/CASCommands.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ module Test.Monad.CASCommands where import Database.Redis.Monad
Test/Monad/MultiCommands.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ {-# LANGUAGE ScopedTypeVariables #-} module Test.Monad.MultiCommands where
Test/MultiCommands.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ module Test.MultiCommands where import Test.Setup
Test/PubSubCommands.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ module Test.PubSubCommands where import Test.Setup
Test/SetCommands.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ module Test.SetCommands where import Data.Set@@ -13,7 +18,9 @@ TLabel "srandmember" test_srandmember, TLabel "sinter and sinterStore" test_sinter_sinterstore, TLabel "sunion and sunionStore" test_sunion_sunionstore,- TLabel "sdiff and sdiffStore" test_sdiff_sdiffstore]+ TLabel "sdiff and sdiffStore" test_sdiff_sdiffstore,+ TLabel "variadic sadd" test_variadic_sadd,+ TLabel "variadic srem" test_variadic_srem] asSet :: Reply String -> IO (Set (Maybe String)) asSet r = fromRMultiBulk r >>= return . fromList . fromJust@@ -116,3 +123,17 @@ sdiffStore r "set3" ["set", "set2"] >>= fromRInt >>= assertEqual "" (size s3) smembers r "set3" >>= asSet >>= assertEqual "" s3 sdiffStore r "set3" ["set", "set4"] >>= fromRInt >>= assertEqual "" (size s)++test_variadic_sadd = TCase $ testRedis $+ do r <- ask+ liftIO $ do sadd_ r "set2" ["1", "2", "3"]+ s2 <- smembers r "set2" >>= asSet+ assertEqual "" (fromList [Just "1", Just "2", Just "3"]) s2++test_variadic_srem = TCase $ testRedis $+ do r <- ask+ addSet+ liftIO $ do res <- srem_ r "set" ["1", "3", "5"] >>= fromRInt+ assertEqual "Two elements removed" 2 res+ res <- smembers r "set" >>= asSet+ assertEqual "" (fromList [Just "2"]) res
Test/Setup.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ {-# LANGUAGE FlexibleContexts, PackageImports #-} module Test.Setup ( startRedis,@@ -69,9 +74,9 @@ threadDelay $ 10000 return () -shutdownRedis = do r <- connect localhost defaultPort- shutdown r- return ()+shutdownRedis host port = do r <- connect host port+ shutdown r+ return () testRedis :: (ReaderT Redis IO ()) -> Opts -> IO () testRedis t opts = bracket setup teardown $ runReaderT t
Test/SortCommands.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ module Test.SortCommands where import Data.Char (toUpper)
Test/StringCommands.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ module Test.StringCommands where import Test.Setup@@ -16,7 +21,8 @@ TLabel "setrange" test_setrange, TLabel "getbit" test_getbit, TLabel "setbit" test_setbit,- TLabel "strlen" test_strlen]+ TLabel "strlen" test_strlen,+ TLabel "incrByFloat" test_incrByFloat] test_set_get = TCase $ testRedis $ do r <- ask@@ -58,7 +64,6 @@ test_incr_decr = TCase $ testRedis $ do r <- ask- addStr liftIO $ do set r "i" (0 :: Int) >>= fromROk incr r "i" >>= fromRInt >>= assertEqual "" 1 (get r "i" :: IO (Reply String)) >>= fromRBulk >>= assertEqual "" (Just "1")@@ -124,3 +129,9 @@ addStr liftIO $ do Just foo <- get r "foo" >>= fromRBulk strlen r "foo" >>= fromRInt >>= assertEqual ("lenght of \"" ++ foo ++ "\"" ) (length foo)++test_incrByFloat = TCase $ testRedis $+ do r <- ask+ liftIO $ do set r "a" (1 :: Int) >>= noError+ incrByFloat r "a" 0.2 >>= fromRBulk >>= assertEqual "" (Just (1.0 + 0.2))+ get r "a" >>= fromRBulk >>= assertEqual "" (Just (1.0 + 0.2 :: Double))
Test/Utils.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ {-# LANGUAGE CPP #-} module Test.Utils where
Test/ZSetCommands.hs view
@@ -1,3 +1,8 @@+{-+Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>+License: MIT+-}+ {-# LANGUAGE PackageImports #-} module Test.ZSetCommands where @@ -17,7 +22,8 @@ TLabel "zrank and zrevrank" test_zrank_zrevrank, TLabel "zremrangebyrank" test_zremrangebyrank, TLabel "zunionStore" test_zunionStore,- TLabel "zinterStore" test_zinterStore]+ TLabel "zinterStore" test_zinterStore,+ TLabel "variadic zadd and zrem" test_variadic_zadd_zrem] asZSet :: Reply String -> IO [(String, Double)] asZSet r = fromRMultiBulk r >>= return . build . map fromJust . fromJust@@ -189,3 +195,13 @@ assertEqual "" (length expected) res z' <- zrange r "zset3" takeAll True >>= asZSet assertEqual "" expected z'++test_variadic_zadd_zrem = TCase $ testRedis $+ do r <- ask+ liftIO $ do res <- zadd_ r "zset" (zip (map fromIntegral [1..]) ["1", "2", "3", "4"]) >>= fromRInt+ assertEqual "Four elements added" 4 res+ res <- zrem_ r "zset" ["2", "3", "5"] >>= fromRInt+ assertEqual "Two elements removed" 2 res+ Just res <- zrange r "zset" takeAll True >>= fromRMultiBulk+ assertEqual "" [Just "1", Just "1", Just "4", Just "4"] res+
redis.cabal view
@@ -1,5 +1,5 @@ Name: redis-Version: 0.11+Version: 0.12 License: MIT Maintainer: Alexander Bogdanov <andorn@gmail.com> Author: Alexander Bogdanov <andorn@gmail.com>@@ -11,11 +11,11 @@ key-value store. It is often referred as a data structure server since keys can contain different data structures, such as strings, hashes, lists, sets and sorted sets.- . + . This library is a Haskell driver for Redis. It's tested with- current git version and with v2.2.4 of redis server. It also- tested with v2.0.5 and basic functions are works correctly but not- all of them.+ current git version and with v2.4.6 of redis server. It also+ tested with v2.2 and v2.0 and basic functions are works correctly+ but not all of them. . You can use Test module from the source package to run unit tests. Try /runhaskell Test.hs --help/ for usage info. Caution! Do not@@ -28,28 +28,23 @@ . Please let me know if tests or benchmark goes terribly wrong. .- Changes from v0.10:- .- - Simple optimisation of redis protocol replays parsing that leads to- significant speed improvement on get-like commands- .- - New commandline options for test runner (see above)+ Changes from v0.11: .- - Simple benchmark included (see above)+ - Drop parsec dependency .- - New commands implemented: brpoplpush (blocking rpoplpush),- getrange, setrange, getbit and setbit+ - New commands implemented: incrbyfloat and hincrbyfloat .- - getType reply is now parsed into RedisKeyType datatype instead- of just returning Reply. Warning! It's backward incompatible!+ - Added variadic versions of del, hdel, lpush, rpush, sadd, srem,+ zadd, zrem (named as del_, hdel_ etc.) .- - info reply is now parsed into Map String String. Warning! It's- backward incompatible!+ - Fixed compilation with GHC 7.2 (and hopefully with more recent+ versions too), thanks Ben Gamari and Sean Hess for reporting. . Stability: beta Build-Type: Simple Cabal-Version: >= 1.4+License-File: LICENSE Extra-Source-Files: Test.hs, Test/CASCommands.hs, Test/ListCommands.hs,@@ -65,7 +60,7 @@ Library Build-Depends: base < 5, containers, bytestring, utf8-string,- network, mtl, old-time, MonadCatchIO-mtl, parsec+ network, mtl, old-time, MonadCatchIO-mtl Exposed-modules: Database.Redis.Redis Database.Redis.Monad Database.Redis.ByteStringClass