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

better findAndModify error handling

Browse source
This commit is contained in:
Greg Weber 2014-07-24 08:12:44 -07:00
parent f2a6307530
commit a047c309e5
1 changed files with 14 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

29
Database/MongoDB/Query.hs
View file

@ -439,7 +439,7 @@ findAndModify q ups = do
return $ case eres of return $ case eres of
Left l -> Left l Left l -> Left l
Right r -> case r of Right r -> case r of
-- mongoDB manual says this is only possible when update is True -- only possible when upsert is True and new is False
Nothing -> Left "findAndModify: impossible null result" Nothing -> Left "findAndModify: impossible null result"
Just doc -> Right doc Just doc -> Right doc
@ -467,21 +467,20 @@ findAndModifyOpts (Query {
, "new" := Bool famNew -- return updated document, not original document , "new" := Bool famNew -- return updated document, not original document
, "upsert" := Bool famUpsert -- insert if nothing is found , "upsert" := Bool famUpsert -- insert if nothing is found
]) ])
return $ return $ case lookupErr result of
case lookup "value" result of Just e -> leftErr e
Left err -> leftErr err Nothing -> case lookup "value" result of
Right mdoc -> case mdoc of Left err -> leftErr $ "no document found: " `mappend` err
Just doc@(_:_) -> case lookupErr result of Right mdoc -> case mdoc of
Just e -> leftErr e Just doc@(_:_) -> Right (Just doc)
Nothing -> Right (Just doc) Just [] -> case famOpts of
_ -> case famOpts of FamUpdate { famUpsert = True, famNew = False } -> Right Nothing
FamUpdate { famUpsert = True, famNew = True } -> Right Nothing _ -> leftErr $ show result
_ -> leftErr $ show result _ -> leftErr $ show result
where where
leftErr err = Left $ "findAndModify: no document found: " leftErr err = Left $ "findAndModify " `mappend` show collection
`mappend` show collection `mappend` "\nfrom query: " `mappend` show sel
`mappend` "from query: " `mappend` show sel `mappend` "\nerror: " `mappend` err
`mappend` err
-- return Nothing means ok, Just is the error message -- return Nothing means ok, Just is the error message
lookupErr result = case lookup "lastErrorObject" result of lookupErr result = case lookup "lastErrorObject" result of