mongodb/test/QuerySpec.hs

493 lines
25 KiB
Haskell
Raw Permalink 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
import Data.String (IsString(..))
2014-08-07 15:54:38 +00:00
import TestImport
import Control.Concurrent (threadDelay)
2014-08-18 07:05:44 +00:00
import Control.Exception
import Control.Monad (forM_, when)
import System.Environment (getEnv)
import System.IO.Error (catchIOError)
2016-05-21 20:22:18 +00:00
import qualified Data.List as L
2014-08-18 07:05:44 +00:00
2015-06-21 04:10:35 +00:00
import qualified Data.Text as T
2014-08-18 07:05:44 +00:00
testDBName :: Database
testDBName = "mongodb-haskell-test"
2014-08-19 13:29:18 +00:00
db :: Action IO a -> IO a
db action = do
mongodbHost <- getEnv mongodbHostEnvVariable `catchIOError` (\_ -> return "localhost")
pipe <- connect (host mongodbHost)
2014-08-18 07:05:44 +00:00
result <- access pipe master testDBName action
close pipe
return result
2014-08-07 15:54:38 +00:00
getWireVersion :: IO Int
getWireVersion = db $ do
sd <- retrieveServerData
return $ maxWireVersion sd
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 ()
insertUsers :: IO ()
insertUsers = db $
insertAll_ "users" [ ["_id" =: "jane", "joined" =: parseDate "2011-03-02", "likes" =: ["golf", "racquetball"]]
, ["_id" =: "joe", "joined" =: parseDate "2012-07-02", "likes" =: ["tennis", "golf", "swimming"]]
, ["_id" =: "jill", "joined" =: parseDate "2013-11-17", "likes" =: ["cricket", "golf"]]
]
pendingIfMongoVersion :: ((Integer, Integer) -> Bool) -> SpecWith () -> Spec
pendingIfMongoVersion invalidVersion = before $ do
version <- db $ extractVersion . T.splitOn "." . at "version" <$> runCommand1 "buildinfo"
when (invalidVersion version) $ pendingWith "This test does not run in the current database version"
where
extractVersion (major:minor:_) = (read $ T.unpack major, read $ T.unpack minor)
extractVersion _ = error "Invalid version specification"
2020-07-30 00:18:36 +00:00
bigDocument :: Document
bigDocument = (flip map) [1..10000] $ \i -> (fromString $ "team" ++ (show i)) =: ("team " ++ (show i) ++ " name")
fineGrainedBigDocument :: Document
fineGrainedBigDocument = (flip map) [1..1000] $ \i -> (fromString $ "team" ++ (show i)) =: ("team " ++ (show i) ++ " name")
hugeDocument :: Document
hugeDocument = (flip map) [1..1000000] $ \i -> (fromString $ "team" ++ (show i)) =: ("team " ++ (show i) ++ " name")
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 "upsert" $ do
it "upserts a document twice with the same spec" $ do
let q = select ["name" =: "jack"] "users"
db $ upsert q ["color" =: "blue", "name" =: "jack"]
-- since there is no way to ask for a ack, we must wait for "a sufficient time"
-- for the write to be visible
threadDelay 10000
db (rest =<< find (select [] "users")) >>= print
db (count $ select ["name" =: "jack"] "users") `shouldReturn` 1
db $ upsert q ["color" =: "red", "name" =: "jack"]
threadDelay 10000
db (count $ select ["name" =: "jack"] "users") `shouldReturn` 1
Just doc <- db $ findOne (select ["name" =: "jack"] "users")
doc !? "color" `shouldBe` Just "red"
2014-08-18 07:05:44 +00:00
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"]
, ["name" =: "Dodgers", "league" =: "American"]
]
2014-08-18 07:05:44 +00:00
ids `shouldBe` ()
it "fails if the document is too big" $ do
(db $ insertMany_ "hugeDocCollection" [hugeDocument]) `shouldThrow` anyException
2014-08-18 07:05:44 +00:00
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"]
2016-11-20 21:55:40 +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
2015-03-18 10:35:51 +00:00
2015-06-21 04:10:35 +00:00
describe "insertAll_" $ do
it "inserts documents and receives 100 000 of them" $ do
let docs = (flip map) [0..200000] $ \i ->
["name" =: (T.pack $ "name " ++ (show i))]
db $ insertAll_ "bigCollection" docs
db $ do
cur <- find $ (select [] "bigCollection") {limit = 100000, batchSize = 100000}
returnedDocs <- rest cur
liftIO $ (length returnedDocs) `shouldBe` 100000
describe "insertAll_" $ do
it "inserts big documents" $ do
let docs = replicate 100 bigDocument
db $ insertAll_ "bigDocCollection" docs
db $ do
cur <- find $ (select [] "bigDocCollection") {limit = 100000, batchSize = 100000}
returnedDocs <- rest cur
liftIO $ (length returnedDocs) `shouldBe` 100
it "inserts fine grained big documents" $ do
let docs = replicate 1000 fineGrainedBigDocument
db $ insertAll_ "bigDocFineGrainedCollection" docs
db $ do
cur <- find $ (select [] "bigDocFineGrainedCollection") {limit = 100000, batchSize = 100000}
returnedDocs <- rest cur
liftIO $ (length returnedDocs) `shouldBe` 1000
it "skips one too big document" $ do
(db $ insertAll_ "hugeDocCollection" [hugeDocument]) `shouldThrow` anyException
db $ do
cur <- find $ (select [] "hugeDocCollection") {limit = 100000, batchSize = 100000}
returnedDocs <- rest cur
liftIO $ (length returnedDocs) `shouldBe` 0
2015-09-30 05:41:52 +00:00
describe "rest" $ do
it "returns all documents from the collection" $ do
let docs = (flip map) [0..6000] $ \i ->
["name" =: (T.pack $ "name " ++ (show i))]
collectionName = "smallCollection"
db $ insertAll_ collectionName docs
db $ do
cur <- find $ (select [] collectionName)
returnedDocs <- rest cur
liftIO $ (length returnedDocs) `shouldBe` 6001
2016-06-09 07:28:54 +00:00
describe "updateMany" $ do
it "updates value" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
_id <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
result <- db $ rest =<< find (select [] "team")
result `shouldBe` [["_id" =: _id, "name" =: "Yankees", "league" =: "American"]]
_ <- db $ updateMany "team" [([ "_id" =: _id]
, ["$set" =: ["league" =: "European"]]
, [])]
updatedResult <- db $ rest =<< find (select [] "team")
updatedResult `shouldBe` [["_id" =: _id, "name" =: "Yankees", "league" =: "European"]]
2016-06-09 07:28:54 +00:00
it "upserts value" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
c <- db $ count (select [] "team")
c `shouldBe` 0
_ <- db $ updateMany "team" [( []
, ["name" =: "Giants", "league" =: "MLB"]
, [Upsert]
)]
updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
map L.sort updatedResult `shouldBe` [["league" =: "MLB", "name" =: "Giants"]]
2016-06-09 07:28:54 +00:00
it "updates all documents with Multi enabled" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
_ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
_ <- db $ insert "team" ["name" =: "Yankees", "league" =: "MiLB"]
_ <- db $ updateMany "team" [( ["name" =: "Yankees"]
, ["$set" =: ["league" =: "MLB"]]
, [MultiUpdate]
)]
updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
(L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "MLB", "name" =: "Yankees"]
, ["league" =: "MLB", "name" =: "Yankees"]
]
2016-06-09 07:28:54 +00:00
it "updates one document when there is no Multi option" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
_ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
_ <- db $ insert "team" ["name" =: "Yankees", "league" =: "MiLB"]
_ <- db $ updateMany "team" [( ["name" =: "Yankees"]
, ["$set" =: ["league" =: "MLB"]]
, []
)]
updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
(L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "MLB", "name" =: "Yankees"]
, ["league" =: "MiLB", "name" =: "Yankees"]
]
2016-06-09 07:28:54 +00:00
it "can process different updates" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
_ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American"]
_ <- db $ insert "team" ["name" =: "Giants" , "league" =: "MiLB"]
_ <- db $ updateMany "team" [ ( ["name" =: "Yankees"]
, ["$set" =: ["league" =: "MiLB"]]
, []
)
, ( ["name" =: "Giants"]
, ["$set" =: ["league" =: "MLB"]]
, []
)
]
updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
(L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "MLB" , "name" =: "Giants"]
, ["league" =: "MiLB", "name" =: "Yankees"]
]
2016-06-09 07:28:54 +00:00
it "can process different updates" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
_ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American", "score" =: (Nothing :: Maybe Int)]
_ <- db $ insert "team" ["name" =: "Giants" , "league" =: "MiLB", "score" =: (1 :: Int)]
updateResult <- (db $ updateMany "team" [ ( ["name" =: "Yankees"]
, ["$inc" =: ["score" =: (1 :: Int)]]
, []
)
, ( ["name" =: "Giants"]
, ["$inc" =: ["score" =: (2 :: Int)]]
, []
)
])
failed updateResult `shouldBe` True
updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
(L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "American", "name" =: "Yankees", "score" =: (Nothing :: Maybe Int)]
, ["league" =: "MiLB" , "name" =: "Giants" , "score" =: (1 :: Int)]
]
2016-06-09 07:28:54 +00:00
it "can handle big updates" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
let docs = (flip map) [0..20000] $ \i ->
["name" =: (T.pack $ "name " ++ (show i))]
ids <- db $ insertAll "bigCollection" docs
let updateDocs = (flip map) ids (\i -> ( [ "_id" =: i]
, ["$set" =: ["name" =: ("name " ++ (show i))]]
, []
))
_ <- db $ updateMany "team" updateDocs
updatedResult <- db $ rest =<< find (select [] "team")
forM_ updatedResult $ \r -> let (i :: ObjectId) = "_id" `at` r
in (("name" `at` r) :: String) `shouldBe` ("name" ++ (show i))
2016-06-09 07:28:54 +00:00
describe "updateAll" $ do
it "can process different updates" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
_ <- db $ insert "team" ["name" =: "Yankees", "league" =: "American", "score" =: (Nothing :: Maybe Int)]
_ <- db $ insert "team" ["name" =: "Giants" , "league" =: "MiLB", "score" =: (1 :: Int)]
updateResult <- (db $ updateAll "team" [ ( ["name" =: "Yankees"]
, ["$inc" =: ["score" =: (1 :: Int)]]
, []
)
, ( ["name" =: "Giants"]
, ["$inc" =: ["score" =: (2 :: Int)]]
, []
)
])
failed updateResult `shouldBe` True
updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
(L.sort $ map L.sort updatedResult) `shouldBe` [ ["league" =: "American", "name" =: "Yankees", "score" =: (Nothing :: Maybe Int)]
, ["league" =: "MiLB" , "name" =: "Giants" , "score" =: (3 :: Int)]
]
it "returns correct number of matched and modified" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
_ <- db $ insertMany "testCollection" [["myField" =: "myValue"], ["myField2" =: "myValue2"]]
_ <- db $ insertMany "testCollection" [["myField" =: "myValue"], ["myField2" =: "myValue2"]]
res <- db $ updateMany "testCollection" [(["myField" =: "myValue"], ["$set" =: ["myField" =: "newValue"]], [MultiUpdate])]
nMatched res `shouldBe` 2
nModified res `shouldBe` (Just 2)
2017-05-29 23:11:25 +00:00
it "returns correct number of upserted" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
res <- db $ updateMany "testCollection" [(["myField" =: "myValue"], ["$set" =: ["myfield" =: "newValue"]], [Upsert])]
(length $ upserted res) `shouldBe` 1
2017-05-29 23:34:35 +00:00
it "updates only one doc without multi update" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
_ <- db $ insertMany "testCollection" [["myField" =: "myValue"], ["myField2" =: "myValue2"]]
_ <- db $ insertMany "testCollection" [["myField" =: "myValue"], ["myField2" =: "myValue2"]]
res <- db $ updateMany "testCollection" [(["myField" =: "myValue"], ["$set" =: ["myField" =: "newValue"]], [])]
nMatched res `shouldBe` 1
nModified res `shouldBe` (Just 1)
2016-06-09 07:28:54 +00:00
2016-06-19 04:41:58 +00:00
describe "delete" $ do
it "actually deletes something" $ do
_ <- db $ insert "team" ["name" =: ("Giants" :: String)]
db $ delete $ select ["name" =: "Giants"] "team"
updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
length updatedResult `shouldBe` 0
it "deletes all matching entries" $ do
_ <- db $ insert "team" ["name" =: ("Giants" :: String)]
_ <- db $ insert "team" [ "name" =: ("Giants" :: String)
, "score" =: (10 :: Int)
]
db $ delete $ select ["name" =: "Giants"] "team"
updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
length updatedResult `shouldBe` 0
it "works if there is no matching document" $ do
db $ delete $ select ["name" =: "Giants"] "team"
updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
length updatedResult `shouldBe` 0
describe "deleteOne" $ do
it "actually deletes something" $ do
_ <- db $ insert "team" ["name" =: ("Giants" :: String)]
db $ deleteOne $ select ["name" =: "Giants"] "team"
updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
length updatedResult `shouldBe` 0
it "deletes only one matching entry" $ do
_ <- db $ insert "team" ["name" =: ("Giants" :: String)]
_ <- db $ insert "team" [ "name" =: ("Giants" :: String)
, "score" =: (10 :: Int)
]
db $ deleteOne $ select ["name" =: "Giants"] "team"
updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
length updatedResult `shouldBe` 1
it "works if there is no matching document" $ do
db $ deleteOne $ select ["name" =: "Giants"] "team"
updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
length updatedResult `shouldBe` 0
describe "deleteMany" $ do
it "actually deletes something" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
_ <- db $ insert "team" ["name" =: ("Giants" :: String)]
_ <- db $ insert "team" ["name" =: ("Yankees" :: String)]
_ <- db $ deleteMany "team" [ (["name" =: ("Giants" :: String)], [])
, (["name" =: ("Yankees" :: String)], [])
]
updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
length updatedResult `shouldBe` 0
2016-06-19 04:41:58 +00:00
describe "deleteAll" $ do
it "actually deletes something" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
_ <- db $ insert "team" [ "name" =: ("Giants" :: String)
, "score" =: (Nothing :: Maybe Int)
]
_ <- db $ insert "team" [ "name" =: ("Yankees" :: String)
, "score" =: (1 :: Int)
]
_ <- db $ deleteAll "team" [ (["name" =: ("Giants" :: String)], [])
, (["name" =: ("Yankees" :: String)], [])
]
updatedResult <- db $ rest =<< find ((select [] "team") {project = ["_id" =: (0 :: Int)]})
length updatedResult `shouldBe` 0
2016-06-19 04:41:58 +00:00
it "can handle big deletes" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
let docs = (flip map) [0..20000] $ \i ->
["name" =: (T.pack $ "name " ++ (show i))]
_ <- db $ insertAll "bigCollection" docs
_ <- db $ deleteAll "bigCollection" $ map (\d -> (d, [])) docs
updatedResult <- db $ rest =<< find ((select [] "bigCollection") {project = ["_id" =: (0 :: Int)]})
length updatedResult `shouldBe` 0
2017-05-28 19:38:34 +00:00
it "returns correct result" $ do
wireVersion <- getWireVersion
when (wireVersion > 1) $ do
_ <- db $ insert "testCollection" [ "myField" =: "myValue" ]
_ <- db $ insert "testCollection" [ "myField" =: "myValue" ]
res <- db $ deleteAll "testCollection" [ (["myField" =: "myValue"], []) ]
nRemoved res `shouldBe` 2
2016-05-21 20:22:18 +00:00
describe "allCollections" $ do
it "returns all collections in a database" $ do
_ <- db $ insert "team1" ["name" =: "Yankees", "league" =: "American"]
_ <- db $ insert "team2" ["name" =: "Yankees", "league" =: "American"]
_ <- db $ insert "team3" ["name" =: "Yankees", "league" =: "American"]
collections <- db $ allCollections
liftIO $ (L.sort collections) `shouldContain` ["team1", "team2", "team3"]
describe "aggregate" $ before_ insertUsers $
2015-03-18 10:35:51 +00:00
it "aggregates to normalize and sort documents" $ do
result <- db $ aggregate "users" [ ["$project" =: ["name" =: ["$toUpper" =: "$_id"], "_id" =: 0]]
, ["$sort" =: ["name" =: 1]]
]
result `shouldBe` [["name" =: "JANE"], ["name" =: "JILL"], ["name" =: "JOE"]]
2020-07-30 00:18:36 +00:00
-- This feature was introduced in MongoDB version 3.2
-- https://docs.mongodb.com/manual/reference/command/find/
describe "findCommand" $ pendingIfMongoVersion (< (3,2)) $
context "when mongo version is 3.2 or superior" $ before insertUsers $ do
it "fetches all the records" $ do
result <- db $ rest =<< findCommand (select [] "users")
length result `shouldBe` 3
it "filters the records" $ do
result <- db $ rest =<< findCommand (select ["_id" =: "joe"] "users")
length result `shouldBe` 1
it "projects the records" $ do
result <- db $ rest =<< findCommand
(select [] "users") { project = [ "_id" =: 1 ] }
result `shouldBe` [["_id" =: "jane"], ["_id" =: "joe"], ["_id" =: "jill"]]
it "sorts the records" $ do
result <- db $ rest =<< findCommand
(select [] "users") { project = [ "_id" =: 1 ]
, sort = [ "_id" =: 1 ]
}
result `shouldBe` [["_id" =: "jane"], ["_id" =: "jill"], ["_id" =: "joe"]]
2020-07-30 00:18:36 +00:00