Keep write concern errors in list
This commit is contained in:
parent
b6fa6ea402
commit
74e8aa205d
1 changed files with 8 additions and 6 deletions
|
@ -155,7 +155,7 @@ data UpdateResult = UpdateResult
|
|||
-- ^ Mongodb server before 2.6 doesn't allow to calculate this value. This field is nothing if we can't calculate the number of modified documents.
|
||||
, upserted :: [Upserted]
|
||||
, writeErrors :: [WriteError]
|
||||
, writeConcernError :: Maybe WriteConcernError
|
||||
, writeConcernErrors :: [WriteConcernError]
|
||||
} deriving Show
|
||||
|
||||
data Upserted = Upserted
|
||||
|
@ -649,9 +649,11 @@ update' ordered col updateDocs = do
|
|||
if all isNothing $ map nModified blocks
|
||||
then Nothing
|
||||
else Just $ sum $ catMaybes $ map nModified blocks
|
||||
let totalWriteErrors = concat $ map writeErrors blocks
|
||||
let totalWriteConcernErrors = concat $ map writeConcernErrors blocks
|
||||
|
||||
let upsertedTotal = concat $ map upserted blocks
|
||||
return $ UpdateResult updatedTotal modifiedTotal upsertedTotal [] Nothing -- TODO change Nothing to Something
|
||||
return $ UpdateResult updatedTotal modifiedTotal upsertedTotal totalWriteErrors totalWriteConcernErrors
|
||||
|
||||
updateBlock :: (MonadIO m)
|
||||
=> Bool -> Collection -> (Int, [Document]) -> Action m UpdateResult
|
||||
|
@ -670,7 +672,7 @@ updateBlock ordered col (prevCount, docs) = do
|
|||
let multi = if at "multi" updateDoc then [MultiUpdate] else []
|
||||
mRes <- runReaderT (write (Update (db <.> col) (upsrt ++ multi) sel doc)) ctx
|
||||
case mRes of
|
||||
Nothing -> return $ Right $ UpdateResult 0 Nothing [] [] Nothing
|
||||
Nothing -> return $ Right $ UpdateResult 0 Nothing [] [] []
|
||||
Just resDoc -> do
|
||||
let em = lookup "err" resDoc
|
||||
case em of
|
||||
|
@ -679,7 +681,7 @@ updateBlock ordered col (prevCount, docs) = do
|
|||
let ups = do
|
||||
upsValue <- lookup "upserted" resDoc
|
||||
return $ Upserted i upsValue
|
||||
return $ Right $ UpdateResult n Nothing (maybeToList ups) [] Nothing
|
||||
return $ Right $ UpdateResult n Nothing (maybeToList ups) [] [] -- TODO add wtimeout checking. if there is timeout field then we need to add a WRITE_CONCERN_ERROR.
|
||||
Just errV -> do
|
||||
return $ Left $ WriteError i (at "code" resDoc) errV
|
||||
`catch` \(e :: SomeException) -> do
|
||||
|
@ -689,7 +691,7 @@ updateBlock ordered col (prevCount, docs) = do
|
|||
let onlyUpdates = rights results
|
||||
let totalnMatched = sum $ map nMatched onlyUpdates
|
||||
let totalUpserted = concat $ map upserted onlyUpdates
|
||||
return $ UpdateResult totalnMatched Nothing totalUpserted onlyErrors Nothing
|
||||
return $ UpdateResult totalnMatched Nothing totalUpserted onlyErrors []
|
||||
else do
|
||||
mode <- asks mongoWriteMode
|
||||
let writeConcern = case mode of
|
||||
|
@ -697,7 +699,7 @@ updateBlock ordered col (prevCount, docs) = do
|
|||
Confirm params -> params
|
||||
doc <- runCommand $ updateCommandDocument col ordered docs writeConcern
|
||||
|
||||
let writeConcernError = do
|
||||
let writeConcernError = maybeToList $ do
|
||||
wceDoc <- doc !? "writeConcernError"
|
||||
return $ docToWriteConcernError wceDoc
|
||||
|
||||
|
|
Loading…
Reference in a new issue