Track JSONPath in derived parsers

Author: lyxia

Data/Aeson/TH.hs

@@ -107,7 +107,7 @@ import Data.Aeson.Types ( Value(..), Parser
                         , defaultOptions
                         , defaultTaggedObject
                         )
-import Data.Aeson.Types.Internal (Encoding(..))
+import Data.Aeson.Types.Internal (Encoding(..), (<?>), JSONPathElement(Key))
 import Control.Monad       ( liftM2, return, mapM, fail )
 import Data.Bool           ( Bool(False, True), otherwise, (&&), not )
 import Data.Either         ( Either(Left, Right) )
@@ -1010,7 +1010,7 @@ instance OVERLAPPABLE_ (FromJSON a) => LookupField a where
     lookupField tName rec obj key =
         case H.lookup key obj of
           Nothing -> unknownFieldFail tName rec (T.unpack key)
-          Just v  -> parseJSON v
+          Just v  -> parseJSON v <?> Key key
 
 instance (FromJSON a) => LookupField (Maybe a) where
     lookupField _ _ = (.:?)

Data/Aeson/Types/Generic.hs

@@ -679,12 +679,11 @@ instance (FromRecord a, FromRecord b) => FromRecord (a :*: b) where
                                    <*> parseRecord opts Nothing obj
 
 instance (Selector s, GFromJSON a) => FromRecord (S1 s a) where
-    parseRecord opts (Just lab) = maybe (notFound $ unpack lab)
-                      (gParseJSON opts) . H.lookup lab
-    parseRecord opts Nothing    = maybe (notFound label)
-                      (gParseJSON opts) . H.lookup (pack label)
+    parseRecord opts lab = gParseJSON opts <=< (.: label)
         where
-          label = fieldLabelModifier opts $ selName (undefined :: t s a p)
+          label = fromMaybe defLabel lab
+          defLabel = pack . fieldLabelModifier opts $
+                       selName (undefined :: t s a p)
 
 instance OVERLAPPING_ (Selector s, FromJSON a) =>
   FromRecord (S1 s (K1 i (Maybe a))) where