4768638 · typeable/aeson

Data/Aeson/TH.hs+2−1

compare with master

unifiedsplit

@@ -13,6 +13,7 @@

13{-# LANGUAGE TemplateHaskell #-}

14#endif

15

16+#include "incoherent-compat.h"

16#include "overlapping-compat.h"

17#include "overlapping-compat.h"

17

18

18{-|

19{-|

@@ -1222,7 +1223,7 @@ class LookupField a where

1222instance OVERLAPPABLE_ LookupField a where

1223instance OVERLAPPABLE_ LookupField a where

1223 lookupField = lookupFieldWith

1224 lookupField = lookupFieldWith

1224

1225

1225−instance LookupField (Maybe a) where

1226+instance INCOHERENT_ LookupField (Maybe a) where

1226 lookupField pj _ _ = parseOptionalFieldWith pj

1227 lookupField pj _ _ = parseOptionalFieldWith pj

1227

1228

1228lookupFieldWith :: (Value -> Parser a) -> String -> String

1229lookupFieldWith :: (Value -> Parser a) -> String -> String

Data/Aeson/Types/FromJSON.hs+4−4

@@ -18,6 +18,7 @@

18{-# LANGUAGE PolyKinds #-}

19#endif

20

21+#include "incoherent-compat.h"

21#include "overlapping-compat.h"

22#include "overlapping-compat.h"

22

23

23-- TODO: Drop this when we remove support for Data.Attoparsec.Number

24-- TODO: Drop this when we remove support for Data.Attoparsec.Number

@@ -942,9 +943,8 @@ instance ( FromRecord arity a

942 (:*:) <$> parseRecord opts fargs Nothing obj

943 (:*:) <$> parseRecord opts fargs Nothing obj

943 <*> parseRecord opts fargs Nothing obj

944 <*> parseRecord opts fargs Nothing obj

944

945

945−instance ( Selector s

946+instance OVERLAPPABLE_ (Selector s, GFromJSON arity a) =>

946− , GFromJSON arity a

947− ) => FromRecord arity (S1 s a) where

947+ FromRecord arity (S1 s a) where

948 parseRecord opts fargs lab =

949 (<?> Key label) . gParseJSON opts fargs <=< (.: label)

950 where

@@ -952,7 +952,7 @@ instance ( Selector s

952 defLabel = pack . fieldLabelModifier opts $

953 selName (undefined :: t s a p)

954

955−instance OVERLAPPING_ (Selector s, FromJSON a) =>

955+instance INCOHERENT_ (Selector s, FromJSON a) =>

956 FromRecord arity (S1 s (K1 i (Maybe a))) where

957 parseRecord _ _ (Just lab) obj = (M1 . K1) <$> obj .:? lab

958 parseRecord opts _ Nothing obj = (M1 . K1) <$> obj .:? pack label

aeson.cabal+1

@@ -47,6 +47,7 @@ extra-source-files:

47 benchmarks/Typed/*.hs

48 benchmarks/json-data/*.json

49 include/overlapping-compat.h

50+ include/incoherent-compat.h

50 changelog.md

51 changelog.md

51 examples/*.cabal

52 examples/*.cabal

52 examples/*.hs

53 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

235gSomeTypeToEncodingOmitNothingFields :: SomeType Int -> Encoding

236gSomeTypeToEncodingOmitNothingFields = genericToEncoding optsOmitNothingFields

237

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+

238-------------------------------------------------------------------------------

257-------------------------------------------------------------------------------

239-- EitherTextInt encoders/decodes

258-- EitherTextInt encoders/decodes

240-------------------------------------------------------------------------------

259-------------------------------------------------------------------------------

tests/Types.hs+12

@@ -70,6 +70,18 @@ data SomeType a = Nullary

70 | List [a]

71 deriving (Eq, Show)

72

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+

73-- Used for testing UntaggedValue SumEncoding

85-- Used for testing UntaggedValue SumEncoding

74data EitherTextInt

86data EitherTextInt

75 = LeftBool Bool

87 = LeftBool Bool