Commit 08f7d24d authored by Iustin Pop's avatar Iustin Pop

Improve TemplateHaskell code to support empty objects

Currently, an empty objects will generate warnings as the arguments of
various functions are unused. By adding conditional code for this, we
can support generation of empty objects, e.g. like needed in Rpc code.

Additionally, the patch also converts RpcCallVersion to THH, now that
it can build it. We change the serialisation for this (from JSNull to
JSObject []), but this shouldn't matter as this is not used in
production.
Signed-off-by: default avatarIustin Pop <iustin@google.com>
Reviewed-by: default avatarGuido Trotter <ultrotter@google.com>
parent 466b7a39
......@@ -379,17 +379,10 @@ instance Rpc RpcCallNodeInfo RpcResultNodeInfo where
-- ** Version
-- | Version
-- Query node version.
-- Note: We can't use THH as it does not know what to do with empty dict
data RpcCallVersion = RpcCallVersion {}
deriving (Show, Eq)
instance J.JSON RpcCallVersion where
showJSON _ = J.JSNull
readJSON J.JSNull = return RpcCallVersion
readJSON _ = fail "Unable to read RpcCallVersion"
-- | Query node version.
$(buildObject "RpcCallVersion" "rpcCallVersion" [])
-- | Query node reply.
$(buildObject "RpcResultVersion" "rpcResultVersion"
[ simpleField "version" [t| Int |]
])
......
......@@ -791,7 +791,7 @@ genLoadObject :: (Field -> Q (Name, Stmt))
genLoadObject load_fn sname fields = do
let name = mkName sname
funname = mkName $ "load" ++ sname
arg1 = mkName "v"
arg1 = mkName $ if null fields then "_" else "v"
objname = mkName "o"
opid = mkName "op_id"
st1 <- bindS (varP objname) [| liftM JSON.fromJSObject
......@@ -799,7 +799,12 @@ genLoadObject load_fn sname fields = do
fbinds <- mapM load_fn fields
let (fnames, fstmts) = unzip fbinds
let cval = foldl (\accu fn -> AppE accu (VarE fn)) (ConE name) fnames
fstmts' = st1:fstmts ++ [NoBindS (AppE (VarE 'return) cval)]
retstmt = [NoBindS (AppE (VarE 'return) cval)]
-- FIXME: should we require an empty dict for an empty type?
-- this allows any JSValue right now
fstmts' = if null fields
then retstmt
else st1:fstmts ++ retstmt
sigt <- [t| JSON.JSValue -> JSON.Result $(conT name) |]
return $ (SigD funname sigt,
FunD funname [Clause [VarP arg1] (NormalB (DoE fstmts')) []])
......
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