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: Iustin Pop <[email protected]> --- src/Ganeti/Rpc.hs | 13 +++---------- src/Ganeti/THH.hs | 9 +++++++-- 2 files changed, 10 insertions(+), 12 deletions(-) diff --git a/src/Ganeti/Rpc.hs b/src/Ganeti/Rpc.hs index 38df585..3f86e3d 100644 --- a/src/Ganeti/Rpc.hs +++ b/src/Ganeti/Rpc.hs @@ -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 |] ]) diff --git a/src/Ganeti/THH.hs b/src/Ganeti/THH.hs index 2fb5084..4f8daed 100644 --- a/src/Ganeti/THH.hs +++ b/src/Ganeti/THH.hs @@ -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')) []]) -- 1.8.1.3
