on master help sign in
Merge pull request #696 from RyanGlScott/th-abstraction-0.3

Adapt to breaking changes in th-abstraction-0.3.0.0

commit85529fc59d8ec73240d3149746152068995d8ae3 authorAdam Bergmark <adam@bergmark.nl> dateSat 27 Apr 2019, 19:08 (7 years ago) parent3f8a420dfe3ad8
4 files changed+31−22
Data/Aeson/TH.hs+28−20 aeson.cabal+1−1 benchmarks/aeson-benchmarks.cabal+1−1 changelog.md+1
Data/Aeson/TH.hs+28−20
@@ -334,13 +334,13 @@ consToValue :: ToJSONFun
334334consToValue _ _ _ _ [] = error $ "Data.Aeson.TH.consToValue: "
335335 ++ "Not a single constructor given!"
336336
337−consToValue target jc opts vars cons = do
337+consToValue target jc opts instTys cons = do
338338 value <- newName "value"
339339 tjs <- newNameList "_tj" $ arityInt jc
340340 tjls <- newNameList "_tjl" $ arityInt jc
341341 let zippedTJs = zip tjs tjls
342342 interleavedTJs = interleave tjs tjls
343− lastTyVars = map varTToName $ drop (length vars - arityInt jc) vars
343+ lastTyVars = map varTToName $ drop (length instTys - arityInt jc) instTys
344344 tvMap = M.fromList $ zip lastTyVars zippedTJs
345345 lamE (map varP $ interleavedTJs ++ [value]) $
346346 caseE (varE value) (matches tvMap)
@@ -672,13 +672,13 @@ consFromJSON :: JSONClass
672672consFromJSON _ _ _ _ [] = error $ "Data.Aeson.TH.consFromJSON: "
673673 ++ "Not a single constructor given!"
674674
675−consFromJSON jc tName opts vars cons = do
675+consFromJSON jc tName opts instTys cons = do
676676 value <- newName "value"
677677 pjs <- newNameList "_pj" $ arityInt jc
678678 pjls <- newNameList "_pjl" $ arityInt jc
679679 let zippedPJs = zip pjs pjls
680680 interleavedPJs = interleave pjs pjls
681− lastTyVars = map varTToName $ drop (length vars - arityInt jc) vars
681+ lastTyVars = map varTToName $ drop (length instTys - arityInt jc) instTys
682682 tvMap = M.fromList $ zip lastTyVars zippedPJs
683683 lamE (map varP $ interleavedPJs ++ [value]) $ lamExpr value tvMap
684684
@@ -1209,23 +1209,27 @@ deriveJSONClass :: [(JSONFun, JSONClass -> Name -> Options -> [Type]
12091209deriveJSONClass consFuns jc opts name = do
12101210 info <- reifyDatatype name
12111211 case info of
1212− DatatypeInfo { datatypeContext = ctxt
1213− , datatypeName = parentName
1214− , datatypeVars = vars
1215− , datatypeVariant = variant
1216− , datatypeCons = cons
1212+ DatatypeInfo { datatypeContext = ctxt
1213+ , datatypeName = parentName
1214+#if MIN_VERSION_th_abstraction(0,3,0)
1215+ , datatypeInstTypes = instTys
1216+#else
1217+ , datatypeVars = instTys
1218+#endif
1219+ , datatypeVariant = variant
1220+ , datatypeCons = cons
12171221 } -> do
12181222 (instanceCxt, instanceType)
1219− <- buildTypeInstance parentName jc ctxt vars variant
1223+ <- buildTypeInstance parentName jc ctxt instTys variant
12201224 (:[]) <$> instanceD (return instanceCxt)
12211225 (return instanceType)
1222− (methodDecs parentName vars cons)
1226+ (methodDecs parentName instTys cons)
12231227 where
12241228 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) ->
12261230 funD (jsonFunValName jf (arity jc))
12271231 [ clause []
1228− (normalB $ jfMaker jc parentName opts vars cons)
1232+ (normalB $ jfMaker jc parentName opts instTys cons)
12291233 []
12301234 ]
12311235
@@ -1241,17 +1245,21 @@ mkFunCommon :: (JSONClass -> Name -> Options -> [Type] -> [ConstructorInfo] -> Q
12411245mkFunCommon consFun jc opts name = do
12421246 info <- reifyDatatype name
12431247 case info of
1244− DatatypeInfo { datatypeContext = ctxt
1245− , datatypeName = parentName
1246− , datatypeVars = vars
1247− , datatypeVariant = variant
1248− , datatypeCons = cons
1248+ DatatypeInfo { datatypeContext = ctxt
1249+ , datatypeName = parentName
1250+#if MIN_VERSION_th_abstraction(0,3,0)
1251+ , datatypeInstTypes = instTys
1252+#else
1253+ , datatypeVars = instTys
1254+#endif
1255+ , datatypeVariant = variant
1256+ , datatypeCons = cons
12491257 } -> do
12501258 -- We force buildTypeInstance here since it performs some checks for whether
12511259 -- or not the provided datatype's kind matches the derived method's
12521260 -- typeclass, and produces errors if it can't.
1253− !_ <- buildTypeInstance parentName jc ctxt vars variant
1254− consFun jc parentName opts vars cons
1261+ !_ <- buildTypeInstance parentName jc ctxt instTys variant
1262+ consFun jc parentName opts instTys cons
12551263
12561264dispatchFunByType :: JSONClass
12571265 -> JSONFun
aeson.cabal+1−1
@@ -152,7 +152,7 @@ library
152152 dlist >= 0.8.0.4 && < 0.9,
153153 hashable >= 1.2.7.0 && < 1.3,
154154 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,
156156 time-locale-compat >= 0.1.1.5 && < 0.2,
157157 uuid-types >= 1.0.3 && < 1.1,
158158 vector >= 0.12.0.1 && < 0.13
benchmarks/aeson-benchmarks.cabal+1−1
@@ -45,7 +45,7 @@ library
4545 tagged >=0.8.3 && <0.9,
4646 template-haskell >= 2.4,
4747 text >= 1.2.3,
48− th-abstraction >= 0.2.2 && < 0.3,
48+ th-abstraction >= 0.2.2 && < 0.4,
4949 time,
5050 transformers,
5151 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
22
33## Upcoming
44* 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.
56
67### 1.4.2.0
78