mongodb-queue 0.2.5 → 0.2.5.1

raw patch · 2 files changed

+24/−10 lines, 2 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• Database/MongoDB/Queue.hs +23/−9
• mongodb-queue.cabal +1/−1

@@ -1,4 +1,5 @@-{-# LANGUAGE FlexibleContexts, RecordWildCards, Rank2Types, DeriveDataTypeable #-}+{-# LANGUAGE FlexibleContexts, RecordWildCards, Rank2Types, DeriveDataTypeable, ExtendedDefaultRules #-}+{-# OPTIONS_GHC -fno-warn-type-defaults #-} module Database.MongoDB.Queue (     emit   , nextFromQueue@@ -19,6 +20,8 @@ import Network.BSD (getHostName, HostName) import Control.Monad (void) +default (Int)+ queueCollection, handled, dataField, _id, hostField, versionField :: Text queueCollection = "queue" handled = "handled"@@ -124,18 +127,29 @@ -- -- Do not call this from multiple threads against the same QueueWorker nextFromQueue :: QueueWorker -> IO Document-nextFromQueue QueueWorker {..} = do-    cursor <- qwGetCursor-    qwRunDB $ do+nextFromQueue QueueWorker {..} =+    qwGetCursor >>= qwRunDB . processNext+  where+    processNext cursor = do         origDoc <- nextDoc cursor `catch` handleDroppedCursor+        let idQuery = [_id := valueAt _id origDoc] -        eDoc <- findAndModify (select [_id := (valueAt _id origDoc)] qwCollection) {-            sort = ["$natural" =: (-1 :: Int)]-          } [ "$set" =: [handled =: True] ]+        eDoc <- findAndModify (selectQuery $ idQuery ++ [handled =: False])+                             ["$set" =: [handled =: True]]         case eDoc of-          Left err  -> liftIO $ throwIO $ FindAndModifyError err           Right doc -> return (at dataField doc)-  where+          Left err  ->  do+              -- a different cursor can lock this first by setting handled to True+              -- verify that this is what happened+              mDoc <- findOne (selectQuery idQuery)+              case mDoc of+                Nothing  -> liftIO $ throwIO $ FindAndModifyError err+                Just _ -> processNext cursor++    selectQuery query = (select query qwCollection) {+        sort = ["$natural" =: -1]+      }+     handleDroppedCursor :: (MonadIO m, MonadBaseControl IO m, Functor m) => SomeException -> Action m Document     handleDroppedCursor _ = nextDoc =<< liftIO (         threadDelay (1000 * 1000) >> qwGetCursor

@@ -2,7 +2,7 @@ -- documentation, see http://haskell.org/cabal/users-guide/  name:                mongodb-queue-version:             0.2.5+version:             0.2.5.1 synopsis:            a message queue using MongoDB -- description:          homepage:            https://github.com/docmunch/haskell-mongodb-queue