merge duplicate code

This commit is contained in:
Tony Hannan 2012-01-23 19:45:42 -05:00
parent b8f25ad6f0
commit d0aeb42e7c

View file

@ -496,43 +496,36 @@ nextBatch :: (MonadIO m, MonadBaseControl IO m) => Cursor -> Action m [Document]
-- ^ Return next batch of documents in query result, which will be empty if finished. -- ^ Return next batch of documents in query result, which will be empty if finished.
nextBatch (Cursor fcol batchSize var) = modifyMVar var $ \dBatch -> do nextBatch (Cursor fcol batchSize var) = modifyMVar var $ \dBatch -> do
-- Pre-fetch next batch promise from server and return current batch. -- Pre-fetch next batch promise from server and return current batch.
-- Discard pre-fetched batch if empty with nonzero cid. Batch limit cid docs <- fulfill' fcol batchSize dBatch
Batch limit cid docs <- fulfill' dBatch dBatch' <- if cid /= 0 then nextBatch' fcol batchSize limit cid else return $ return (Batch 0 0 [])
dBatch' <- if cid /= 0 then nextBatch' limit cid else return $ return (Batch 0 0 [])
return (dBatch', docs) return (dBatch', docs)
where
fulfill' dBatch = do -- Discard pre-fetched batch if empty with nonzero cid.
b@(Batch limit cid docs) <- fulfill dBatch fulfill' fcol batchSize dBatch = do
if cid /= 0 && null docs b@(Batch limit cid docs) <- fulfill dBatch
then nextBatch' limit cid >>= fulfill if cid /= 0 && null docs
else return b then nextBatch' fcol batchSize limit cid >>= fulfill
nextBatch' limit cid = request [] (GetMore fcol batchSize' cid, remLimit) else return b
where (batchSize', remLimit) = batchSizeRemainingLimit batchSize limit
nextBatch' fcol batchSize limit cid = request [] (GetMore fcol batchSize' cid, remLimit)
where (batchSize', remLimit) = batchSizeRemainingLimit batchSize limit
next :: (MonadIO m, MonadBaseControl IO m) => Cursor -> Action m (Maybe Document) next :: (MonadIO m, MonadBaseControl IO m) => Cursor -> Action m (Maybe Document)
-- ^ Return next document in query result, or Nothing if finished. -- ^ Return next document in query result, or Nothing if finished.
next (Cursor fcol batchSize var) = modifyMVar var nextState where next (Cursor fcol batchSize var) = modifyMVar var nextState where
-- Pre-fetch next batch promise from server when last one in current batch is returned. -- Pre-fetch next batch promise from server when last one in current batch is returned.
-- Discard pre-fetched batch if empty with nonzero cid.
-- nextState:: DelayedBatch -> Action m (DelayedBatch, Maybe Document) -- nextState:: DelayedBatch -> Action m (DelayedBatch, Maybe Document)
nextState dBatch = do nextState dBatch = do
Batch limit cid docs <- fulfill' dBatch Batch limit cid docs <- fulfill' fcol batchSize dBatch
case docs of case docs of
doc : docs' -> do doc : docs' -> do
dBatch' <- if null docs' && cid /= 0 dBatch' <- if null docs' && cid /= 0
then nextBatch' limit cid then nextBatch' fcol batchSize limit cid
else return $ return (Batch limit cid docs') else return $ return (Batch limit cid docs')
return (dBatch', Just doc) return (dBatch', Just doc)
[] -> if cid == 0 [] -> if cid == 0
then return (return $ Batch 0 0 [], Nothing) -- finished then return (return $ Batch 0 0 [], Nothing) -- finished
else fmap (,Nothing) $ nextBatch' limit cid else fmap (,Nothing) $ nextBatch' fcol batchSize limit cid
fulfill' dBatch = do
b@(Batch limit cid docs) <- fulfill dBatch
if cid /= 0 && null docs
then nextBatch' limit cid >>= fulfill
else return b
nextBatch' limit cid = request [] (GetMore fcol batchSize' cid, remLimit)
where (batchSize', remLimit) = batchSizeRemainingLimit batchSize limit
nextN :: (MonadIO m, MonadBaseControl IO m, Functor m) => Int -> Cursor -> Action m [Document] nextN :: (MonadIO m, MonadBaseControl IO m, Functor m) => Int -> Cursor -> Action m [Document]
-- ^ Return next N documents or less if end is reached -- ^ Return next N documents or less if end is reached