insertAll (KeepGoing)
This commit is contained in:
parent
19da43a348
commit
5e4a8aee3f
4 changed files with 41 additions and 16 deletions
|
@ -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")
|
||||
>
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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")
|
||||
|
||||
|
|
Loading…
Reference in a new issue