Revision 92ad1f44
| b/htools/Ganeti/THH.hs | ||
|---|---|---|
| 513 | 513 |
-> [(String, [Field])] -- ^ Constructor name and parameters |
| 514 | 514 |
-> Q [Dec] |
| 515 | 515 |
genOpCode name cons = do |
| 516 |
let tname = mkName name |
|
| 516 | 517 |
decl_d <- mapM (\(cname, fields) -> do |
| 517 | 518 |
-- we only need the type of the field, without Q |
| 518 | 519 |
fields' <- mapM actualFieldType fields |
| 519 | 520 |
let fields'' = zip (repeat NotStrict) fields' |
| 520 | 521 |
return $ NormalC (mkName cname) fields'') |
| 521 | 522 |
cons |
| 522 |
let declD = DataD [] (mkName name) [] decl_d [''Show, ''Read, ''Eq]
|
|
| 523 |
let declD = DataD [] tname [] decl_d [''Show, ''Read, ''Eq]
|
|
| 523 | 524 |
|
| 524 |
(savesig, savefn) <- genSaveOpCode cons |
|
| 525 |
(savesig, savefn) <- genSaveOpCode tname "saveOpCode" cons |
|
| 526 |
(uncurry saveConstructor) |
|
| 525 | 527 |
(loadsig, loadfn) <- genLoadOpCode cons |
| 526 | 528 |
return [declD, loadsig, loadfn, savesig, savefn] |
| 527 | 529 |
|
| ... | ... | |
| 551 | 553 |
-- |
| 552 | 554 |
-- This builds a per-constructor match clause that contains the |
| 553 | 555 |
-- respective constructor-serialisation code. |
| 554 |
genSaveOpCode :: [(String, [Field])] -> Q (Dec, Dec) |
|
| 555 |
genSaveOpCode opdefs = do |
|
| 556 |
cclauses <- mapM (uncurry saveConstructor) opdefs |
|
| 557 |
let fname = mkName "saveOpCode" |
|
| 558 |
sigt <- [t| $(conT (mkName "OpCode")) -> JSON.JSValue |] |
|
| 556 |
genSaveOpCode :: Name -- ^ Object ype |
|
| 557 |
-> String -- ^ Function name |
|
| 558 |
-> [(String, [Field])] -- ^ Object definition |
|
| 559 |
-> ((String, [Field]) -> Q Clause) -- ^ Constructor save fn |
|
| 560 |
-> Q (Dec, Dec) |
|
| 561 |
genSaveOpCode tname sname opdefs fn = do |
|
| 562 |
cclauses <- mapM fn opdefs |
|
| 563 |
let fname = mkName sname |
|
| 564 |
sigt = AppT (AppT ArrowT (ConT tname)) (ConT ''JSON.JSValue) |
|
| 559 | 565 |
return $ (SigD fname sigt, FunD fname cclauses) |
| 560 | 566 |
|
| 561 | 567 |
-- | Generates load code for a single constructor of the opcode data type. |
Also available in: Unified diff