From f6d886e8bd30fadf63a2e7585a183898a50be9ba Mon Sep 17 00:00:00 2001 From: Fujimura Daisuke Date: Mon, 18 Aug 2014 14:37:05 +0800 Subject: [PATCH 1/7] Reorganize specs --- mongoDB.cabal | 4 +--- test/{QueryTest.hs => QuerySpec.hs} | 7 ++++--- test/Spec.hs | 1 + test/main.hs | 8 -------- 4 files changed, 6 insertions(+), 14 deletions(-) rename test/{QueryTest.hs => QuerySpec.hs} (78%) create mode 100644 test/Spec.hs delete mode 100644 test/main.hs diff --git a/mongoDB.cabal b/mongoDB.cabal index 16a6b54..d2fd10c 100644 --- a/mongoDB.cabal +++ b/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 - diff --git a/test/QueryTest.hs b/test/QuerySpec.hs similarity index 78% rename from test/QueryTest.hs rename to test/QuerySpec.hs index e957232..1e55a2f 100644 --- a/test/QueryTest.hs +++ b/test/QuerySpec.hs @@ -1,11 +1,12 @@ -module QueryTest (querySpec) where +{-# LANGUAGE OverloadedStrings #-} +module QuerySpec (spec) where import TestImport fakeDB :: MonadIO m => Action m a -> m a fakeDB = access (error "Pipe") (error "AccessMode") "fake" -querySpec :: Spec -querySpec = +spec :: Spec +spec = describe "useDb" $ it "changes the db" $ do db1 <- fakeDB thisDatabase diff --git a/test/Spec.hs b/test/Spec.hs new file mode 100644 index 0000000..a824f8c --- /dev/null +++ b/test/Spec.hs @@ -0,0 +1 @@ +{-# OPTIONS_GHC -F -pgmF hspec-discover #-} diff --git a/test/main.hs b/test/main.hs deleted file mode 100644 index 5e74cec..0000000 --- a/test/main.hs +++ /dev/null @@ -1,8 +0,0 @@ -module Main where -import Test.Hspec (hspec) - -import QueryTest - -main :: IO () -main = hspec $ do - querySpec From 38b65f35dc7f4aa759c111861f2331d1fa7bfe8c Mon Sep 17 00:00:00 2001 From: Fujimura Daisuke Date: Mon, 18 Aug 2014 15:23:22 +0800 Subject: [PATCH 2/7] Update travis.yml to use mongodb --- .travis.yml | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/.travis.yml b/.travis.yml index 6a21913..7a22b05 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1 +1,3 @@ -language: haskell \ No newline at end of file +language: haskell +services: + - mongodb From b88ef1cc929416914e858ef282bb17bcc2ffe5ca Mon Sep 17 00:00:00 2001 From: Fujimura Daisuke Date: Mon, 18 Aug 2014 15:27:17 +0800 Subject: [PATCH 3/7] Measure code coverage with coveralls.io --- .travis.yml | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/.travis.yml b/.travis.yml index 7a22b05..1587db1 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,3 +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 From 70e8cbc9c2d4d3e7edf0d6d57a5c2bb6ef44f276 Mon Sep 17 00:00:00 2001 From: Fujimura Daisuke Date: Mon, 18 Aug 2014 15:05:44 +0800 Subject: [PATCH 4/7] 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 From c6d6f8c71ace9eec4714315386ee83c853f0499d Mon Sep 17 00:00:00 2001 From: Fujimura Daisuke Date: Tue, 19 Aug 2014 12:01:05 +0800 Subject: [PATCH 5/7] Minor refactor Use `shouldReturn` --- test/QuerySpec.hs | 7 +++---- 1 file changed, 3 insertions(+), 4 deletions(-) diff --git a/test/QuerySpec.hs b/test/QuerySpec.hs index 1bd3cc8..eb38a9f 100644 --- a/test/QuerySpec.hs +++ b/test/QuerySpec.hs @@ -24,10 +24,9 @@ spec :: Spec spec = around withCleanDatabase $ do describe "useDb" $ do it "changes the db" $ do - db1 <- fakeDB thisDatabase - db1 `shouldBe` testDBName - db2 <- fakeDB $ useDb "another-mongodb-haskell-test" thisDatabase - db2 `shouldBe` "another-mongodb-haskell-test" + let anotherDBName = "another-mongodb-haskell-test" + fakeDB thisDatabase `shouldReturn` testDBName + fakeDB (useDb anotherDBName thisDatabase) `shouldReturn` anotherDBName describe "insert" $ do it "inserts a document to the collection and returns its _id" $ do From 3dd594999a844f8ba531b36f0c1f046d40b7ea9b Mon Sep 17 00:00:00 2001 From: Fujimura Daisuke Date: Tue, 19 Aug 2014 21:29:18 +0800 Subject: [PATCH 6/7] Rename `fakeDB` to `db` --- test/QuerySpec.hs | 62 +++++++++++++++++++++++------------------------ 1 file changed, 31 insertions(+), 31 deletions(-) diff --git a/test/QuerySpec.hs b/test/QuerySpec.hs index eb38a9f..f63ed30 100644 --- a/test/QuerySpec.hs +++ b/test/QuerySpec.hs @@ -8,8 +8,8 @@ import Control.Exception testDBName :: Database testDBName = "mongodb-haskell-test" -fakeDB :: Action IO a -> IO a -fakeDB action = do +db :: Action IO a -> IO a +db action = do pipe <- connect (host "127.0.0.1") result <- access pipe master testDBName action close pipe @@ -18,41 +18,41 @@ fakeDB action = do withCleanDatabase :: IO a -> IO () withCleanDatabase action = dropDB >> action >> dropDB >> return () where - dropDB = fakeDB $ dropDatabase testDBName + dropDB = db $ dropDatabase testDBName spec :: Spec spec = around withCleanDatabase $ do describe "useDb" $ do it "changes the db" $ do let anotherDBName = "another-mongodb-haskell-test" - fakeDB thisDatabase `shouldReturn` testDBName - fakeDB (useDb anotherDBName thisDatabase) `shouldReturn` anotherDBName + 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 <- fakeDB $ insert "team" ["name" =: "Yankees", "league" =: "American"] - result <- fakeDB $ rest =<< find (select [] "team") + _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 <- fakeDB $ insert_ "team" ["name" =: "Yankees", "league" =: "American"] - fakeDB (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1 + _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:_) <- fakeDB $ insertMany "team" [ ["name" =: "Yankees", "league" =: "American"] + (_id1:_id2:_) <- db $ insertMany "team" [ ["name" =: "Yankees", "league" =: "American"] , ["name" =: "Dodgers", "league" =: "American"] ] - result <- fakeDB $ rest =<< find (select [] "team") + 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 <- fakeDB $ insert "team" ["name" =: "Dodgers", "league" =: "American"] - _ <- fakeDB $ insertMany "team" [ ["name" =: "Yankees", "league" =: "American"] + _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] @@ -62,10 +62,10 @@ spec = around withCleanDatabase $ do before (insertDuplicatingDocument `catch` \(_ :: Failure) -> return ()) $ do it "inserts documents before it" $ - fakeDB ( count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1 + db ( 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 + db ( count $ select ["name" =: "Indians", "league" =: "American"] "team") `shouldReturn` 0 it "raises exception" $ insertDuplicatingDocument `shouldThrow` anyException @@ -73,15 +73,15 @@ spec = around withCleanDatabase $ do describe "insertMany_" $ do it "inserts documents to the collection and returns nothing" $ do - ids <- fakeDB $ insertMany_ "team" [ ["name" =: "Yankees", "league" =: "American"] + 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 <- fakeDB $ insert "team" ["name" =: "Dodgers", "league" =: "American"] - _ <- fakeDB $ insertMany_ "team" [ ["name" =: "Yankees", "league" =: "American"] + _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] @@ -91,26 +91,26 @@ spec = around withCleanDatabase $ do before (insertDuplicatingDocument `catch` \(_ :: Failure) -> return ()) $ do it "inserts documents before it" $ - fakeDB (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1 + db (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 + 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:_) <- fakeDB $ insertAll "team" [ ["name" =: "Yankees", "league" =: "American"] + (_id1:_id2:_) <- db $ insertAll "team" [ ["name" =: "Yankees", "league" =: "American"] , ["name" =: "Dodgers", "league" =: "American"] ] - result <- fakeDB $ rest =<< find (select [] "team") + 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 <- fakeDB $ insert "team" ["name" =: "Dodgers", "league" =: "American"] - _ <- fakeDB $ insertAll "team" [ ["name" =: "Yankees", "league" =: "American"] + _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] @@ -120,23 +120,23 @@ spec = around withCleanDatabase $ do 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 + 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 <- fakeDB $ insertAll_ "team" [ ["name" =: "Yankees", "league" =: "American"] + 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 <- fakeDB $ insert "team" ["name" =: "Dodgers", "league" =: "American"] - _ <- fakeDB $ insertAll_ "team" [ ["name" =: "Yankees", "league" =: "American"] + _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] @@ -146,8 +146,8 @@ spec = around withCleanDatabase $ do 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 + 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 From 7354bf0ada26b134c8d276d48e6fbb93324ec4c1 Mon Sep 17 00:00:00 2001 From: Fujimura Daisuke Date: Tue, 19 Aug 2014 21:30:07 +0800 Subject: [PATCH 7/7] Minor code format fix --- test/QuerySpec.hs | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/QuerySpec.hs b/test/QuerySpec.hs index f63ed30..8615919 100644 --- a/test/QuerySpec.hs +++ b/test/QuerySpec.hs @@ -62,10 +62,10 @@ spec = around withCleanDatabase $ do before (insertDuplicatingDocument `catch` \(_ :: Failure) -> return ()) $ do it "inserts documents before it" $ - db ( count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1 + 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 + db (count $ select ["name" =: "Indians", "league" =: "American"] "team") `shouldReturn` 0 it "raises exception" $ insertDuplicatingDocument `shouldThrow` anyException