@@ -334,13 +334,13 @@ consToValue :: ToJSONFun
334consToValue _ _ _ _ [] = error $ "Data.Aeson.TH.consToValue: "
334consToValue _ _ _ _ [] = error $ "Data.Aeson.TH.consToValue: "
335 ++ "Not a single constructor given!"
335 ++ "Not a single constructor given!"
337−consToValue target jc opts vars cons = do
337+consToValue target jc opts instTys cons = do
338 value <- newName "value"
338 value <- newName "value"
339 tjs <- newNameList "_tj" $ arityInt jc
339 tjs <- newNameList "_tj" $ arityInt jc
340 tjls <- newNameList "_tjl" $ arityInt jc
340 tjls <- newNameList "_tjl" $ arityInt jc
341 let zippedTJs = zip tjs tjls
341 let zippedTJs = zip tjs tjls
342 interleavedTJs = interleave 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
344 tvMap = M.fromList $ zip lastTyVars zippedTJs
345 lamE (map varP $ interleavedTJs ++ [value]) $
345 lamE (map varP $ interleavedTJs ++ [value]) $
346 caseE (varE value) (matches tvMap)
346 caseE (varE value) (matches tvMap)
@@ -672,13 +672,13 @@ consFromJSON :: JSONClass
672consFromJSON _ _ _ _ [] = error $ "Data.Aeson.TH.consFromJSON: "
672consFromJSON _ _ _ _ [] = error $ "Data.Aeson.TH.consFromJSON: "
673 ++ "Not a single constructor given!"
673 ++ "Not a single constructor given!"
675−consFromJSON jc tName opts vars cons = do
675+consFromJSON jc tName opts instTys cons = do
676 value <- newName "value"
676 value <- newName "value"
677 pjs <- newNameList "_pj" $ arityInt jc
677 pjs <- newNameList "_pj" $ arityInt jc
678 pjls <- newNameList "_pjl" $ arityInt jc
678 pjls <- newNameList "_pjl" $ arityInt jc
679 let zippedPJs = zip pjs pjls
679 let zippedPJs = zip pjs pjls
680 interleavedPJs = interleave 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
682 tvMap = M.fromList $ zip lastTyVars zippedPJs
683 lamE (map varP $ interleavedPJs ++ [value]) $ lamExpr value tvMap
683 lamE (map varP $ interleavedPJs ++ [value]) $ lamExpr value tvMap
@@ -1209,23 +1209,27 @@ deriveJSONClass :: [(JSONFun, JSONClass -> Name -> Options -> [Type]
1209deriveJSONClass consFuns jc opts name = do
1209deriveJSONClass consFuns jc opts name = do
1210 info <- reifyDatatype name
1210 info <- reifyDatatype name
1211 case info of
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
1214− , datatypeVars = vars
1217+ , datatypeVars = instTys
1215− , datatypeVariant = variant
1219+ , datatypeVariant = variant
1216− , datatypeCons = cons
1220+ , datatypeCons = cons
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)
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)
@@ -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
1246− , datatypeVars = vars
1253+ , datatypeVars = instTys
1247− , datatypeVariant = variant
1255+ , datatypeVariant = variant
1248− , datatypeCons = cons
1256+ , datatypeCons = cons
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
1256dispatchFunByType :: JSONClass
1264dispatchFunByType :: JSONClass
1257 -> JSONFun
1265 -> JSONFun