Commits

Alvaro Videla committed e9fac71

implemented sets and zsets

  • Participants
  • Parent commits 0d7eea9

Comments (0)

Files changed (5)

Database/Redis.hs

 import qualified Database.Redis.Strings as S
 import qualified Database.Redis.Keys as K
 import qualified Database.Redis.Lists as L
--- import qualified Database.Redis.Sets as SS
--- import qualified Database.Redis.Zsets as Z
+import qualified Database.Redis.Sets as SS
+import qualified Database.Redis.Zsets as Z
 import qualified Database.Redis.RSCC as RSCC
 import qualified Database.Redis.Misc as Misc
 import qualified Database.Redis.DBM as DBM
   lrem :: (Key k, Serializable s) => a -> k -> Int -> s -> IO (Maybe Int)
   lpop, rpop :: (Key k, Serializable s) => a -> k -> IO (Maybe s)
   
-  -- sadd, srem :: (Key k, Serializable s) => a -> k -> s -> IO (Bool)
-  -- spop :: (Key k, Serializable s) => a -> k -> IO (Maybe s)
-  -- smove :: (Key k, Serializable s) => a -> k -> k -> s -> IO (Bool)
-  -- scard :: (Key k) => a -> k -> IO (Maybe Int)
-  -- sismember :: (Key k, Serializable s) => a -> k -> s -> IO (Bool)
-  -- sinter, sunion, sdiff :: (Key k, Serializable s) => a -> [k] -> IO (Maybe [Maybe s])
-  -- sinterstore, sunionstore, sdiffstore :: (Key k) => a -> k -> [k] -> IO (Bool)
-  -- smembers :: (Key k, Serializable s) => a -> k -> IO (Maybe [Maybe s])
-  -- srandmember :: (Key k, Serializable s) => a -> k -> IO (Maybe s)
-  -- 
-  -- zadd :: (Key k, Serializable s) => a -> k -> Int -> s -> IO (Bool)
-  -- zrem :: (Key k, Serializable s) => a -> k -> s -> IO (Bool)
-  -- zrange, zrevrange, zrangebyscore :: (Key k, Serializable s) => a -> k -> Int -> Int -> IO (Maybe [Maybe s])
-  -- zcard :: (Key k) => a -> k -> IO (Maybe Int)
-  -- zscore :: (Key k, Serializable s) => a -> k -> s -> IO (Maybe Int)
+  sadd :: (Key k, Serializable s) => a -> k -> s -> IO (Bool)
+  srem :: (Key k, Serializable s) => a -> k -> s -> IO (Bool)
+  spop :: (Key k, Serializable s) => a -> k -> IO (Maybe s)
+  smove :: (Key k, Serializable s) => a -> k -> k -> s -> IO (Bool)
+  scard :: (Key k) => a -> k -> IO (Maybe Int)
+  sismember :: (Key k, Serializable s) => a -> k -> s -> IO (Bool)
+  sinter :: (Key k, Serializable s) => a -> [k] -> IO (Maybe [Maybe s])
+  sunion :: (Key k, Serializable s) => a -> [k] -> IO (Maybe [Maybe s])
+  sdiff :: (Key k, Serializable s) => a -> [k] -> IO (Maybe [Maybe s])
+  sinterstore :: (Key k) => a -> k -> [k] -> IO (Maybe Int)
+  sunionstore :: (Key k) => a -> k -> [k] -> IO (Maybe Int)
+  sdiffstore :: (Key k) => a -> k -> [k] -> IO (Maybe Int)
+  smembers :: (Key k, Serializable s) => a -> k -> IO (Maybe [Maybe s])
+  srandmember :: (Key k, Serializable s) => a -> k -> IO (Maybe s)
+  
+  zadd :: (Key k, Serializable s) => a -> k -> Int -> s -> IO (Bool)
+  zrem :: (Key k, Serializable s) => a -> k -> s -> IO (Bool)
+  zrange, zrevrange, zrangebyscore :: (Key k, Serializable s) => a -> k -> Int -> Int -> IO (Maybe [Maybe s])
+  zcard :: (Key k) => a -> k -> IO (Maybe Int)
+  zscore :: (Key k, Serializable s) => a -> k -> s -> IO (Maybe String)
   
   select :: a -> Int -> IO (Bool)
   move :: (Key k) => a -> k -> Int -> IO (Bool)
   lpop = L.lpop
   rpop = L.rpop
   
-  -- sadd = SS.sadd
-  -- srem = SS.srem
-  -- spop = SS.spop
-  -- smove = SS.smove
-  -- scard = SS.scard
-  -- sismember = SS.sismember
-  -- sinter = SS.sinter
-  -- sunion = SS.sunion
-  -- sdiff = SS.sdiff
-  -- sinterstore = SS.sinterstore
-  -- sunionstore = SS.sunionstore
-  -- sdiffstore = SS.sdiffstore
-  -- smembers = SS.smembers
-  -- srandmember = SS.srandmember
+  sadd = SS.sadd
+  srem = SS.srem
+  spop = SS.spop
+  smove = SS.smove
+  scard = SS.scard
+  sismember = SS.sismember
+  sinter = SS.sinter
+  sunion = SS.sunion
+  sdiff = SS.sdiff
+  sinterstore = SS.sinterstore
+  sunionstore = SS.sunionstore
+  sdiffstore = SS.sdiffstore
+  smembers = SS.smembers
+  srandmember = SS.srandmember
   
-  -- zadd = Z.zadd
-  -- zrem = Z.zrem
-  -- zrange = Z.zrange
-  -- zrevrange = Z.zrevrange
-  -- zrangebyscore = Z.zrangebyscore
-  -- zcard = Z.zcard
-  -- zscore = Z.zscore
+  zadd = Z.zadd
+  zrem = Z.zrem
+  zrange = Z.zrange
+  zrevrange = Z.zrevrange
+  zrangebyscore = Z.zrangebyscore
+  zcard = Z.zcard
+  zscore = Z.zscore
   
   select = DBM.select
   move = DBM.move

Database/Redis/Protocol.hs

   hPutCommand handle [action, toKey key, show bytes]
   hPutNetLn handle valString
   hFlush handle
-  return ()
 
 readIntegerReply :: Handle -> IO (Maybe Int)
 readIntegerReply handle = do
   val <- readSingleLineReply handle
   case val of
     Just "OK" -> return True
-    _ -> return False
+    _ -> return False
+    
+doMultiCommand :: (Key k, Serializable s) => String -> Handle -> [k] -> IO (Maybe [Maybe s])
+doMultiCommand command handle keys = do
+  hPutCommand handle $ command : (map toKey keys)
+  getMultiBulkReply handle
+
+doStoreCommand :: (Key k) => String -> Handle -> k -> [k] -> IO (Maybe Int)
+doStoreCommand command handle key keys = do 
+  hPutCommand handle $ command : (toKey key) : (map toKey keys)
+  readIntegerReply handle
+
+doRangeCommand :: (Key k, Serializable s) => String -> Handle -> k -> Int -> Int -> IO (Maybe [Maybe s])
+doRangeCommand command handle key start end = do
+  hPutCommand handle [command, toKey key, show start, show end]
+  getMultiBulkReply handle

Database/Redis/Sets.hs

   
 import Database.Redis.Protocol
 import Database.Redis.Key
-import Database.Redis.Serializable
+import Database.Redis.Serializable
+import System.IO
+
+sadd :: (Key k, Serializable s) => Server -> k -> s -> IO (Bool)
+sadd (Server handle) key value = do
+  sendBulkCommand "SADD" handle key value
+  intReplyAsBool handle
+
+srem :: (Key k, Serializable s) => Server -> k -> s -> IO (Bool)
+srem (Server handle) key value = do
+  sendBulkCommand "SREM" handle key value
+  intReplyAsBool handle
+
+spop :: (Key k, Serializable s) => Server -> k -> IO (Maybe s)
+spop (Server handle) key = do
+  hPutCommand handle ["SPOP", toKey key]
+  getBulkReply handle
+
+smove :: (Key k, Serializable s) => Server -> k -> k -> s -> IO (Bool)
+smove (Server handle) srckey dstkey value = do
+  let valString = toString value
+  let bytes = length valString
+  hPutCommand handle ["SMOVE", toKey srckey, toKey dstkey, show bytes]
+  hPutNetLn handle valString
+  hFlush handle
+  intReplyAsBool handle
+
+scard :: (Key k) => Server -> k -> IO (Maybe Int)
+scard (Server handle) key = do
+  hPutCommand handle ["SCARD", toKey key]
+  readIntegerReply handle
+
+sismember :: (Key k, Serializable s) => Server -> k -> s -> IO (Bool)
+sismember (Server handle) key value = do
+  let valString = toString value
+  let bytes = length valString
+  hPutCommand handle ["sismember", toKey key, show bytes]
+  hPutNetLn handle valString
+  hFlush handle
+  intReplyAsBool handle
+
+sinter :: (Key k, Serializable s) => Server -> [k] -> IO (Maybe [Maybe s])
+sinter (Server handle) keys = doMultiCommand "SINTER" handle keys
+
+sunion :: (Key k, Serializable s) => Server -> [k] -> IO (Maybe [Maybe s])
+sunion (Server handle) keys = doMultiCommand "SUNION" handle keys
+
+sdiff :: (Key k, Serializable s) => Server -> [k] -> IO (Maybe [Maybe s])
+sdiff (Server handle) keys = doMultiCommand "SDIFF" handle keys
+
+sinterstore :: (Key k) => Server -> k -> [k] -> IO (Maybe Int)
+sinterstore (Server handle) key keys = doStoreCommand "SINTERSTORE" handle key keys
+  
+sunionstore :: (Key k) => Server -> k -> [k] -> IO (Maybe Int)
+sunionstore (Server handle) key keys = doStoreCommand "SUNIONSTORE" handle key keys
+  
+sdiffstore :: (Key k) => Server -> k -> [k] -> IO (Maybe Int)
+sdiffstore (Server handle) key keys = doStoreCommand "SDIFFSTORE" handle key keys
+
+smembers :: (Key k, Serializable s) => Server -> k -> IO (Maybe [Maybe s])
+smembers (Server handle) key = do
+  hPutCommand handle ["SMEMBERS", toKey key]
+  getMultiBulkReply handle
+
+srandmember :: (Key k, Serializable s) => Server -> k -> IO (Maybe s)
+srandmember (Server handle) key = do
+  hPutCommand handle ["SRANDMEMBER", toKey key]
+  getBulkReply handle

Database/Redis/Strings.hs

   getBulkReply handle
 
 mget :: (Key k, Serializable s) => Server -> [k] -> IO (Maybe [Maybe s])  
-mget (Server handle) keys = do
-  hPutCommand handle $ "MGET" : (map toKey keys)
-  getMultiBulkReply handle
+mget (Server handle) keys = doMultiCommand "MGET" handle keys
 
 setnx :: (Key k, Serializable s) => Server -> k -> s -> IO (Bool)
 setnx (Server handle) key value = do

Database/Redis/Zsets.hs

   
 import Database.Redis.Protocol
 import Database.Redis.Key
-import Database.Redis.Serializable
+import Database.Redis.Serializable
+import System.IO
+
+zadd :: (Key k, Serializable s) => Server -> k -> Int -> s -> IO (Bool)
+zadd (Server handle) key score value =  do
+  let valString = toString value
+  let bytes = length valString
+  hPutCommand handle ["ZADD", toKey key, show score, show bytes]
+  hPutNetLn handle valString
+  hFlush handle
+  intReplyAsBool handle
+
+zrem :: (Key k, Serializable s) => Server -> k -> s -> IO (Bool)
+zrem (Server handle) key value =  do
+  sendBulkCommand "ZREM" handle key value
+  intReplyAsBool handle
+
+zrange :: (Key k, Serializable s) => Server -> k -> Int -> Int -> IO (Maybe [Maybe s])
+zrange (Server handle) key start end = do
+  doRangeCommand "ZRANGE" handle key start end
+
+zrevrange :: (Key k, Serializable s) => Server -> k -> Int -> Int -> IO (Maybe [Maybe s])
+zrevrange (Server handle) key start end = do
+  doRangeCommand "ZREVRANGE" handle key start end
+
+zrangebyscore :: (Key k, Serializable s) => Server -> k -> Int -> Int -> IO (Maybe [Maybe s])
+zrangebyscore (Server handle) key start end = do
+  doRangeCommand "ZRANGEBYSCORE" handle key start end
+
+zcard :: (Key k) => Server -> k -> IO (Maybe Int)
+zcard (Server handle) key = do
+  hPutCommand handle ["ZCARD", toKey key]
+  readIntegerReply handle
+
+zscore :: (Key k, Serializable s) => Server -> k -> s -> IO (Maybe String)
+zscore (Server handle) key value = do
+  sendBulkCommand "ZSCORE" handle key value
+  readBulkReply handle