redis-0.10: Test/Setup.hs

{-# LANGUAGE FlexibleContexts #-}
module Test.Setup where

import Control.Exception (bracket)
import Control.Concurrent
import Control.Monad.Reader
import Test.HUnit
import System.Cmd
import System.Directory
import System.FilePath
import Database.Redis.Redis

startRedis :: FilePath -> IO ()
startRedis path_to_redis = do cwd <- getCurrentDirectory
                              system $ path_to_redis ++ " " ++ (cwd </> "redis.conf")
                              threadDelay $ 10000
                              return ()

shutdownRedis = do r <- connect localhost defaultPort
                   shutdown r
                   return ()

testRedis :: (ReaderT Redis IO ()) -> IO ()
testRedis t = bracket setup teardown $ runReaderT t
    where setup = do r <- connect localhost defaultPort
                     select r 0
                     return r
          teardown r = do flushAll r
                          disconnect r

testRedis2 :: (ReaderT Redis (ReaderT Redis IO) ()) -> IO ()
testRedis2 t = bracket setup teardown $ \(r1, r2) -> runReaderT (runReaderT t r2) r1
    where setup = do r1 <- connect localhost defaultPort
                     select r1 0
                     r2 <- connect localhost defaultPort
                     select r2 0
                     return (r1, r2)
          teardown (r1, r2) = do flushAll r1
                                 disconnect r1
                                 disconnect r2

ask2 :: (MonadReader a m, MonadTrans t) => t m a
ask2 = lift ask

addStr :: (MonadReader Redis m, MonadIO m) => m ()
addStr = do r <- ask
            liftIO $ do set r "foo" "foo"
                        set r "bar" "bar"
            return ()

addList :: (MonadReader Redis m, MonadIO m) => m ()
addList = do r <- ask
             liftIO $ mapM_ (rpush r "list") ["1", "2", "3"]


addSet :: (MonadReader Redis m, MonadIO m) => m ()
addSet = do r <- ask
            liftIO $ mapM_ (sadd r "set") ["1", "2", "3"]

addZSet :: (MonadReader Redis m, MonadIO m) => m ()
addZSet = do r <- ask
             liftIO $ mapM_ (uncurry (zadd r "zset")) $ zip (reverse [1.0, 2.0, 3.0, 4.0, 5.0]) ["1", "2", "3", "4", "5"]

addHash :: (MonadReader Redis m, MonadIO m) => m ()
addHash = do r <- ask
             liftIO $ mapM_ (uncurry (hset r "hash")) $ zip ["foo", "bar", "baz"] ["1", "2", "3"]

addAll :: (MonadReader Redis m, MonadIO m) => m ()
addAll = addStr >> addList >> addSet >> addZSet >> addHash