redis-0.10: Test/StringCommands.hs

module Test.StringCommands where

import Test.HUnit
import Control.Monad.Reader
import Data.Maybe
import Database.Redis.Redis
import Test.Setup
import Test.Utils

tests = TestList [TestLabel "get and set" test_set_get,
                  TestLabel "setNx" test_setNx,
                  TestLabel "setEx" test_setEx,
                  TestLabel "mSet and mGet" test_m_set_get,
                  TestLabel "mSetNx" test_mSetNx,
                  TestLabel "getSet" test_getSet,
                  TestLabel "incr and incrBy, decr and decrBy" test_incr_decr,
                  TestLabel "append" test_append,
                  TestLabel "substr" test_substr,
                  TestLabel "strlen" test_strlen]

test_set_get = TestCase $ testRedis $
    do r <- ask
       addStr
       liftIO $ do get r "foo" >>= fromRBulk >>= assertEqual "" (Just "foo")
                   set r "foo" "zoo" >>= fromROk
                   get r "foo" >>= fromRBulk >>= assertEqual "foo was set to zoo" (Just "zoo")

test_setNx = TestCase $ testRedis $
    do r <- ask
       addStr
       liftIO $ do setNx r "foo" "zoo" >>= fromRInt >>= assertEqual "setNx doesn't replace key value" 0
                   get r "foo" >>= fromRBulk >>= assertEqual "" (Just "foo")

test_setEx = TestCase $ testRedis $
    do r <- ask
       addStr
       liftIO $ do setEx r "foo" 30 "zoo" >>= fromROk
                   get r "foo" >>= fromRBulk >>= assertEqual "foo was set to zoo" (Just "zoo")
                   ttl r "foo" >>= fromRInt >>= assertBool "foo TTL must be less then 30 seconds" . (<= 30)

test_m_set_get = TestCase $ testRedis $
    do r <- ask
       addStr
       liftIO $ do mSet r [("foo", "zoo"), ("zoo", "foo")] >>= fromROk
                   mGet r ["foo", "zoo", "baz"] >>= fromRMultiBulk >>= assertEqual "" (Just [Just "zoo", Just "foo", Nothing])

test_mSetNx = TestCase $ testRedis $
    do r <- ask
       addStr
       liftIO $ do mSetNx r [("foo", "zoo"), ("zoo", "foo")] >>= fromRInt >>= assertEqual "foo already exists" 0
                   mGet r ["foo", "zoo"] >>= fromRMultiBulk >>= assertEqual "" (Just [Just "foo", Nothing])

test_getSet = TestCase $ testRedis $
    do r <- ask
       addStr
       liftIO $ do getSet r "foo" "zoo" >>= fromRBulk >>= assertEqual "" (Just "foo")
                   get r "foo" >>= fromRBulk >>= assertEqual "foo was set to zoo" (Just "zoo")

test_incr_decr = TestCase $ testRedis $
    do r <- ask
       addStr
       liftIO $ do set r "i" (0 :: Int) >>= fromROk
                   incr r "i" >>= fromRInt >>= assertEqual "" 1
                   (get r "i" :: IO (Reply String)) >>= fromRBulk >>= assertEqual "" (Just "1")
                   incrBy r "i" 2 >>= fromRInt >>= assertEqual "" 3
                   (get r "i" :: IO (Reply String)) >>= fromRBulk >>= assertEqual "" (Just "3")
                   decr r "i" >>= fromRInt >>= assertEqual "" 2
                   (get r "i" :: IO (Reply String)) >>= fromRBulk >>= assertEqual "" (Just "2")
                   decrBy r "i" 2 >>= fromRInt >>= assertEqual "" 0
                   (get r "i" :: IO (Reply String)) >>= fromRBulk >>= assertEqual "" (Just "0")

test_append = TestCase $ testRedis $
    do r <- ask
       addStr
       liftIO $ do Just foo <- get r "foo" >>= fromRBulk
                   newlength <- append r "foo" "foo" >>= fromRInt
                   Just foo' <- get r "foo" >>= fromRBulk
                   assertEqual ("Expected: \"" ++ foo ++ "\" ++ \"foo\"") (foo ++ "foo") foo'
                   assertEqual "" (length foo') newlength

test_substr = TestCase $ testRedis $
    do r <- ask
       addStr
       liftIO $ do Just foo <- get r "foo" >>= fromRBulk
                   let s = take 1 . drop 1 $ foo :: String
                   substr r "foo" (1, 1) >>= fromRBulk >>= assertEqual "" (Just s)

test_strlen = TestCase $ testRedis $
    do r <- ask
       addStr
       liftIO $ do Just foo <- get r "foo" >>= fromRBulk
                   strlen r "foo" >>= fromRInt >>= assertEqual ("lenght of \"" ++ foo ++ "\"" ) (length foo)