From 979a2be07d8f1662bfff620c034f41a0c5da2159 Mon Sep 17 00:00:00 2001
From: Greg Weber <greg@gregweber.info>
Date: Sun, 28 Sep 2014 16:09:44 -0700
Subject: [PATCH] mongoDB: more detailed error messages

---
 .../Database/Persist/MongoDB.hs               | 25 ++++++++++++-------
 persistent-mongoDB/persistent-mongoDB.cabal   |  2 +-
 2 files changed, 17 insertions(+), 10 deletions(-)

diff --git a/persistent-mongoDB/Database/Persist/MongoDB.hs b/persistent-mongoDB/Database/Persist/MongoDB.hs
index f38053b59..efd7bf40a 100644
--- a/persistent-mongoDB/Database/Persist/MongoDB.hs
+++ b/persistent-mongoDB/Database/Persist/MongoDB.hs
@@ -880,16 +880,23 @@ fromPersistValuesThrow entDef doc =
                    unHaskellName (entityHaskell entDef) `mappend` ": " `mappend` t
         Right entity -> return entity
 
+mapLeft :: (a -> c) -> Either a b -> Either c b
+mapLeft _ (Right r) = Right r
+mapLeft f (Left l)  = Left (f l)
+
 eitherFromPersistValues :: (PersistEntity record) => EntityDef -> [DB.Field] -> Either T.Text (Entity record)
-eitherFromPersistValues entDef doc =
-    let castDoc = assocListFromDoc doc
-        -- normally _id is the first field
-        mKey = lookup id_ castDoc
-    in case mKey of
-         Nothing -> Left "could not find _id field"
-         Just kpv -> fromPersistValues (map snd $ orderPersistValues (toEmbedEntityDef entDef) castDoc)
-            >>= \body -> keyFromValues [kpv]
-            >>= \key   -> Right $ Entity key body
+eitherFromPersistValues entDef doc = case mKey of
+   Nothing  -> addDetail $ Left $ "could not find _id field: "
+   Just kpv -> do
+      body <- addDetail (fromPersistValues (map snd $ orderPersistValues (toEmbedEntityDef entDef) castDoc))
+      key <- keyFromValues [kpv]
+      return $ Entity key body
+  where
+    addDetail :: Either Text a -> Either Text a
+    addDetail = mapLeft (\msg -> msg `mappend` " for doc: " `mappend` T.pack (show doc))
+    castDoc = assocListFromDoc doc
+    -- normally _id is the first field
+    mKey = lookup id_ castDoc
 
 -- | unlike many SQL databases, MongoDB makes no guarantee of the ordering
 -- of the fields returned in the document.
diff --git a/persistent-mongoDB/persistent-mongoDB.cabal b/persistent-mongoDB/persistent-mongoDB.cabal
index b456f313f..91156e1d6 100644
--- a/persistent-mongoDB/persistent-mongoDB.cabal
+++ b/persistent-mongoDB/persistent-mongoDB.cabal
@@ -1,5 +1,5 @@
 name:            persistent-mongoDB
-version:         2.0.8
+version:         2.0.8.1
 license:         MIT
 license-file:    LICENSE
 author:          Greg Weber <greg@gregweber.info>