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

Fix delete count

Browse source
This commit is contained in:
Victor Denisov 2017-05-28 12:58:29 -07:00
parent 8dac250e10
commit 50b7fef240
1 changed files with 10 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
Database/MongoDB/Query.hs
View file

@ -939,15 +939,18 @@ 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"
liftIO $ putStrLn $ "result of delete block: " ++ (show n)
let successResults = WriteResult False 0 Nothing n [] [] []
let writeErrorsResults = let writeErrorsResults =
case look "writeErrors" doc of case look "writeErrors" doc of
Nothing -> WriteResult False 0 Nothing n [] [] [] Nothing -> WriteResult False 0 Nothing 0 [] [] []
Just (Array err) -> WriteResult True 0 Nothing n [] (map (anyToWriteError prevCount) err) [] Just (Array err) -> WriteResult True 0 Nothing 0 [] (map (anyToWriteError prevCount) err) []
Just unknownErr -> WriteResult Just unknownErr -> WriteResult
True True
0 0
Nothing Nothing
n 0
[] []
[ ProtocolFailure [ ProtocolFailure
prevCount prevCount
@ -956,12 +959,12 @@ deleteBlock ordered col (prevCount, docs) = do
[] []
let writeConcernResults = let writeConcernResults =
case look "writeConcernError" doc of case look "writeConcernError" doc of
Nothing -> WriteResult False 0 Nothing n [] [] [] Nothing -> WriteResult False 0 Nothing 0 [] [] []
Just (Doc err) -> WriteResult Just (Doc err) -> WriteResult
True True
0 0
Nothing Nothing
n 0
[] []
[] []
[ WriteConcernFailure [ WriteConcernFailure
@ -972,14 +975,14 @@ deleteBlock ordered col (prevCount, docs) = do
True True
0 0
Nothing Nothing
n 0
[] []
[] []
[ ProtocolFailure [ ProtocolFailure
prevCount prevCount
$ "Expected doc in writeConcernError, but received: " $ "Expected doc in writeConcernError, but received: "
++ (show unknownErr)] ++ (show unknownErr)]
return $ mergeWriteResults writeErrorsResults writeConcernResults return $ foldl1' mergeWriteResults [successResults, writeErrorsResults, writeConcernResults]
anyToWriteError :: Int -> Value -> Failure anyToWriteError :: Int -> Value -> Failure
anyToWriteError _ (Doc d) = docToWriteError d anyToWriteError _ (Doc d) = docToWriteError d