From 57722a7d43b86ecbf7743f6623af666ed801bf0a Mon Sep 17 00:00:00 2001
From: Greg Weber <greg@gregweber.info>
Date: Thu, 29 Aug 2013 11:57:07 -0700
Subject: [PATCH] handle findAndModify edge cases

also give better error messages
---
 Database/MongoDB/Query.hs | 42 +++++++++++++++++++++++++--------------
 mongoDB.cabal             |  2 +-
 2 files changed, 28 insertions(+), 16 deletions(-)

diff --git a/Database/MongoDB/Query.hs b/Database/MongoDB/Query.hs
index ad7b72f..e67a2a8 100644
--- a/Database/MongoDB/Query.hs
+++ b/Database/MongoDB/Query.hs
@@ -48,6 +48,7 @@ import Control.Monad (unless, replicateM, liftM)
 import Data.Int (Int32)
 import Data.Maybe (listToMaybe, catMaybes)
 import Data.Word (Word32)
+import Data.Monoid (mappend)
 
 #if MIN_VERSION_base(4,6,0)
 import Control.Concurrent.MVar.Lifted (MVar, newMVar, mkWeakMVar,
@@ -450,21 +451,32 @@ findAndModify (Query {
   , project = project
   , sort = sort
   }) updates = do
-  result <- runCommand [
-     "findAndModify" := String collection
-   , "new"    := Bool True -- return updated document, not original document
-   , "query"  := Doc sel
-   , "update" := Doc updates
-   , "fields" := Doc project
-   , "sort"   := Doc sort
-   ]
-  return $ case findErr result of
-    Nothing -> case lookup "value" result of
-      Nothing -> Left "findAndModify: no document found (value field was empty)"
-      Just doc -> Right doc
-    Just e -> Left e
-    where
-      findErr result = lookup "err" (at "lastErrorObject" result)
+    result <- runCommand
+        [ "findAndModify" := String collection
+        , "new"    := Bool True -- return updated document, not original document
+        , "query"  := Doc sel
+        , "update" := Doc updates
+        , "fields" := Doc project
+        , "sort"   := Doc sort
+        ]
+    return $
+      case lookup "value" result of
+          Left err   -> leftErr err
+          Right mdoc -> case mdoc of
+              Nothing  -> leftErr $ show result
+              Just doc -> case lookupErr result of
+                  Just e -> leftErr e
+                  Nothing -> Right doc
+  where
+    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
 -- ^ Return performance stats of query execution
diff --git a/mongoDB.cabal b/mongoDB.cabal
index 2ffbd47..d36ccc3 100644
--- a/mongoDB.cabal
+++ b/mongoDB.cabal
@@ -1,5 +1,5 @@
 Name:           mongoDB
-Version:        1.4.1
+Version:        1.4.1.1
 Synopsis:       Driver (client) for MongoDB, a free, scalable, fast, document
                 DBMS
 Description:    This package lets you connect to MongoDB servers and