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

Update Query.hs

Browse source
This commit is contained in:
Andrea Condoluci 2020-04-03 12:47:39 +02:00
parent ff0b0a31f3
commit 9ce116b4bc
1 changed files with 8 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

19
Database/MongoDB/Query.hs
View file

@ -895,25 +895,22 @@ delete' ordered col deleteDocs = do
NoConfirm -> ["w" =: (0 :: Int)] NoConfirm -> ["w" =: (0 :: Int)]
Confirm params -> params Confirm params -> params
let docSize = sizeOfDocument $ deleteCommandDocument col ordered [] writeConcern let docSize = sizeOfDocument $ deleteCommandDocument col ordered [] writeConcern
let preChunks = splitAtLimit let chunks = splitAtLimit
(maxBsonObjectSize sd - docSize) (maxBsonObjectSize sd - docSize)
-- size of auxiliary part of delete -- size of auxiliary part of delete
-- document should be subtracted from -- document should be subtracted from
-- the overall size -- the overall size
(maxWriteBatchSize sd) (maxWriteBatchSize sd)
deletes deletes
let chunks =
if ordered
then takeRightsUpToLeft preChunks
else rights preChunks
ctx <- ask ctx <- ask
let lens = map length chunks let lens = map (either (const 1) length) chunks
let lSums = 0 : (zipWith (+) lSums lens) let lSums = 0 : (zipWith (+) lSums lens)
blockResult <- liftIO $ interruptibleFor ordered (zip lSums chunks) $ \b -> do let failureResult e = return $ WriteResult True 0 Nothing 0 [] [e] []
dr <- runReaderT (deleteBlock ordered col b) ctx let doChunk b = runReaderT (deleteBlock ordered col b) ctx `catch` failureResult
return dr blockResult <- liftIO $ interruptibleFor ordered (zip lSums chunks) $ \(n, c) ->
`catch` \(e :: Failure) -> do case c of
return $ WriteResult True 0 Nothing 0 [] [e] [] Left e -> failureResult e
Right b -> doChunk (n, b)
return $ foldl1' mergeWriteResults blockResult return $ foldl1' mergeWriteResults blockResult