Report errors in UpdateResult instead of Exceptions
This commit is contained in:
parent
5254793767
commit
10675a0673
1 changed files with 18 additions and 15 deletions
|
@ -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)
|
||||||
|
|
Loading…
Reference in a new issue