Add declaration of interruptibleFor function
This commit is contained in:
parent
316ae02ecc
commit
d9db9bca52
1 changed files with 18 additions and 1 deletions
|
@ -1,6 +1,6 @@
|
||||||
-- | Query and update documents
|
-- | 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 (
|
module Database.MongoDB.Query (
|
||||||
-- * Monad
|
-- * Monad
|
||||||
|
@ -150,6 +150,9 @@ data AccessMode =
|
||||||
type GetLastError = Document
|
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.
|
-- ^ 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
|
data UpdateResult = UpdateResult
|
||||||
{ failed :: Bool
|
{ failed :: Bool
|
||||||
, nMatched :: Int
|
, nMatched :: Int
|
||||||
|
@ -160,6 +163,9 @@ data UpdateResult = UpdateResult
|
||||||
, writeConcernErrors :: [WriteConcernError]
|
, writeConcernErrors :: [WriteConcernError]
|
||||||
} deriving Show
|
} deriving Show
|
||||||
|
|
||||||
|
instance Result UpdateResult where
|
||||||
|
isFailed = failed
|
||||||
|
|
||||||
data Upserted = Upserted
|
data Upserted = Upserted
|
||||||
{ upsertedIndex :: Int
|
{ upsertedIndex :: Int
|
||||||
, upsertedId :: ObjectId
|
, upsertedId :: ObjectId
|
||||||
|
@ -698,6 +704,17 @@ updateBlock ordered col (prevCount, docs) = do
|
||||||
writeErrors
|
writeErrors
|
||||||
writeConcernErrors
|
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)
|
updateBlockLegacy :: (MonadIO m)
|
||||||
=> Bool -> Collection -> (Int, [Document]) -> Action m UpdateResult
|
=> Bool -> Collection -> (Int, [Document]) -> Action m UpdateResult
|
||||||
updateBlockLegacy ordered col (prevCount, docs) = do
|
updateBlockLegacy ordered col (prevCount, docs) = do
|
||||||
|
|
Loading…
Reference in a new issue