summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorWillLangstroth <>2010-11-10 18:52:22 (GMT)
committerLuite Stegeman <luite@luite.com>2010-11-10 18:52:22 (GMT)
commita707321149171a62e35da6259092707007959342 (patch)
tree72e39a6e4174b3d2a80a80616b902e9ab4ff4feb
parent2876091a78f326b5a084030f020c170bb82b8547 (diff)
version 0.0.120.0.12
-rw-r--r--redis-hs.cabal4
-rw-r--r--src/Database/Redis/General.hs30
-rw-r--r--src/Database/Redis/Internal.hs19
-rw-r--r--test/redis-tests.cabal2
-rw-r--r--test/suite/Database/Redis/General/Tests.hs44
5 files changed, 68 insertions, 31 deletions
diff --git a/redis-hs.cabal b/redis-hs.cabal
index 201c79a..e2d1c06 100644
--- a/redis-hs.cabal
+++ b/redis-hs.cabal
@@ -1,5 +1,5 @@
name: redis-hs
-version: 0.0.11
+version: 0.0.12
author: Will Langstroth <will@langstroth.com>
maintainer: Will Langstroth <will@langstroth.com>
license: MIT
@@ -50,7 +50,7 @@ library
base == 4.*,
bytestring >= 0.9,
-- mtl == 2.*,
- network >= 2.2.3,
+ network == 2.2.1.*,
utf8-string >= 0.3.5
ghc-options: -Wall -fwarn-tabs
diff --git a/src/Database/Redis/General.hs b/src/Database/Redis/General.hs
index 5a8a526..d727b3a 100644
--- a/src/Database/Redis/General.hs
+++ b/src/Database/Redis/General.hs
@@ -14,8 +14,10 @@ module Database.Redis.General
, toUTF8
, ping
, unwrapReply
+ , unwrapReplyB
) where
+import Data.Maybe
import System.IO
@@ -126,3 +128,31 @@ ping :: Handle
ping h = request h $ map toUTF8 ["PING"]
+------------------------------------------------------------------------------
+unwrapReply :: Maybe RedisReply -> String
+unwrapReply reply =
+ case reply of
+ Just (RedisBulk [Just (RedisSingle x)]) -> fromUTF8 x
+ Just (RedisSingle x) -> fromUTF8 x
+ Just (RedisError x) -> fromUTF8 x
+ Just (RedisInteger x) -> show x
+ Nothing -> "Nada"
+ _ -> "Not yet Supported"
+
+
+------------------------------------------------------------------------------
+-- | N.B. This only goes down one level right now
+unwrapReplyB :: Maybe RedisReply -> [ByteString]
+unwrapReplyB reply =
+ case reply of
+ Just (RedisSingle x) -> [x]
+ Just (RedisError x) -> [x]
+ Just (RedisInteger x) -> [toUTF8 $ show x]
+ Just (RedisBulk x) -> catMaybes $ map bulks x
+ Nothing -> [toUTF8 "Nada"]
+ where
+ bulks rs = case rs of
+ Just (RedisBulk [Just (RedisSingle x)]) -> Just x
+ Nothing -> Nothing
+ _ -> Nothing
+
diff --git a/src/Database/Redis/Internal.hs b/src/Database/Redis/Internal.hs
index 7b32271..cdcf5d3 100644
--- a/src/Database/Redis/Internal.hs
+++ b/src/Database/Redis/Internal.hs
@@ -8,7 +8,7 @@ module Database.Redis.Internal
, request
, crlf
, toUTF8
- , unwrapReply
+ , fromUTF8
) where
@@ -112,21 +112,12 @@ toUTF8 = U.fromString
------------------------------------------------------------------------------
-toInt :: ByteString -> Int
-toInt b = read (U.toString b) :: Int
+fromUTF8 :: ByteString -> String
+fromUTF8 = U.toString
------------------------------------------------------------------------------
--- FIXME: this needs to deal with the rest of the patterns, but this way is
--- awkward.
-unwrapReply :: Maybe RedisReply -> String
-unwrapReply reply =
- case reply of
- Just (RedisBulk [Just (RedisSingle x)]) -> U.toString x
- Just (RedisSingle x) -> U.toString x
- Just (RedisError x) -> U.toString x
- Just (RedisInteger x) -> show x
- Nothing -> "Nada"
- _ -> "Not yet Supported"
+toInt :: ByteString -> Int
+toInt b = read (U.toString b) :: Int
diff --git a/test/redis-tests.cabal b/test/redis-tests.cabal
index 8e1165f..fa0f96c 100644
--- a/test/redis-tests.cabal
+++ b/test/redis-tests.cabal
@@ -1,5 +1,5 @@
name: redis-tests
-version: 0.0.11
+version: 0.0.12
build-type: Simple
cabal-version: >= 1.6
diff --git a/test/suite/Database/Redis/General/Tests.hs b/test/suite/Database/Redis/General/Tests.hs
index 517ec54..ed2cde2 100644
--- a/test/suite/Database/Redis/General/Tests.hs
+++ b/test/suite/Database/Redis/General/Tests.hs
@@ -27,6 +27,7 @@ tests = [ testCase "redis keyExists" keyExistsTest
, testCase "redis keysB" keysBTest
, testCase "redis keyRandom" keyRandomTest
, testCase "redis keyRename" keyRenameTest
+ , testCase "redis unwrapReplyB" unwrapReplyBTest
]
@@ -34,7 +35,7 @@ tests = [ testCase "redis keyExists" keyExistsTest
keyExistsTest :: H.Assertion
keyExistsTest = do
con <- connect localhost defaultPort
- _ <- select con 0
+ _ <- select con 9
_ <- itemSet con "thekey" "thevalue"
returning <- keyExists con "thekey"
_ <- keyDelete con ["thekey"]
@@ -46,7 +47,7 @@ keyExistsTest = do
keyExistsBTest :: H.Assertion
keyExistsBTest = do
con <- connect localhost defaultPort
- _ <- select con 0
+ _ <- select con 8
_ <- itemSetB con (toUTF8 "thebkey") (toUTF8 "thevalue")
returning <- keyExistsB con (toUTF8 "thebkey")
_ <- keyDeleteB con $ map toUTF8 ["thebkey"]
@@ -58,7 +59,7 @@ keyExistsBTest = do
keyTypeTest :: H.Assertion
keyTypeTest = do
con <- connect localhost defaultPort
- _ <- select con 0
+ _ <- select con 9
_ <- itemSet con "typekey" "typevalue"
returning <- keyType con "typekey"
_ <- keyDelete con ["typekey"]
@@ -70,7 +71,7 @@ keyTypeTest = do
keyTypeBTest :: H.Assertion
keyTypeBTest = do
con <- connect localhost defaultPort
- _ <- select con 0
+ _ <- select con 8
_ <- itemSet con "typebkey" "typevalue"
returning <- keyTypeB con (toUTF8 "typebkey")
_ <- keyDelete con ["typebkey"]
@@ -82,7 +83,7 @@ keyTypeBTest = do
keysTest :: H.Assertion
keysTest = do
con <- connect localhost defaultPort
- _ <- select con 0
+ _ <- select con 9
_ <- itemSet con "keystest0" "value"
_ <- itemSet con "keystest1" "value"
returning <- keys con "keys*"
@@ -100,16 +101,16 @@ keysTest = do
keysBTest :: H.Assertion
keysBTest = do
con <- connect localhost defaultPort
- _ <- select con 0
- _ <- itemSetB con (toUTF8 "keystest2") (toUTF8 "value")
- _ <- itemSetB con (toUTF8 "keystest3") (toUTF8 "value")
+ _ <- select con 8
+ _ <- itemSetB con (toUTF8 "keystest0") (toUTF8 "value")
+ _ <- itemSetB con (toUTF8 "keystest1") (toUTF8 "value")
returning <- keysB con (toUTF8 "keys*")
- _ <- keyDeleteB con $ map toUTF8 ["keystest2"]
- _ <- keyDeleteB con $ map toUTF8 ["keystest3"]
+ _ <- keyDeleteB con $ map toUTF8 ["keystest0"]
+ _ <- keyDeleteB con $ map toUTF8 ["keystest1"]
disconnect con
H.assertEqual "keysB"
- (Just (RedisBulk [Just (RedisBulk [Just (RedisSingle $ toUTF8 "keystest2")])
- ,Just (RedisBulk [Just (RedisSingle $ toUTF8 "keystest3")])
+ (Just (RedisBulk [Just (RedisBulk [Just (RedisSingle $ toUTF8 "keystest0")])
+ ,Just (RedisBulk [Just (RedisSingle $ toUTF8 "keystest1")])
,Nothing]))
returning
@@ -118,7 +119,7 @@ keysBTest = do
keyRandomTest :: H.Assertion
keyRandomTest = do
con <- connect localhost defaultPort
- _ <- select con 0
+ _ <- select con 9
_ <- keyRandom con
disconnect con
H.assertEqual "keyRandom" "blah" "blah"
@@ -128,10 +129,11 @@ keyRandomTest = do
keyRenameTest :: H.Assertion
keyRenameTest = do
con <- connect localhost defaultPort
- _ <- select con 0
+ _ <- select con 9
_ <- itemSet con "renametest" "special"
_ <- keyRename con "renametest" "success"
returning <- keys con "success"
+ _ <- keyDelete con ["success"]
disconnect con
H.assertEqual "keysRename"
(Just (RedisBulk [Just (RedisBulk [Just (RedisSingle $ toUTF8 "success")])
@@ -139,3 +141,17 @@ keyRenameTest = do
returning
+------------------------------------------------------------------------------
+unwrapReplyBTest :: H.Assertion
+unwrapReplyBTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 9
+ _ <- listRightPush con "bulktest" "value0"
+ _ <- listRightPush con "bulktest" "value1"
+ returning <- listRange con "bulktest" 0 1
+ let test = unwrapReplyB returning
+ _ <- keyDelete con ["bulktest"]
+ disconnect con
+ H.assertEqual "unwrap" (map toUTF8 ["value0","value1"]) test
+
+