git.iko.soy/typeable/aeson
on master help sign in
Merge pull request #470 from spl/lookupfield-incoherent-instances

Add incoherent instances to LookupField in Data.Aeson.TH

commit8d27887b3ab4e5ba5844d52695adbfdb90456fef authorAdam Bergmark <adam@bergmark.nl> dateSat 8 Oct 2016, 19:36 (10 years ago) parent8044d1a4768638
6 files changed+45−5
compare with master
unifiedsplit
Data/Aeson/TH.hs+2−1 Data/Aeson/Types/FromJSON.hs+4−4 aeson.cabal+1 include/incoherent-compat.h+7 tests/Encoders.hs+19 tests/Types.hs+12
Data/Aeson/TH.hs+2−1
@@ -13,6 +13,7 @@
1313{-# LANGUAGE TemplateHaskell #-}
1414#endif
1515
16+#include "incoherent-compat.h"
1617#include "overlapping-compat.h"
1718
1819{-|
@@ -1222,7 +1223,7 @@ class LookupField a where
12221223instance OVERLAPPABLE_ LookupField a where
12231224 lookupField = lookupFieldWith
12241225
1225−instance LookupField (Maybe a) where
1226+instance INCOHERENT_ LookupField (Maybe a) where
12261227 lookupField pj _ _ = parseOptionalFieldWith pj
12271228
12281229lookupFieldWith :: (Value -> Parser a) -> String -> String
Data/Aeson/Types/FromJSON.hs+4−4
@@ -18,6 +18,7 @@
1818{-# LANGUAGE PolyKinds #-}
1919#endif
2020
21+#include "incoherent-compat.h"
2122#include "overlapping-compat.h"
2223
2324-- TODO: Drop this when we remove support for Data.Attoparsec.Number
@@ -942,9 +943,8 @@ instance ( FromRecord arity a
942943 (:*:) <$> parseRecord opts fargs Nothing obj
943944 <*> parseRecord opts fargs Nothing obj
944945
945−instance ( Selector s
946− , GFromJSON arity a
947− ) => FromRecord arity (S1 s a) where
946+instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>
947+ FromRecord arity (S1 s a) where
948948 parseRecord opts fargs lab =
949949 (<?> Key label) . gParseJSON opts fargs <=< (.: label)
950950 where
@@ -952,7 +952,7 @@ instance ( Selector s
952952 defLabel = pack . fieldLabelModifier opts $
953953 selName (undefined :: t s a p)
954954
955−instance OVERLAPPING_ (Selector s, FromJSON a) =>
955+instance INCOHERENT_ (Selector s, FromJSON a) =>
956956 FromRecord arity (S1 s (K1 i (Maybe a))) where
957957 parseRecord _ _ (Just lab) obj = (M1 . K1) <$> obj .:? lab
958958 parseRecord opts _ Nothing obj = (M1 . K1) <$> obj .:? pack label
aeson.cabal+1
@@ -47,6 +47,7 @@ extra-source-files:
4747 benchmarks/Typed/*.hs
4848 benchmarks/json-data/*.json
4949 include/overlapping-compat.h
50+ include/incoherent-compat.h
5051 changelog.md
5152 examples/*.cabal
5253 examples/*.hs
include/incoherent-compat.hnew file+7
@@ -0,0 +1,7 @@
1+#if __GLASGOW_HASKELL__ >= 710
2+#define INCOHERENT_ {-# INCOHERENT #-}
3+#else
4+-- This causes some type class instances to break:
5+-- {-# LANGUAGE IncoherentInstances #-}
6+#define INCOHERENT_
7+#endif
tests/Encoders.hs+19
@@ -235,6 +235,25 @@ gSomeTypeToJSONOmitNothingFields = genericToJSON optsOmitNothingFields
235235gSomeTypeToEncodingOmitNothingFields :: SomeType Int -> Encoding
236236gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields
237237
238+--------------------------------------------------------------------------------
239+-- IncoherentInstancesNeeded
240+--------------------------------------------------------------------------------
241+
242+-- | This test demonstrates the need for IncoherentInstances. See the definition
243+-- of 'IncoherentInstancesNeeded' for a discussion of the issue.
244+--
245+-- NOTE 1: We only need to compile this test. We do not need to run it.
246+--
247+-- NOTE 2: We actually only use the INCOHERENT pragma on specific instances
248+-- instead of the IncoherentInstances language extension. Therefore, this is
249+-- only supported on GHC versions >= 7.10.
250+#if __GLASGOW_HASKELL__ >= 710
251+incoherentInstancesNeededParseJSONString :: FromJSON a => Value -> Parser (IncoherentInstancesNeeded a)
252+incoherentInstancesNeededParseJSONString = case () of
253+ _ | True -> $(mkParseJSON defaultOptions ''IncoherentInstancesNeeded)
254+ | False -> genericParseJSON defaultOptions
255+#endif
256+
238257-------------------------------------------------------------------------------
239258-- EitherTextInt encoders/decodes
240259-------------------------------------------------------------------------------
tests/Types.hs+12
@@ -70,6 +70,18 @@ data SomeType a = Nullary
7070 | List [a]
7171 deriving (Eq, Show)
7272
73+-- | This type requires IncoherentInstances for the instances of the type
74+-- classes Data.Aeson.TH.LookupField and Data.Aeson.Types.FromJSON.FromRecord.
75+--
76+-- The minimum known requirements for this type are:
77+-- * Record type with at least two fields
78+-- * One field type is either a type parameter or a type/data family
79+-- * Another field type is a @Maybe@ of the above field type
80+data IncoherentInstancesNeeded a = IncoherentInstancesNeeded
81+ { incoherentInstancesNeededMaybeNot :: a
82+ , incoherentInstancesNeededMaybeYes :: Maybe a
83+ } deriving Generic
84+
7385-- Used for testing UntaggedValue SumEncoding
7486data EitherTextInt
7587 = LeftBool Bool