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.
|
-- ^ 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]
|
, upserted :: [Upserted]
|
||||||
, writeErrors :: [WriteError]
|
, writeErrors :: [WriteError]
|
||||||
, writeConcernError :: Maybe WriteConcernError
|
, writeConcernErrors :: [WriteConcernError]
|
||||||
} deriving Show
|
} deriving Show
|
||||||
|
|
||||||
data Upserted = Upserted
|
data Upserted = Upserted
|
||||||
|
@ -649,9 +649,11 @@ update' ordered col updateDocs = do
|
||||||
if all isNothing $ map nModified blocks
|
if all isNothing $ map nModified blocks
|
||||||
then Nothing
|
then Nothing
|
||||||
else Just $ sum $ catMaybes $ map nModified blocks
|
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
|
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)
|
updateBlock :: (MonadIO m)
|
||||||
=> Bool -> Collection -> (Int, [Document]) -> Action m UpdateResult
|
=> 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 []
|
let multi = if at "multi" updateDoc then [MultiUpdate] else []
|
||||||
mRes <- runReaderT (write (Update (db <.> col) (upsrt ++ multi) sel doc)) ctx
|
mRes <- runReaderT (write (Update (db <.> col) (upsrt ++ multi) sel doc)) ctx
|
||||||
case mRes of
|
case mRes of
|
||||||
Nothing -> return $ Right $ UpdateResult 0 Nothing [] [] Nothing
|
Nothing -> return $ Right $ UpdateResult 0 Nothing [] [] []
|
||||||
Just resDoc -> do
|
Just resDoc -> do
|
||||||
let em = lookup "err" resDoc
|
let em = lookup "err" resDoc
|
||||||
case em of
|
case em of
|
||||||
|
@ -679,7 +681,7 @@ updateBlock ordered col (prevCount, docs) = do
|
||||||
let ups = do
|
let ups = do
|
||||||
upsValue <- lookup "upserted" resDoc
|
upsValue <- lookup "upserted" resDoc
|
||||||
return $ Upserted i upsValue
|
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
|
Just errV -> do
|
||||||
return $ Left $ WriteError i (at "code" resDoc) errV
|
return $ Left $ WriteError i (at "code" resDoc) errV
|
||||||
`catch` \(e :: SomeException) -> do
|
`catch` \(e :: SomeException) -> do
|
||||||
|
@ -689,7 +691,7 @@ updateBlock ordered col (prevCount, docs) = do
|
||||||
let onlyUpdates = rights results
|
let onlyUpdates = rights results
|
||||||
let totalnMatched = sum $ map nMatched onlyUpdates
|
let totalnMatched = sum $ map nMatched onlyUpdates
|
||||||
let totalUpserted = concat $ map upserted onlyUpdates
|
let totalUpserted = concat $ map upserted onlyUpdates
|
||||||
return $ UpdateResult totalnMatched Nothing totalUpserted onlyErrors Nothing
|
return $ UpdateResult totalnMatched Nothing totalUpserted onlyErrors []
|
||||||
else do
|
else do
|
||||||
mode <- asks mongoWriteMode
|
mode <- asks mongoWriteMode
|
||||||
let writeConcern = case mode of
|
let writeConcern = case mode of
|
||||||
|
@ -697,7 +699,7 @@ updateBlock ordered col (prevCount, docs) = do
|
||||||
Confirm params -> params
|
Confirm params -> params
|
||||||
doc <- runCommand $ updateCommandDocument col ordered docs writeConcern
|
doc <- runCommand $ updateCommandDocument col ordered docs writeConcern
|
||||||
|
|
||||||
let writeConcernError = do
|
let writeConcernError = maybeToList $ do
|
||||||
wceDoc <- doc !? "writeConcernError"
|
wceDoc <- doc !? "writeConcernError"
|
||||||
return $ docToWriteConcernError wceDoc
|
return $ docToWriteConcernError wceDoc
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue