(* wrappi
 * Copyright (C) 2011 Red Hat Inc.
 *
 * This program is free software; you can redistribute it and/or modify
 * it under the terms of the GNU General Public License as published by
 * the Free Software Foundation; either version 2 of the License, or
 * (at your option) any later version.
 *
 * This program is distributed in the hope that it will be useful,
 * but WITHOUT ANY WARRANTY; without even the implied warranty of
 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
 * GNU General Public License for more details.
 *
 * You should have received a copy of the GNU General Public License
 * along with this program; if not, write to the Free Software
 * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
 *)

open Camlp4.PreCast

open Wrappi_utils
open Wrappi_types
open Wrappi_boilerplate
open Wrappi_pr

open Printf

let inputs = ["wrappi_c_xdr.ml"]

(* Traditionally 'rpcgen' is used to generate this code.  However the
 * glibc maintainers have shown no interest (in fact, malign influence)
 * in doing a proper job maintaining this, resulting in bitrot and poor
 * code being generated.  In any case the code that rpcgen makes is
 * relatively simple.
 *)

let pr_xdr_of_ptype n = function
  | TBool ->
    pr "  if (!xdr_bool (xdrs, &%s)) return FALSE;\n" n
  | TBuffer -> assert false (* XXX not implemented *)
  | TEnum _ ->
    pr "  if (!xdr_int (xdrs, &%s)) return FALSE;\n" n
  | TFile -> assert false (* XXX not implemented *)
  | THash t -> assert false (* XXX not implemented *)
  | TInt -> (* XXX not int, correct type depends on preconditions *)
    pr "  if (!xdr_int (xdrs, &%s)) return FALSE;\n" n
  | TInt32 ->
    pr "  if (!xdr_int32_t (xdrs, &%s)) return FALSE;\n" n
  | TInt64 ->
    pr "  if (!xdr_int64_t (xdrs, &%s)) return FALSE;\n" n
  | TList t -> assert false (* XXX not implemented *)
  | TNullable TString ->
    pr "  if (!xdr_pointer (xdrs, &%s, sizeof (unlimited_string), (xdrproc_t) xdr_unlimited_string)) return FALSE;\n" n
  | TNullable _ -> assert false (* XXX may be implemented in future *)
  | TString ->
    pr "  if (!xdr_unlimited_string (xdrs, (void *) &%s)) return FALSE;\n" n
  | TStruct sname ->
    pr "  if (!xdr_struct_%s (xdrs, %s)) return FALSE;\n" sname n
  | TTypedef name -> assert false (* should never happen *)
  | TUInt32 ->
    pr "  if (!xdr_uint32_t (xdrs, &%s)) return FALSE;\n" n
  | TUInt64 ->
    pr "  if (!xdr_uint64_t (xdrs, &%s)) return FALSE;\n" n
  | TUnion uname ->
    pr "  if (!xdr_union_%s (xdrs, %s)) return FALSE;\n" uname n

let generate_lib_xdr_c api =
  generate_header inputs CStyle LGPLv2plus;

  pr "\
#include <config.h>

#include <stdlib.h>
#include <rpc/xdr.h>

#include \"wrappi.h\"
#include \"internal.h\"

/* An unlimited length string. */
typedef char *unlimited_string;

static bool_t
xdr_unlimited_string (XDR *xdrs, unlimited_string *objp)
{
  if (!xdr_string (xdrs, objp, ~0)) return FALSE;
  return TRUE;
}
";

  iter_structs api (
    fun sd ->
      let name = sd.sd_name in

      pr "\n";
      pr "static bool_t\n";
      pr "xdr_struct_%s (XDR *xdrs, struct wrap_%s *objp)\n" name name;
      pr "{\n";

      Array.iter (
        fun (n, t) ->
          pr_xdr_of_ptype (sprintf "objp->%s" n) t
      ) sd.sd_fields;

      pr "  return TRUE;\n";
      pr "}\n";
  );

  iter_entry_points api (
    fun ep ->
      let name = ep.ep_name in
      let ret, req, opt = ep.ep_ftype in

      pr "\n";
      pr "bool_t\n";
      pr "wrap_int_xdr_%s_args (XDR *xdrs, struct wrap_%s_args *args)\n"
        name name;
      pr "{\n";

      List.iter (
        fun (n, t, _) ->
          pr_xdr_of_ptype (sprintf "args->%s" n) t
      ) req;

      if opt <> [] then assert false; (* XXX not implemented *)

      pr "  return TRUE;\n";
      pr "}\n";

      pr "\n";
      pr "bool_t\n";
      pr "wrap_int_xdr_%s_ret (XDR *xdrs, struct wrap_%s_ret *ret)\n"
        name name;
      pr "{\n";

      (match ret with
      | RVoid -> ()
      | RStaticString ->
        pr_xdr_of_ptype "ret->r" TString (* XXX is this right? *)
      | Return t ->
        pr_xdr_of_ptype "ret->r" t
      );

      pr "  return TRUE;\n";
      pr "}\n"
  )

let generate api =
  output_to "lib/xdr.c" generate_lib_xdr_c api