Vergara_Tech/mongodb
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Assign ids before insert block

Browse source
This commit is contained in:
Victor Denisov 2017-02-12 11:59:15 -08:00
parent b6078cc19d
commit 7ae65ce487
1 changed files with 8 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

15
Database/MongoDB/Query.hs
View file

@ -419,7 +419,8 @@ write notice = asks mongoWriteMode >>= \mode -> case mode of
insert :: (MonadIO m) => Collection -> Document -> Action m Value insert :: (MonadIO m) => Collection -> Document -> Action m Value
-- ^ Insert document into collection and return its \"_id\" value, which is created automatically if not supplied -- ^ Insert document into collection and return its \"_id\" value, which is created automatically if not supplied
insert col doc = do insert col doc = do
res <- insertBlock [] col (0, [doc]) doc' <- liftIO $ assignId doc
res <- insertBlock [] col (0, [doc'])
case res of case res of
Left failure -> liftIO $ throwIO failure Left failure -> liftIO $ throwIO failure
Right r -> return $ head r Right r -> return $ head r
@ -472,6 +473,7 @@ insert' :: (MonadIO m)
insert' opts col docs = do insert' opts col docs = do
p <- asks mongoPipe p <- asks mongoPipe
let sd = P.serverData p let sd = P.serverData p
docs' <- liftIO $ mapM assignId docs
mode <- asks mongoWriteMode mode <- asks mongoWriteMode
let writeConcern = case mode of let writeConcern = case mode of
NoConfirm -> ["w" =: (0 :: Int)] NoConfirm -> ["w" =: (0 :: Int)]
@ -484,7 +486,7 @@ insert' opts col docs = do
-- document should be subtracted from -- document should be subtracted from
-- the overall size -- the overall size
(maxWriteBatchSize sd) (maxWriteBatchSize sd)
docs docs'
let chunks = let chunks =
if ordered if ordered
then takeRightsUpToLeft preChunks then takeRightsUpToLeft preChunks
@ -509,13 +511,12 @@ insertBlock :: (MonadIO m)
insertBlock _ _ (_, []) = return $ Right [] insertBlock _ _ (_, []) = return $ Right []
insertBlock opts col (prevCount, docs) = do insertBlock opts col (prevCount, docs) = do
db <- thisDatabase db <- thisDatabase
docs' <- liftIO $ mapM assignId docs
p <- asks mongoPipe p <- asks mongoPipe
let sd = P.serverData p let sd = P.serverData p
if (maxWireVersion sd < 2) if (maxWireVersion sd < 2)
then do then do
res <- liftDB $ write (Insert (db <.> col) opts docs') res <- liftDB $ write (Insert (db <.> col) opts docs)
let errorMessage = do let errorMessage = do
jRes <- res jRes <- res
em <- lookup "err" jRes em <- lookup "err" jRes
@ -525,15 +526,15 @@ insertBlock opts col (prevCount, docs) = do
case errorMessage of case errorMessage of
Just failure -> return $ Left failure Just failure -> return $ Left failure
Nothing -> return $ Right $ map (valueAt "_id") docs' Nothing -> return $ Right $ map (valueAt "_id") docs
else do else do
mode <- asks mongoWriteMode mode <- asks mongoWriteMode
let writeConcern = case mode of let writeConcern = case mode of
NoConfirm -> ["w" =: (0 :: Int)] NoConfirm -> ["w" =: (0 :: Int)]
Confirm params -> params Confirm params -> params
doc <- runCommand $ insertCommandDocument opts col docs' writeConcern doc <- runCommand $ insertCommandDocument opts col docs writeConcern
case (look "writeErrors" doc, look "writeConcernError" doc) of case (look "writeErrors" doc, look "writeConcernError" doc) of
(Nothing, Nothing) -> return $ Right $ map (valueAt "_id") docs' (Nothing, Nothing) -> return $ Right $ map (valueAt "_id") docs
(Just err, Nothing) -> do (Just err, Nothing) -> do
return $ Left $ WriteFailure return $ Left $ WriteFailure
prevCount -- TODO: insert error reporting should be rewritten since we can not really report meaningful result for every document prevCount -- TODO: insert error reporting should be rewritten since we can not really report meaningful result for every document