Skip to content
Browse files

more tests, different keys, consistent parameters, listIndex still fa…

…iling after UTF8 input
  • Loading branch information...
1 parent 21f93a3 commit cf5fd568b5daa70c64b6be63fa073895c0146c1f @wlangstroth wlangstroth committed
Showing with 44 additions and 16 deletions.
  1. +4 −4 Database/Redis/Simple.hs
  2. +40 −12 test/suite/Database/Redis/Simple/Tests.hs
View
8 Database/Redis/Simple.hs
@@ -45,8 +45,8 @@ itemGet :: Binary a
=> Redis -- ^ Redis handle
-> Key -- ^ Key of the value to get
-> IO (Maybe a) -- ^ Resulting value
-itemGet redis key = do
- reply <- get redis $ unKey key
+itemGet redis (Key key) = do
+ reply <- get redis key
return $ case reply of RBulk (Just r) -> Just $ decode r
_ -> Nothing
@@ -147,8 +147,8 @@ listIndex :: Binary a
-> Key -- ^ Key of the list
-> Int -- ^ Index
-> IO (Maybe a) -- ^ Resulting value
-listIndex redis key idx = do
- reply <- lindex redis (unKey key) idx
+listIndex redis (Key key) idx = do
+ reply <- lindex redis key idx
return $ case reply of RBulk (Just r) -> Just $ decode r
_ -> Nothing
View
52 test/suite/Database/Redis/Simple/Tests.hs
@@ -6,7 +6,7 @@ module Database.Redis.Simple.Tests
import qualified Data.ByteString.UTF8 as U
-- import qualified Data.ByteString.Char8 as B
-- import qualified Data.ByteString.Lazy.Char8 as L
--- import Data.Maybe
+import Data.Maybe
import Test.Framework (Test)
import Test.Framework.Providers.HUnit
-- import Test.Framework.Providers.QuickCheck2
@@ -24,7 +24,9 @@ tests = [ testCase "redis-simple itemSet" itemSetTest
, testCase "redis-simple itemGet" itemGetTest
, testCase "redis-simple itemExists" itemExistsTest
, testCase "redis-simple setAdd" setAddTest
--- , testCase "redis-simple listRightPush" listRightPushTest
+ , testCase "redis-simple setContains" setContainsTest
+ , testCase "redis-simple listRightPush" listRightPushTest
+ , testCase "redis-simple listIndex" listIndexTest
-- , testCase "redis-simple itemDelete" deleteTest
-- , testCase "redis-simple itemIsNoMore" itemIsNoMoreTest
]
@@ -32,8 +34,7 @@ tests = [ testCase "redis-simple itemSet" itemSetTest
------------------------------------------------------------------------------
-- N.B. These tests are simple checks for basically successful behaviour,
--- but cannot be comprehensive, since that would require testing the
--- underlying library. Grano salis.
+-- but are not comprehensive.
testing :: String
@@ -44,6 +45,14 @@ testKey :: Key
testKey = Key $ U.fromString "single"
+listKey :: Key
+listKey = Key $ U.fromString "thelist"
+
+
+setKey :: Key
+setKey = Key $ U.fromString "theset"
+
+
------------------------------------------------------------------------------
itemSetTest :: H.Assertion
itemSetTest = do
@@ -94,25 +103,44 @@ itemIsNoMoreTest = do
H.assertEqual "Item set should no longer exist" False returning
+-}
+------------------------------------------------------------------------------
+setAddTest :: H.Assertion
+setAddTest = do
+ con <- connect "127.0.0.1" defaultPort
+ _ <- select con 0
+ returning <- setAdd con setKey testing
+ disconnect con
+ H.assertEqual "setAdd (SADD)" () returning
+
+
+------------------------------------------------------------------------------
+setContainsTest :: H.Assertion
+setContainsTest = do
+ con <- connect "127.0.0.1" defaultPort
+ _ <- select con 0
+ returning <- setContains con setKey testing
+ disconnect con
+ H.assertEqual "Item set should exist" True returning
+
+
------------------------------------------------------------------------------
listRightPushTest :: H.Assertion
listRightPushTest = do
con <- connect "127.0.0.1" defaultPort
_ <- select con 0
- _ <- listRightPush con testKey testing
- returning <- listIndex con testKey 0
+ returning <- listRightPush con listKey testing
disconnect con
- H.assertEqual "listRightPush (RPUSH)" testing (fromJust returning)
+ H.assertEqual "listRightPush (RPUSH)" () returning
--}
------------------------------------------------------------------------------
-setAddTest :: H.Assertion
-setAddTest = do
+listIndexTest :: H.Assertion
+listIndexTest = do
con <- connect "127.0.0.1" defaultPort
_ <- select con 0
- returning <- setAdd con testKey testing
+ Just returning <- listIndex con listKey 1
disconnect con
- H.assertEqual "setAdd (SADD)" () returning
+ H.assertEqual "listIndex (LINDEX)" testing returning

0 comments on commit cf5fd56

Please sign in to comment.
Something went wrong with that request. Please try again.