Merge pull request #12 from mkscrg/master

Fix for tailable cursor

Database/MongoDB/Query.hs

@@ -496,10 +496,16 @@ nextBatch :: (MonadIO m, MonadBaseControl IO m) => Cursor -> Action m [Document]
 -- ^ Return next batch of documents in query result, which will be empty if finished.
 nextBatch (Cursor fcol batchSize var) = modifyMVar var $ \dBatch -> do
 	-- Pre-fetch next batch promise from server and return current batch.
-	Batch limit cid docs <- fulfill dBatch
+	-- Discard pre-fetched batch if empty with nonzero cid.
+	Batch limit cid docs <- fulfill' dBatch
 	dBatch' <- if cid /= 0 then nextBatch' limit cid else return $ return (Batch 0 0 [])
 	return (dBatch', docs)
  where
+	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
 
@@ -507,9 +513,10 @@ next :: (MonadIO m, MonadBaseControl IO m) => Cursor -> Action m (Maybe Document
 -- ^ Return next document in query result, or Nothing if finished.
 next (Cursor fcol batchSize var) = modifyMVar var nextState where
 	-- 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 dBatch = do
-		Batch limit cid docs <- fulfill dBatch
+		Batch limit cid docs <- fulfill' dBatch
 		case docs of
 			doc : docs' -> do
 				dBatch' <- if null docs' && cid /= 0
@@ -518,7 +525,12 @@ next (Cursor fcol batchSize var) = modifyMVar var nextState where
 				return (dBatch', Just doc)
 			[] -> if cid == 0
 				then return (return $ Batch 0 0 [], Nothing)  -- finished
-				else error $ "server returned empty batch but says more results on server"
+				else fmap (,Nothing) $ nextBatch' 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