Report errors in UpdateResult instead of Exceptions

This commit is contained in:
Victor Denisov 2016-08-22 22:50:00 -07:00
parent 5254793767
commit 10675a0673

View file

@ -599,9 +599,8 @@ updateMany :: (MonadIO m)
updateMany = update' True 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. Current returned value is only a place holder. With - remaining documents. With mongodb server before 2.6 it will send update
- mongodb server before 2.6 it will send update requests one by one. After 2.6 - requests one by one. After 2.6 it will use bulk update feature in mongodb.
- it will use bulk update feature in mongodb.
-} -}
updateAll :: (MonadIO m) updateAll :: (MonadIO m)
=> Collection => Collection
@ -691,23 +690,20 @@ updateBlock ordered col (prevCount, docs) = do
NoConfirm -> ["w" =: (0 :: Int)] NoConfirm -> ["w" =: (0 :: Int)]
Confirm params -> params Confirm params -> params
doc <- runCommand $ updateCommandDocument col ordered docs writeConcern doc <- runCommand $ updateCommandDocument col ordered docs writeConcern
case (look "writeErrors" doc, look "writeConcernError" doc) of case look "writeConcernError" doc of
(Nothing, Nothing) -> return () Nothing -> return ()
(Just err, Nothing) -> do Just err -> do
liftIO $ throwIO $ WriteFailure liftIO $ throwIO $ WriteFailure
(maybe 0 id $ lookup "ok" doc) (maybe 0 id $ lookup "ok" doc)
(show err) (show err)
(Nothing, Just err) -> do
liftIO $ throwIO $ WriteFailure
(maybe 0 id $ lookup "ok" doc)
(show err)
(Just err, Just writeConcernErr) -> do
liftIO $ throwIO $ WriteFailure
(maybe 0 id $ lookup "ok" doc)
(show err ++ show writeConcernErr)
let writeErrors = map docToWriteError $ fromMaybe [] (doc !? "writeErrors")
let upsertedDocs = fromMaybe [] (doc !? "upserted") let upsertedDocs = fromMaybe [] (doc !? "upserted")
return $ UpdateResult (at "n" doc) (at "nModified" doc) (map docToUpserted upsertedDocs) [] return $ UpdateResult
(at "n" doc)
(at "nModified" doc)
(map docToUpserted upsertedDocs)
writeErrors
docToUpserted :: Document -> Upserted docToUpserted :: Document -> Upserted
docToUpserted doc = Upserted ind uid docToUpserted doc = Upserted ind uid
@ -715,6 +711,13 @@ docToUpserted doc = Upserted ind uid
ind = at "index" doc ind = at "index" doc
uid = at "_id" doc uid = at "_id" doc
docToWriteError :: Document -> WriteError
docToWriteError doc = WriteError ind code msg
where
ind = at "index" doc
code = at "code" doc
msg = at "errmsg" doc
-- ** Delete -- ** Delete
delete :: (MonadIO m) delete :: (MonadIO m)