IncoherentInstances needed to derive some instances

* Add IncoherentInstances to Data.Aeson.TH and Data.Aeson.FromJSON
* Add data type with test that demonstrates the need for IncoherentInstances
  in TH and Generic deriving (specifically for the classes LookupField and
  FromRecord)
* Fix #468

Data/Aeson/TH.hs

@@ -13,6 +13,7 @@
 {-# LANGUAGE TemplateHaskell #-}
 #endif
 
+#include "incoherent-compat.h"
 #include "overlapping-compat.h"
 
 {-|
@@ -1222,7 +1223,7 @@ class LookupField a where
 instance OVERLAPPABLE_ LookupField a where
     lookupField = lookupFieldWith
 
-instance LookupField (Maybe a) where
+instance INCOHERENT_ LookupField (Maybe a) where
     lookupField pj _ _ = parseOptionalFieldWith pj
 
 lookupFieldWith :: (Value -> Parser a) -> String -> String

Data/Aeson/Types/FromJSON.hs

@@ -18,6 +18,7 @@
 {-# LANGUAGE PolyKinds #-}
 #endif
 
+#include "incoherent-compat.h"
 #include "overlapping-compat.h"
 
 -- TODO: Drop this when we remove support for Data.Attoparsec.Number
@@ -942,17 +943,16 @@ instance ( FromRecord arity a
       (:*:) <$> parseRecord opts fargs Nothing obj
             <*> parseRecord opts fargs Nothing obj
 
-instance ( Selector s
-         , GFromJSON arity a
-         ) => FromRecord arity (S1 s a) where
+instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>
+  FromRecord arity (S1 s a) where
     parseRecord opts fargs lab =
       (<?> Key label) . gParseJSON opts fargs <=< (.: label)
         where
           label = fromMaybe defLabel lab
           defLabel = pack . fieldLabelModifier opts $
                        selName (undefined :: t s a p)
 
-instance OVERLAPPING_ (Selector s, FromJSON a) =>
+instance INCOHERENT_ (Selector s, FromJSON a) =>
   FromRecord arity (S1 s (K1 i (Maybe a))) where
     parseRecord _ _ (Just lab) obj = (M1 . K1) <$> obj .:? lab
     parseRecord opts _ Nothing obj = (M1 . K1) <$> obj .:? pack label

aeson.cabal

@@ -47,6 +47,7 @@ extra-source-files:
     benchmarks/Typed/*.hs
     benchmarks/json-data/*.json
     include/overlapping-compat.h
+    include/incoherent-compat.h
     changelog.md
     examples/*.cabal
     examples/*.hs

include/incoherent-compat.h

@@ -0,0 +1,7 @@
+#if __GLASGOW_HASKELL__ >= 710
+#define INCOHERENT_ {-# INCOHERENT #-}
+#else
+-- This causes some type class instances to break:
+-- {-# LANGUAGE IncoherentInstances #-}
+#define INCOHERENT_
+#endif

tests/Encoders.hs

@@ -235,6 +235,25 @@ gSomeTypeToJSONOmitNothingFields = genericToJSON optsOmitNothingFields
 gSomeTypeToEncodingOmitNothingFields :: SomeType Int -> Encoding
 gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields
 
+--------------------------------------------------------------------------------
+-- IncoherentInstancesNeeded
+--------------------------------------------------------------------------------
+
+-- | This test demonstrates the need for IncoherentInstances. See the definition
+-- of 'IncoherentInstancesNeeded' for a discussion of the issue.
+--
+-- NOTE 1: We only need to compile this test. We do not need to run it.
+--
+-- NOTE 2: We actually only use the INCOHERENT pragma on specific instances
+-- instead of the IncoherentInstances language extension. Therefore, this is
+-- only supported on GHC versions >= 7.10.
+#if __GLASGOW_HASKELL__ >= 710
+incoherentInstancesNeededParseJSONString :: FromJSON a => Value -> Parser (IncoherentInstancesNeeded a)
+incoherentInstancesNeededParseJSONString = case () of
+  _ | True  -> $(mkParseJSON defaultOptions ''IncoherentInstancesNeeded)
+    | False -> genericParseJSON defaultOptions
+#endif
+
 -------------------------------------------------------------------------------
 -- EitherTextInt encoders/decodes
 -------------------------------------------------------------------------------

tests/Types.hs

@@ -70,6 +70,18 @@ data SomeType a = Nullary
                 | List [a]
   deriving (Eq, Show)
 
+-- | This type requires IncoherentInstances for the instances of the type
+-- classes Data.Aeson.TH.LookupField and Data.Aeson.Types.FromJSON.FromRecord.
+--
+-- The minimum known requirements for this type are:
+-- * Record type with at least two fields
+-- * One field type is either a type parameter or a type/data family
+-- * Another field type is a @Maybe@ of the above field type
+data IncoherentInstancesNeeded a = IncoherentInstancesNeeded
+  { incoherentInstancesNeededMaybeNot :: a
+  , incoherentInstancesNeededMaybeYes :: Maybe a
+  } deriving Generic
+
 -- Used for testing UntaggedValue SumEncoding
 data EitherTextInt
     = LeftBool Bool