some minor fixes
This commit is contained in:
parent
460c7e735b
commit
e586fd51cc
1 changed files with 44 additions and 33 deletions
|
@ -520,6 +520,8 @@ splitAtLimit ordered maxSize maxCount list = chop (go 0 0 []) list
|
||||||
go curSize curCount [] xs -- Skip this document and insert the other documents.
|
go curSize curCount [] xs -- Skip this document and insert the other documents.
|
||||||
else
|
else
|
||||||
throw $ WriteFailure 0 0 "One document is too big for the message" -- TODO add proper index in the first argument
|
throw $ WriteFailure 0 0 "One document is too big for the message" -- TODO add proper index in the first argument
|
||||||
|
-- TODO it shouldn't throw exceptions. otherwise no documents will be added to the list.
|
||||||
|
-- It should return UpdateResult with this document as failed.
|
||||||
go curSize curCount res (x:xs) =
|
go curSize curCount res (x:xs) =
|
||||||
if ( ((curSize + (sizeOfDocument x) + 2 + curCount) > maxSize)
|
if ( ((curSize + (sizeOfDocument x) + 2 + curCount) > maxSize)
|
||||||
-- we have ^ 2 brackets and curCount commas in
|
-- we have ^ 2 brackets and curCount commas in
|
||||||
|
@ -596,8 +598,11 @@ updateCommandDocument col ordered updates writeConcern =
|
||||||
|
|
||||||
{-| Bulk update operation. If one update fails it will not update the remaining
|
{-| Bulk update operation. If one update fails it will not update the remaining
|
||||||
- documents. Current returned value is only a place holder. With mongodb server
|
- documents. Current returned value is only a place holder. With mongodb server
|
||||||
- before 2.6 it will send update requests one by one. After 2.6 it will use
|
- before 2.6 it will send update requests one by one. In order to receive
|
||||||
- bulk update feature in mongodb.
|
- error messages in versions under 2.6 you need to user confirmed writes.
|
||||||
|
- Otherwise even if the errors had place the list of errors will be empty and
|
||||||
|
- the result will be success. After 2.6 it will use bulk update feature in
|
||||||
|
- mongodb.
|
||||||
-}
|
-}
|
||||||
updateMany :: (MonadIO m)
|
updateMany :: (MonadIO m)
|
||||||
=> Collection
|
=> Collection
|
||||||
|
@ -607,7 +612,10 @@ updateMany = update' True
|
||||||
|
|
||||||
{-| Bulk update operation. If one update fails it will proceed with the
|
{-| Bulk update operation. If one update fails it will proceed with the
|
||||||
- remaining documents. With mongodb server before 2.6 it will send update
|
- remaining documents. With mongodb server before 2.6 it will send update
|
||||||
- requests one by one. After 2.6 it will use bulk update feature in mongodb.
|
- requests one by one. In order to receive error messages in versions under
|
||||||
|
- 2.6 you need to user confirmed writes. Otherwise even if the errors had
|
||||||
|
- place the list of errors will be empty and the result will be success.
|
||||||
|
- After 2.6 it will use bulk update feature in mongodb.
|
||||||
-}
|
-}
|
||||||
updateAll :: (MonadIO m)
|
updateAll :: (MonadIO m)
|
||||||
=> Collection
|
=> Collection
|
||||||
|
@ -630,6 +638,8 @@ update' ordered col updateDocs = do
|
||||||
updateDocs
|
updateDocs
|
||||||
|
|
||||||
mode <- asks mongoWriteMode
|
mode <- asks mongoWriteMode
|
||||||
|
ctx <- ask
|
||||||
|
liftIO $ do
|
||||||
let writeConcern = case mode of
|
let writeConcern = case mode of
|
||||||
NoConfirm -> ["w" =: (0 :: Int)]
|
NoConfirm -> ["w" =: (0 :: Int)]
|
||||||
Confirm params -> params
|
Confirm params -> params
|
||||||
|
@ -644,12 +654,11 @@ update' ordered col updateDocs = do
|
||||||
updates
|
updates
|
||||||
let lens = map length chunks
|
let lens = map length chunks
|
||||||
let lSums = 0 : (zipWith (+) lSums lens)
|
let lSums = 0 : (zipWith (+) lSums lens)
|
||||||
ctx <- ask
|
blocks <- interruptibleFor ordered (zip lSums chunks) $ \b -> do
|
||||||
blocks <- liftIO $ interruptibleFor ordered (zip lSums chunks) $ \b -> liftIO $ do
|
|
||||||
ur <- runReaderT (updateBlock ordered col b) ctx
|
ur <- runReaderT (updateBlock ordered col b) ctx
|
||||||
return ur
|
return ur
|
||||||
`catch` \(e :: Failure) -> do
|
`catch` \(e :: Failure) -> do
|
||||||
return $ UpdateResult True 0 Nothing [] [e] [] -- TODO probably should be revised
|
return $ UpdateResult True 0 Nothing [] [e] []
|
||||||
let failedTotal = or $ map failed blocks
|
let failedTotal = or $ map failed blocks
|
||||||
let updatedTotal = sum $ map nMatched blocks
|
let updatedTotal = sum $ map nMatched blocks
|
||||||
let modifiedTotal =
|
let modifiedTotal =
|
||||||
|
@ -662,6 +671,8 @@ update' ordered col updateDocs = do
|
||||||
let upsertedTotal = concat $ map upserted blocks
|
let upsertedTotal = concat $ map upserted blocks
|
||||||
return $ UpdateResult failedTotal updatedTotal modifiedTotal upsertedTotal totalWriteErrors totalWriteConcernErrors
|
return $ UpdateResult failedTotal updatedTotal modifiedTotal upsertedTotal totalWriteErrors totalWriteConcernErrors
|
||||||
|
|
||||||
|
`catch` \(e :: Failure) -> return $ UpdateResult True 0 Nothing [] [e] []
|
||||||
|
|
||||||
updateBlock :: (MonadIO m)
|
updateBlock :: (MonadIO m)
|
||||||
=> Bool -> Collection -> (Int, [Document]) -> Action m UpdateResult
|
=> Bool -> Collection -> (Int, [Document]) -> Action m UpdateResult
|
||||||
updateBlock ordered col (prevCount, docs) = do
|
updateBlock ordered col (prevCount, docs) = do
|
||||||
|
@ -747,7 +758,7 @@ mergeUpdateResults
|
||||||
(nMatched1 + nMatched2)
|
(nMatched1 + nMatched2)
|
||||||
((liftM2 (+)) nModified1 nModified2)
|
((liftM2 (+)) nModified1 nModified2)
|
||||||
(upserted1 ++ upserted2)
|
(upserted1 ++ upserted2)
|
||||||
(writeErrors1 ++ writeErrors2)
|
(writeErrors1 ++ writeErrors2) -- TODO this should be rewritten with IO containers. Otherwise its N^2 complexity.
|
||||||
(writeConcernErrors1 ++ writeConcernErrors2)
|
(writeConcernErrors1 ++ writeConcernErrors2)
|
||||||
)
|
)
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue