Revision ffbd9592 htools/Ganeti/THH.hs
| b/htools/Ganeti/THH.hs | ||
|---|---|---|
| 328 | 328 |
-- @ |
| 329 | 329 |
-- |
| 330 | 330 |
-- in an instance JSON /name/ declaration |
| 331 |
genShowJSON :: String -> Q [Dec] |
|
| 332 |
genShowJSON name = [d| showJSON = JSON.showJSON . $(varE (toRawName name)) |] |
|
| 331 |
genShowJSON :: String -> Q Dec |
|
| 332 |
genShowJSON name = do |
|
| 333 |
body <- [| JSON.showJSON . $(varE (toRawName name)) |] |
|
| 334 |
return $ FunD (mkName "showJSON") [Clause [] (NormalB body) []] |
|
| 333 | 335 |
|
| 334 | 336 |
-- | Creates the readJSON member of a JSON instance declaration. |
| 335 | 337 |
-- |
| ... | ... | |
| 363 | 365 |
let base = nameBase name |
| 364 | 366 |
showJ <- genShowJSON base |
| 365 | 367 |
readJ <- genReadJSON base |
| 366 |
return [InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) (readJ:showJ)]
|
|
| 368 |
return [InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) [readJ,showJ]]
|
|
| 367 | 369 |
|
| 368 | 370 |
-- * Template code for opcodes |
| 369 | 371 |
|
| ... | ... | |
| 595 | 597 |
shjson <- objectShowJSON sname |
| 596 | 598 |
rdjson <- objectReadJSON sname |
| 597 | 599 |
let instdecl = InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) |
| 598 |
(rdjson:shjson)
|
|
| 600 |
[rdjson, shjson]
|
|
| 599 | 601 |
return $ savedecls ++ [loadsig, loadfn, instdecl] |
| 600 | 602 |
|
| 601 | 603 |
genSaveObject :: (Name -> Field -> Q Exp) |
| ... | ... | |
| 634 | 636 |
nameE = stringE (fieldName field) |
| 635 | 637 |
fvarE = varE fvar |
| 636 | 638 |
|
| 637 |
objectShowJSON :: String -> Q [Dec] |
|
| 638 |
objectShowJSON name = |
|
| 639 |
[d| showJSON = JSON.showJSON . $(varE . mkName $ "save" ++ name) |] |
|
| 639 |
objectShowJSON :: String -> Q Dec |
|
| 640 |
objectShowJSON name = do |
|
| 641 |
body <- [| JSON.showJSON . $(varE . mkName $ "save" ++ name) |] |
|
| 642 |
return $ FunD (mkName "showJSON") [Clause [] (NormalB body) []] |
|
| 640 | 643 |
|
| 641 | 644 |
genLoadObject :: (Field -> Q (Name, Stmt)) |
| 642 | 645 |
-> String -> [Field] -> Q (Dec, Dec) |
| ... | ... | |
| 732 | 735 |
shjson <- objectShowJSON sname |
| 733 | 736 |
rdjson <- objectReadJSON sname |
| 734 | 737 |
let instdecl = InstanceD [] (AppT (ConT ''JSON.JSON) (ConT name)) |
| 735 |
(rdjson:shjson)
|
|
| 738 |
[rdjson, shjson]
|
|
| 736 | 739 |
return $ savedecls ++ [loadsig, loadfn, instdecl] |
| 737 | 740 |
|
| 738 | 741 |
savePParamField :: Name -> Field -> Q Exp |
Also available in: Unified diff