Add compound failure

This commit is contained in:
Victor Denisov 2017-03-05 00:55:31 -08:00
parent 7ae65ce487
commit 48d8dba4e1

View file

@ -130,6 +130,7 @@ data Failure =
| WriteFailure Int ErrorCode String -- ^ Error observed by getLastError after a write, error description is in string, index of failed document is the first argument | WriteFailure Int ErrorCode String -- ^ Error observed by getLastError after a write, error description is in string, index of failed document is the first argument
| DocNotFound Selection -- ^ 'fetch' found no document matching selection | DocNotFound Selection -- ^ 'fetch' found no document matching selection
| AggregateFailure String -- ^ 'aggregate' returned an error | AggregateFailure String -- ^ 'aggregate' returned an error
| CompoundFailure [Failure] -- ^ When we need to aggregate several failures and report them.
deriving (Show, Eq, Typeable) deriving (Show, Eq, Typeable)
instance Exception Failure instance Exception Failure
@ -535,21 +536,22 @@ insertBlock opts col (prevCount, docs) = do
doc <- runCommand $ insertCommandDocument opts col docs writeConcern doc <- runCommand $ insertCommandDocument opts col docs writeConcern
case (look "writeErrors" doc, look "writeConcernError" doc) of case (look "writeErrors" doc, look "writeConcernError" doc) of
(Nothing, Nothing) -> return $ Right $ map (valueAt "_id") docs (Nothing, Nothing) -> return $ Right $ map (valueAt "_id") docs
(Just err, Nothing) -> do (Just (Array errs), Nothing) -> do
return $ Left $ WriteFailure let writeErrors = map (anyToWriteError prevCount) $ errs
prevCount -- TODO: insert error reporting should be rewritten since we can not really report meaningful result for every document let errorsWithFailureIndex = map (addFailureIndex prevCount) writeErrors
(maybe 0 id $ lookup "ok" doc) return $ Left $ CompoundFailure errorsWithFailureIndex
(show err)
(Nothing, Just err) -> do (Nothing, Just err) -> do
return $ Left $ WriteFailure return $ Left $ WriteFailure
prevCount -- TODO: insert error reporting should be rewritten -----''------ prevCount
(maybe 0 id $ lookup "ok" doc) (maybe 0 id $ lookup "ok" doc)
(show err) (show err)
(Just err, Just writeConcernErr) -> do (Just (Array errs), Just writeConcernErr) -> do
return $ Left $ WriteFailure let writeErrors = map (anyToWriteError prevCount) $ errs
prevCount -- TODO: insert error reporting should be rewritten -----''------ let errorsWithFailureIndex = map (addFailureIndex prevCount) writeErrors
return $ Left $ CompoundFailure $ (WriteFailure
prevCount
(maybe 0 id $ lookup "ok" doc) (maybe 0 id $ lookup "ok" doc)
(show err ++ show writeConcernErr) (show writeConcernErr)) : errorsWithFailureIndex
splitAtLimit :: Int -> Int -> [Document] -> [Either Failure [Document]] splitAtLimit :: Int -> Int -> [Document] -> [Either Failure [Document]]
splitAtLimit maxSize maxCount list = chop (go 0 0 []) list splitAtLimit maxSize maxCount list = chop (go 0 0 []) list