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

Merge pull request #15 from gregwebs/fix-findAndModify

Browse source 
handle findAndModify edge cases
This commit is contained in:
Fedor Gogolev 2013-09-02 09:13:12 -07:00
commit 6b37a429d4
2 changed files with 28 additions and 16 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

28
Database/MongoDB/Query.hs
View file

@ -48,6 +48,7 @@ import Control.Monad (unless, replicateM, liftM)
import Data.Int (Int32) import Data.Int (Int32)
import Data.Maybe (listToMaybe, catMaybes) import Data.Maybe (listToMaybe, catMaybes)
import Data.Word (Word32) import Data.Word (Word32)
import Data.Monoid (mappend)
#if MIN_VERSION_base(4,6,0) #if MIN_VERSION_base(4,6,0)
import Control.Concurrent.MVar.Lifted (MVar, newMVar, mkWeakMVar, import Control.Concurrent.MVar.Lifted (MVar, newMVar, mkWeakMVar,
@ -450,21 +451,32 @@ findAndModify (Query {
, project = project , project = project
, sort = sort , sort = sort
}) updates = do }) updates = do
result <- runCommand [ result <- runCommand
"findAndModify" := String collection [ "findAndModify" := String collection
, "new" := Bool True -- return updated document, not original document , "new" := Bool True -- return updated document, not original document
, "query" := Doc sel , "query" := Doc sel
, "update" := Doc updates , "update" := Doc updates
, "fields" := Doc project , "fields" := Doc project
, "sort" := Doc sort , "sort" := Doc sort
] ]
return $ case findErr result of return $
Nothing -> case lookup "value" result of case lookup "value" result of
Nothing -> Left "findAndModify: no document found (value field was empty)" Left err -> leftErr err
Just doc -> Right doc Right mdoc -> case mdoc of
Just e -> Left e Nothing -> leftErr $ show result
Just doc -> case lookupErr result of
Just e -> leftErr e
Nothing -> Right doc
where where
findErr result = lookup "err" (at "lastErrorObject" result) leftErr err = Left $ "findAndModify: no document found: "
`mappend` show collection
`mappend` "from query: " `mappend` show sel
`mappend` err
-- return Nothing means ok, Just is the error message
lookupErr result = case lookup "lastErrorObject" result of
Right errObject -> lookup "err" errObject
Left err -> Just err
explain :: (MonadIO m) => Query -> Action m Document explain :: (MonadIO m) => Query -> Action m Document
-- ^ Return performance stats of query execution -- ^ Return performance stats of query execution

2
mongoDB.cabal
View file

@ -1,5 +1,5 @@
Name: mongoDB Name: mongoDB
Version: 1.4.1 Version: 1.4.1.1
Synopsis: Driver (client) for MongoDB, a free, scalable, fast, document Synopsis: Driver (client) for MongoDB, a free, scalable, fast, document
DBMS DBMS
Description: This package lets you connect to MongoDB servers and Description: This package lets you connect to MongoDB servers and