From d9db9bca526508ecef9d3188489469edb87b5926 Mon Sep 17 00:00:00 2001
From: Victor Denisov <denisovenator@gmail.com>
Date: Tue, 1 Nov 2016 16:34:47 -0700
Subject: [PATCH] Add declaration of interruptibleFor function

---
 Database/MongoDB/Query.hs | 19 ++++++++++++++++++-
 1 file changed, 18 insertions(+), 1 deletion(-)

diff --git a/Database/MongoDB/Query.hs b/Database/MongoDB/Query.hs
index 612ff6d..cb57dae 100644
--- a/Database/MongoDB/Query.hs
+++ b/Database/MongoDB/Query.hs
@@ -1,6 +1,6 @@
 -- | Query and update documents
 
-{-# LANGUAGE OverloadedStrings, RecordWildCards, NamedFieldPuns, TupleSections, FlexibleContexts, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, StandaloneDeriving, TypeSynonymInstances, TypeFamilies, CPP, DeriveDataTypeable, ScopedTypeVariables #-}
+{-# LANGUAGE OverloadedStrings, RecordWildCards, NamedFieldPuns, TupleSections, FlexibleContexts, FlexibleInstances, UndecidableInstances, MultiParamTypeClasses, GeneralizedNewtypeDeriving, StandaloneDeriving, TypeSynonymInstances, TypeFamilies, CPP, DeriveDataTypeable, ScopedTypeVariables, BangPatterns #-}
 
 module Database.MongoDB.Query (
     -- * Monad
@@ -150,6 +150,9 @@ data AccessMode =
 type GetLastError = Document
 -- ^ Parameters for getLastError command. For example @[\"w\" =: 2]@ tells the server to wait for the write to reach at least two servers in replica set before acknowledging. See <http://www.mongodb.org/display/DOCS/Last+Error+Commands> for more options.
 
+class Result a where
+  isFailed :: a -> Bool
+
 data UpdateResult = UpdateResult
                   { failed      :: Bool
                   , nMatched    :: Int
@@ -160,6 +163,9 @@ data UpdateResult = UpdateResult
                   , writeConcernErrors :: [WriteConcernError]
                   } deriving Show
 
+instance Result UpdateResult where
+  isFailed = failed
+
 data Upserted = Upserted
               { upsertedIndex :: Int
               , upsertedId    :: ObjectId
@@ -698,6 +704,17 @@ updateBlock ordered col (prevCount, docs) = do
                     writeErrors
                     writeConcernErrors
 
+
+interruptibleFor :: Result b => Bool -> [a] -> (a -> IO b) -> IO [b]
+interruptibleFor ordered = go []
+  where
+    go !res [] _ = return $ reverse res
+    go !res (x:xs) f = do
+      y <- f x
+      if isFailed y && ordered
+        then return $ reverse (y:res)
+        else go (y:res) xs f
+
 updateBlockLegacy :: (MonadIO m)
                   => Bool -> Collection -> (Int, [Document]) -> Action m UpdateResult
 updateBlockLegacy ordered col (prevCount, docs) = do