Handle exceptions in updateBlock
This commit is contained in:
parent
692cdb94c7
commit
f81d5ec42e
1 changed files with 14 additions and 3 deletions
|
@ -78,6 +78,7 @@ import Data.Bson (Document, Field(..), Label, Val, Value(String, Doc, Bool),
|
|||
Javascript, at, valueAt, lookup, look, genObjectId, (=:),
|
||||
(=?), (!?), Val(..), ObjectId)
|
||||
import Data.Bson.Binary (putDocument)
|
||||
import Data.IORef (newIORef, writeIORef, readIORef)
|
||||
import Data.Maybe (fromJust, isJust)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
@ -644,7 +645,17 @@ update' ordered col updateDocs = do
|
|||
updates
|
||||
let lens = map length chunks
|
||||
let lSums = 0 : (zipWith (+) lSums lens)
|
||||
blocks <- forM (zip lSums chunks) (updateBlock ordered col) -- TODO update block can throw exception which will cause other blocks to fail. It's important when ordered is false
|
||||
exceptionThrown <- liftIO $ newIORef False
|
||||
blocks <- forM (zip lSums chunks) $ \b -> do
|
||||
ctx <- ask
|
||||
liftIO $ do
|
||||
et <- readIORef exceptionThrown
|
||||
if et && ordered
|
||||
then return $ UpdateResult True 0 Nothing [] [] [] -- TODO probably should be revised
|
||||
else runReaderT (updateBlock ordered col b) ctx
|
||||
`catch` \(e :: SomeException) -> do
|
||||
writeIORef exceptionThrown True
|
||||
return $ UpdateResult True 0 Nothing [] [] [] -- TODO probably should be revised
|
||||
let failedTotal = or $ map failed blocks
|
||||
let updatedTotal = sum $ map nMatched blocks
|
||||
let modifiedTotal =
|
||||
|
@ -670,7 +681,7 @@ updateBlock ordered col (prevCount, docs) = do
|
|||
NoConfirm -> ["w" =: (0 :: Int)]
|
||||
Confirm params -> params
|
||||
doc <- runCommand $ updateCommandDocument col ordered docs writeConcern
|
||||
let writeConcernError = maybeToList $ do
|
||||
let writeConcernErrors = maybeToList $ do
|
||||
wceDoc <- doc !? "writeConcernError"
|
||||
return $ docToWriteConcernError wceDoc
|
||||
|
||||
|
@ -682,7 +693,7 @@ updateBlock ordered col (prevCount, docs) = do
|
|||
(at "nModified" doc)
|
||||
(map docToUpserted upsertedDocs)
|
||||
writeErrors
|
||||
writeConcernError
|
||||
writeConcernErrors
|
||||
|
||||
updateBlockLegacy :: (MonadIO m)
|
||||
=> Bool -> Collection -> (Int, [Document]) -> Action m UpdateResult
|
||||
|
|
Loading…
Reference in a new issue