persistent-mongoDB 2.5.0.1 → 2.6.0

raw patch · 3 files changed

+33/−19 lines, 3 filesdep ~http-api-datanew-uploaderPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: http-api-data

API changes (from Hackage documentation)

Files

• ChangeLog.md +5/−0
• Database/Persist/MongoDB.hs +26/−17
• persistent-mongoDB.cabal +2/−2

@@ -1,3 +1,8 @@+## 2.6.0++* Fix upsert behavior [#613](https://github.com/yesodweb/persistent/issues/613)+* Relax bounds for http-api-data+ ## 2.5  * changes for read/write typeclass split

@@ -122,7 +122,7 @@ import Data.Bson (ObjectId(..)) import qualified Database.MongoDB as DB import Database.MongoDB.Query (Database)-import Control.Applicative (Applicative, (<$>))+import Control.Applicative as A (Applicative, (<$>)) import Network (PortID (PortNumber)) import Network.Socket (HostName) import Data.Maybe (mapMaybe, fromJust)@@ -137,7 +137,7 @@ import Control.Monad.IO.Class (liftIO) import Data.Aeson (Value (Number), (.:), (.:?), (.!=), FromJSON(..), ToJSON(..), withText, withObject) import Data.Aeson.Types (modifyFailure)-import Control.Monad (liftM, (>=>), forM_)+import Control.Monad (liftM, (>=>), forM_, unless) import qualified Data.Pool as Pool import Data.Time (NominalDiffTime) #ifdef HIGH_PRECISION_DATE@@ -220,7 +220,7 @@ instance FromHttpApiData (BackendKey DB.MongoContext) where     parseUrlPiece input = do       s <- parseUrlPieceWithPrefix "o" input <!> return input-      MongoKey <$> readTextData s+      MongoKey A.<$> readTextData s       where         infixl 3 <!>         Left _ <!> y = y@@ -257,7 +257,7 @@     sqlType _ = Sql.SqlOther "doesn't make much sense for MongoDB"  -withConnection :: (Trans.MonadIO m, Applicative m)+withConnection :: (Trans.MonadIO m, A.Applicative m)                => MongoConf                -> (ConnectionPool -> m b) -> m b withConnection mc =@@ -508,7 +508,7 @@ keyFrom_idEx idVal = case keyFrom_id idVal of     Right k  -> return k     Left err -> liftIO $ throwIO $ PersistMongoDBError $ "could not convert key: "-        `mappend` T.pack (show idVal)+        `Data.Monoid.mappend` T.pack (show idVal)         `mappend` err  keyFrom_id :: (PersistEntity record) => DB.Value -> Either Text (Key record)@@ -622,20 +622,29 @@         uniq <- onlyUnique newRecord         upsertBy uniq newRecord upds +-- -        let uniqKeys = map DB.label uniqueDoc+-- -        let insDoc = DB.exclude uniqKeys $ toInsertDoc newRecord+--          let selection = DB.select uniqueDoc $ collectionName newRecord+-- -        if null upds+-- -          then DB.upsert selection ["$set" DB.=: insDoc]+-- -          else do+-- -            DB.upsert selection ["$setOnInsert" DB.=: insDoc]+-- -            DB.modify selection $ updatesToDoc upds+-- -        -- because findAndModify $setOnInsert is broken we do a separate get now+     upsertBy uniq newRecord upds = do-        let uniqueDoc = toUniquesDoc uniq-        let uniqKeys = map DB.label uniqueDoc-        let insDoc = DB.exclude uniqKeys $ toInsertDoc newRecord-        let selection = DB.select uniqueDoc $ collectionName newRecord-        if null upds-          then DB.upsert selection ["$set" DB.=: insDoc]-          else do-            DB.upsert selection ["$setOnInsert" DB.=: insDoc]-            DB.modify selection $ updatesToDoc upds-        -- because findAndModify $setOnInsert is broken we do a separate get now+        let uniqueDoc = toUniquesDoc uniq :: [DB.Field]+        let uniqKeys = map DB.label uniqueDoc :: [DB.Label]   +        let insDoc = DB.exclude uniqKeys $ toInsertDoc newRecord :: DB.Document+        let selection = DB.select uniqueDoc $ collectionName newRecord :: DB.Selection         mdoc <- getBy uniq-        maybe (err "possible race condition: getBy found Nothing")-            return mdoc+        case mdoc of+          Nothing -> unless (null upds) (DB.upsert selection ["$setOnInsert" DB.=: insDoc])+          Just _ -> unless (null upds) (DB.modify selection $ DB.exclude uniqKeys $ updatesToDoc upds)+        newMdoc <- getBy uniq+        case newMdoc of+          Nothing -> err "possible race condition: getBy found Nothing"+          Just doc -> return doc       where         err = Trans.liftIO . throwIO . UpsertError         {-

@@ -1,5 +1,5 @@ name:            persistent-mongoDB-version:         2.5.0.1+version:         2.6.0 license:         MIT license-file:    LICENSE author:          Greg Weber <greg@gregweber.info>@@ -32,7 +32,7 @@                    , network            >= 2.2.1.7                    , cereal             >= 0.3.0.0                    , path-pieces        >= 0.1-                   , http-api-data      >= 0.2       && < 0.3+                   , http-api-data      >= 0.2       && < 0.4                    , monad-control      >= 0.3                    , aeson              >= 0.6.2                    , attoparsec