packages feed

redis 0.2 → 0.3

raw patch · 6 files changed

+643/−468 lines, 6 filesdep +binary

Dependencies added: binary

Files

+ Database/Redis/ByteStringClass.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+module Database.Redis.ByteStringClass where++import Prelude hiding (concat)+import Data.ByteString+import qualified Data.ByteString.Lazy as L+import qualified Data.ByteString.UTF8 as U+import Data.Binary++-- | Utility class for conversion to and from Strict ByteString+class BS a where+    toBS   :: a -> ByteString+    fromBS :: ByteString -> a++instance BS ByteString where+    toBS   = id+    fromBS = id++instance BS L.ByteString where+    toBS   = concat . L.toChunks . encode+    fromBS = decode . L.fromChunks . return++instance BS String where+    toBS   = U.fromString+    fromBS = U.toString++instance BS Int where+    toBS   = U.fromString . show+    fromBS = read . U.toString++instance BS Double where+    toBS   = U.fromString . show+    fromBS = read . U.toString++instance BS () where+    toBS   = const empty+    fromBS = const ()
Database/Redis/Monad.hs view
@@ -53,7 +53,7 @@        set, setNx, mSet, mSetNx,        get, getSet, mGet,        incr, incrBy, decr,-       decrBy, append,+       decrBy, append, substr,         -- ** Lists        rpush, lpush, llen, lrange, ltrim,@@ -69,6 +69,7 @@        zadd, zrem, zincrBy, zrange,        zrevrange, zrangebyscore, zcount,        zremrangebyscore, zcard, zscore,+       zrank,         -- ** Sorting        sort, listRelated,@@ -85,6 +86,7 @@  import qualified Database.Redis.Redis as R import Database.Redis.Redis (IsInterval)+import Database.Redis.ByteStringClass  class MonadIO m => WithRedis m where     getRedis :: m (R.Redis)@@ -99,280 +101,288 @@ isConnected :: WithRedis m => m Bool isConnected = getRedis >>= liftIO . R.isConnected -ping :: WithRedis m => m R.Reply+ping :: WithRedis m => m (R.Reply ()) ping = getRedis >>= liftIO . R.ping -auth :: WithRedis m => String -> m R.Reply+auth :: WithRedis m => String -> m (R.Reply ()) auth pwd = getRedis >>= liftIO . flip R.auth pwd  quit :: WithRedis m => m () quit = getRedis >>= liftIO . R.quit -shutdown :: WithRedis m => m R.Reply+shutdown :: WithRedis m => m () shutdown = getRedis >>= liftIO . R.shutdown -multi :: WithRedis m => m R.Reply+multi :: WithRedis m => m (R.Reply ()) multi = getRedis >>= liftIO . R.multi -exec :: WithRedis m => m R.Reply+exec :: (WithRedis m, BS s) => m (R.Reply s) exec = getRedis >>= liftIO . R.exec -discard :: WithRedis m => m R.Reply+discard :: WithRedis m => m (R.Reply ()) discard = getRedis >>= liftIO . R.discard -run_multi :: WithRedis m => [m R.Reply] -> m R.Reply+run_multi :: (WithRedis m, BS s) => [m (R.Reply ())] -> m (R.Reply s) run_multi cs = let cs' = map (>>= R.noError) cs                in do multi                      sequence_ cs'                      exec -exists :: WithRedis m => String -> m R.Reply+exists :: (WithRedis m, BS s) => s -> m (R.Reply Int) exists key = getRedis >>= liftIO . flip R.exists key -del :: WithRedis m => String -> m R.Reply+del :: (WithRedis m, BS s) => s -> m (R.Reply Int) del key = getRedis >>= liftIO . flip R.del key -getType :: WithRedis m => String -> m R.Reply+getType :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2) getType key = getRedis >>= liftIO . flip R.getType key -keys :: WithRedis m => String -> m R.Reply+keys :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2) keys pattern = getRedis >>= liftIO . flip R.keys pattern -randomKey :: WithRedis m => m R.Reply+randomKey :: (WithRedis m, BS s) => m (R.Reply s) randomKey = getRedis >>= liftIO . R.randomKey -rename :: WithRedis m => String -> String -> m R.Reply+rename :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply ()) rename from to = do r <- getRedis                     liftIO $ R.rename r from to -renameNx :: WithRedis m => String -> String -> m R.Reply+renameNx :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int) renameNx from to = do r <- getRedis                       liftIO $ R.renameNx r from to -dbsize :: WithRedis m => m R.Reply+dbsize :: WithRedis m => m (R.Reply Int) dbsize = getRedis >>= liftIO . R.dbsize -expire :: WithRedis m => String -> Int -> m R.Reply+expire :: (WithRedis m, BS s) => s -> Int -> m (R.Reply Int) expire key seconds = do r <- getRedis                         liftIO $ R.expire r key seconds -expireAt :: WithRedis m => String -> Int -> m R.Reply+expireAt :: (WithRedis m, BS s) => s -> Int -> m (R.Reply Int) expireAt key timestamp = do r <- getRedis                             liftIO $ R.expireAt r key timestamp -ttl :: WithRedis m => String -> m R.Reply+ttl :: (WithRedis m, BS s) => s -> m (R.Reply Int) ttl key = getRedis >>= liftIO . flip R.ttl key -select :: WithRedis m => Int -> m R.Reply+select :: WithRedis m => Int -> m (R.Reply ()) select db = getRedis >>= liftIO . flip R.select db -move :: WithRedis m => String -> Int -> m R.Reply+move :: (WithRedis m, BS s) => s -> Int -> m (R.Reply Int) move key db = do r <- getRedis                  liftIO $ R.move r key db -flushDb :: WithRedis m => m R.Reply+flushDb :: WithRedis m => m (R.Reply ()) flushDb = getRedis >>= liftIO . R.flushDb -flushAll :: WithRedis m => m R.Reply+flushAll :: WithRedis m => m (R.Reply ()) flushAll = getRedis >>= liftIO . R.flushAll -info :: WithRedis m => m R.Reply+info :: (WithRedis m, BS s) => m (R.Reply s) info = getRedis >>= liftIO . R.info -set :: WithRedis m => String -> String -> m R.Reply+set :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply ()) set key val = do r <- getRedis                  liftIO $ R.set r key val -setNx :: WithRedis m => String -> String -> m R.Reply+setNx :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int) setNx key val = do r <- getRedis                    liftIO $ R.setNx r key val -mSet :: WithRedis m => [(String, String)] -> m R.Reply+mSet :: (WithRedis m, BS s1, BS s2) => [(s1, s2)] -> m (R.Reply ()) mSet ks = getRedis >>= liftIO . flip R.mSet ks -mSetNx :: WithRedis m => [(String, String)] -> m R.Reply+mSetNx :: (WithRedis m, BS s1, BS s2) => [(s1, s2)] -> m (R.Reply Int) mSetNx ks = getRedis >>= liftIO . flip R.mSetNx ks -get :: WithRedis m => String -> m R.Reply+get :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2) get key = getRedis >>= liftIO . flip R.get key -getSet :: WithRedis m => String -> String -> m R.Reply+getSet :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> s2 -> m (R.Reply s3) getSet key val = do r <- getRedis                     liftIO $ R.getSet r key val -mGet :: WithRedis m => [String] -> m R.Reply+mGet :: (WithRedis m, BS s1, BS s2) => [s1] -> m (R.Reply s2) mGet keys = getRedis >>= liftIO . flip R.mGet keys -incr :: WithRedis m => String -> m R.Reply+incr :: (WithRedis m, BS s) => s -> m (R.Reply Int) incr key = getRedis >>= liftIO . flip R.incr key -incrBy :: WithRedis m => String -> Int -> m R.Reply+incrBy :: (WithRedis m, BS s) => s -> Int -> m (R.Reply Int) incrBy key n = do r <- getRedis                   liftIO $ R.incrBy r key n -decr :: WithRedis m => String -> m R.Reply+decr :: (WithRedis m, BS s) => s -> m (R.Reply Int) decr key = getRedis >>= liftIO . flip R.decr key -decrBy :: WithRedis m => String -> Int -> m R.Reply+decrBy :: (WithRedis m, BS s) => s -> Int -> m (R.Reply Int) decrBy key n = do r <- getRedis                   liftIO $ R.decrBy r key n -append :: WithRedis m => String -> String -> m R.Reply+append :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int) append key str = do r <- getRedis                     liftIO $ R.append r key str -rpush :: WithRedis m => String -> String -> m R.Reply+substr :: (WithRedis m, BS s1, BS s2) => s1 -> (Int, Int) -> m (R.Reply s2)+substr key range = do r <- getRedis+                      liftIO $ R.substr r key range++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 -lpush :: WithRedis m => String -> String -> m R.Reply+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 -llen :: WithRedis m => String -> m R.Reply+llen :: (WithRedis m, BS s) => s -> m (R.Reply Int) llen key = getRedis >>= liftIO . flip R.llen key -lrange :: WithRedis m => String -> (Int, Int) -> m R.Reply+lrange :: (WithRedis m, BS s1, BS s2) => s1 -> (Int, Int) -> m (R.Reply s2) lrange key limit = do r <- getRedis                       liftIO $ R.lrange r key limit -ltrim :: WithRedis m => String -> (Int, Int) -> m R.Reply+ltrim :: (WithRedis m, BS s) => s -> (Int, Int) -> m (R.Reply ()) ltrim key limit = do r <- getRedis                      liftIO $ R.ltrim r key limit -lindex :: WithRedis m => String -> Int -> m R.Reply+lindex :: (WithRedis m, BS s1, BS s2) => s1 -> Int -> m (R.Reply s2) lindex key index = do r <- getRedis                       liftIO $ R.lindex r key index -lset :: WithRedis m => String -> Int -> String -> m R.Reply+lset :: (WithRedis m, BS s1, BS s2) => s1 -> Int -> s2 -> m (R.Reply ()) lset key index val = do r <- getRedis                         liftIO $ R.lset r key index val -lrem :: WithRedis m => String -> Int -> String -> m R.Reply+lrem :: (WithRedis m, BS s1, BS s2) => s1 -> Int -> s2 -> m (R.Reply Int) lrem key count value = do r <- getRedis                           liftIO $ R.lrem r key count value -lpop :: WithRedis m => String -> m R.Reply+lpop :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2) lpop key = getRedis >>= liftIO . flip R.lpop key -rpop :: WithRedis m => String -> m R.Reply+rpop :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2) rpop key = getRedis >>= liftIO . flip R.rpop key -rpoplpush :: WithRedis m => String -> String -> m R.Reply+rpoplpush :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> s2 -> m (R.Reply s3) rpoplpush src dst = do r <- getRedis                        liftIO $ R.rpoplpush r src dst -blpop :: WithRedis m => [String] -> Int -> m R.Reply+blpop :: (WithRedis m, BS s1, BS s2) => [s1] -> Int -> m (R.Reply s2) blpop keys timeout = do r <- getRedis                         liftIO $ R.blpop r keys timeout -brpop :: WithRedis m => [String] -> Int -> m R.Reply+brpop :: (WithRedis m, BS s1, BS s2) => [s1] -> Int -> m (R.Reply s2) brpop keys timeout = do r <- getRedis                         liftIO $ R.brpop r keys timeout -sadd :: WithRedis m => String -> String -> m R.Reply+sadd :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int) sadd key val = do r <- getRedis                   liftIO $ R.sadd r key val -srem :: WithRedis m => String -> String -> m R.Reply+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 -spop :: WithRedis m => String -> m R.Reply+spop :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2) spop key = getRedis >>= liftIO . flip R.spop key -smove :: WithRedis m => String -> String -> String -> m R.Reply+smove :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> s2 -> s3 -> m (R.Reply Int) smove src dst member = do r <- getRedis                           liftIO $ R.smove r src dst member -scard :: WithRedis m => String -> m R.Reply+scard :: (WithRedis m, BS s) => s -> m (R.Reply Int) scard key = getRedis >>= liftIO . flip R.scard key -sismember :: WithRedis m => String -> m R.Reply+sismember :: (WithRedis m, BS s) => s -> m (R.Reply Int) sismember key = getRedis >>= liftIO . flip R.sismember key -smembers :: WithRedis m => String -> m R.Reply+smembers :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2) smembers key = getRedis >>= liftIO . flip R.smembers key -srandmember :: WithRedis m => String -> m R.Reply+srandmember :: (WithRedis m, BS s1, BS s2) => s1 -> m (R.Reply s2) srandmember key = getRedis >>= liftIO . flip R.srandmember key -sinter :: WithRedis m => [String] -> m R.Reply+sinter :: (WithRedis m, BS s1, BS s2) => [s1] -> m (R.Reply s2) sinter key = getRedis >>= liftIO . flip R.sinter key -sinterStore :: WithRedis m => String -> [String] -> m R.Reply+sinterStore :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> m (R.Reply ()) sinterStore dst keys = do r <- getRedis                           liftIO $ R.sinterStore r dst keys -sunion :: WithRedis m => [String] -> m R.Reply+sunion :: (WithRedis m, BS s1, BS s2) => [s1] -> m (R.Reply s2) sunion keys = getRedis >>= liftIO . flip R.sunion keys -sunionStore :: WithRedis m => String -> [String] -> m R.Reply+sunionStore :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> m (R.Reply ()) sunionStore dst keys = do r <- getRedis                           liftIO $ R.sunionStore r dst keys -sdiff :: WithRedis m => [String] -> m R.Reply+sdiff :: (WithRedis m, BS s1, BS s2) => [s1] -> m (R.Reply s2) sdiff keys = getRedis >>= liftIO . flip R.sdiff keys -sdiffStore :: WithRedis m => String -> [String] -> m R.Reply+sdiffStore :: (WithRedis m, BS s1, BS s2) => s1 -> [s2] -> m (R.Reply ()) sdiffStore dst keys = do r <- getRedis                          liftIO $ R.sdiffStore r dst keys -zadd :: WithRedis m => String -> Double -> String -> m R.Reply+zadd :: (WithRedis m, BS s1, BS s2) => s1 -> Double -> s2 -> m (R.Reply Int) zadd key score member = do r <- getRedis                            liftIO $ R.zadd r key score member -zrem :: WithRedis m => String -> String -> m R.Reply+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 -zincrBy :: WithRedis m => String -> Double -> String -> m R.Reply+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 -zrange :: WithRedis m => String -> (Int, Int) -> Bool -> m R.Reply+zrange :: (WithRedis m, BS s1, BS s2) => s1 -> (Int, Int) -> Bool -> m (R.Reply s2) zrange key limit withscores = do r <- getRedis                                  liftIO $ R.zrange r key limit withscores -zrevrange :: WithRedis m => String -> (Int, Int) -> Bool -> m R.Reply+zrevrange :: (WithRedis m, BS s1, BS s2) => s1 -> (Int, Int) -> Bool -> m (R.Reply s2) zrevrange key limit withscores = do r <- getRedis                                     liftIO $ R.zrevrange r key limit withscores -zrangebyscore :: (WithRedis m, IsInterval i Double) => String -> i -> Bool -> m R.Reply+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 -zcount :: (WithRedis m, IsInterval i Double) => String -> i -> m R.Reply+zcount :: (WithRedis m, IsInterval i Double, BS s) => s -> i -> m (R.Reply Int) zcount key limit = do r <- getRedis                       liftIO $ R.zcount r key limit -zremrangebyscore :: WithRedis m => String -> (Double, Double) -> m R.Reply+zremrangebyscore :: (WithRedis m, BS s) => s -> (Double, Double) -> m (R.Reply Int) zremrangebyscore key limit = do r <- getRedis                                 liftIO $ R.zremrangebyscore r key limit -zcard :: WithRedis m => String -> m R.Reply+zcard :: (WithRedis m, BS s) => s -> m (R.Reply Int) zcard key = getRedis >>= liftIO . flip R.zcard key -zscore :: WithRedis m => String -> String -> m R.Reply+zscore :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> s2 -> m (R.Reply s3) zscore key member = do r <- getRedis                        liftIO $ R.zscore r key member -sort :: WithRedis m => String -> R.SortOptions -> m R.Reply+zrank :: (WithRedis m, BS s1, BS s2) => s1 -> s2 -> m (R.Reply Int)+zrank key member = do r <- getRedis+                      liftIO $ R.zrank r key member++sort :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> R.SortOptions s2 -> m (R.Reply s3) sort key opt = do r <- getRedis                   liftIO $ R.sort r key opt -listRelated :: WithRedis m => String -> String -> (Int, Int) -> m R.Reply+listRelated :: (WithRedis m, BS s1, BS s2, BS s3) => s1 -> s2 -> (Int, Int) -> m (R.Reply s3) listRelated related key l = do r <- getRedis                                liftIO $ R.listRelated r related key l -save :: WithRedis m => m R.Reply+save :: WithRedis m => m (R.Reply ()) save = getRedis >>= liftIO . R.save -bgsave :: WithRedis m => m R.Reply+bgsave :: WithRedis m => m (R.Reply ()) bgsave = getRedis >>= liftIO . R.bgsave -lastsave :: WithRedis m => m R.Reply+lastsave :: WithRedis m => m (R.Reply Int) lastsave = getRedis >>= liftIO . R.lastsave -bgrewriteaof :: WithRedis m => m R.Reply+bgrewriteaof :: WithRedis m => m (R.Reply ()) bgrewriteaof = getRedis >>= liftIO . R.bgrewriteaof
Database/Redis/Redis.hs view
@@ -20,7 +20,8 @@ THE SOFTWARE. -} -{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies, FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, FunctionalDependencies,+  FlexibleContexts, OverloadedStrings #-}  -- | Main Redis API and protocol implementation module Database.Redis.Redis (@@ -51,7 +52,7 @@        set, setNx, mSet, mSetNx,        get, getSet, mGet,        incr, incrBy, decr,-       decrBy, append,+       decrBy, append, substr,         -- ** Lists        rpush, lpush, llen, lrange, ltrim,@@ -67,6 +68,7 @@        zadd, zrem, zincrBy, zrange,        zrevrange, zrangebyscore, zcount,        zremrangebyscore, zcard, zscore,+       zrank,         -- ** Sorting        sort, listRelated,@@ -76,12 +78,21 @@ ) where +import Prelude hiding (putStrLn) import qualified Network.Socket as S import qualified System.IO as IO+import System.IO.UTF8 (putStrLn) import qualified Data.ByteString as B+import Data.ByteString (ByteString)+import Data.ByteString.Char8 () import qualified Data.ByteString.UTF8 as U import Data.Maybe (fromJust)+import Data.List (intersperse) +import Database.Redis.ByteStringClass++tracebs bs = putStrLn (U.toString bs)+ -- | Redis connection descriptor data Redis = Redis { server   :: (String, String), -- ^ hostname and port pair                      handle :: IO.Handle           -- ^ real network connection@@ -89,27 +100,44 @@                 deriving (Show, Eq)  -- | Redis command variants-data Command = CInline String-             | CMInline [String]-             | CBulk [String] String-             | CMBulk [String]+data Command = CInline ByteString+             | CMInline [ByteString]+             | CBulk [ByteString] ByteString+             | CMBulk [ByteString]  -- | Redis reply variants-data Reply = RTimeout               -- ^ Timeout. Currently unused-           | ROk                    -- ^ \"Ok\" reply-           | RPong                  -- ^ Reply for the ping command-           | RQueued                -- ^ Used inside multi-exec block-           | RError String          -- ^ Some kind of server-side error-           | RInline String         -- ^ Simple oneline reply-           | RInt Int               -- ^ Integer reply-           | RBulk (Maybe String)   -- ^ Multiline reply-           | RMulti (Maybe [Reply]) -- ^ Complex reply. It may consists of various type of replys-             deriving (Show, Eq)+data BS s => Reply s = RTimeout               -- ^ Timeout. Currently unused+                     | 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++instance BS s => Show (Reply s) where+    show RTimeout = "RTimeout"+    show ROk = "ROk"+    show RPong = "RPong"+    show RQueued = "RQueued"+    show (RError msg) = "RError: " ++ msg+    show (RInline s) = "RInline (" ++ (showbs s) ++ ")"+    show (RInt a) = "RInt " ++ show a+    show (RBulk (Just s)) = "RBulk " ++ showbs s+    show (RBulk Nothing) = "RBulk Nothing"+    show (RMulti (Just rs)) = "RMulti [" ++ join rs ++ "]"+                              where join = concat . intersperse ", " . map show+    show (RMulti Nothing) = "[]"+ -- | Unwraps RInline reply. -- -- Throws an exception when called with something different from RInline-fromRInline :: (Monad m) => Reply -> m String+fromRInline :: (Monad m, BS s) => Reply s -> m s fromRInline reply = case reply of                       RError msg -> error msg                       RInline s  -> return s@@ -118,7 +146,7 @@ -- | Unwraps RBulk reply. -- -- Throws an exception when called with something different from RBulk-fromRBulk :: (Monad m) => Reply -> m (Maybe String)+fromRBulk :: (Monad m, BS s) => Reply s -> m (Maybe s) fromRBulk reply = case reply of                     RError msg -> error msg                     RBulk s    -> return s@@ -127,7 +155,7 @@ -- | Unwraps RMulti reply -- -- Throws an exception when called with something different from RMulti-fromRMulti :: (Monad m) => Reply -> m (Maybe [Reply])+fromRMulti :: (Monad m, BS s) => Reply s -> m (Maybe [Reply s]) fromRMulti reply = case reply of                      RError msg -> error msg                      RMulti ss  -> return ss@@ -136,13 +164,13 @@ -- | Unwraps RMulti reply filled with RBulk -- -- Throws an exception when called with something different from RMulti-fromRMultiBulk :: (Monad m) => Reply -> m (Maybe [Maybe String])+fromRMultiBulk :: (Monad m, BS s) => Reply s -> m (Maybe [Maybe s]) fromRMultiBulk reply = fromRMulti reply >>= return . (>>= sequence . map fromRBulk)  -- | Unwraps RInt reply -- -- Throws an exception when called with something different from RInt-fromRInt :: (Monad m) => Reply -> m Int+fromRInt :: (Monad m, BS s) => Reply s -> m Int fromRInt reply = case reply of                    RError msg -> error msg                    RInt n     -> return n@@ -151,7 +179,7 @@ -- | Unwraps ROk reply -- -- Throws an exception when called with something different from ROk-fromROk :: (Monad m) => Reply -> m ()+fromROk :: (Monad m, BS s) => Reply s -> m () fromROk reply = case reply of                    RError msg -> error msg                    ROk        -> return ()@@ -160,7 +188,7 @@ -- | Unwraps every non-error reply -- -- Throws an exception when called with something different from RMulti-noError :: (Monad m) => Reply -> m ()+noError :: (Monad m, BS s) => Reply s -> m () noError reply = case reply of                    RError msg -> error msg                    _          -> return ()@@ -210,86 +238,82 @@ isConnected = IO.hIsOpen . handle  {- ================ Private =============== -}-send :: IO.Handle -> [String] -> IO ()+send :: IO.Handle -> [ByteString] -> IO () send h [] = return ()-send h (s:ls) = let bs = U.fromString s-                in B.hPut h bs >> B.hPut h uspace >> send h ls+send h (bs:ls) = B.hPut h bs >> B.hPut h uspace >> send h ls  sendCommand :: Redis -> Command -> IO ()-sendCommand r (CInline s) = let h = handle r-                                bs = U.fromString s-                            in B.hPut h bs >> hPutRn h >> IO.hFlush h+sendCommand r (CInline bs) = let h = handle r+                             in B.hPut h bs >> hPutRn h >> IO.hFlush h sendCommand r (CMInline ls) = let h = handle r                               in send h ls >> hPutRn h >> IO.hFlush h-sendCommand r (CBulk lcmd s) = let h = handle r-                                   bs = U.fromString s-                                   size = U.fromString $ show $ B.length bs-                               in do send h lcmd-                                     B.hPut h uspace-                                     B.hPut h size-                                     hPutRn h-                                     B.hPut h bs-                                     hPutRn h-                                     IO.hFlush h+sendCommand r (CBulk lcmd bs) = let h = handle r+                                    size = U.fromString $ show $ B.length bs+                                in do send h lcmd+                                      B.hPut h uspace+                                      B.hPut h size+                                      hPutRn h+                                      B.hPut h bs+                                      hPutRn h+                                      IO.hFlush h sendCommand r (CMBulk strings) = let h = handle r                                      sendls [] = return ()-                                     sendls (l:ls) = let bs = U.fromString l-                                                         size = U.fromString . show . B.length-                                                     in do B.hPut h ubucks-                                                           B.hPut h $ size bs-                                                           hPutRn h-                                                           B.hPut h bs-                                                           hPutRn h-                                                           sendls ls+                                     sendls (bs:ls) = let size = U.fromString . show . B.length+                                                      in do B.hPut h ubucks+                                                            B.hPut h $ size bs+                                                            hPutRn h+                                                            B.hPut h bs+                                                            hPutRn h+                                                            sendls ls                                  in do B.hPut h uasterisk                                        B.hPut h $ U.fromString $ show $ length strings                                        hPutRn h                                        sendls strings                                        IO.hFlush h -recv :: Redis -> IO Reply-recv r = do first <- bsToStr `fmap` B.hGetLine h-            case first of-              ('-':rest)  -> recv_err rest-              ('+':rest)  -> recv_inline rest-              (':':rest)  -> recv_int rest-              ('$':rest)  -> recv_bulk rest-              ('*':rest)  -> recv_multi rest+recv :: BS s => Redis -> IO (Reply s)+recv r = do first <- trim `fmap` B.hGetLine h+            case U.uncons first of+              Just ('-', rest)  -> recv_err rest+              Just ('+', rest)  -> recv_inline rest+              Just (':', rest)  -> recv_int rest+              Just ('$', rest)  -> recv_bulk rest+              Just ('*', rest)  -> recv_multi rest     where       h = handle r-      bsToStr = (takeWhile (\c -> c /= '\r' && c /= '\n')) . U.toString+      trim = B.takeWhile (\c -> c /= 13 && c /= 10) -      recv_err :: String -> IO Reply-      recv_err rest = return $ RError rest+      -- recv_err :: ByteString -> IO Reply+      recv_err rest = return $ RError $ U.toString rest -      recv_inline :: String -> IO Reply+      -- recv_inline :: ByteString -> IO Reply       recv_inline rest = return $ case rest of                                     "OK"       -> ROk                                     "PONG"     -> RPong                                     "QUEUED"   -> RQueued-                                    _          -> RInline rest+                                    _          -> RInline $ fromBS rest -      recv_int :: String -> IO Reply-      recv_int rest = let reply = read rest :: Int+      -- recv_int :: ByteString -> IO Reply+      recv_int rest = let reply = read (U.toString rest) :: Int                       in return $ RInt reply -      recv_bulk :: String -> IO Reply-      recv_bulk rest = let size = read rest :: Int+      -- recv_bulk :: ByteString -> IO Reply+      recv_bulk rest = let size = read (U.toString rest) :: Int                        in do body <- recv_bulk_body size-                             return $ RBulk body+                             return $ RBulk (fromBS `fmap` body) -      recv_bulk_body :: Int -> IO (Maybe String)+      -- recv_bulk_body :: Int -> IO (Maybe ByteString)       recv_bulk_body (-1) = return Nothing       recv_bulk_body size = do body <- B.hGet h (size + 2)-                               let reply = U.toString $ B.take size body+                               let reply = B.take size body                                return $ Just reply -      recv_multi :: String -> IO Reply-      recv_multi rest = let cnt = read rest :: Int+      -- recv_multi :: ByteString -> IO Reply+      recv_multi rest = let cnt = read (U.toString rest) :: Int                         in do bulks <- recv_multi_n cnt                               return $ RMulti bulks -      recv_multi_n :: Int -> IO (Maybe [Reply])+      -- recv_multi_n :: Int -> IO (Maybe [Reply])       recv_multi_n (-1) = return Nothing       recv_multi_n 0    = return $ Just []       recv_multi_n n = do this <- recv r@@ -300,49 +324,51 @@ -- | ping - pong -- -- RPong returned if no errors happends-ping :: Redis -> IO Reply+ping :: Redis -> IO (Reply ()) ping r = sendCommand r (CInline "PING") >> recv r  -- | Password authentication -- -- ROk returned-auth :: Redis-     -> String                  -- ^ password-     -> IO Reply-auth r pwd = sendCommand r (CMInline ["AUTH", pwd] ) >> recv r+auth :: BS s =>+        Redis+     -> s                       -- ^ password+     -> IO (Reply ())+auth r pwd = sendCommand r (CMInline ["AUTH", toBS pwd] ) >> recv r  -- | Quit and close connection quit :: Redis -> IO () quit r = sendCommand r (CInline "QUIT") >> disconnect r  -- | Stop all the clients, save the DB, then quit the server-shutdown :: Redis -> IO Reply-shutdown r = sendCommand r (CInline "SHUTDOWN") >> recv r+shutdown :: Redis -> IO ()+shutdown r = sendCommand r (CInline "SHUTDOWN") >> disconnect r  -- | Begin the multi-exec block -- -- ROk returned-multi :: Redis -> IO Reply+multi :: Redis -> IO (Reply ()) multi r = sendCommand r (CInline "MULTI") >> recv r  -- | Execute queued commands -- -- RMulti returned - replys for all executed commands-exec :: Redis -> IO Reply+exec :: BS s => Redis -> IO (Reply s) exec r = sendCommand r (CInline "EXEC") >> recv r  -- | Discard queued commands without execution -- -- ROk returned-discard :: Redis -> IO Reply+discard :: Redis -> IO (Reply ()) discard r = sendCommand r (CInline "DISCARD") >> recv r  -- | Run commands within multi-exec block -- -- RMulti returned - replys for all executed commands-run_multi :: Redis-          -> [IO Reply]         -- ^ IO actions to run-          -> IO Reply+run_multi :: (BS s) =>+             Redis+          -> [IO (Reply ())]    -- ^ IO actions to run+          -> IO (Reply s) run_multi r cs = let cs' = map (>>= noError) cs                  in do multi r                        sequence_ cs'@@ -351,63 +377,69 @@ -- | Test if the key exists -- -- (RInt 1) returned if the key exists and (RInt 0) otherwise-exists :: Redis-       -> String                -- ^ target key-       -> IO Reply-exists r key = sendCommand r (CMBulk ["EXISTS", key]) >> recv r+exists :: BS s =>+          Redis+       -> s                     -- ^ target key+       -> IO (Reply Int)+exists r key = sendCommand r (CMBulk ["EXISTS", toBS key]) >> recv r  -- | Remove the key -- -- (RInt 0) returned if no keys were removed or (RInt n) with removed keys count-del :: Redis-    -> String                   -- ^ target key-    -> IO Reply-del r key = sendCommand r (CMBulk ["DEL", key]) >> recv r+del :: BS s =>+       Redis+    -> s                        -- ^ target key+    -> IO (Reply Int)+del r key = sendCommand r (CMBulk ["DEL", toBS key]) >> recv r  -- | Return the type of the value stored at key in form of a string -- -- RInline with one of "none", "string", "list", "set", "zset" returned-getType :: Redis-        -> String               -- ^ target key-        -> IO Reply-getType r key = sendCommand r (CMBulk ["TYPE", key]) >> recv r+getType :: (BS s1, BS s2) =>+           Redis+        -> s1                   -- ^ target key+        -> IO (Reply s2)+getType r key = sendCommand r (CMBulk ["TYPE", toBS key]) >> recv r  -- | Returns all the keys matching the glob-style pattern -- -- RMulti filled with RBulk returned-keys :: Redis-     -> String                  -- ^ target keys pattern-     -> IO Reply-keys r pattern = sendCommand r (CMInline ["KEYS", pattern]) >> recv r+keys :: (BS s1, BS s2) =>+        Redis+     -> s1                      -- ^ target keys pattern+     -> IO (Reply s2)+keys r pattern = sendCommand r (CMInline ["KEYS", toBS pattern]) >> recv r  -- | Return random key name -- -- RInline returned-randomKey :: Redis -> IO Reply+randomKey :: BS s => Redis -> IO (Reply s) randomKey r = sendCommand r (CInline "RANDOMKEY") >> recv r  -- | Rename the key. If key with that name exists it'll be overwritten. -- -- ROk returned-rename :: Redis-       -> String                -- ^ source key-       -> String                -- ^ destination key-       -> IO Reply-rename r from to = sendCommand r (CMBulk ["RENAME", from, to]) >> recv r+rename :: (BS s1, BS s2) =>+          Redis+       -> s1                    -- ^ source key+       -> s2                    -- ^ destination key+       -> IO (Reply ())+rename r from to = sendCommand r (CMBulk ["RENAME", toBS from, toBS to]) >> recv r  -- | Rename the key if no keys with destination name exists. -- -- (RInt 1) returned if key was renamed and (RInt 0) otherwise-renameNx :: Redis-         -> String              -- ^ source key-         -> String              -- ^ destination key-         -> IO Reply-renameNx r from to = sendCommand r (CMBulk ["RENAMENX", from, to]) >> recv r+renameNx :: (BS s1, BS s2) =>+            Redis+         -> s1                  -- ^ source key+         -> s2                  -- ^ destination key+         -> IO (Reply Int)+renameNx r from to = sendCommand r (CMBulk ["RENAMENX", toBS from, toBS to]) >> recv r  -- | Get the number of keys in the currently selected database -- -- RInt returned-dbsize :: Redis -> IO Reply+dbsize :: Redis -> IO (Reply Int) dbsize r = sendCommand r (CInline "DBSIZE") >> recv r  -- | Set an expiration timeout in seconds on the specified key.@@ -415,61 +447,65 @@ -- For more information see <http://code.google.com/p/redis/wiki/ExpireCommand> -- -- (RInt 1) returned if timeout was set and (RInt 0) otherwise-expire :: Redis-       -> String                -- ^ target key+expire :: BS s =>+          Redis+       -> s                     -- ^ target key        -> Int                   -- ^ timeout in seconds-       -> IO Reply-expire r key seconds = sendCommand r (CMBulk ["EXPIRE", key, show seconds]) >> recv r+       -> IO (Reply Int)+expire r key seconds = sendCommand r (CMBulk ["EXPIRE", toBS key, toBS seconds]) >> recv r  -- | Set an expiration time in form of UNIX timestamp on the specified key -- -- For more information see <http://code.google.com/p/redis/wiki/ExpireCommand> -- -- (RInt 1) returned if timeout was set and (RInt 0) otherwise-expireAt :: Redis-         -> String              -- ^ target key+expireAt :: BS s =>+            Redis+         -> s                   -- ^ target key          -> Int                 -- ^ timeout in seconds-         -> IO Reply-expireAt r key timestamp = sendCommand r (CMBulk ["EXPIRE", key, show timestamp]) >> recv r+         -> IO (Reply Int)+expireAt r key timestamp = sendCommand r (CMBulk ["EXPIRE", toBS key, toBS timestamp]) >> recv r  -- | Return the remining time to live of the key or -1 if key has no -- associated timeout -- -- RInt returned-ttl :: Redis-    -> String                   -- ^ target key-    -> IO Reply-ttl r key = sendCommand r (CMBulk ["TTL", key]) >> recv r+ttl :: BS s =>+       Redis+    -> s                        -- ^ target key+    -> IO (Reply Int)+ttl r key = sendCommand r (CMBulk ["TTL", toBS key]) >> recv r  -- | Select the DB with the specified zero-based numeric index -- -- ROk returned select :: Redis        -> Int                   -- ^ database number-       -> IO Reply-select r db = sendCommand r (CMInline ["SELECT", show db]) >> recv r+       -> IO (Reply ())+select r db = sendCommand r (CMInline ["SELECT", toBS db]) >> recv r  -- | Move the specified key from the currently selected DB to the -- specified destination DB. If such a key is already exists in the -- target DB no data modification performed. -- -- (RInt 1) returned if the key was moved and (RInt 0) otherwise-move :: Redis-     -> String                  -- ^ target key+move :: BS s =>+        Redis+     -> s                       -- ^ target key      -> Int                     -- ^ destination database number-     -> IO Reply-move r key db = sendCommand r (CMBulk ["MOVE", key, show db]) >> recv r+     -> IO (Reply Int)+move r key db = sendCommand r (CMBulk ["MOVE", toBS key, toBS db]) >> recv r  -- | Delete all the keys of the currently selected DB -- -- ROk returned-flushDb :: Redis -> IO Reply+flushDb :: Redis -> IO (Reply ()) flushDb r = sendCommand r (CInline "FLUSHDB") >> recv r  -- | Delete all the keys of all the existing databases -- -- ROk returned-flushAll :: Redis -> IO Reply+flushAll :: Redis -> IO (Reply ()) flushAll r = sendCommand r (CInline "FLUSHALL") >> recv r  -- | Returns different information and statistics about the server@@ -477,143 +513,170 @@ -- for more information see <http://code.google.com/p/redis/wiki/InfoCommand> -- -- RBulk returned-info :: Redis -> IO Reply+info :: BS s => Redis -> IO (Reply s) info r = sendCommand r (CInline "INFO") >> recv r  -- | Set the string value as value of the key -- -- ROk returned-set :: Redis-    -> String                   -- ^ target key-    -> String                   -- ^ value-    -> IO Reply-set r key val = sendCommand r (CMBulk ["SET", key, val]) >> recv r+set :: (BS s1, BS s2) => Redis+    -> s1                   -- ^ target key+    -> s2                   -- ^ value+    -> IO (Reply ())+set r key val = sendCommand r (CMBulk ["SET", toBS key, toBS val]) >> recv r  -- | Set the key value if key does not exists -- -- (RInt 1) returned if key was set and (RInt 0) otherwise-setNx :: Redis-      -> String                 -- ^ target key-      -> String                 -- ^ value-      -> IO Reply-setNx r key val = sendCommand r (CMBulk ["SETNX", key, val]) >> recv r+setNx :: (BS s1, BS s2) =>+         Redis+      -> s1                     -- ^ target key+      -> s2                     -- ^ value+      -> IO (Reply Int)+setNx r key val = sendCommand r (CMBulk ["SETNX", toBS key, toBS val]) >> recv r  -- | Atomically set multiple keys -- -- ROk returned-mSet :: Redis-     -> [(String, String)]      -- ^ (key, value) pairs-     -> IO Reply+mSet :: (BS s1, BS s2) =>+        Redis+     -> [(s1, s2)]              -- ^ (key, value) pairs+     -> IO (Reply ()) mSet r ks = let interlace' [] ls = ls-                interlace' ((a, b):rest) ls = interlace' rest (a:b:ls)+                interlace' ((a, b):rest) ls = interlace' rest (toBS a : toBS b : ls)                 interlace ls = interlace' ls []             in sendCommand r (CMBulk ("MSET" : interlace ks)) >> recv r  -- | Atomically set multiple keys if none of them exists. -- -- (RInt 1) returned if all keys was set and (RInt 0) otherwise-mSetNx :: Redis-       -> [(String, String)]    -- ^ (key, value) pairs-       -> IO Reply+mSetNx :: (BS s1, BS s2) =>+          Redis+       -> [(s1, s2)]            -- ^ (key, value) pairs+       -> IO (Reply Int) mSetNx r ks = let interlace' [] ls = ls-                  interlace' ((a, b):rest) ls = interlace' rest (a:b:ls)+                  interlace' ((a, b):rest) ls = interlace' rest (toBS a : toBS b : ls)                   interlace ls = interlace' ls []               in sendCommand r (CMBulk ("MSETNX" : interlace ks)) >> recv r  -- | Get the value of the specified key. -- -- RBulk returned-get :: Redis-    -> String                   -- ^ target key-    -> IO Reply-get r key = sendCommand r (CMBulk ["GET", key]) >> recv r+get :: (BS s1, BS s2) =>+       Redis+    -> s1                       -- ^ target key+    -> IO (Reply s2)+get r key = sendCommand r (CMBulk ["GET", toBS key]) >> recv r + -- | Atomically set this value and return the old value -- -- RBulk returned-getSet :: Redis-       -> String                -- ^ target key-       -> String                -- ^ value-       -> IO Reply-getSet r key val = sendCommand r (CMBulk ["GETSET", key, val]) >> recv r+getSet :: (BS s1, BS s2, BS s3) =>+          Redis+       -> s1                -- ^ target key+       -> s2                -- ^ value+       -> IO (Reply s3)+getSet r key val = sendCommand r (CMBulk ["GETSET", toBS key, toBS val]) >> recv r  -- | Get the values of all specified keys -- -- RMulti filled with RBulk replys returned-mGet :: Redis-     -> [String]                -- ^ target keys-     -> IO Reply-mGet r keys = sendCommand r (CMBulk ("MGET" : keys)) >> recv r+mGet :: (BS s1, BS s2) =>+        Redis+     -> [s1]                    -- ^ target keys+     -> IO (Reply s2)+mGet r keys = sendCommand r (CMBulk ("MGET" : map toBS keys)) >> recv r  -- | Increment the key value by one -- -- RInt returned with new key value-incr :: Redis-     -> String                  -- ^ target key-     -> IO Reply-incr r key = sendCommand r (CMBulk ["INCR", key]) >> recv r+incr :: BS s =>+        Redis+     -> s                       -- ^ target key+     -> IO (Reply Int)+incr r key = sendCommand r (CMBulk ["INCR", toBS key]) >> recv r  -- | Increment the key value by N -- -- RInt returned with new key value-incrBy :: Redis-       -> String                -- ^ target key+incrBy :: BS s =>+          Redis+       -> s                     -- ^ target key        -> Int                   -- ^ increment-       -> IO Reply-incrBy r key n = sendCommand r (CMBulk ["INCRBY", key, show n]) >> recv r+       -> IO (Reply Int)+incrBy r key n = sendCommand r (CMBulk ["INCRBY", toBS key, toBS n]) >> recv r  -- | Decrement the key value by one -- -- RInt returned with new key value-decr :: Redis-     -> String                  -- ^ target key-     -> IO Reply-decr r key = sendCommand r (CMBulk ["DECR", key]) >> recv r+decr :: BS s =>+        Redis+     -> s                  -- ^ target key+     -> IO (Reply Int)+decr r key = sendCommand r (CMBulk ["DECR", toBS key]) >> recv r  -- | Decrement the key value by N -- -- RInt returned with new key value-decrBy :: Redis-       -> String                -- ^ target key+decrBy :: BS s =>+          Redis+       -> s                -- ^ target key        -> Int                   -- ^ decrement-       -> IO Reply-decrBy r key n = sendCommand r (CMBulk ["DECRBY", key, show n]) >> recv r+       -> IO (Reply Int)+decrBy r key n = sendCommand r (CMBulk ["DECRBY", toBS key, toBS n]) >> recv r  -- | Append string to the string-typed key -- -- RInt returned - the length of resulting string-append :: Redis-       -> String                -- ^ target key-       -> String                -- ^ value-       -> IO Reply-append r key str = sendCommand r (CMBulk ["APPEND", key, str]) >> recv r+append :: (BS s1, BS s2) =>+          Redis+       -> s1                    -- ^ target key+       -> s2                    -- ^ value+       -> IO (Reply Int)+append r key str = sendCommand r (CMBulk ["APPEND", toBS key, toBS str]) >> recv r --- | Add string value to the head of the list-type key+-- | Get a substring. Indexes are zero-based. ----- ROk returned or RError if key is not a list-rpush :: Redis-      -> String                 -- ^ target key-      -> String                 -- ^ value-      -> IO Reply-rpush r key val = sendCommand r (CMBulk ["RPUSH", key, val]) >> recv r+-- RBulk returned+substr :: (BS s1, BS s2) =>+          Redis+       -> s1+       -> (Int, Int)+       -> IO (Reply s2)+substr r key (from, to) = sendCommand r (CMBulk ["SUBSTR", toBS key, toBS from, toBS to]) >> recv r --- | Add string value to the tail of the list-type key+-- | Add string value to the head of the list-type key. New list+-- length returned ----- ROk returned or RError if key is not a list-lpush :: Redis-      -> String                 -- ^ target key-      -> String                 -- ^ value-      -> IO Reply-lpush r key val = sendCommand r (CMBulk ["LPUSH", key, val]) >> recv r+-- RInt returned+rpush :: (BS s1, BS s2) =>+         Redis+      -> s1                     -- ^ target key+      -> s2                     -- ^ value+      -> IO (Reply Int)+rpush r key val = sendCommand r (CMBulk ["RPUSH", toBS key, toBS val]) >> recv r +-- | Add string value to the tail of the list-type key. New list+-- length returned+--+-- RInt returned+lpush :: (BS s1, BS s2) =>+         Redis+      -> s1                     -- ^ target key+      -> s2                     -- ^ value+      -> IO (Reply Int)+lpush r key val = sendCommand r (CMBulk ["LPUSH", toBS key, toBS val]) >> recv r+ -- | Return lenght of the list. Note that for not-existing keys it -- returns zero length. -- -- RInt returned or RError if key is not a list-llen :: Redis-     -> String                  -- ^ target key-     -> IO Reply-llen r key = sendCommand r (CMBulk ["LLEN", key]) >> recv r+llen :: BS s =>+        Redis+     -> s                       -- ^ target key+     -> IO (Reply Int)+llen r key = sendCommand r (CMBulk ["LLEN", toBS key]) >> recv r  -- | Return the specified range of list elements. List indexed from 0 -- to (llen - 1). lrange returns slice including \"from\" and \"to\"@@ -625,225 +688,254 @@ -- list, -2 - is the second from the end and so on. -- -- RMulti filled with RBulk returned-lrange :: Redis-       -> String                -- ^ traget key+lrange :: (BS s1, BS s2) =>+          Redis+       -> s1                    -- ^ traget key        -> (Int, Int)            -- ^ (from, to) pair-       -> IO Reply-lrange r key (from, to) = sendCommand r (CMBulk ["LRANGE", key, show from, show to]) >> recv r+       -> IO (Reply s2)+lrange r key (from, to) = sendCommand r (CMBulk ["LRANGE", toBS key, toBS from, toBS to]) >> recv r + -- | Trim list so that it will contain only the specified range of elements. -- -- ROk returned-ltrim :: Redis-      -> String                 -- ^ target key+ltrim :: BS s =>+         Redis+      -> s                      -- ^ target key       -> (Int, Int)             -- ^ (from, to) pair-      -> IO Reply-ltrim r key (from, to) = sendCommand r (CMBulk ["LTRIM", key, show from, show to]) >> recv r+      -> IO (Reply ())+ltrim r key (from, to) = sendCommand r (CMBulk ["LTRIM", toBS key, toBS from, toBS to]) >> recv r  -- | Return the specified element of the list by its index -- -- RBulk returned-lindex :: Redis-       -> String                -- ^ target key+lindex :: (BS s1, BS s2) =>+          Redis+       -> s1                    -- ^ target key        -> Int                   -- ^ index-       -> IO Reply-lindex r key index = sendCommand r (CMBulk ["LINDEX", key, show index]) >> recv r+       -> IO (Reply s2)+lindex r key index = sendCommand r (CMBulk ["LINDEX", toBS key, toBS index]) >> recv r  -- | Set the list's value indexed by an /index/ to the new value -- -- ROk returned if element was set and RError if index is out of -- range or key is not a list-lset :: Redis -> String -> Int -> String -> IO Reply-lset r key index val = sendCommand r (CMBulk ["LSET", key, show index, val]) >> recv r+lset :: (BS s1, BS s2) =>+        Redis+     -> s1                      -- ^ target key+     -> Int                     -- ^ index+     -> s2                      -- ^ new value+     -> IO (Reply ())+lset r key index val = sendCommand r (CMBulk ["LSET", toBS key, toBS index, toBS val]) >> recv r  -- | Remove the first /count/ occurrences of the /value/ element from the list -- -- RInt returned - the number of elements removed-lrem :: Redis-     -> String                  -- ^ target key+lrem :: (BS s1, BS s2) =>+        Redis+     -> s1                      -- ^ target key      -> Int                     -- ^ occurrences-     -> String                  -- ^ value-     -> IO Reply-lrem r key count value = sendCommand r (CMBulk ["LREM", key, show count, value]) >> recv r+     -> s2                      -- ^ value+     -> IO (Reply Int)+lrem r key count value = sendCommand r (CMBulk ["LREM", toBS key, toBS count, toBS value]) >> recv r  -- | Atomically return and remove the first element of the list -- -- RBulk returned-lpop :: Redis-     -> String                  -- ^ target key-     -> IO Reply-lpop r key = sendCommand r (CMBulk ["LPOP", key]) >> recv r+lpop :: (BS s1, BS s2) =>+        Redis+     -> s1                      -- ^ target key+     -> IO (Reply s2)+lpop r key = sendCommand r (CMBulk ["LPOP", toBS key]) >> recv r  -- | Atomically return and remove the last element of the list -- -- RBulk returned-rpop :: Redis-     -> String                  -- ^ target key-     -> IO Reply-rpop r key = sendCommand r (CMBulk ["RPOP", key]) >> recv r+rpop :: (BS s1, BS s2) =>+        Redis+     -> s1                      -- ^ target key+     -> IO (Reply s2)+rpop r key = sendCommand r (CMBulk ["RPOP", toBS key]) >> recv r  -- | Atomically return and remove the last (tail) element of the -- source list, and push the element as the first (head) element of -- the destination list -- -- RBulk returned-rpoplpush :: Redis-          -> String             -- ^ source key-          -> String             -- ^ destination key-          -> IO Reply-rpoplpush r src dst = sendCommand r (CMBulk ["RPOPLPUSH", src, dst]) >> recv r+rpoplpush :: (BS s1, BS s2, BS s3) =>+             Redis+          -> s1                 -- ^ source key+          -> s2                 -- ^ destination key+          -> IO (Reply s3)+rpoplpush r src dst = sendCommand r (CMBulk ["RPOPLPUSH", toBS src, toBS dst]) >> recv r  -- | Blocking lpop -- -- For more information see <http://code.google.com/p/redis/wiki/BlpopCommand> -- -- RMulti returned filled with key name and popped value-blpop :: Redis-      -> [String]               -- ^ keys list+blpop :: (BS s1, BS s2) =>+         Redis+      -> [s1]                   -- ^ keys list       -> Int                    -- ^ timeout-      -> IO Reply-blpop r keys timeout = sendCommand r (CMBulk (("BLPOP" : keys) ++ [show timeout])) >> recv r+      -> IO (Reply s2)+blpop r keys timeout = sendCommand r (CMBulk (("BLPOP" : map toBS keys) ++ [toBS timeout])) >> recv r  -- | Blocking rpop -- -- For more information see <http://code.google.com/p/redis/wiki/BlpopCommand> -- -- RMulti returned filled with key name and popped value-brpop :: Redis-      -> [String]               -- ^ keys list+brpop :: (BS s1, BS s2) =>+         Redis+      -> [s1]                   -- ^ keys list       -> Int                    -- ^ timeout-      -> IO Reply-brpop r keys timeout = sendCommand r (CMBulk (("BRPOP" : keys) ++ [show timeout])) >> recv r+      -> IO (Reply s2)+brpop r keys timeout = sendCommand r (CMBulk (("BRPOP" : map toBS keys) ++ [toBS timeout])) >> recv r  -- | Add the specified member to the set value stored at key -- -- (RInt 1) returned if element was added and (RInt 0) if element was -- already a member of the set-sadd :: Redis-     -> String                  -- ^ target key-     -> String                  -- ^ value-     -> IO Reply-sadd r key val = sendCommand r (CMBulk ["SADD", key, val]) >> recv r+sadd :: (BS s1, BS s2) =>+        Redis+     -> s1                      -- ^ target key+     -> s2                      -- ^ value+     -> IO (Reply Int)+sadd r key val = sendCommand r (CMBulk ["SADD", toBS key, toBS val]) >> recv r  -- | Remove the specified member from the set value stored at key -- -- (RInt 1) returned if element was removed and (RInt 0) if element -- is not a member of the set-srem :: Redis-     -> String                  -- ^ target key-     -> String                  -- ^ value-     -> IO Reply-srem r key val = sendCommand r (CMBulk ["SREM", key, val]) >> recv r+srem :: (BS s1, BS s2) =>+        Redis+     -> s1                      -- ^ target key+     -> s2                      -- ^ value+     -> IO (Reply Int)+srem r key val = sendCommand r (CMBulk ["SREM", toBS key, toBS val]) >> recv r  -- | Remove a random element from a Set returning it as return value -- -- RBulk returned-spop :: Redis-     -> String                  -- ^ target key-     -> IO Reply-spop r key = sendCommand r (CMBulk ["SPOP", key]) >> recv r+spop :: (BS s1, BS s2) =>+        Redis+     -> s1                      -- ^ target key+     -> IO (Reply s2)+spop r key = sendCommand r (CMBulk ["SPOP", toBS key]) >> recv r  -- | Move the specifided member from one set to another -- -- (RInt 1) returned if element was moved and (RInt 0) if element -- is not a member of the source set-smove :: Redis-      -> String                 -- ^ source key-      -> String                 -- ^ destination key-      -> String                 -- ^ value-      -> IO Reply-smove r src dst member = sendCommand r (CMBulk ["SMOVE", src, dst, member]) >> recv r+smove :: (BS s1, BS s2, BS s3) =>+         Redis+      -> s1                     -- ^ source key+      -> s2                     -- ^ destination key+      -> s3                     -- ^ value+      -> IO (Reply Int)+smove r src dst member = sendCommand r (CMBulk ["SMOVE", toBS src, toBS dst, toBS member]) >> recv r  -- | Return the number of elements of the set. If key doesn't exists 0 -- returned. -- -- RInt returned-scard :: Redis-      -> String                 -- ^ target key-      -> IO Reply-scard r key = sendCommand r (CMBulk ["SCARD", key]) >> recv r+scard :: BS s =>+         Redis+      -> s                      -- ^ target key+      -> IO (Reply Int)+scard r key = sendCommand r (CMBulk ["SCARD", toBS key]) >> recv r  -- | Test if element is member of the set. If key doesn't exists 0 -- returned. -- -- (RInt 1) returned if element is member of the set and (RInt 0) otherwise-sismember :: Redis-          -> String             -- ^ target key-          -> IO Reply-sismember r key = sendCommand r (CMBulk ["SISMEMBER", key]) >> recv r+sismember :: BS s =>+             Redis+          -> s                  -- ^ target key+          -> IO (Reply Int)+sismember r key = sendCommand r (CMBulk ["SISMEMBER", toBS key]) >> recv r  -- | Return all the members (elements) of the set -- -- RMulti filled with RBulk returned-smembers :: Redis-         -> String              -- ^ target key-         -> IO Reply-smembers r key = sendCommand r (CMBulk ["SMEMBERS", key]) >> recv r+smembers :: (BS s1, BS s2) =>+            Redis+         -> s1                  -- ^ target key+         -> IO (Reply s2)+smembers r key = sendCommand r (CMBulk ["SMEMBERS", toBS key]) >> recv r  -- | Return a random element from a set -- -- RBulk returned-srandmember :: Redis-            -> String           -- ^ target key-            -> IO Reply-srandmember r key = sendCommand r (CMBulk ["SRANDMEMBER", key]) >> recv r+srandmember :: (BS s1, BS s2) =>+               Redis+            -> s1               -- ^ target key+            -> IO (Reply s2)+srandmember r key = sendCommand r (CMBulk ["SRANDMEMBER", toBS key]) >> recv r  -- | Return the members of a set resulting from the intersection of -- all the specifided sets -- -- RMulti filled with RBulk returned-sinter :: Redis-       -> [String]              -- ^ keys list-       -> IO Reply-sinter r keys = sendCommand r (CMBulk ("SINTER" : keys)) >> recv r+sinter :: (BS s1, BS s2) =>+          Redis+       -> [s1]                  -- ^ keys list+       -> IO (Reply s2)+sinter r keys = sendCommand r (CMBulk ("SINTER" : map toBS keys)) >> recv r  -- | The same as 'sinter' but instead of being returned the resulting set -- is stored -- -- ROk returned-sinterStore :: Redis-            -> String           -- ^ where to store resulting set-            -> [String]         -- ^ sets list-            -> IO Reply-sinterStore r dst keys = sendCommand r (CMBulk ("SINTERSTORE" : dst : keys)) >> recv r+sinterStore :: (BS s1, BS s2) =>+               Redis+            -> s1               -- ^ where to store resulting set+            -> [s2]             -- ^ sets list+            -> IO (Reply ())+sinterStore r dst keys = sendCommand r (CMBulk ("SINTERSTORE" : toBS dst : map toBS keys)) >> recv r  -- | Return the members of a set resulting from the union of all the -- specifided sets -- -- RMulti filled with RBulk returned-sunion :: Redis-       -> [String]              -- ^ keys list-       -> IO Reply-sunion r keys = sendCommand r (CMBulk ("SUNION" : keys)) >> recv r+sunion :: (BS s1, BS s2) =>+          Redis+       -> [s1]                  -- ^ keys list+       -> IO (Reply s2)+sunion r keys = sendCommand r (CMBulk ("SUNION" : map toBS keys)) >> recv r  -- | The same as 'sunion' but instead of being returned the resulting set -- is stored -- -- ROk returned-sunionStore :: Redis-            -> String           -- ^ where to store resulting set-            -> [String]         -- ^ sets list-            -> IO Reply-sunionStore r dst keys = sendCommand r (CMBulk ("SUNIONSTORE" : dst : keys)) >> recv r+sunionStore :: (BS s1, BS s2) =>+               Redis+            -> s1               -- ^ where to store resulting set+            -> [s2]             -- ^ sets list+            -> IO (Reply ())+sunionStore r dst keys = sendCommand r (CMBulk ("SUNIONSTORE" : toBS dst : map toBS keys)) >> recv r  -- | Return the members of a set resulting from the difference between -- the first set provided and all the successive sets -- -- RMulti filled with RBulk returned-sdiff :: Redis-      -> [String]               -- ^ keys list-      -> IO Reply-sdiff r keys = sendCommand r (CMBulk ("SDIFF" : keys)) >> recv r+sdiff :: (BS s1, BS s2) =>+         Redis+      -> [s1]                   -- ^ keys list+      -> IO (Reply s2)+sdiff r keys = sendCommand r (CMBulk ("SDIFF" : map toBS keys)) >> recv r  -- | The same as 'sdiff' but instead of being returned the resulting -- set is stored -- -- ROk returned-sdiffStore :: Redis-           -> String            -- ^ where to store resulting set-           -> [String]          -- ^ sets list-           -> IO Reply-sdiffStore r dst keys = sendCommand r (CMBulk ("SDIFFSTORE" : dst : keys)) >> recv r+sdiffStore :: (BS s1, BS s2) =>+              Redis+           -> s1                -- ^ where to store resulting set+           -> [s2]              -- ^ sets list+           -> IO (Reply ())+sdiffStore r dst keys = sendCommand r (CMBulk ("SDIFFSTORE" : toBS dst : map toBS keys)) >> recv r  -- | Add the specified member having the specifeid score to the sorted -- set@@ -851,22 +943,24 @@ -- (RInt 1) returned if new element was added and (RInt 0) if that -- element was already a member of the sortet set and the score was -- updated-zadd :: Redis-     -> String                  -- ^ target key+zadd :: (BS s1, BS s2) =>+        Redis+     -> s1                      -- ^ target key      -> Double                  -- ^ score-     -> String                  -- ^ value-     -> IO Reply-zadd r key score member = sendCommand r (CMBulk ["ZADD", key, show score, member]) >> recv r+     -> s2                      -- ^ value+     -> IO (Reply Int)+zadd r key score member = sendCommand r (CMBulk ["ZADD", toBS key, toBS score, toBS member]) >> recv r  -- | Remove the specified member from the sorted set -- -- (RInt 1) returned if element was removed and (RInt 0) if element -- was not a member of the sorted set-zrem :: Redis-     -> String                  -- ^ target key-     -> String                  -- ^ value-     -> IO Reply-zrem r key member = sendCommand r (CMBulk ["ZREM", key, member]) >> recv r+zrem :: (BS s1, BS s2) =>+        Redis+     -> s1                      -- ^ target key+     -> s2                      -- ^ value+     -> IO (Reply Int)+zrem r key member = sendCommand r (CMBulk ["ZREM", toBS key, toBS member]) >> recv r  -- | If /member/ already in the sorted set adds the /increment/ to its -- score and updates the position of the element in the sorted set@@ -875,12 +969,13 @@ -- virtually zero). The new score of the member is returned. -- -- RBulk returned-zincrBy :: Redis-        -> String               -- ^ target key+zincrBy :: (BS s1, BS s2, BS s3) =>+           Redis+        -> s1                   -- ^ target key         -> Double               -- ^ increment-        -> String               -- ^ value-        -> IO Reply-zincrBy r key increment member = sendCommand r (CMBulk ["ZINCRBY", key, show increment, member]) >> recv r+        -> s2                   -- ^ value+        -> IO (Reply s3)+zincrBy r key increment member = sendCommand r (CMBulk ["ZINCRBY", toBS key, toBS increment, toBS member]) >> recv r  -- | Return the specified elements of the sorted set. Start and end -- are zero-based indexes. WITHSCORES paramenter indicates if it's@@ -889,12 +984,13 @@ -- value2, score2 and so on. -- -- RMulti filled with RBulk returned-zrange :: Redis-       -> String                -- ^ target key+zrange :: (BS s1, BS s2) =>+          Redis+       -> s1                    -- ^ target key        -> (Int, Int)            -- ^ (from, to) pair        -> Bool                  -- ^ withscores option-       -> IO Reply-zrange r key limit withscores = let cmd' = ["ZRANGE", key, show $ fst limit, show $ snd limit]+       -> IO (Reply s2)+zrange r key limit withscores = let cmd' = ["ZRANGE", toBS key, toBS $ fst limit, toBS $ snd limit]                                     cmd | withscores = cmd' ++ ["WITHSCORES"]                                         | otherwise  = cmd'                                 in sendCommand r (CMBulk cmd) >> recv r@@ -904,12 +1000,13 @@ -- lowerest score -- -- RMulti filled with RBulk returned-zrevrange :: Redis-          -> String             -- ^ target key+zrevrange :: (BS s1, BS s2) =>+             Redis+          -> s1                 -- ^ target key           -> (Int, Int)         -- ^ (from, to) pair           -> Bool               -- ^ withscores option-          -> IO Reply-zrevrange r key limit withscores = let cmd' = ["ZREVRANGE", key, show $ fst limit, show $ snd limit]+          -> IO (Reply s2)+zrevrange r key limit withscores = let cmd' = ["ZREVRANGE", toBS key, toBS $ fst limit, toBS $ snd limit]                                        cmd | withscores = cmd' ++ ["WITHSCORES"]                                            | otherwise  = cmd'                                    in sendCommand r (CMBulk cmd) >> recv r@@ -962,13 +1059,13 @@ -- lays within a given interval -- -- RMulti filled with RBulk returned-zrangebyscore :: IsInterval i Double =>+zrangebyscore :: (IsInterval i Double, BS s1, BS s2) =>                  Redis-              -> String         -- ^ target key+              -> s1             -- ^ target key               -> i              -- ^ scores interval               -> Bool           -- ^ withscores option-              -> IO Reply-zrangebyscore r key i withscores = let cmd' = i' `seq` ["ZRANGEBYSCORE", key, from i', to i']+              -> 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@@ -978,55 +1075,69 @@ -- lays within a given interval -- -- RInt returned-zcount :: IsInterval i Double =>+zcount :: (IsInterval i Double, BS s) =>           Redis-       -> String                -- ^ target key+       -> s                     -- ^ target key        -> i                     -- ^ scores interval-       -> IO Reply-zcount r key i = let cmd = i' `seq` ["ZCOUNT", key, from i', to i']+       -> IO (Reply Int)+zcount r key i = let cmd = i' `seq` ["ZCOUNT", toBS key, toBS (from i'), toBS (to i')]                      i' = toInterval i                  in cmd `seq` sendCommand r (CMBulk cmd) >> recv r  -- | Remove all the elements in the sorted set with a score that lays--- within a given interval+-- within a given interval. For now this command doesn't supports open+-- and semi-open intervals -- -- RInt returned - the number of elements removed-zremrangebyscore :: Redis-                 -> String           -- ^ target key+zremrangebyscore :: BS s =>+                    Redis+                 -> s                -- ^ target key                  -> (Double, Double) -- ^ (from, to) pair. zremrangebyscore                                      -- currently doesn't supports                                      -- open intervals-                 -> IO Reply-zremrangebyscore r key (from, to) = sendCommand r (CMBulk ["ZREMRANGEBYSCORE", key, show from, show to]) >> recv r+                 -> IO (Reply Int)+zremrangebyscore r key (from, to) = sendCommand r (CMBulk ["ZREMRANGEBYSCORE", toBS key, toBS from, toBS to]) >> recv r  -- | Return the sorted set cardinality (number of elements) -- -- RInt returned-zcard :: Redis-      -> String                 -- ^ target key-      -> IO Reply-zcard r key = sendCommand r (CMBulk ["ZCARD", key]) >> recv r+zcard :: BS s =>+         Redis+      -> s                      -- ^ target key+      -> IO (Reply Int)+zcard r key = sendCommand r (CMBulk ["ZCARD", toBS key]) >> recv r  -- | Return the score of the specified element of the sorted set -- -- RBulk returned-zscore :: Redis-       -> String                -- ^ target key-       -> String                -- ^ value-       -> IO Reply-zscore r key member = sendCommand r (CMBulk ["ZSCORE", key, member]) >> recv r+zscore :: (BS s1, BS s2, BS s3) =>+          Redis+       -> s1                    -- ^ target key+       -> s2                    -- ^ value+       -> IO (Reply s3)+zscore r key member = sendCommand r (CMBulk ["ZSCORE", toBS key, toBS member]) >> recv r +-- | Returns sorted set element sequence number counting from zero+--+-- RInt returned+zrank :: (BS s1, BS s2) =>+         Redis+      -> s1+      -> s2+      -> IO (Reply Int)+zrank r key member = sendCommand r (CMBulk ["ZRANK", toBS key, toBS member]) >> recv r+ -- | Options data type for the 'sort' command-data SortOptions = SortOptions { desc       :: Bool, -- ^ sort with descending order-                                 limit      :: (Int, Int), -- ^ return (from, to) elements-                                 alpha      :: Bool,       -- ^ sort alphabetically-                                 sort_by    :: String,     -- ^ sort by value from this key-                                 get_obj    :: [String],   -- ^ return this keys values-                                 store      :: String      -- ^ store result to this key-                               }+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+                                         }  -- | Default options for the 'sort' command-sortDefaults :: SortOptions+sortDefaults :: SortOptions ByteString sortDefaults = SortOptions { desc = False,                              limit = takeAll,                              alpha = False,@@ -1039,66 +1150,69 @@ -- for more information see <http://code.google.com/p/redis/wiki/SortCommand> -- -- RMulti filled with RBulk returned-sort :: Redis-     -> String                  -- ^ target key-     -> SortOptions             -- ^ options-     -> IO Reply+sort :: (BS s1, BS s2, BS s3) =>+        Redis+     -> s1                      -- ^ target key+     -> SortOptions s2          -- ^ options+     -> IO (Reply s3) sort r key opt = let opt_s = buildOptions opt+                     buildOptions :: BS s => SortOptions s -> [ByteString]                      buildOptions opt = let desc_s                                                 | desc opt  = ["DESC"]                                                 | otherwise = []                                             limit_s                                                 | (limit opt) == (0, 0) = []-                                                | otherwise             = ["LIMIT", (show $ fst $ limit opt), (show $ snd $ limit opt)]+                                                | otherwise             = ["LIMIT", (toBS $ fst $ limit opt), (toBS $ snd $ limit opt)]                                             alpha_s                                                 | alpha opt = ["ALPHA"]                                                 | otherwise = []                                             sort_by_s-                                                | null $ sort_by opt = []-                                                | otherwise          = ["BY",(sort_by opt)]+                                                | B.null $ toBS (sort_by opt) = []+                                                | otherwise                   = ["BY",(toBS $ sort_by opt)]                                             get_obj_s                                                 | null $ get_obj opt = []-                                                | otherwise          = "GET" : get_obj opt+                                                | otherwise          = "GET" : map toBS (get_obj opt)                                             store_s-                                                | null $ store opt = []-                                                | otherwise        = ["STORE", store opt]+                                                | B.null $ toBS (store opt) = []+                                                | otherwise                 = ["STORE", toBS $ store opt]                                         in concat [sort_by_s, limit_s, get_obj_s, desc_s, alpha_s, store_s]-                 in sendCommand r (CMBulk ("SORT" : key : opt_s)) >> recv r+                 in sendCommand r (CMBulk ("SORT" : toBS key : opt_s)) >> recv r  -- | Shortcut for the 'sort' with some 'get_obj' and constant -- 'sort_by' options -- -- RMulti filled with RBulk returned-listRelated :: Redis-            -> String           -- ^ target key-            -> String           -- ^ key returned+listRelated :: (BS s1, BS s2, BS s3) =>+               Redis+            -> s1               -- ^ related key+            -> s2               -- ^ index key             -> (Int, Int)       -- ^ range-            -> IO Reply+            -> IO (Reply s3) listRelated r related key l = let opts = sortDefaults { sort_by = "x",-                                                        get_obj = [related],+                                                        get_obj = [toBS related],                                                         limit = l }                               in sort r key opts  -- | Save the whole dataset on disk -- -- ROk returned-save :: Redis -> IO Reply+save :: Redis -> IO (Reply ()) save r = sendCommand r (CInline "SAVE") >> recv r  -- | Save the DB in background -- -- ROk returned-bgsave :: Redis -> IO Reply+bgsave :: Redis -> IO (Reply ()) bgsave r = sendCommand r (CInline "BGSAVE") >> recv r  -- | Return the UNIX TIME of the last DB save executed with success -- -- RInt returned-lastsave :: Redis -> IO Reply+lastsave :: Redis -> IO (Reply Int) lastsave r = sendCommand r (CInline "LASTSAVE") >> recv r  -- | Rewrites the Append Only File in background -- -- ROk returned-bgrewriteaof :: Redis -> IO Reply+bgrewriteaof :: Redis -> IO (Reply ()) bgrewriteaof r = sendCommand r (CInline "BGREWRITEAOF") >> recv r
Database/Redis/Utils/Lock.hs view
@@ -26,16 +26,18 @@  import Control.Concurrent (threadDelay) import Database.Redis.Redis+import Database.Redis.ByteStringClass import System.Time  -- | Acquire lock. This function is not reentrant so thread can be -- locked by itself if it try to acquire the same lock before it was -- released.-acquire :: Redis-        -> String               -- ^ The lock's name-        -> Int                  -- ^ Timeout in milliseconds.-        -> Int                  -- ^ Time interval between attempts to lock on-        -> IO Bool              -- ^ True if lock was acquired+acquire :: BS s =>+           Redis+        -> s            -- ^ The lock's name+        -> Int          -- ^ Timeout in milliseconds.+        -> Int          -- ^ Time interval between attempts to lock on+        -> IO Bool      -- ^ True if lock was acquired acquire r name 0 _ = acquireOnce r name acquire r name timeout retry_timeout = do res <- acquireOnce r name                                           if res then return True else getClockTime >>= trylock@@ -59,7 +61,7 @@  -- | Release lock. There is no any guarantees that lock was acquired -- in this thread. Just release this lock and go forth.-release :: Redis -> String -> IO ()+release :: BS s => Redis -> s -> IO () release r name = del r name >>= noError  diffClockTimesMs :: ClockTime -> ClockTime -> Int
Database/Redis/Utils/Monad/Lock.hs view
@@ -26,8 +26,9 @@ import Control.Monad.Trans import qualified Database.Redis.Utils.Lock as L import Database.Redis.Monad (WithRedis(..))+import Database.Redis.ByteStringClass -acquire :: WithRedis m => String -> Int -> Int -> m Bool+acquire :: (WithRedis m, BS s) => s -> Int -> Int -> m Bool acquire name timeout retry_timeout =     do r <- getRedis        liftIO $ L.acquire r name timeout retry_timeout@@ -36,5 +37,5 @@  acquireOnce name = getRedis >>= liftIO . flip L.acquireOnce name -release :: WithRedis m => String -> m ()+release :: (WithRedis m, BS s) => s -> m () release name = getRedis >>= liftIO . flip L.release name
redis.cabal view
@@ -1,5 +1,5 @@ Name:                redis-Version:             0.2+Version:             0.3 License:             MIT Maintainer:          Alexander Bogdanov <andorn@gmail.com> Author:              Alexander Bogdanov <andorn@gmail.com>@@ -11,7 +11,17 @@     but the dataset is not volatile. Values can be strings, exactly     like in memcached, but also lists, sets, and ordered sets.     .-    This library is a Haskell driver for Redis.+    This library is a Haskell driver for Redis. Note that this library+	supports the most recent (actually the git one) version of Redis+	protocol. Most of the functions will work correctly with stable version+	but not all.+	.+	Changes from v0.2:+	.+	- (!) A lot of data and function types changed. Now it is posible to get not only+	  String result but also a ByteString and other.+	.+	- New protocol functions added: substr, zrank  Stability:           beta Build-Type:          Simple@@ -19,9 +29,10 @@  Library     Build-Depends:       base < 5, bytestring, utf8-string,-                         network, mtl, old-time+                         network, mtl, old-time, binary     Exposed-modules:     Database.Redis.Redis                          Database.Redis.Monad+                         Database.Redis.ByteStringClass                          Database.Redis.Monad.State                          Database.Redis.Utils.Lock                          Database.Redis.Utils.Monad.Lock