From 1898928cf08b76202d803461185e76cd83a323de Mon Sep 17 00:00:00 2001
From: Victor Denisov <denisovenator@gmail.com>
Date: Mon, 10 Oct 2016 22:26:04 -0700
Subject: [PATCH] Calculate filed total of update command

---
 Database/MongoDB/Query.hs | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/Database/MongoDB/Query.hs b/Database/MongoDB/Query.hs
index f39b6e2..1f5dfc2 100644
--- a/Database/MongoDB/Query.hs
+++ b/Database/MongoDB/Query.hs
@@ -78,7 +78,6 @@ 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.Either (lefts, rights)
 import Data.Maybe (fromJust, isJust)
 import Data.Text (Text)
 import qualified Data.Text as T
@@ -504,7 +503,7 @@ insertBlock opts col docs = do
             liftIO $ throwIO $ WriteFailure
                                     (maybe 0 id $ lookup "ok" doc)
                                     (show err)
-          (Just err, Just writeConcernErr) -> do
+          (Just err, Just writeConcernErr) -> do -- TODO writeConcernError is not a failure
             liftIO $ throwIO $ WriteFailure
                                     (maybe 0 id $ lookup "ok" doc)
                                     (show err ++ show writeConcernErr)
@@ -646,6 +645,7 @@ update' ordered col updateDocs = do
   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
+  let failedTotal = or $ map failed blocks
   let updatedTotal = sum $ map nMatched blocks
   let modifiedTotal =
         if all isNothing $ map nModified blocks
@@ -655,7 +655,7 @@ update' ordered col updateDocs = do
   let totalWriteConcernErrors = concat $ map writeConcernErrors blocks
 
   let upsertedTotal = concat $ map upserted blocks
-  return $ UpdateResult False updatedTotal modifiedTotal upsertedTotal totalWriteErrors totalWriteConcernErrors -- TODO first False should be calculated intelligently
+  return $ UpdateResult failedTotal updatedTotal modifiedTotal upsertedTotal totalWriteErrors totalWriteConcernErrors
 
 updateBlock :: (MonadIO m)
             => Bool -> Collection -> (Int, [Document]) -> Action m UpdateResult
@@ -688,7 +688,6 @@ updateBlock ordered col (prevCount, docs) = do
 updateBlockLegacy :: (MonadIO m)
                   => Bool -> Collection -> (Int, [Document]) -> Action m UpdateResult
 updateBlockLegacy ordered col (prevCount, docs) = do
-  p <- asks mongoPipe
   db <- thisDatabase
   ctx <- ask
   results <-