insertAll (KeepGoing)

Database/MongoDB.hs

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

Database/MongoDB/Internal/Protocol.hs

@@ -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

Database/MongoDB/Query.hs

@@ -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
+-- ^ 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 col docs = do
+insertMany = insert' []
-	db <- thisDatabase
-	docs' <- liftIO $ mapM assignId docs
-	write (Insert (db <.> col) docs')
-	mapM (look "_id") docs'
 
 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

doc/Example.hs

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