summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorWillLangstroth <>2010-11-08 17:39:35 (GMT)
committerLuite Stegeman <luite@luite.com>2010-11-08 17:39:35 (GMT)
commit223496a1cf2e128106a7a58ddfad010f5ded4e68 (patch)
treeae290edf83a3664defaaa3a8ce682cb20bccd192
parent2ef7bbdf724f6a46948ed0df68a610d78af92f11 (diff)
version 0.0.80.0.8
-rw-r--r--LICENSE2
-rw-r--r--redis-hs.cabal15
-rw-r--r--src/Database/Redis/Connection.hs3
-rw-r--r--src/Database/Redis/General.hs42
-rw-r--r--src/Database/Redis/Internal.hs6
-rw-r--r--src/Database/Redis/List.hs27
-rw-r--r--test/redis-tests.cabal2
-rw-r--r--test/suite/Database/Redis/Connection/Tests.hs30
-rw-r--r--test/suite/Database/Redis/General/Tests.hs80
-rw-r--r--test/suite/Database/Redis/List/Tests.hs99
-rw-r--r--test/suite/Database/Redis/Set/Tests.hs87
-rw-r--r--test/suite/Database/Redis/String/Tests.hs49
-rw-r--r--test/suite/Database/Redis/Tests.hs227
-rw-r--r--test/suite/TestSuite.hs22
14 files changed, 429 insertions, 262 deletions
diff --git a/LICENSE b/LICENSE
index 2fd9054..761b4d3 100644
--- a/LICENSE
+++ b/LICENSE
@@ -1,4 +1,4 @@
-Copyright (c) 2010 Contributors
+Copyright © 2010 Will Langstroth
Permission is hereby granted, free of charge, to any person
obtaining a copy of this software and associated documentation
diff --git a/redis-hs.cabal b/redis-hs.cabal
index 6fb478f..9484754 100644
--- a/redis-hs.cabal
+++ b/redis-hs.cabal
@@ -1,5 +1,5 @@
name: redis-hs
-version: 0.0.7
+version: 0.0.8
author: Will Langstroth <will@langstroth.com>
maintainer: Will Langstroth <will@langstroth.com>
license: MIT
@@ -16,8 +16,7 @@ description:
The feature set is incomplete, and version 1.0.0 will be tagged only when the
library has full command coverage, reasonable test coverage, and solid
documentation.
- .
- The source code is available on GitHub <http://github.com/wlangstroth/redis-hs>.
+
category: Database
build-type: Simple
@@ -30,7 +29,11 @@ extra-source-files:
README.md,
test/redis-tests.cabal,
test/suite/TestSuite.hs,
- test/suite/Database/Redis/Tests.hs
+ test/suite/Database/Redis/Connection/Tests.hs
+ test/suite/Database/Redis/General/Tests.hs
+ test/suite/Database/Redis/List/Tests.hs
+ test/suite/Database/Redis/Set/Tests.hs
+ test/suite/Database/Redis/String/Tests.hs
library
hs-source-dirs: src
@@ -47,10 +50,12 @@ library
build-depends:
base == 4.*,
bytestring >= 0.9,
- mtl == 2.*,
+-- mtl == 2.*,
network >= 2.2.3,
utf8-string >= 0.3.5
+ ghc-options: -Wall -fwarn-tabs
+
source-repository head
type: git
location: http://github.com/wlangstroth/snap-core.git
diff --git a/src/Database/Redis/Connection.hs b/src/Database/Redis/Connection.hs
index 4623dd0..e3f3b8e 100644
--- a/src/Database/Redis/Connection.hs
+++ b/src/Database/Redis/Connection.hs
@@ -1,3 +1,6 @@
+-- | Module containing all the functions necessary to make a connection to
+-- the Redis server.
+
module Database.Redis.Connection
( defaultPort
, localhost
diff --git a/src/Database/Redis/General.hs b/src/Database/Redis/General.hs
index e04ccac..d1139e4 100644
--- a/src/Database/Redis/General.hs
+++ b/src/Database/Redis/General.hs
@@ -1,9 +1,11 @@
module Database.Redis.General
( RedisReply(..)
, keyExists
+ , keyExistsB
, keyDelete
, keyType
, keys
+ , keysB
, keyRandom
, select
, toUTF8
@@ -18,43 +20,57 @@ import Database.Redis.Internal
------------------------------------------------------------------------------
--- EXISTS
+-- | Calls `EXISTS` with a 'String' argument
keyExists :: Handle
- -> String
+ -> String -- ^ key
-> IO (Maybe RedisReply)
keyExists h key = request h $ map toUTF8 ["EXISTS", key]
--- EXISTS for ByteString input
+-- | Calls `EXISTS` with a 'ByteString' argument
keyExistsB :: Handle
- -> ByteString
+ -> ByteString -- ^ key
-> IO (Maybe RedisReply)
keyExistsB h key = request h [toUTF8 "EXISTS", key]
------------------------------------------------------------------------------
--- DEL
--- FIXME: should handle multiple deletions
-keyDelete :: Handle -> String -> IO (Maybe RedisReply)
+-- | Calls `DEL` with a /single/ 'String' argument. This function does not
+-- yet accept multiple keys.
+keyDelete :: Handle
+ -> String -- ^ key to delete
+ -> IO (Maybe RedisReply)
keyDelete h key = request h $ map toUTF8 ["DEL", key]
------------------------------------------------------------------------------
--- TYPE
-keyType :: Handle -> String -> IO (Maybe RedisReply)
+-- | Calls `TYPE` with a 'String' argument
+keyType :: Handle
+ -> String
+ -> IO (Maybe RedisReply)
keyType h key = request h $ map toUTF8 ["TYPE", key]
------------------------------------------------------------------------------
--- KEYS
-keys :: Handle -> String -> IO (Maybe RedisReply)
+-- | Calls `KEYS` with a 'String' argument
+keys :: Handle
+ -> String
+ -> IO (Maybe RedisReply)
keys h pattern = request h $ map toUTF8 ["KEYS", pattern]
+-- | Calls `KEYS` with a 'String' argument
+keysB :: Handle
+ -> ByteString
+ -> IO (Maybe RedisReply)
+keysB h pattern = request h [toUTF8 "KEYS", pattern]
+
+
------------------------------------------------------------------------------
-- RANDOMKEY
-keyRandom :: Handle -> IO (Maybe RedisReply)
-keyRandom h = request h $ map toUTF8 ["RANDOMKEY"]
+keyRandom :: Handle
+ -> IO (Maybe RedisReply)
+keyRandom h = request h [toUTF8 "RANDOMKEY"]
-- RENAME
diff --git a/src/Database/Redis/Internal.hs b/src/Database/Redis/Internal.hs
index 6985cc8..a4b6c77 100644
--- a/src/Database/Redis/Internal.hs
+++ b/src/Database/Redis/Internal.hs
@@ -1,3 +1,7 @@
+{-
+-- | This module processes requests and replies.
+-}
+
module Database.Redis.Internal
( RedisReply(..)
, ByteString
@@ -8,6 +12,8 @@ module Database.Redis.Internal
) where
+-- import Data.Maybe
+
import Data.ByteString.UTF8 (ByteString)
import qualified Data.ByteString.UTF8 as U
import qualified Data.ByteString as B
diff --git a/src/Database/Redis/List.hs b/src/Database/Redis/List.hs
index d7abeb2..4e3405d 100644
--- a/src/Database/Redis/List.hs
+++ b/src/Database/Redis/List.hs
@@ -1,3 +1,9 @@
+{-
+-- | This module interacts with the list structure in Redis. All the functions
+-- take either 'String' or 'ByteString' arguments, but send 'ByteString'
+-- 'request's regardless.
+-}
+
module Database.Redis.List
( listRightPush
, listRightPushB
@@ -11,14 +17,13 @@ module Database.Redis.List
, listIndexB
) where
--- import Data.ByteString (ByteString)
import System.IO
import Database.Redis.Internal
------------------------------------------------------------------------------
--- | RPUSH
+-- | Calls `RPUSH` with 'String' arguments
listRightPush :: Handle
-> String -- ^ key
-> String -- ^ value
@@ -26,7 +31,7 @@ listRightPush :: Handle
listRightPush h key value = request h $ map toUTF8 ["RPUSH", key, value]
--- | RPUSH for ByteString input
+-- | Calls `RPUSH` with 'ByteString' arguments
listRightPushB :: Handle
-> ByteString -- ^ key
-> ByteString -- ^ value
@@ -35,7 +40,7 @@ listRightPushB h key value = request h [toUTF8 "RPUSH", key, value]
------------------------------------------------------------------------------
--- LPUSH
+-- | Calls `LPUSH` with 'String' arguments
listLeftPush :: Handle
-> String -- ^ key
-> String -- ^ value
@@ -43,7 +48,7 @@ listLeftPush :: Handle
listLeftPush h key value = request h $ map toUTF8 ["LPUSH", key, value]
--- | LPUSH for ByteString input
+-- | Calls `LPUSH` with 'ByteString' arguments
listLeftPushB :: Handle
-> ByteString -- ^ key
-> ByteString -- ^ value
@@ -52,14 +57,14 @@ listLeftPushB h key value = request h [toUTF8 "LPUSH", key, value]
------------------------------------------------------------------------------
--- | LLEN
+-- | Calls `LLEN` with a 'String' argument
listLength :: Handle
-> String -- ^ key
-> IO (Maybe RedisReply)
listLength h key = request h $ map toUTF8 ["LLEN", key]
--- | LLEN for ByteString input
+-- | Calls `LLEN` with a 'ByteString' argument
listLengthB :: Handle
-> ByteString -- ^ key
-> IO (Maybe RedisReply)
@@ -67,7 +72,7 @@ listLengthB h key = request h [toUTF8 "LLEN", key]
------------------------------------------------------------------------------
--- | LRANGE
+-- | Calls `LRANGE` with a 'String' argument
listRange :: Handle
-> String -- ^ key
-> Int -- ^ start
@@ -77,7 +82,7 @@ listRange h key start end =
request h $ map toUTF8 ["LRANGE", key, show start, show end]
--- | LRANGE for ByteString input
+-- | Calls `LRANGE` with a 'ByteString' argument
listRangeB :: Handle
-> ByteString -- ^ key
-> Int -- ^ start
@@ -92,7 +97,7 @@ listRangeB h key start end =
------------------------------------------------------------------------------
--- LINDEX
+-- | Calls `LINDEX` with 'String' and 'Int' arguments
listIndex :: Handle
-> String -- ^ key
-> Int -- ^ index
@@ -101,7 +106,7 @@ listIndex h key index =
request h $ map toUTF8 ["LINDEX", key, show index]
--- LINDEX for ByteString input
+-- | Calls `LINDEX` with 'ByteString' and 'Int' arguments
listIndexB :: Handle
-> ByteString -- ^ key
-> Int -- ^ index
diff --git a/test/redis-tests.cabal b/test/redis-tests.cabal
index 11f9681..32e0c2e 100644
--- a/test/redis-tests.cabal
+++ b/test/redis-tests.cabal
@@ -1,5 +1,5 @@
name: redis-tests
-version: 0.0.7
+version: 0.0.8
build-type: Simple
cabal-version: >= 1.6
diff --git a/test/suite/Database/Redis/Connection/Tests.hs b/test/suite/Database/Redis/Connection/Tests.hs
new file mode 100644
index 0000000..1582305
--- /dev/null
+++ b/test/suite/Database/Redis/Connection/Tests.hs
@@ -0,0 +1,30 @@
+module Database.Redis.Connection.Tests
+ ( tests ) where
+
+
+------------------------------------------------------------------------------
+import Test.Framework (Test)
+import Test.Framework.Providers.HUnit
+import qualified Test.HUnit as H
+
+
+import Database.Redis
+
+
+------------------------------------------------------------------------------
+-- N.B. These aren't proper tests yet, just checks
+
+
+------------------------------------------------------------------------------
+tests :: [Test]
+tests = [ testCase "redis-link ping" pingTest ]
+
+------------------------------------------------------------------------------
+pingTest :: H.Assertion
+pingTest = do
+ con <- connect localhost defaultPort
+ returning <- ping con
+ disconnect con
+ H.assertEqual "ping" (Just $ RedisSingle $ toUTF8 "PONG") returning
+
+
diff --git a/test/suite/Database/Redis/General/Tests.hs b/test/suite/Database/Redis/General/Tests.hs
new file mode 100644
index 0000000..15b97da
--- /dev/null
+++ b/test/suite/Database/Redis/General/Tests.hs
@@ -0,0 +1,80 @@
+module Database.Redis.General.Tests
+ ( tests ) where
+
+
+------------------------------------------------------------------------------
+import Test.Framework (Test)
+import Test.Framework.Providers.HUnit
+-- import Test.Framework.Providers.QuickCheck2
+import qualified Test.HUnit as H
+-- import Test.QuickCheck
+-- import Test.QuickCheck.Monadic
+
+import Database.Redis
+
+
+------------------------------------------------------------------------------
+-- N.B. These aren't proper tests yet, just checks
+
+
+------------------------------------------------------------------------------
+tests :: [Test]
+tests = [ testCase "redis-link keyExists" keyExistsTest
+ , testCase "redis-link keyType" keyTypeTest
+ , testCase "redis-link keys" keysTest
+ , testCase "redis-link keyRandom" keyRandomTest
+ ]
+
+
+------------------------------------------------------------------------------
+keyExistsTest :: H.Assertion
+keyExistsTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 0
+ _ <- itemSet con "thekey" "thevalue"
+ returning <- keyExists con "thekey"
+ _ <- keyDelete con "thekey"
+ disconnect con
+ H.assertEqual "keyExistsTest" (Just $ RedisInteger 1) returning
+
+
+------------------------------------------------------------------------------
+keyTypeTest :: H.Assertion
+keyTypeTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 0
+ _ <- itemSet con "typekey" "typevalue"
+ returning <- keyType con "typekey"
+ _ <- keyDelete con "typekey"
+ disconnect con
+ H.assertEqual "keyTypeTest" (Just $ RedisSingle $ toUTF8 "string") returning
+
+
+------------------------------------------------------------------------------
+keysTest :: H.Assertion
+keysTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 0
+ _ <- itemSet con "keystest0" "value"
+ _ <- itemSet con "keystest1" "value"
+ returning <- keys con "keys*"
+ _ <- keyDelete con "keystest0"
+ _ <- keyDelete con "keystest1"
+ disconnect con
+ H.assertEqual "keysTest"
+ (Just (RedisBulk [Just (RedisBulk [Just (RedisSingle $ toUTF8 "keystest0")])
+ ,Just (RedisBulk [Just (RedisSingle $ toUTF8 "keystest1")])
+ ,Nothing]))
+ returning
+
+
+------------------------------------------------------------------------------
+keyRandomTest :: H.Assertion
+keyRandomTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 0
+ returning <- keyRandom con
+ disconnect con
+ H.assertEqual "keyRandomTest" "blah" "blah"
+
+
diff --git a/test/suite/Database/Redis/List/Tests.hs b/test/suite/Database/Redis/List/Tests.hs
new file mode 100644
index 0000000..a672ad8
--- /dev/null
+++ b/test/suite/Database/Redis/List/Tests.hs
@@ -0,0 +1,99 @@
+module Database.Redis.List.Tests
+ ( tests ) where
+
+
+------------------------------------------------------------------------------
+import Test.Framework (Test)
+import Test.Framework.Providers.HUnit
+-- import Test.Framework.Providers.QuickCheck2
+import qualified Test.HUnit as H
+-- import Test.QuickCheck
+-- import Test.QuickCheck.Monadic
+
+import Database.Redis
+
+
+------------------------------------------------------------------------------
+-- N.B. These aren't proper tests yet, just checks
+
+
+------------------------------------------------------------------------------
+tests :: [Test]
+tests = [ testCase "redis-link listRightPush" listRightPushTest
+ , testCase "redis-link listLeftPush" listLeftPushTest
+ , testCase "redis-link listIndex" listIndexTest
+ , testCase "redis-link listLength" listLengthTest
+ , testCase "redis-link listRange" listRangeTest
+ ]
+
+
+------------------------------------------------------------------------------
+listRightPushTest :: H.Assertion
+listRightPushTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 0
+ returning <- listRightPush con "thelist" "theitem"
+ _ <- keyDelete con "thelist"
+ disconnect con
+ H.assertBool "listRightPush" $ case returning of
+ Just (RedisInteger _) -> True
+ _ -> False
+
+
+------------------------------------------------------------------------------
+listLeftPushTest :: H.Assertion
+listLeftPushTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 0
+ returning <- listLeftPush con "leftlist" "anitem"
+ _ <- keyDelete con "leftlist"
+ disconnect con
+ H.assertBool "listLeftPush" $ case returning of
+ Just (RedisInteger _) -> True
+ _ -> False
+
+
+------------------------------------------------------------------------------
+listLengthTest :: H.Assertion
+listLengthTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 0
+ _ <- listRightPush con "lengthlist" "anitem"
+ _ <- listRightPush con "lengthlist" "anitem"
+ returning <- listLength con "lengthlist"
+ _ <- keyDelete con "lengthlist"
+ disconnect con
+ H.assertEqual "listLeftPush" (Just $ RedisInteger 2) returning
+
+
+------------------------------------------------------------------------------
+listIndexTest :: H.Assertion
+listIndexTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 0
+ _ <- listRightPush con "indexlist" "theitem"
+ returning <- listIndex con "indexlist" 0
+ _ <- keyDelete con "indexlist"
+ disconnect con
+ H.assertEqual "listIndex"
+ (Just $ RedisBulk [Just (RedisSingle $ toUTF8 "theitem")])
+ returning
+
+
+------------------------------------------------------------------------------
+listRangeTest :: H.Assertion
+listRangeTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 0
+ _ <- listRightPush con "alist" "value0"
+ _ <- listRightPush con "alist" "value1"
+ returning <- listRange con "alist" 0 1
+ _ <- keyDelete con "alist"
+ disconnect con
+ H.assertEqual "listRange"
+ (Just (RedisBulk [Just (RedisBulk [Just (RedisSingle $ toUTF8 "value0")])
+ ,Just (RedisBulk [Just (RedisSingle $ toUTF8 "value1")])
+ ,Nothing]))
+ returning
+
+
diff --git a/test/suite/Database/Redis/Set/Tests.hs b/test/suite/Database/Redis/Set/Tests.hs
new file mode 100644
index 0000000..0ef7c91
--- /dev/null
+++ b/test/suite/Database/Redis/Set/Tests.hs
@@ -0,0 +1,87 @@
+module Database.Redis.Set.Tests
+ ( tests ) where
+
+
+------------------------------------------------------------------------------
+import Test.Framework (Test)
+import Test.Framework.Providers.HUnit
+-- import Test.Framework.Providers.QuickCheck2
+import qualified Test.HUnit as H
+-- import Test.QuickCheck
+-- import Test.QuickCheck.Monadic
+
+import Database.Redis
+
+
+------------------------------------------------------------------------------
+-- N.B. These aren't proper tests yet, just checks
+
+
+------------------------------------------------------------------------------
+tests :: [Test]
+tests = [ testCase "redis-link setAdd" setAddTest
+ , testCase "redis-link setContains" setContainsTest
+ , testCase "redis-link setMembers" setMembersTest
+ , testCase "redis-link setRemove" setRemoveTest
+ ]
+
+
+------------------------------------------------------------------------------
+setAddTest :: H.Assertion
+setAddTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 0
+ returning <- setAdd con "theset" "bob"
+ _ <- keyDelete con "theset"
+ disconnect con
+ H.assertEqual "setAdd" (Just $ RedisInteger 1) returning
+
+
+------------------------------------------------------------------------------
+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
+
+
+------------------------------------------------------------------------------
+setMembersTest :: H.Assertion
+setMembersTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 0
+ _ <- setAdd con "nameset" "Bob"
+ _ <- setAdd con "nameset" "Jane"
+ returning <- setMembers con "nameset"
+ _ <- keyDelete con "setkey"
+ disconnect con
+ H.assertEqual "setContains"
+ (Just (RedisBulk [Just (RedisBulk [Just (RedisSingle $ toUTF8 "Bob")])
+ ,Just (RedisBulk [Just (RedisSingle $ toUTF8 "Jane")])
+ ,Nothing]))
+ returning
+
+
+------------------------------------------------------------------------------
+setRemoveTest :: H.Assertion
+setRemoveTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 0
+ _ <- setAdd con "setit" "Bob"
+ _ <- setAdd con "setit" "Frank"
+ _ <- setAdd con "setit" "Jane"
+ _ <- setRemove con "setit" "Frank"
+ returning <- setMembers con "setit"
+ _ <- keyDelete con "setit"
+ disconnect con
+ H.assertEqual "setRemove"
+ (Just (RedisBulk [Just (RedisBulk [Just (RedisSingle $ toUTF8 "Bob")])
+ ,Just (RedisBulk [Just (RedisSingle $ toUTF8 "Jane")])
+ ,Nothing]))
+ returning
+
+
diff --git a/test/suite/Database/Redis/String/Tests.hs b/test/suite/Database/Redis/String/Tests.hs
new file mode 100644
index 0000000..b1e1c10
--- /dev/null
+++ b/test/suite/Database/Redis/String/Tests.hs
@@ -0,0 +1,49 @@
+module Database.Redis.String.Tests
+ ( tests ) where
+
+
+------------------------------------------------------------------------------
+import Test.Framework (Test)
+import Test.Framework.Providers.HUnit
+-- import Test.Framework.Providers.QuickCheck2
+import qualified Test.HUnit as H
+-- import Test.QuickCheck
+-- import Test.QuickCheck.Monadic
+
+import Database.Redis
+
+
+------------------------------------------------------------------------------
+-- N.B. These aren't proper tests yet, just checks
+
+
+------------------------------------------------------------------------------
+tests :: [Test]
+tests = [ testCase "redis-link itemSet" itemSetTest
+ , testCase "redis-link itemGet" itemGetTest
+ ]
+
+
+------------------------------------------------------------------------------
+itemSetTest :: H.Assertion
+itemSetTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 0
+ returning <- itemSet con "akey" "ἐστίν"
+ _ <- keyDelete con "akey"
+ disconnect con
+ H.assertEqual "itemSet" (Just $ RedisSingle $ toUTF8 "OK") returning
+
+
+------------------------------------------------------------------------------
+itemGetTest :: H.Assertion
+itemGetTest = do
+ con <- connect localhost defaultPort
+ _ <- select con 0
+ _ <- itemSet con "differentKey" "ἐστίν"
+ returning <- itemGet con "differentKey"
+ _ <- keyDelete con "differentKey"
+ disconnect con
+ H.assertEqual "itemGet" (Just $ RedisBulk [Just (RedisSingle $ toUTF8 "ἐστίν")]) returning
+
+
diff --git a/test/suite/Database/Redis/Tests.hs b/test/suite/Database/Redis/Tests.hs
deleted file mode 100644
index a55f74c..0000000
--- a/test/suite/Database/Redis/Tests.hs
+++ /dev/null
@@ -1,227 +0,0 @@
-module Database.Redis.Tests
- ( tests ) where
-
-
-------------------------------------------------------------------------------
--- import Data.ByteString.Char8 (ByteString)
--- import qualified Data.ByteString.Char8 as B
--- import qualified Data.ByteString.Lazy.Char8 as L
--- import Data.Maybe
-import Test.Framework (Test)
-import Test.Framework.Providers.HUnit
--- import Test.Framework.Providers.QuickCheck2
-import qualified Test.HUnit as H
--- import Test.QuickCheck
--- import Test.QuickCheck.Monadic
-
-import Database.Redis
-
-
-------------------------------------------------------------------------------
--- N.B. These aren't proper tests yet, just checks
-
-
-------------------------------------------------------------------------------
-tests :: [Test]
-tests = [ testCase "redis-link ping" pingTest
- , testCase "redis-link itemSet" itemSetTest
- , testCase "redis-link itemGet" itemGetTest
- , testCase "redis-link keyExists" keyExistsTest
- , testCase "redis-link keyType" keyTypeTest
- , testCase "redis-link listRightPush" listRightPushTest
- , testCase "redis-link listLeftPush" listLeftPushTest
- , testCase "redis-link listIndex" listIndexTest
- , testCase "redis-link listLength" listLengthTest
- , testCase "redis-link listRange" listRangeTest
- , testCase "redis-link setAdd" setAddTest
- , testCase "redis-link setContains" setContainsTest
- , testCase "redis-link setMembers" setMembersTest
- , testCase "redis-link setRemove" setRemoveTest
- ]
-
-
-------------------------------------------------------------------------------
-pingTest :: H.Assertion
-pingTest = do
- con <- connect localhost defaultPort
- returning <- ping con
- disconnect con
- H.assertEqual "ping" (Just $ RedisSingle $ toUTF8 "PONG") returning
-
-
-------------------------------------------------------------------------------
-itemSetTest :: H.Assertion
-itemSetTest = do
- con <- connect localhost defaultPort
- _ <- select con 0
- returning <- itemSet con "akey" "ἐστίν"
- _ <- keyDelete con "akey"
- disconnect con
- H.assertEqual "itemSet" (Just $ RedisSingle $ toUTF8 "OK") returning
-
-
-------------------------------------------------------------------------------
-itemGetTest :: H.Assertion
-itemGetTest = do
- con <- connect localhost defaultPort
- _ <- select con 0
- _ <- itemSet con "differentKey" "ἐστίν"
- returning <- itemGet con "differentKey"
- _ <- keyDelete con "differentKey"
- disconnect con
- H.assertEqual "itemGet" (Just $ RedisBulk [Just (RedisSingle $ toUTF8 "ἐστίν")]) returning
-
-
-------------------------------------------------------------------------------
-keyExistsTest :: H.Assertion
-keyExistsTest = do
- con <- connect localhost defaultPort
- _ <- select con 0
- _ <- itemSet con "thekey" "thevalue"
- returning <- keyExists con "thekey"
- _ <- keyDelete con "thekey"
- disconnect con
- H.assertEqual "keyExistsTest" (Just $ RedisInteger 1) returning
-
-
-------------------------------------------------------------------------------
-keyTypeTest :: H.Assertion
-keyTypeTest = do
- con <- connect localhost defaultPort
- _ <- select con 0
- _ <- itemSet con "typekey" "typevalue"
- returning <- keyType con "typekey"
- _ <- keyDelete con "typekey"
- disconnect con
- H.assertEqual "keyTypeTest" (Just $ RedisSingle $ toUTF8 "string") returning
-
-
-------------------------------------------------------------------------------
-listRightPushTest :: H.Assertion
-listRightPushTest = do
- con <- connect localhost defaultPort
- _ <- select con 0
- returning <- listRightPush con "thelist" "theitem"
- _ <- keyDelete con "thelist"
- disconnect con
- H.assertBool "listRightPush" $ case returning of
- Just (RedisInteger _) -> True
- _ -> False
-
-
-------------------------------------------------------------------------------
-listLeftPushTest :: H.Assertion
-listLeftPushTest = do
- con <- connect localhost defaultPort
- _ <- select con 0
- returning <- listLeftPush con "leftlist" "anitem"
- _ <- keyDelete con "leftlist"
- disconnect con
- H.assertBool "listLeftPush" $ case returning of
- Just (RedisInteger _) -> True
- _ -> False
-
-
-------------------------------------------------------------------------------
-listLengthTest :: H.Assertion
-listLengthTest = do
- con <- connect localhost defaultPort
- _ <- select con 0
- _ <- listRightPush con "lengthlist" "anitem"
- _ <- listRightPush con "lengthlist" "anitem"
- returning <- listLength con "lengthlist"
- _ <- keyDelete con "lengthlist"
- disconnect con
- H.assertEqual "listLeftPush" (Just $ RedisInteger 2) returning
-
-
-------------------------------------------------------------------------------
-listIndexTest :: H.Assertion
-listIndexTest = do
- con <- connect localhost defaultPort
- _ <- select con 0
- _ <- listRightPush con "indexlist" "theitem"
- returning <- listIndex con "indexlist" 0
- _ <- keyDelete con "indexlist"
- disconnect con
- H.assertEqual "listIndex"
- (Just $ RedisBulk [Just (RedisSingle $ toUTF8 "theitem")])
- returning
-
-
-------------------------------------------------------------------------------
-listRangeTest :: H.Assertion
-listRangeTest = do
- con <- connect localhost defaultPort
- _ <- select con 0
- _ <- listRightPush con "alist" "value0"
- _ <- listRightPush con "alist" "value1"
- returning <- listRange con "alist" 0 1
- _ <- keyDelete con "alist"
- disconnect con
- H.assertEqual "listRange"
- (Just (RedisBulk [Just (RedisBulk [Just (RedisSingle $ toUTF8 "value0")])
- ,Just (RedisBulk [Just (RedisSingle $ toUTF8 "value1")])
- ,Nothing]))
- returning
-
-
-------------------------------------------------------------------------------
-setAddTest :: H.Assertion
-setAddTest = do
- con <- connect localhost defaultPort
- _ <- select con 0
- returning <- setAdd con "theset" "bob"
- _ <- keyDelete con "theset"
- disconnect con
- H.assertEqual "setAdd" (Just $ RedisInteger 1) returning
-
-
-------------------------------------------------------------------------------
-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
-
-
-------------------------------------------------------------------------------
-setMembersTest :: H.Assertion
-setMembersTest = do
- con <- connect localhost defaultPort
- _ <- select con 0
- _ <- setAdd con "nameset" "Bob"
- _ <- setAdd con "nameset" "Jane"
- returning <- setMembers con "nameset"
- _ <- keyDelete con "setkey"
- disconnect con
- H.assertEqual "setContains"
- (Just (RedisBulk [Just (RedisBulk [Just (RedisSingle $ toUTF8 "Bob")])
- ,Just (RedisBulk [Just (RedisSingle $ toUTF8 "Jane")])
- ,Nothing]))
- returning
-
-
-------------------------------------------------------------------------------
-setRemoveTest :: H.Assertion
-setRemoveTest = do
- con <- connect localhost defaultPort
- _ <- select con 0
- _ <- setAdd con "setit" "Bob"
- _ <- setAdd con "setit" "Frank"
- _ <- setAdd con "setit" "Jane"
- _ <- setRemove con "setit" "Frank"
- returning <- setMembers con "setit"
- _ <- keyDelete con "setit"
- disconnect con
- H.assertEqual "setRemove"
- (Just (RedisBulk [Just (RedisBulk [Just (RedisSingle $ toUTF8 "Bob")])
- ,Just (RedisBulk [Just (RedisSingle $ toUTF8 "Jane")])
- ,Nothing]))
- returning
-
-
diff --git a/test/suite/TestSuite.hs b/test/suite/TestSuite.hs
index c08892d..a090b76 100644
--- a/test/suite/TestSuite.hs
+++ b/test/suite/TestSuite.hs
@@ -1,11 +1,25 @@
module Main where
+
import Test.Framework (defaultMain, testGroup)
-import qualified Database.Redis.Tests
+import qualified Database.Redis.General.Tests
+import qualified Database.Redis.Connection.Tests
+import qualified Database.Redis.String.Tests
+import qualified Database.Redis.List.Tests
+import qualified Database.Redis.Set.Tests
+
+
main :: IO ()
main = defaultMain tests
- where tests = [
- testGroup "Database.Redis.Tests"
- Database.Redis.Tests.tests
+ where tests = [ testGroup "Database.Redis.General.Tests"
+ Database.Redis.General.Tests.tests
+ , testGroup "Database.Redis.Connection.Tests"
+ Database.Redis.Connection.Tests.tests
+ , testGroup "Database.Redis.String.Tests"
+ Database.Redis.String.Tests.tests
+ , testGroup "Database.Redis.List.Tests"
+ Database.Redis.List.Tests.tests
+ , testGroup "Database.Redis.Set.Tests"
+ Database.Redis.Set.Tests.tests
]