Revision 08f7d24d src/Ganeti/THH.hs

b/src/Ganeti/THH.hs
791 791 
genLoadObject load_fn sname fields = do
792 792 
  let name = mkName sname
793 793 
      funname = mkName $ "load" ++ sname
794 
      arg1 = mkName "v"
794 
      arg1 = mkName $ if null fields then "_" else "v"
795 795 
      objname = mkName "o"
796 796 
      opid = mkName "op_id"
797 797 
  st1 <- bindS (varP objname) [| liftM JSON.fromJSObject
......
799 799 
  fbinds <- mapM load_fn fields
800 800 
  let (fnames, fstmts) = unzip fbinds
801 801 
  let cval = foldl (\accu fn -> AppE accu (VarE fn)) (ConE name) fnames
802 
      fstmts' = st1:fstmts ++ [NoBindS (AppE (VarE 'return) cval)]
802 
      retstmt = [NoBindS (AppE (VarE 'return) cval)]
803 
      -- FIXME: should we require an empty dict for an empty type?
804 
      -- this allows any JSValue right now
805 
      fstmts' = if null fields
806 
                  then retstmt
807 
                  else st1:fstmts ++ retstmt
803 808 
  sigt <- [t| JSON.JSValue -> JSON.Result $(conT name) |]
804 809 
  return $ (SigD funname sigt,
805 810 
            FunD funname [Clause [VarP arg1] (NormalB (DoE fstmts')) []])

Also available in: Unified diff