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

Inline send function

Browse source
This commit is contained in:
Victor Denisov 2016-08-05 20:29:20 -07:00
parent b34162f084
commit 8348045cc5
1 changed files with 11 additions and 10 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

21
Database/MongoDB/Query.hs
View file

@ -185,12 +185,6 @@ mongoReadMode = readMode . mongoAccessMode
mongoWriteMode :: MongoContext -> WriteMode mongoWriteMode :: MongoContext -> WriteMode
mongoWriteMode = writeMode . mongoAccessMode mongoWriteMode = writeMode . mongoAccessMode
send :: (MonadIO m) => [Notice] -> Action m ()
-- ^ Send notices as a contiguous batch to server with no reply. Throw 'ConnectionFailure' if pipe fails.
send ns = do
pipe <- asks mongoPipe
liftIOE ConnectionFailure $ P.send pipe ns
class HasMongoContext env where class HasMongoContext env where
mongoContext :: env -> MongoContext mongoContext :: env -> MongoContext
instance HasMongoContext MongoContext where instance HasMongoContext MongoContext where
@ -381,7 +375,9 @@ data WriteMode =
write :: (MonadIO m) => Notice -> Action m () write :: (MonadIO m) => Notice -> Action m ()
-- ^ Send write to server, and if write-mode is 'Safe' then include getLastError request and raise 'WriteFailure' if it reports an error. -- ^ Send write to server, and if write-mode is 'Safe' then include getLastError request and raise 'WriteFailure' if it reports an error.
write notice = asks mongoWriteMode >>= \mode -> case mode of write notice = asks mongoWriteMode >>= \mode -> case mode of
NoConfirm -> send [notice] NoConfirm -> do
pipe <- asks mongoPipe
liftIOE ConnectionFailure $ P.send pipe [notice]
Confirm params -> do Confirm params -> do
let q = query (("getlasterror" =: (1 :: Int)) : params) "$cmd" let q = query (("getlasterror" =: (1 :: Int)) : params) "$cmd"
pipe <- asks mongoPipe pipe <- asks mongoPipe
@ -1030,7 +1026,8 @@ nextBatch (Cursor fcol batchSize var) = modifyMVar var $ \dBatch -> do
case (cid, newLimit) of case (cid, newLimit) of
(0, _) -> return (emptyBatch, resultDocs) (0, _) -> return (emptyBatch, resultDocs)
(_, Just 0) -> do (_, Just 0) -> do
send [KillCursors [cid]] pipe <- asks mongoPipe
liftIOE ConnectionFailure $ P.send pipe [KillCursors [cid]]
return (emptyBatch, resultDocs) return (emptyBatch, resultDocs)
(_, _) -> (, resultDocs) <$> getNextBatch (_, _) -> (, resultDocs) <$> getNextBatch
@ -1066,7 +1063,9 @@ next (Cursor fcol batchSize var) = modifyMVar var nextState where
dBatch' <- if null docs' && cid /= 0 && ((newLimit > (Just 0)) || (isNothing newLimit)) dBatch' <- if null docs' && cid /= 0 && ((newLimit > (Just 0)) || (isNothing newLimit))
then nextBatch' fcol batchSize newLimit cid then nextBatch' fcol batchSize newLimit cid
else return $ return (Batch newLimit cid docs') else return $ return (Batch newLimit cid docs')
when (newLimit == (Just 0)) $ unless (cid == 0) $ send [KillCursors [cid]] when (newLimit == (Just 0)) $ unless (cid == 0) $ do
pipe <- asks mongoPipe
liftIOE ConnectionFailure $ P.send pipe [KillCursors [cid]]
return (dBatch', Just doc) return (dBatch', Just doc)
[] -> if cid == 0 [] -> if cid == 0
then return (return $ Batch (Just 0) 0 [], Nothing) -- finished then return (return $ Batch (Just 0) 0 [], Nothing) -- finished
@ -1083,7 +1082,9 @@ rest c = loop (next c)
closeCursor :: (MonadIO m, MonadBaseControl IO m) => Cursor -> Action m () closeCursor :: (MonadIO m, MonadBaseControl IO m) => Cursor -> Action m ()
closeCursor (Cursor _ _ var) = modifyMVar var $ \dBatch -> do closeCursor (Cursor _ _ var) = modifyMVar var $ \dBatch -> do
Batch _ cid _ <- fulfill dBatch Batch _ cid _ <- fulfill dBatch
unless (cid == 0) $ send [KillCursors [cid]] unless (cid == 0) $ do
pipe <- asks mongoPipe
liftIOE ConnectionFailure $ P.send pipe [KillCursors [cid]]
return $ (return $ Batch (Just 0) 0 [], ()) return $ (return $ Batch (Just 0) 0 [], ())
isCursorClosed :: (MonadIO m, MonadBase IO m) => Cursor -> Action m Bool isCursorClosed :: (MonadIO m, MonadBase IO m) => Cursor -> Action m Bool