Commit ffbd9592 authored by Iustin Pop's avatar Iustin Pop

Fix compatibility with TemplateHaskell from GHC 7.4

GHC 7.4 has updated the TemplateHaskell library, and it turns out that
the way we built the JSON instance implementation for showJSON was not
good (probably this is why GHC 6.12 was generating some warnings).

The patch changes the build of showJSON to be the same as readJSON,
which was working fine. As a bonus, this fixes both the 7.4 issue and
the 6.12 one.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarRené Nussbaumer <rn@google.com>
parent 30f2802f
......@@ -328,8 +328,10 @@ declareSADT = declareADT ''String
-- @
--
-- in an instance JSON /name/ declaration
genShowJSON :: String -> Q [Dec]
genShowJSON name = [d| showJSON = JSON.showJSON . $(varE (toRawName name)) |]
genShowJSON :: String -> Q Dec
genShowJSON name = do
body <- [| JSON.showJSON . $(varE (toRawName name)) |]
return $ FunD (mkName "showJSON") [Clause [] (NormalB body) []]
-- | Creates the readJSON member of a JSON instance declaration.
--
......@@ -363,7 +365,7 @@ makeJSONInstance name = do
let base = nameBase name
showJ <- genShowJSON base
readJ <- genReadJSON base
return [InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) (readJ:showJ)]
return [InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) [readJ,showJ]]
-- * Template code for opcodes
......@@ -595,7 +597,7 @@ buildObjectSerialisation sname fields = do
shjson <- objectShowJSON sname
rdjson <- objectReadJSON sname
let instdecl = InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name))
(rdjson:shjson)
[rdjson, shjson]
return $ savedecls ++ [loadsig, loadfn, instdecl]
genSaveObject :: (Name -> Field -> Q Exp)
......@@ -634,9 +636,10 @@ saveObjectField fvar field
nameE = stringE (fieldName field)
fvarE = varE fvar
objectShowJSON :: String -> Q [Dec]
objectShowJSON name =
[d| showJSON = JSON.showJSON . $(varE . mkName $ "save" ++ name) |]
objectShowJSON :: String -> Q Dec
objectShowJSON name = do
body <- [| JSON.showJSON . $(varE . mkName $ "save" ++ name) |]
return $ FunD (mkName "showJSON") [Clause [] (NormalB body) []]
genLoadObject :: (Field -> Q (Name, Stmt))
-> String -> [Field] -> Q (Dec, Dec)
......@@ -732,7 +735,7 @@ buildPParamSerialisation sname fields = do
shjson <- objectShowJSON sname
rdjson <- objectReadJSON sname
let instdecl = InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name))
(rdjson:shjson)
[rdjson, shjson]
return $ savedecls ++ [loadsig, loadfn, instdecl]
savePParamField :: Name -> Field -> Q Exp
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment