From 5e4a8aee3f8f064c4a994ba5881915dc1ad404cd Mon Sep 17 00:00:00 2001 From: Tony Hannan Date: Thu, 21 Jul 2011 16:39:19 -0400 Subject: [PATCH] insertAll (KeepGoing) --- Database/MongoDB.hs | 6 +++--- Database/MongoDB/Internal/Protocol.hs | 17 ++++++++++++++-- Database/MongoDB/Query.hs | 28 +++++++++++++++++++-------- doc/Example.hs | 6 +++--- 4 files changed, 41 insertions(+), 16 deletions(-) diff --git a/Database/MongoDB.hs b/Database/MongoDB.hs index ea959cf..46ae3a7 100644 --- a/Database/MongoDB.hs +++ b/Database/MongoDB.hs @@ -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") > diff --git a/Database/MongoDB/Internal/Protocol.hs b/Database/MongoDB/Internal/Protocol.hs index 77598d5..63855d5 100644 --- a/Database/MongoDB/Internal/Protocol.hs +++ b/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 diff --git a/Database/MongoDB/Query.hs b/Database/MongoDB/Query.hs index e8fafd3..e62d21d 100644 --- a/Database/MongoDB/Query.hs +++ b/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 -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 diff --git a/doc/Example.hs b/doc/Example.hs index d7fa9e6..7404a89 100644 --- a/doc/Example.hs +++ b/doc/Example.hs @@ -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")