From 70e8cbc9c2d4d3e7edf0d6d57a5c2bb6ef44f276 Mon Sep 17 00:00:00 2001 From: Fujimura Daisuke Date: Mon, 18 Aug 2014 15:05:44 +0800 Subject: [PATCH] Add tests for insert operations --- test/QuerySpec.hs | 155 +++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 147 insertions(+), 8 deletions(-) diff --git a/test/QuerySpec.hs b/test/QuerySpec.hs index 1e55a2f..1bd3cc8 100644 --- a/test/QuerySpec.hs +++ b/test/QuerySpec.hs @@ -1,15 +1,154 @@ -{-# LANGUAGE OverloadedStrings #-} +{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules, ScopedTypeVariables #-} +{-# OPTIONS_GHC -fno-warn-type-defaults #-} + module QuerySpec (spec) where import TestImport +import Control.Exception -fakeDB :: MonadIO m => Action m a -> m a -fakeDB = access (error "Pipe") (error "AccessMode") "fake" +testDBName :: Database +testDBName = "mongodb-haskell-test" + +fakeDB :: Action IO a -> IO a +fakeDB action = do + pipe <- connect (host "127.0.0.1") + result <- access pipe master testDBName action + close pipe + return result + +withCleanDatabase :: IO a -> IO () +withCleanDatabase action = dropDB >> action >> dropDB >> return () + where + dropDB = fakeDB $ dropDatabase testDBName spec :: Spec -spec = - describe "useDb" $ +spec = around withCleanDatabase $ do + describe "useDb" $ do it "changes the db" $ do db1 <- fakeDB thisDatabase - db1 `shouldBe` "fake" - db2 <- fakeDB $ useDb "use" thisDatabase - db2 `shouldBe` "use" + db1 `shouldBe` testDBName + db2 <- fakeDB $ useDb "another-mongodb-haskell-test" thisDatabase + db2 `shouldBe` "another-mongodb-haskell-test" + + describe "insert" $ do + it "inserts a document to the collection and returns its _id" $ do + _id <- fakeDB $ insert "team" ["name" =: "Yankees", "league" =: "American"] + result <- fakeDB $ rest =<< find (select [] "team") + result `shouldBe` [["_id" =: _id, "name" =: "Yankees", "league" =: "American"]] + + describe "insert_" $ do + it "inserts a document to the collection and doesn't return _id" $ do + _id <- fakeDB $ insert_ "team" ["name" =: "Yankees", "league" =: "American"] + fakeDB (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1 + _id `shouldBe` () + + describe "insertMany" $ do + it "inserts documents to the collection and returns their _ids" $ do + (_id1:_id2:_) <- fakeDB $ insertMany "team" [ ["name" =: "Yankees", "league" =: "American"] + , ["name" =: "Dodgers", "league" =: "American"] + ] + result <- fakeDB $ rest =<< find (select [] "team") + result `shouldBe` [ ["_id" =: _id1, "name" =: "Yankees", "league" =: "American"] + , ["_id" =: _id2, "name" =: "Dodgers", "league" =: "American"] + ] + context "Insert a document with duplicating key" $ do + let insertDuplicatingDocument = do + _id <- fakeDB $ insert "team" ["name" =: "Dodgers", "league" =: "American"] + _ <- fakeDB $ insertMany "team" [ ["name" =: "Yankees", "league" =: "American"] + -- Try to insert document with + -- duplicate key + , ["name" =: "Dodgers", "league" =: "American", "_id" =: _id] + , ["name" =: "Indians", "league" =: "American"] + ] + return () + + before (insertDuplicatingDocument `catch` \(_ :: Failure) -> return ()) $ do + it "inserts documents before it" $ + fakeDB ( count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1 + + it "doesn't insert documents after it" $ + fakeDB ( count $ select ["name" =: "Indians", "league" =: "American"] "team") `shouldReturn` 0 + + it "raises exception" $ + insertDuplicatingDocument `shouldThrow` anyException + -- TODO No way to call getLastError? + + describe "insertMany_" $ do + it "inserts documents to the collection and returns nothing" $ do + ids <- fakeDB $ insertMany_ "team" [ ["name" =: "Yankees", "league" =: "American"] + , ["name" =: "Dodgers", "league" =: "American"] + ] + ids `shouldBe` () + + context "Insert a document with duplicating key" $ do + let insertDuplicatingDocument = do + _id <- fakeDB $ insert "team" ["name" =: "Dodgers", "league" =: "American"] + _ <- fakeDB $ insertMany_ "team" [ ["name" =: "Yankees", "league" =: "American"] + -- Try to insert document with + -- duplicate key + , ["name" =: "Dodgers", "league" =: "American", "_id" =: _id] + , ["name" =: "Indians", "league" =: "American"] + ] + return () + + before (insertDuplicatingDocument `catch` \(_ :: Failure) -> return ()) $ do + it "inserts documents before it" $ + fakeDB (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1 + it "doesn't insert documents after it" $ + fakeDB (count $ select ["name" =: "Indians", "league" =: "American"] "team") `shouldReturn` 0 + it "raises exception" $ + insertDuplicatingDocument `shouldThrow` anyException + + describe "insertAll" $ do + it "inserts documents to the collection and returns their _ids" $ do + (_id1:_id2:_) <- fakeDB $ insertAll "team" [ ["name" =: "Yankees", "league" =: "American"] + , ["name" =: "Dodgers", "league" =: "American"] + ] + result <- fakeDB $ rest =<< find (select [] "team") + result `shouldBe` [["_id" =: _id1, "name" =: "Yankees", "league" =: "American"] + ,["_id" =: _id2, "name" =: "Dodgers", "league" =: "American"] + ] + + context "Insert a document with duplicating key" $ do + let insertDuplicatingDocument = do + _id <- fakeDB $ insert "team" ["name" =: "Dodgers", "league" =: "American"] + _ <- fakeDB $ insertAll "team" [ ["name" =: "Yankees", "league" =: "American"] + -- Try to insert document with + -- duplicate key + , ["name" =: "Dodgers", "league" =: "American", "_id" =: _id] + , ["name" =: "Indians", "league" =: "American"] + ] + return () + + before (insertDuplicatingDocument `catch` \(_ :: Failure) -> return ()) $ do + it "inserts all documents which can be inserted" $ do + fakeDB (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1 + fakeDB (count $ select ["name" =: "Indians", "league" =: "American"] "team") `shouldReturn` 1 + + it "raises exception" $ + insertDuplicatingDocument `shouldThrow` anyException + + describe "insertAll_" $ do + it "inserts documents to the collection and returns their _ids" $ do + ids <- fakeDB $ insertAll_ "team" [ ["name" =: "Yankees", "league" =: "American"] + , ["name" =: "Dodgers", "league" =: "American"] + ] + ids `shouldBe` () + + context "Insert a document with duplicating key" $ do + let insertDuplicatingDocument = do + _id <- fakeDB $ insert "team" ["name" =: "Dodgers", "league" =: "American"] + _ <- fakeDB $ insertAll_ "team" [ ["name" =: "Yankees", "league" =: "American"] + -- Try to insert document with + -- duplicate key + , ["name" =: "Dodgers", "league" =: "American", "_id" =: _id] + , ["name" =: "Indians", "league" =: "American"] + ] + return () + + before (insertDuplicatingDocument `catch` \(_ :: Failure) -> return ()) $ do + it "inserts all documents which can be inserted" $ do + fakeDB (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1 + fakeDB (count $ select ["name" =: "Indians", "league" =: "American"] "team") `shouldReturn` 1 + + it "raises exception" $ + insertDuplicatingDocument `shouldThrow` anyException