{-# LANGUAGE ScopedTypeVariables #-} module Test.Monad.MultiCommands where import Control.Monad.Reader import Control.Exception import Control.Concurrent (threadDelay) import Control.Concurrent.MVar import Test.HUnit import Database.Redis.Monad import Database.Redis.Monad.State import Test.Setup import Test.Utils tests = TestList [TestLabel "run_multi" test_run_multi, TestLabel "run_multi with exception" test_run_multi_exception] run r = liftIO . runWithRedis r test_run_multi = TestCase $ testRedis2 $ let act = do set "foo" "cool" >>= liftIO . assertRQueued "" set "baz" "baz" >>= liftIO . assertRQueued "" liftIO $ threadDelay 2000 in do r1 <- ask r2 <- ask2 addStr (foo :: Maybe String) <- run r2 $ do foo <- get "foo" >>= fromRBulk exists "baz" >>= fromRInt >>= liftIO . assertEqual "" 0 return foo v <- liftIO $ later 1000 $ runWithRedis r2 $ get "foo" >>= liftIO . fromRBulk run r1 $ (run_multi act :: RedisM (Reply ())) liftIO $ takeMVar v >>= assertEqual "exec was not called yet" foo run r2 $ do get "foo" >>= fromRBulk >>= liftIO . assertEqual "now foo got a new value" (Just "cool") exists "baz" >>= fromRInt >>= liftIO . assertEqual "now baz is exists" 1 test_run_multi_exception = TestCase $ testRedis2 $ let act = do set "foo" "cool" >>= liftIO . assertRQueued "" set "baz" "baz" >>= liftIO . assertRQueued "" liftIO $ threadDelay 2000 error "bang!" in do r1 <- ask r2 <- ask2 addStr foo <- run r2 $ do foo <- get "foo" >>= fromRBulk :: RedisM (Maybe String) exists "baz" >>= fromRInt >>= liftIO . assertEqual "" 0 return foo v <- liftIO $ later 1000 $ runWithRedis r2 $ get "foo" >>= fromRBulk liftIO $ assertRaises "" (ErrorCall undefined) $ runWithRedis r1 $ (run_multi act :: RedisM (Reply ())) >> return () liftIO $ takeMVar v >>= assertEqual "exec was not called yet" foo run r2 $ do get "foo" >>= fromRBulk >>= liftIO . assertEqual "exception catched and multi statement was discarder" foo exists "baz" >>= fromRInt >>= liftIO . assertEqual "exception catched and multi statement was discarder" 0