85529fc · typeable/aeson

git.iko.soy/typeable/aeson

on master help sign in

Merge pull request #696 from RyanGlScott/th-abstraction-0.3

85529fcAdam Bergmark7 years ago

Data/Aeson/TH.hs+28−20

compare with master

unifiedsplit

@@ -334,13 +334,13 @@ consToValue :: ToJSONFun

334consToValue _ _ _ _ [] = error $ "Data.Aeson.TH.consToValue: "

335 ++ "Not a single constructor given!"

336

337−consToValue target jc opts vars cons = do

337+consToValue target jc opts instTys cons = do

338 value <- newName "value"

339 tjs <- newNameList "_tj" $ arityInt jc

340 tjls <- newNameList "_tjl" $ arityInt jc

341 let zippedTJs = zip tjs tjls

342 interleavedTJs = interleave tjs tjls

343− lastTyVars = map varTToName $ drop (length vars - arityInt jc) vars

343+ lastTyVars = map varTToName $ drop (length instTys - arityInt jc) instTys

344 tvMap = M.fromList $ zip lastTyVars zippedTJs

345 lamE (map varP $ interleavedTJs ++ [value]) $

346 caseE (varE value) (matches tvMap)

@@ -672,13 +672,13 @@ consFromJSON :: JSONClass

672consFromJSON _ _ _ _ [] = error $ "Data.Aeson.TH.consFromJSON: "

673 ++ "Not a single constructor given!"

674

675−consFromJSON jc tName opts vars cons = do

675+consFromJSON jc tName opts instTys cons = do

676 value <- newName "value"

677 pjs <- newNameList "_pj" $ arityInt jc

678 pjls <- newNameList "_pjl" $ arityInt jc

679 let zippedPJs = zip pjs pjls

680 interleavedPJs = interleave pjs pjls

681− lastTyVars = map varTToName $ drop (length vars - arityInt jc) vars

681+ lastTyVars = map varTToName $ drop (length instTys - arityInt jc) instTys

682 tvMap = M.fromList $ zip lastTyVars zippedPJs

683 lamE (map varP $ interleavedPJs ++ [value]) $ lamExpr value tvMap

684

@@ -1209,23 +1209,27 @@ deriveJSONClass :: [(JSONFun, JSONClass -> Name -> Options -> [Type]

1209deriveJSONClass consFuns jc opts name = do

1210 info <- reifyDatatype name

1211 case info of

1212− DatatypeInfo { datatypeContext = ctxt

1212+ DatatypeInfo { datatypeContext = ctxt

1213− , datatypeName = parentName

1213+ , datatypeName = parentName

1214+#if MIN_VERSION_th_abstraction(0,3,0)

1215+ , datatypeInstTypes = instTys

1216+#else

1214− , datatypeVars = vars

1217+ , datatypeVars = instTys

1218+#endif

1215− , datatypeVariant = variant

1219+ , datatypeVariant = variant

1216− , datatypeCons = cons

1220+ , datatypeCons = cons

1217 } -> do

1221 } -> do

1218 (instanceCxt, instanceType)

1222 (instanceCxt, instanceType)

1219− <- buildTypeInstance parentName jc ctxt vars variant

1223+ <- buildTypeInstance parentName jc ctxt instTys variant

1220 (:[]) <$> instanceD (return instanceCxt)

1224 (:[]) <$> instanceD (return instanceCxt)

1221 (return instanceType)

1225 (return instanceType)

1222− (methodDecs parentName vars cons)

1226+ (methodDecs parentName instTys cons)

1223 where

1227 where

1224 methodDecs :: Name -> [Type] -> [ConstructorInfo] -> [Q Dec]

1228 methodDecs :: Name -> [Type] -> [ConstructorInfo] -> [Q Dec]

1225− methodDecs parentName vars cons = flip map consFuns $ \(jf, jfMaker) ->

1229+ methodDecs parentName instTys cons = flip map consFuns $ \(jf, jfMaker) ->

1226 funD (jsonFunValName jf (arity jc))

1230 funD (jsonFunValName jf (arity jc))

1227 [ clause []

1231 [ clause []

1228− (normalB $ jfMaker jc parentName opts vars cons)

1232+ (normalB $ jfMaker jc parentName opts instTys cons)

1229 []

1233 []

1230 ]

1234 ]

1231

1235

@@ -1241,17 +1245,21 @@ mkFunCommon :: (JSONClass -> Name -> Options -> [Type] -> [ConstructorInfo] -> Q

1241mkFunCommon consFun jc opts name = do

1245mkFunCommon consFun jc opts name = do

1242 info <- reifyDatatype name

1246 info <- reifyDatatype name

1243 case info of

1247 case info of

1244− DatatypeInfo { datatypeContext = ctxt

1248+ DatatypeInfo { datatypeContext = ctxt

1245− , datatypeName = parentName

1249+ , datatypeName = parentName

1250+#if MIN_VERSION_th_abstraction(0,3,0)

1251+ , datatypeInstTypes = instTys

1252+#else

1246− , datatypeVars = vars

1253+ , datatypeVars = instTys

1254+#endif

1247− , datatypeVariant = variant

1255+ , datatypeVariant = variant

1248− , datatypeCons = cons

1256+ , datatypeCons = cons

1249 } -> do

1257 } -> do

1250 -- We force buildTypeInstance here since it performs some checks for whether

1258 -- We force buildTypeInstance here since it performs some checks for whether

1251 -- or not the provided datatype's kind matches the derived method's

1259 -- or not the provided datatype's kind matches the derived method's

1252 -- typeclass, and produces errors if it can't.

1260 -- typeclass, and produces errors if it can't.

1253− !_ <- buildTypeInstance parentName jc ctxt vars variant

1261+ !_ <- buildTypeInstance parentName jc ctxt instTys variant

1254− consFun jc parentName opts vars cons

1262+ consFun jc parentName opts instTys cons

1255

1263

1256dispatchFunByType :: JSONClass

1264dispatchFunByType :: JSONClass

1257 -> JSONFun

1265 -> JSONFun

aeson.cabal+1−1

@@ -152,7 +152,7 @@ library

152 dlist >= 0.8.0.4 && < 0.9,

153 hashable >= 1.2.7.0 && < 1.3,

154 scientific >= 0.3.6.2 && < 0.4,

155− th-abstraction >= 0.2.8.0 && < 0.3,

155+ th-abstraction >= 0.2.8.0 && < 0.4,

156 time-locale-compat >= 0.1.1.5 && < 0.2,

157 uuid-types >= 1.0.3 && < 1.1,

158 vector >= 0.12.0.1 && < 0.13

benchmarks/aeson-benchmarks.cabal+1−1

@@ -45,7 +45,7 @@ library

45 tagged >=0.8.3 && <0.9,

46 template-haskell >= 2.4,

47 text >= 1.2.3,

48− th-abstraction >= 0.2.2 && < 0.3,

48+ th-abstraction >= 0.2.2 && < 0.4,

49 time,

50 transformers,

51 unordered-containers >= 0.2.3.0,

changelog.md+1

@@ -2,6 +2,7 @@ For the latest version of this document, please see [https://github.com/bos/aeso

3## Upcoming

4* Exposes internal helper functions like `<?>`, `JSONPath`, and `parseIndexedJSON` from `Data.Aeson` module. Does not include any breaking changes.

5+* Support building with `th-abstraction-0.3.0.0` or later.

6### 1.4.2.0

7### 1.4.2.0