redis-0.12: Test/SortCommands.hs

{-
Copyright (c) 2010-2011, Alexander Bogdanov <andorn@gmail.com>
License: MIT
-}

module Test.SortCommands where

import Data.Char (toUpper)
import Data.List hiding (sort)
import Data.ByteString.UTF8 (fromString)
import qualified Data.List as L
import System.Random
import Test.Setup

tests = TList [TLabel "sort asc and desc" test_sort_asc_desc,
               TLabel "sort alpha" test_sort_alpha,
               TLabel "sort_by" test_sort_by,
               TLabel "sort get_obj" test_sort_get,
               TLabel "sort store" test_sort_store,
               TLabel "listRelated" test_listRelated]

addUserList name l = do r <- ask
                        lift $ mapM_ (rpush r name) l

unsortedList = randomRIOs ((0 :: Int), 99) 10
unsortedAlphaList = randomRIOs ('a', 'z') 10
unsortedAlphaList2 = randomRIOs ('а', 'я') 10 -- non-ASCII string

test_sort_asc_desc = TCase $ testRedis $
    do r <- ask
       l <- liftIO unsortedList
       addUserList "l" l
       liftIO $ do l' <- sort r "l" sortDefaults >>= fromRMultiBulk >>= return . map fromJust . fromJust
                   assertEqual "" (L.sort l) l'
                   l' <- sort r "l" sortDefaults{desc = True} >>= fromRMultiBulk >>= return . map fromJust . fromJust
                   assertEqual "" (reverse $ L.sort l) l'

test_sort_alpha = TCase $ testRedis $
    do r <- ask
       l1 <- liftIO unsortedAlphaList
       l2 <- liftIO unsortedAlphaList2
       addUserList "l1" l1
       addUserList "l2" l2
       liftIO $ do l' <- sort r "l1" sortDefaults{alpha = True} >>= fromRMultiBulk >>= return . map fromJust . fromJust
                   assertEqual "" (L.sort l1) l'
                   l' <- sort r "l2" sortDefaults{alpha = True} >>= fromRMultiBulk >>= return . map fromJust . fromJust
                   assertEqual "" (L.sort l2) l'
                   l' <- sort r "l1" sortDefaults{desc = True, alpha = True} >>= fromRMultiBulk >>= return . map fromJust . fromJust
                   assertEqual "" (reverse $ L.sort l1) l'
                   l' <- sort r "l2" sortDefaults{desc = True, alpha = True} >>= fromRMultiBulk >>= return . map fromJust . fromJust
                   assertEqual "" (reverse $ L.sort l2) l'

test_sort_by = TCase $ testRedis $
    do r <- ask
       l <- liftIO unsortedList
       addUserList "l" l
       -- set bounch of kes foo_* for sort l in reverse order
       liftIO $ mapM_ (\x -> set r ("foo_" ++ show x) (-x)) [(0 :: Int)..99]

       liftIO $ do l' <- sort r "l" sortDefaults{sort_by = fromString "foo_*"} >>= fromRMultiBulk >>= return . map fromJust . fromJust
                   assertEqual "" (reverse $ L.sort l) l'
                   l' <- sort r "l" sortDefaults{sort_by = fromString "constant"} >>= fromRMultiBulk >>= return . map fromJust . fromJust
                   assertEqual "" l l'

test_sort_get = TCase $ testRedis $
    do r <- ask
       l <- liftIO unsortedAlphaList
       addUserList "l" l
       liftIO $ mapM_ (\x -> set r ("foo_" ++ [x]) (toUpper x) >> set r ("bar_" ++ [x]) 'x') ['a' .. 'z']

       liftIO $ do l' <- sort r "l" sortDefaults{alpha = True, get_obj = [fromString "foo_*", fromString "bar_*"]} >>= fromRMultiBulk >>= return . map fromJust . fromJust
                   assertEqual "" ((++ "x") $ intersperse 'x' $ map toUpper $ L.sort l) l'

test_sort_store = TCase $ testRedis $
    do r <- ask
       l <- liftIO unsortedAlphaList
       addUserList "l" l
       liftIO $ mapM_ (\x -> set r ("foo_" ++ [x]) (toUpper x) >> set r ("bar_" ++ [x]) 'x') ['a' .. 'z']
       liftIO $ do l' <- sort r "l" sortDefaults{alpha = True, get_obj = [fromString "foo_*"]} >>= fromRMultiBulk >>= return . map fromJust . fromJust :: IO [Char]
                   (sort r "l" sortDefaults{alpha = True, get_obj = [fromString "foo_*"], store = fromString "l2"} :: IO (Reply ())) >>= noError
                   l'' <- lrange r "l2" takeAll >>= fromRMultiBulk >>= return . map fromJust . fromJust
                   assertEqual "" l' l''

test_listRelated = TCase $ testRedis $
    do r <- ask
       addList
       liftIO $ mapM_ (\x -> set r ("foo_" ++ show x) (x^2)) [(1 :: Int)..3]
       liftIO $ do l <- lrange r "list" takeAll >>= fromRMultiBulk >>= return . map fromJust . fromJust :: IO [Int]
                   l' <- listRelated r "foo_*" "list" takeAll >>= fromRMultiBulk >>= return . map fromJust . fromJust
                   assertEqual  "" (map (^2) l) l'