some minor fixes

This commit is contained in:
Victor Denisov 2016-11-06 18:41:33 -08:00
parent 460c7e735b
commit e586fd51cc

View file

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