insertAll (KeepGoing)

This commit is contained in:
Tony Hannan 2011-07-21 16:39:19 -04:00
parent 19da43a348
commit 5e4a8aee3f
4 changed files with 41 additions and 16 deletions

View file

@ -17,9 +17,9 @@ Simple example below. Use with language extension /OvererloadedStrings/.
> run = do
> clearTeams
> insertTeams
> printDocs "All Teams" =<< allTeams
> printDocs "National League Teams" =<< nationalLeagueTeams
> printDocs "New York Teams" =<< newYorkTeams
> allTeams >>= printDocs "All Teams"
> nationalLeagueTeams >>= printDocs "National League Teams"
> newYorkTeams >>= printDocs "New York Teams"
>
> clearTeams = delete (select [] "team")
>

View file

@ -11,7 +11,7 @@ module Database.MongoDB.Internal.Protocol (
-- * Message
writeMessage, readMessage,
-- ** Notice
Notice(..), UpdateOption(..), DeleteOption(..), CursorId,
Notice(..), InsertOption(..), UpdateOption(..), DeleteOption(..), CursorId,
-- ** Request
Request(..), QueryOption(..),
-- ** Reply
@ -135,6 +135,7 @@ getHeader = do
data Notice =
Insert {
iFullCollection :: FullCollection,
iOptions :: [InsertOption],
iDocuments :: [Document]}
| Update {
uFullCollection :: FullCollection,
@ -149,6 +150,9 @@ data Notice =
kCursorIds :: [CursorId]}
deriving (Show, Eq)
data InsertOption = KeepGoing -- ^ If set, the database will not stop processing a bulk insert if one fails (eg due to duplicate IDs). This makes bulk insert behave similarly to a series of single inserts, except lastError will be set if any insert fails, not just the last one. (new in 1.9.1)
deriving (Show, Eq)
data UpdateOption =
Upsert -- ^ If set, the database will insert the supplied object into the collection if no matching document is found
| MultiUpdate -- ^ If set, the database will update all matching objects in the collection. Otherwise only updates first matching doc
@ -170,24 +174,33 @@ nOpcode KillCursors{} = 2007
putNotice :: Notice -> RequestId -> Put
putNotice notice requestId = do
putHeader (nOpcode notice) requestId
putInt32 0
case notice of
Insert{..} -> do
putInt32 (iBits iOptions)
putCString iFullCollection
mapM_ putDocument iDocuments
Update{..} -> do
putInt32 0
putCString uFullCollection
putInt32 (uBits uOptions)
putDocument uSelector
putDocument uUpdater
Delete{..} -> do
putInt32 0
putCString dFullCollection
putInt32 (dBits dOptions)
putDocument dSelector
KillCursors{..} -> do
putInt32 0
putInt32 $ toEnum (X.length kCursorIds)
mapM_ putInt64 kCursorIds
iBit :: InsertOption -> Int32
iBit KeepGoing = bit 0
iBits :: [InsertOption] -> Int32
iBits = bitOr . map iBit
uBit :: UpdateOption -> Int32
uBit Upsert = bit 0
uBit MultiUpdate = bit 1

View file

@ -18,7 +18,7 @@ module Database.MongoDB.Query (
Select(select),
-- * Write
-- ** Insert
insert, insert_, insertMany, insertMany_,
insert, insert_, insertMany, insertMany_, insertAll, insertAll_,
-- ** Update
save, replace, repsert, Modifier, modify,
-- ** Delete
@ -41,7 +41,7 @@ module Database.MongoDB.Query (
import Prelude as X hiding (lookup)
import Data.UString as U (UString, dropWhile, any, tail)
import Data.Bson (Document, at, lookup, look, Field(..), (=:), (=?), Label, Value(String,Doc), Javascript, genObjectId)
import Database.MongoDB.Internal.Protocol (Pipe, Notice(..), Request(GetMore), Reply(..), QueryOption(..), ResponseFlag(..), UpdateOption(..), DeleteOption(..), CursorId, FullCollection, Username, Password, pwKey)
import Database.MongoDB.Internal.Protocol (Pipe, Notice(..), Request(GetMore), Reply(..), QueryOption(..), ResponseFlag(..), InsertOption(..), UpdateOption(..), DeleteOption(..), CursorId, FullCollection, Username, Password, pwKey)
import qualified Database.MongoDB.Internal.Protocol as P (send, call, Request(Query))
import Database.MongoDB.Internal.Util (MonadIO', loop, liftIOE, true1, (<.>))
import Control.Monad.MVar
@ -253,17 +253,29 @@ insert_ :: (MonadIO' m) => Collection -> Document -> Action m ()
insert_ col doc = insert col doc >> return ()
insertMany :: (MonadIO m) => Collection -> [Document] -> Action m [Value]
-- ^ Insert documents into collection and return their \"_id\" values, which are created automatically if not supplied
insertMany col docs = do
db <- thisDatabase
docs' <- liftIO $ mapM assignId docs
write (Insert (db <.> col) docs')
mapM (look "_id") docs'
-- ^ Insert documents into collection and return their \"_id\" values, which are created automatically if not supplied. If a document fails to be inserted (eg. due to duplicate key) then remaining docs are aborted, and LastError is set.
insertMany = insert' []
insertMany_ :: (MonadIO m) => Collection -> [Document] -> Action m ()
-- ^ Same as 'insertMany' except don't return _ids
insertMany_ col docs = insertMany col docs >> return ()
insertAll :: (MonadIO m) => Collection -> [Document] -> Action m [Value]
-- ^ Insert documents into collection and return their \"_id\" values, which are created automatically if not supplied. If a document fails to be inserted (eg. due to duplicate key) then remaining docs are still inserted. LastError is set if any doc fails, not just last one.
insertAll = insert' [KeepGoing]
insertAll_ :: (MonadIO m) => Collection -> [Document] -> Action m ()
-- ^ Same as 'insertAll' except don't return _ids
insertAll_ col docs = insertAll col docs >> return ()
insert' :: (MonadIO m) => [InsertOption] -> Collection -> [Document] -> Action m [Value]
-- ^ Insert documents into collection and return their \"_id\" values, which are created automatically if not supplied
insert' opts col docs = do
db <- thisDatabase
docs' <- liftIO $ mapM assignId docs
write (Insert (db <.> col) opts docs')
mapM (look "_id") docs'
assignId :: Document -> IO Document
-- ^ Assign a unique value to _id field if missing
assignId doc = if X.any (("_id" ==) . label) doc

View file

@ -12,9 +12,9 @@ main = do
run = do
clearTeams
insertTeams
printDocs "All Teams" =<< allTeams
printDocs "National League Teams" =<< nationalLeagueTeams
printDocs "New York Teams" =<< newYorkTeams
allTeams >>= printDocs "All Teams"
nationalLeagueTeams >>= printDocs "National League Teams"
newYorkTeams >>= printDocs "New York Teams"
clearTeams = delete (select [] "team")