Merge pull request #8 from fujimura/add-tests

Add tests for insert operations

.travis.yml

@@ -1 +1,14 @@
 language: haskell
+
+services:
+  - mongodb
+
+before_install:
+  - cabal sandbox init && cabal install hpc-coveralls
+
+script:
+  - cabal configure --enable-tests --enable-library-coverage && cabal build
+  - .cabal-sandbox/bin/run-cabal-test --show-details=always
+
+after_script:
+  - .cabal-sandbox/bin/hpc-coveralls test --exclude-dir=test

mongoDB.cabal

@@ -55,10 +55,9 @@ Source-repository head
 
 test-suite test
   hs-source-dirs: test
-  main-is: main.hs
+  main-is: Spec.hs
   ghc-options:       -Wall
   type: exitcode-stdio-1.0
-
   build-depends:   mongoDB
                  , base
                  , mtl
@@ -66,4 +65,3 @@ test-suite test
 
   default-language: Haskell2010
   default-extensions: OverloadedStrings
-

test/QuerySpec.hs

@@ -0,0 +1,153 @@
+{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules, ScopedTypeVariables #-}
+{-# OPTIONS_GHC -fno-warn-type-defaults #-}
+
+module QuerySpec (spec) where
+import TestImport
+import Control.Exception
+
+testDBName :: Database
+testDBName = "mongodb-haskell-test"
+
+db :: Action IO a -> IO a
+db 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 = db $ dropDatabase testDBName
+
+spec :: Spec
+spec = around withCleanDatabase $ do
+  describe "useDb" $ do
+    it "changes the db" $ do
+      let anotherDBName = "another-mongodb-haskell-test"
+      db thisDatabase `shouldReturn` testDBName
+      db (useDb anotherDBName thisDatabase) `shouldReturn` anotherDBName
+
+  describe "insert" $ do
+    it "inserts a document to the collection and returns its _id" $ do
+      _id <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
+      result <- db $ 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 <- db $ insert_ "team" ["name" =: "Yankees", "league" =: "American"]
+      db (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:_) <- db $ insertMany "team" [ ["name" =: "Yankees", "league" =: "American"]
+                                                  , ["name" =: "Dodgers", "league" =: "American"]
+                                                  ]
+      result <- db $ 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 <- db $ insert "team" ["name" =: "Dodgers", "league" =: "American"]
+            _ <- db $ 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" $
+          db (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1
+
+        it "doesn't insert documents after it" $
+          db (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 <- db $ insertMany_ "team" [ ["name" =: "Yankees", "league" =: "American"]
+                                         , ["name" =: "Dodgers", "league" =: "American"]
+                                         ]
+      ids `shouldBe` ()
+
+    context "Insert a document with duplicating key" $ do
+      let insertDuplicatingDocument = do
+            _id <- db $ insert "team" ["name" =: "Dodgers", "league" =: "American"]
+            _ <- db $ 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" $
+          db (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1
+        it "doesn't insert documents after it" $
+          db (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:_) <- db $ insertAll "team" [ ["name" =: "Yankees", "league" =: "American"]
+                                                 , ["name" =: "Dodgers", "league" =: "American"]
+                                                 ]
+      result <- db $ 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 <- db $ insert "team" ["name" =: "Dodgers", "league" =: "American"]
+            _ <- db $ 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
+          db (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1
+          db (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 <- db $ insertAll_ "team" [ ["name" =: "Yankees", "league" =: "American"]
+                                        , ["name" =: "Dodgers", "league" =: "American"]
+                                        ]
+      ids `shouldBe` ()
+
+    context "Insert a document with duplicating key" $ do
+      let insertDuplicatingDocument = do
+            _id <- db $ insert "team" ["name" =: "Dodgers", "league" =: "American"]
+            _ <- db $ 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
+          db (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1
+          db (count $ select ["name" =: "Indians", "league" =: "American"] "team") `shouldReturn` 1
+
+      it "raises exception" $
+        insertDuplicatingDocument `shouldThrow` anyException

test/QueryTest.hs

@@ -1,14 +0,0 @@
-module QueryTest (querySpec) where
-import TestImport
-
-fakeDB :: MonadIO m => Action m a -> m a
-fakeDB = access (error "Pipe") (error "AccessMode") "fake"
-
-querySpec :: Spec
-querySpec =
-  describe "useDb" $
-    it "changes the db" $ do
-      db1 <- fakeDB thisDatabase
-      db1 `shouldBe` "fake"
-      db2 <- fakeDB $ useDb "use" thisDatabase
-      db2 `shouldBe` "use"

test/Spec.hs

@@ -0,0 +1 @@
+{-# OPTIONS_GHC -F -pgmF hspec-discover #-}

test/main.hs

@@ -1,8 +0,0 @@
-module Main where
-import Test.Hspec (hspec)
-
-import QueryTest
-
-main :: IO ()    
-main = hspec $ do
-  querySpec