Merge pull request #8 from fujimura/add-tests
Add tests for insert operations
This commit is contained in:
commit
a77370f2d9
6 changed files with 169 additions and 26 deletions
13
.travis.yml
13
.travis.yml
|
@ -1 +1,14 @@
|
||||||
language: haskell
|
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
|
||||||
|
|
|
@ -55,10 +55,9 @@ Source-repository head
|
||||||
|
|
||||||
test-suite test
|
test-suite test
|
||||||
hs-source-dirs: test
|
hs-source-dirs: test
|
||||||
main-is: main.hs
|
main-is: Spec.hs
|
||||||
ghc-options: -Wall
|
ghc-options: -Wall
|
||||||
type: exitcode-stdio-1.0
|
type: exitcode-stdio-1.0
|
||||||
|
|
||||||
build-depends: mongoDB
|
build-depends: mongoDB
|
||||||
, base
|
, base
|
||||||
, mtl
|
, mtl
|
||||||
|
@ -66,4 +65,3 @@ test-suite test
|
||||||
|
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
default-extensions: OverloadedStrings
|
default-extensions: OverloadedStrings
|
||||||
|
|
||||||
|
|
153
test/QuerySpec.hs
Normal file
153
test/QuerySpec.hs
Normal file
|
@ -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
|
|
@ -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"
|
|
1
test/Spec.hs
Normal file
1
test/Spec.hs
Normal file
|
@ -0,0 +1 @@
|
||||||
|
{-# OPTIONS_GHC -F -pgmF hspec-discover #-}
|
|
@ -1,8 +0,0 @@
|
||||||
module Main where
|
|
||||||
import Test.Hspec (hspec)
|
|
||||||
|
|
||||||
import QueryTest
|
|
||||||
|
|
||||||
main :: IO ()
|
|
||||||
main = hspec $ do
|
|
||||||
querySpec
|
|
Loading…
Reference in a new issue