Commit 92ad1f44 authored by Iustin Pop's avatar Iustin Pop

Make THH:genSaveOpCode a bit more general

This can be improved, by taking all hardcoded names as parameters, to
serve as a more-general "build save clause for a multi-constructor
data type". I'm not renaming the function as well, since I don't know
exactly how much we can abstract later.
Signed-off-by: default avatarIustin Pop <>
Reviewed-by: default avatarHelga Velroyen <>
parent a12f0ef8
......@@ -513,15 +513,17 @@ genOpCode :: String -- ^ Type name to use
-> [(String, [Field])] -- ^ Constructor name and parameters
-> Q [Dec]
genOpCode name cons = do
let tname = mkName name
decl_d <- mapM (\(cname, fields) -> do
-- we only need the type of the field, without Q
fields' <- mapM actualFieldType fields
let fields'' = zip (repeat NotStrict) fields'
return $ NormalC (mkName cname) fields'')
let declD = DataD [] (mkName name) [] decl_d [''Show, ''Read, ''Eq]
let declD = DataD [] tname [] decl_d [''Show, ''Read, ''Eq]
(savesig, savefn) <- genSaveOpCode cons
(savesig, savefn) <- genSaveOpCode tname "saveOpCode" cons
(uncurry saveConstructor)
(loadsig, loadfn) <- genLoadOpCode cons
return [declD, loadsig, loadfn, savesig, savefn]
......@@ -551,11 +553,15 @@ saveConstructor sname fields = do
-- This builds a per-constructor match clause that contains the
-- respective constructor-serialisation code.
genSaveOpCode :: [(String, [Field])] -> Q (Dec, Dec)
genSaveOpCode opdefs = do
cclauses <- mapM (uncurry saveConstructor) opdefs
let fname = mkName "saveOpCode"
sigt <- [t| $(conT (mkName "OpCode")) -> JSON.JSValue |]
genSaveOpCode :: Name -- ^ Object ype
-> String -- ^ Function name
-> [(String, [Field])] -- ^ Object definition
-> ((String, [Field]) -> Q Clause) -- ^ Constructor save fn
-> Q (Dec, Dec)
genSaveOpCode tname sname opdefs fn = do
cclauses <- mapM fn opdefs
let fname = mkName sname
sigt = AppT (AppT ArrowT (ConT tname)) (ConT ''JSON.JSValue)
return $ (SigD fname sigt, FunD fname cclauses)
-- | Generates load code for a single constructor of the opcode data type.
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