LGTM Thanks,
Guido On Fri, Feb 22, 2013 at 5:46 AM, Iustin Pop <[email protected]> wrote: > 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 > -- Guido Trotter Ganeti engineering Google Germany
