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

Apply reviewer's comments

Browse source
This commit is contained in:
Victor Denisov 2015-07-31 03:25:01 -07:00
parent 0038e4163c
commit dca5ae051a
1 changed files with 18 additions and 9 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
Database/MongoDB/Query.hs
View file

@ -63,6 +63,7 @@ import Control.Concurrent.MVar.Lifted (MVar, newMVar, mkWeakMVar,
import Control.Concurrent.MVar.Lifted (MVar, newMVar, addMVarFinalizer, import Control.Concurrent.MVar.Lifted (MVar, newMVar, addMVarFinalizer,
readMVar, modifyMVar) readMVar, modifyMVar)
#endif #endif
import Control.Applicative ((<$>))
import Control.Monad (when) import Control.Monad (when)
import Control.Monad.Base (MonadBase) import Control.Monad.Base (MonadBase)
import Control.Monad.Error (Error(..)) import Control.Monad.Error (Error(..))
@ -528,12 +529,14 @@ queryRequest isExplain Query{..} = do
batchSizeRemainingLimit :: BatchSize -> (Maybe Limit) -> (Int32, Maybe Limit) batchSizeRemainingLimit :: BatchSize -> (Maybe Limit) -> (Int32, Maybe Limit)
-- ^ Given batchSize and limit return P.qBatchSize and remaining limit -- ^ Given batchSize and limit return P.qBatchSize and remaining limit
batchSizeRemainingLimit batchSize mLimit = batchSizeRemainingLimit batchSize mLimit =
let remaining =
case mLimit of case mLimit of
Nothing -> (fromIntegral batchSize, Nothing) Nothing -> batchSize
Just limit -> Just limit ->
if 0 < batchSize && batchSize < limit if 0 < batchSize && batchSize < limit
then (fromIntegral batchSize, Just limit) then batchSize
else (fromIntegral limit, Just limit) else limit
in (fromIntegral remaining, mLimit)
type DelayedBatch = IO Batch type DelayedBatch = IO Batch
-- ^ A promised batch which may fail -- ^ A promised batch which may fail
@ -587,9 +590,15 @@ nextBatch (Cursor fcol batchSize var) = modifyMVar var $ \dBatch -> do
let newLimit = do let newLimit = do
limit <- mLimit limit <- mLimit
return $ limit - (min limit $ fromIntegral $ length docs) return $ limit - (min limit $ fromIntegral $ length docs)
dBatch' <- if cid /= 0 && newLimit /= (Just 0) then nextBatch' fcol batchSize newLimit cid else return $ return (Batch (Just 0) 0 []) let emptyBatch = return $ Batch (Just 0) 0 []
when (newLimit == (Just 0)) $ unless (cid == 0) $ send [KillCursors [cid]] let getNextBatch = nextBatch' fcol batchSize newLimit cid
return (dBatch', maybe docs (\l -> take (fromIntegral l) docs) mLimit) let resultDocs = (maybe id (take . fromIntegral) mLimit) docs
case (cid, newLimit) of
(0, _) -> return (emptyBatch, resultDocs)
(_, Just 0) -> do
send [KillCursors [cid]]
return (emptyBatch, resultDocs)
(_, _) -> (, resultDocs) <$> getNextBatch
fulfill' :: (MonadIO m) => FullCollection -> BatchSize -> DelayedBatch -> Action m Batch fulfill' :: (MonadIO m) => FullCollection -> BatchSize -> DelayedBatch -> Action m Batch
-- Discard pre-fetched batch if empty with nonzero cid. -- Discard pre-fetched batch if empty with nonzero cid.