Vergara_Tech/mongodb
2
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

Rewrite deleteBlock

Browse source
This commit is contained in:
Victor Denisov 2017-04-09 22:23:34 -07:00
parent d6419daa50
commit 1d6d6ca9c0
1 changed files with 41 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

51
Database/MongoDB/Query.hs
View file

@ -915,22 +915,47 @@ deleteBlock ordered col (prevCount, docs) = do
Confirm params -> params Confirm params -> params
doc <- runCommand $ deleteCommandDocument col ordered docs writeConcern doc <- runCommand $ deleteCommandDocument col ordered docs writeConcern
let n = fromMaybe 0 $ doc !? "n" let n = fromMaybe 0 $ doc !? "n"
case (look "writeErrors" doc, look "writeConcernError" doc) of let writeErrorsResults =
(Nothing, Nothing) -> return $ WriteResult False 0 Nothing n [] [] [] case look "writeErrors" doc of
(Just (Array err), Nothing) -> do Nothing -> WriteResult False 0 Nothing n [] [] []
return $ WriteResult True 0 Nothing n [] (map (anyToWriteError prevCount) err) [] Just (Array err) -> WriteResult True 0 Nothing n [] (map (anyToWriteError prevCount) err) []
(Nothing, Just (Doc err)) -> do Just unknownErr -> WriteResult
return $ WriteResult True 0 Nothing n [] [] [ True
WriteConcernFailure 0
Nothing
n
[]
[ ProtocolFailure
prevCount
$ "Expected array of error docs, but received: "
++ (show unknownErr)]
[]
let writeConcernResults =
case look "writeConcernError" doc of
Nothing -> WriteResult False 0 Nothing n [] [] []
Just (Doc err) -> WriteResult
True
0
Nothing
n
[]
[]
[ WriteConcernFailure
(fromMaybe (-1) $ err !? "code") (fromMaybe (-1) $ err !? "code")
(fromMaybe "" $ err !? "errmsg") (fromMaybe "" $ err !? "errmsg")
] ]
(Just (Array err), Just (Doc writeConcernErr)) -> do Just unknownErr -> WriteResult
return $ WriteResult True 0 Nothing n [] (map (anyToWriteError prevCount) err) [ True
WriteConcernFailure 0
(fromMaybe (-1) $ writeConcernErr !? "code") Nothing
(fromMaybe "" $ writeConcernErr !? "errmsg") n
] []
[]
[ ProtocolFailure
prevCount
$ "Expected doc in writeConcernError, but received: "
++ (show unknownErr)]
return $ mergeWriteResults writeErrorsResults writeConcernResults
anyToWriteError :: Int -> Value -> Failure anyToWriteError :: Int -> Value -> Failure
anyToWriteError ind (Doc d) = docToWriteError d anyToWriteError ind (Doc d) = docToWriteError d