mongodb/test/QuerySpec.hs

124 lines
5.9 KiB
Haskell
Raw Normal View History

2014-08-18 07:05:44 +00:00
{-# LANGUAGE OverloadedStrings, ExtendedDefaultRules, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-type-defaults #-}
2014-08-18 06:37:05 +00:00
module QuerySpec (spec) where
2014-08-07 15:54:38 +00:00
import TestImport
2014-08-18 07:05:44 +00:00
import Control.Exception
testDBName :: Database
testDBName = "mongodb-haskell-test"
2014-08-19 13:29:18 +00:00
db :: Action IO a -> IO a
db action = do
2014-08-18 07:05:44 +00:00
pipe <- connect (host "127.0.0.1")
result <- access pipe master testDBName action
close pipe
return result
2014-08-07 15:54:38 +00:00
2015-03-05 20:00:01 +00:00
withCleanDatabase :: ActionWith () -> IO ()
withCleanDatabase action = dropDB >> action () >> dropDB >> return ()
2014-08-18 07:05:44 +00:00
where
2014-08-19 13:29:18 +00:00
dropDB = db $ dropDatabase testDBName
2014-08-07 15:54:38 +00:00
2015-03-18 09:34:01 +00:00
insertDuplicateWith :: (Collection -> [Document] -> Action IO a) -> IO ()
insertDuplicateWith testInsert = do
_id <- db $ insert "team" ["name" =: "Dodgers", "league" =: "American"]
_ <- db $ testInsert "team" [ ["name" =: "Yankees", "league" =: "American"]
-- Try to insert document with duplicate key
, ["name" =: "Dodgers", "league" =: "American", "_id" =: _id]
, ["name" =: "Indians", "league" =: "American"]
]
return ()
2014-08-18 06:37:05 +00:00
spec :: Spec
2014-08-18 07:05:44 +00:00
spec = around withCleanDatabase $ do
describe "useDb" $ do
2014-08-07 15:54:38 +00:00
it "changes the db" $ do
2014-08-19 04:01:05 +00:00
let anotherDBName = "another-mongodb-haskell-test"
2014-08-19 13:29:18 +00:00
db thisDatabase `shouldReturn` testDBName
db (useDb anotherDBName thisDatabase) `shouldReturn` anotherDBName
2014-08-18 07:05:44 +00:00
describe "insert" $ do
it "inserts a document to the collection and returns its _id" $ do
2014-08-19 13:29:18 +00:00
_id <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
result <- db $ rest =<< find (select [] "team")
2014-08-18 07:05:44 +00:00
result `shouldBe` [["_id" =: _id, "name" =: "Yankees", "league" =: "American"]]
describe "insert_" $ do
it "inserts a document to the collection and doesn't return _id" $ do
2014-08-19 13:29:18 +00:00
_id <- db $ insert_ "team" ["name" =: "Yankees", "league" =: "American"]
db (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1
2014-08-18 07:05:44 +00:00
_id `shouldBe` ()
describe "insertMany" $ do
it "inserts documents to the collection and returns their _ids" $ do
2014-08-19 13:29:18 +00:00
(_id1:_id2:_) <- db $ insertMany "team" [ ["name" =: "Yankees", "league" =: "American"]
2014-08-18 07:05:44 +00:00
, ["name" =: "Dodgers", "league" =: "American"]
]
2014-08-19 13:29:18 +00:00
result <- db $ rest =<< find (select [] "team")
2014-08-18 07:05:44 +00:00
result `shouldBe` [ ["_id" =: _id1, "name" =: "Yankees", "league" =: "American"]
, ["_id" =: _id2, "name" =: "Dodgers", "league" =: "American"]
]
context "Insert a document with duplicating key" $ do
2015-03-18 09:34:01 +00:00
before (insertDuplicateWith insertMany `catch` \(_ :: Failure) -> return ()) $ do
2014-08-18 07:05:44 +00:00
it "inserts documents before it" $
2014-08-19 13:30:07 +00:00
db (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1
2014-08-18 07:05:44 +00:00
it "doesn't insert documents after it" $
2014-08-19 13:30:07 +00:00
db (count $ select ["name" =: "Indians", "league" =: "American"] "team") `shouldReturn` 0
2014-08-18 07:05:44 +00:00
it "raises exception" $
2015-03-18 09:34:01 +00:00
insertDuplicateWith insertMany `shouldThrow` anyException
2014-08-18 07:05:44 +00:00
-- TODO No way to call getLastError?
describe "insertMany_" $ do
it "inserts documents to the collection and returns nothing" $ do
2014-08-19 13:29:18 +00:00
ids <- db $ insertMany_ "team" [ ["name" =: "Yankees", "league" =: "American"]
2014-08-18 07:05:44 +00:00
, ["name" =: "Dodgers", "league" =: "American"]
]
ids `shouldBe` ()
context "Insert a document with duplicating key" $ do
2015-03-18 09:34:01 +00:00
before (insertDuplicateWith insertMany_ `catch` \(_ :: Failure) -> return ()) $ do
2014-08-18 07:05:44 +00:00
it "inserts documents before it" $
2014-08-19 13:29:18 +00:00
db (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1
2014-08-18 07:05:44 +00:00
it "doesn't insert documents after it" $
2014-08-19 13:29:18 +00:00
db (count $ select ["name" =: "Indians", "league" =: "American"] "team") `shouldReturn` 0
2014-08-18 07:05:44 +00:00
it "raises exception" $
2015-03-18 09:34:01 +00:00
insertDuplicateWith insertMany_ `shouldThrow` anyException
2014-08-18 07:05:44 +00:00
describe "insertAll" $ do
it "inserts documents to the collection and returns their _ids" $ do
2014-08-19 13:29:18 +00:00
(_id1:_id2:_) <- db $ insertAll "team" [ ["name" =: "Yankees", "league" =: "American"]
2014-08-18 07:05:44 +00:00
, ["name" =: "Dodgers", "league" =: "American"]
]
2014-08-19 13:29:18 +00:00
result <- db $ rest =<< find (select [] "team")
2014-08-18 07:05:44 +00:00
result `shouldBe` [["_id" =: _id1, "name" =: "Yankees", "league" =: "American"]
,["_id" =: _id2, "name" =: "Dodgers", "league" =: "American"]
]
context "Insert a document with duplicating key" $ do
2015-03-18 09:34:01 +00:00
before (insertDuplicateWith insertAll `catch` \(_ :: Failure) -> return ()) $ do
2014-08-18 07:05:44 +00:00
it "inserts all documents which can be inserted" $ do
2014-08-19 13:29:18 +00:00
db (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1
db (count $ select ["name" =: "Indians", "league" =: "American"] "team") `shouldReturn` 1
2014-08-18 07:05:44 +00:00
it "raises exception" $
2015-03-18 09:34:01 +00:00
insertDuplicateWith insertAll `shouldThrow` anyException
2014-08-18 07:05:44 +00:00
describe "insertAll_" $ do
it "inserts documents to the collection and returns their _ids" $ do
2014-08-19 13:29:18 +00:00
ids <- db $ insertAll_ "team" [ ["name" =: "Yankees", "league" =: "American"]
2014-08-18 07:05:44 +00:00
, ["name" =: "Dodgers", "league" =: "American"]
]
ids `shouldBe` ()
context "Insert a document with duplicating key" $ do
2015-03-18 09:34:01 +00:00
before (insertDuplicateWith insertAll_ `catch` \(_ :: Failure) -> return ()) $ do
2014-08-18 07:05:44 +00:00
it "inserts all documents which can be inserted" $ do
2014-08-19 13:29:18 +00:00
db (count $ select ["name" =: "Yankees", "league" =: "American"] "team") `shouldReturn` 1
db (count $ select ["name" =: "Indians", "league" =: "American"] "team") `shouldReturn` 1
2014-08-18 07:05:44 +00:00
it "raises exception" $
2015-03-18 09:34:01 +00:00
insertDuplicateWith insertAll_ `shouldThrow` anyException