summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--redis-hs.cabal2
-rw-r--r--src/Database/Redis/General.hs1
-rw-r--r--src/Database/Redis/Internal.hs12
-rw-r--r--test/redis-tests.cabal2
-rw-r--r--test/suite/Database/Redis/General/Tests.hs15
-rw-r--r--test/suite/Database/Redis/Set/Tests.hs30
6 files changed, 12 insertions, 50 deletions
diff --git a/redis-hs.cabal b/redis-hs.cabal
index c2f55be..7dfa2ce 100644
--- a/redis-hs.cabal
+++ b/redis-hs.cabal
@@ -1,5 +1,5 @@
name: redis-hs
-version: 0.1.1
+version: 0.1.2
author: Will Langstroth <will@langstroth.com>
maintainer: Will Langstroth <will@langstroth.com>
license: MIT
diff --git a/src/Database/Redis/General.hs b/src/Database/Redis/General.hs
index 4da0a50..636f199 100644
--- a/src/Database/Redis/General.hs
+++ b/src/Database/Redis/General.hs
@@ -207,6 +207,7 @@ unwrapReply reply =
Just (RedisError x) -> map fromUTF8 [x]
Just (RedisInteger x) -> [show x]
Just (RedisBulk x) -> map fromUTF8 $ catMaybes $ map bulks x
+ Just _ -> ["Error handling here"]
Nothing -> ["Nada"]
where
bulks rs = case rs of
diff --git a/src/Database/Redis/Internal.hs b/src/Database/Redis/Internal.hs
index fd40739..c801484 100644
--- a/src/Database/Redis/Internal.hs
+++ b/src/Database/Redis/Internal.hs
@@ -2,6 +2,8 @@
-- functions. The methods by which requests are processed are stylistically
-- modified versions of those found in Alexander Bogdanov's @redis@ package,
-- which can be found on hackage at <http://hackage.haskell.org/package/redis>
+-- I have found them faster for operations on UTF8 encoded text than @redis@
+-- package, but your mileage may vary.
module Database.Redis.Internal
( RedisReply(..)
@@ -105,9 +107,9 @@ processReply h = do
multiBulkReplies (-1) = return $ []
multiBulkReplies 0 = return $ []
multiBulkReplies n = do
- this <- processReply h
- rest <- multiBulkReplies (n - 1)
- return $! this : rest
+ r <- processReply h
+ rs <- multiBulkReplies (n - 1)
+ return $! r : rs
------------------------------------------------------------------------------
@@ -117,13 +119,13 @@ crlf = "\r\n"
------------------------------------------------------------------------------
--- | Not strictly necessary, but adds readability
+-- | Not strictly necessary, but can add readability
toUTF8 :: String -> ByteString
toUTF8 = U.fromString
------------------------------------------------------------------------------
--- | Not strictly necessary, but adds readability
+-- | Not strictly necessary, but can add readability
fromUTF8 :: ByteString -> String
fromUTF8 = U.toString
diff --git a/test/redis-tests.cabal b/test/redis-tests.cabal
index 1e2a192..2d805f9 100644
--- a/test/redis-tests.cabal
+++ b/test/redis-tests.cabal
@@ -1,5 +1,5 @@
name: redis-tests
-version: 0.1.0
+version: 0.1.2
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 5ad84bc..6754b2c 100644
--- a/test/suite/Database/Redis/General/Tests.hs
+++ b/test/suite/Database/Redis/General/Tests.hs
@@ -27,7 +27,6 @@ tests = [ testCase "redis keyExists" keyExistsTest
, testCase "redis keysB" keysBTest
, testCase "redis keyRandom" keyRandomTest
, testCase "redis keyRename" keyRenameTest
- , testCase "redis unwrapReplyB" unwrapReplyBTest
]
@@ -138,17 +137,3 @@ 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
-
-
diff --git a/test/suite/Database/Redis/Set/Tests.hs b/test/suite/Database/Redis/Set/Tests.hs
index ea2a744..2c541d6 100644
--- a/test/suite/Database/Redis/Set/Tests.hs
+++ b/test/suite/Database/Redis/Set/Tests.hs
@@ -21,8 +21,6 @@ import Database.Redis
tests :: [Test]
tests = [ testCase "redis setAdd" setAddTest
, testCase "redis setAddB" setAddBTest
- , testCase "redis setContains" setContainsTest
- , testCase "redis setContainsB" setContainsBTest
, testCase "redis setMembers" setMembersTest
, testCase "redis setMembersB" setMembersBTest
, testCase "redis setRemove" setRemoveTest
@@ -55,30 +53,6 @@ setAddBTest = do
------------------------------------------------------------------------------
-setContainsTest :: H.Assertion
-setContainsTest = do
- con <- connect localhost defaultPort
- _ <- select con 0
- _ <- setAdd con "setkey" "bob"
- returning <- setContains con "setkey" "bob"
- _ <- keyDelete con ["setkey"]
- disconnect con
- H.assertEqual "setContains" (Just $ RedisInteger 1) returning
-
-
-------------------------------------------------------------------------------
-setContainsBTest :: H.Assertion
-setContainsBTest = do
- con <- connect localhost defaultPort
- _ <- select con 0
- _ <- setAdd con "setbkey" "bob"
- returning <- setContainsB con (toUTF8 "setbkey") (toUTF8 "bob")
- _ <- keyDelete con ["setbkey"]
- disconnect con
- H.assertEqual "setContainsB" (Just $ RedisInteger 1) returning
-
-
-------------------------------------------------------------------------------
setMembersTest :: H.Assertion
setMembersTest = do
con <- connect localhost defaultPort
@@ -88,7 +62,7 @@ setMembersTest = do
returning <- setMembers con "nameset"
_ <- keyDelete con ["nameset"]
disconnect con
- H.assertEqual "setContains"
+ H.assertEqual "setMembers"
(Just (RedisBulk [Just (RedisBulk [Just (RedisSingle $ toUTF8 "Bob")])
,Just (RedisBulk [Just (RedisSingle $ toUTF8 "Jane")])]))
returning
@@ -104,7 +78,7 @@ setMembersBTest = do
returning <- setMembersB con (toUTF8 "namesetb")
_ <- keyDelete con ["namesetb"]
disconnect con
- H.assertEqual "setContains"
+ H.assertEqual "setMembers"
(Just (RedisBulk [Just (RedisBulk [Just (RedisSingle $ toUTF8 "Bob")])
,Just (RedisBulk [Just (RedisSingle $ toUTF8 "Jane")])]))
returning