{-# 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