let main () =
  let wsdl = wsdl_load filename in
  let schema = wsdl_schema wsdl in

  (* Generate code for types. *)
  let output = dirname // basename ^ "_types.ml" in
  let chan = open_out output in

  fprintf chan
    ("(* Types for module %s.\n" ^^
     "   WARNING: This file is automatically generated by wsdltointf. *)\n" ^^
     "open OCSoap\n\n")
    modname;

  (* tbuf is a Buffer accumulating the type definitions.
   * fbuf is a Buffer accumulating the function definitions.
   *)
  let tbuf = Buffer.create 1024 in
  let fbuf = Buffer.create 1024 in

  let types =
    match schema with
      | None -> []                        (* No schema, no types. *)
      | Some schema -> wsdl_types schema in
  let types = List.map (fun (name, is_abstract, t) ->
                          to_string name, is_abstract, t) types in

  (* Remove extension types, but at the same time produce a map of
   * type name -> child names.
   *)
  let types, childmap = make_extensions types in

  (* Make the basic functions and types. *)
  make_types tbuf fbuf childmap types;

  (* Make the virtual types - for those types which have children. *)
  make_virtual_types tbuf fbuf childmap types;

  (* Write out the types first, followed by the functions. *)
  fprintf chan "type __dummy = unit\n";        (* type ... and ... and ... *)
  Buffer.output_buffer chan tbuf;
  fprintf chan "let rec __dummy = ()\n"; (* let ... and ... and ... *)
  Buffer.output_buffer chan fbuf;

  fprintf chan "(* End of file. *)\n";
  close_out chan;

  (* Generate the list of functions defined in this interface. *)
  let port_types = wsdl_port_types wsdl in
  (* XXX In future deal with multiple <portType> fields, perhaps by
   * mapping them to submodules.  At the moment only handle the case
   * where we have one <portType> in the WSDL.
   *)
  let interface_name, port_type = match port_types with
    | [h] -> h
    | [] -> failwith "no <portType> section in this WSDL document"
    | _ -> failwith "multiple <portType> sections not implemented" in

  let find_element_type element_name =
    try
      let _, _, t =
        List.find (function
                     | (name, _, Element _) when name = element_name -> true
                     | _ -> false
                  ) types in
      t
    with Not_found -> failwith ("element not found: " ^ element_name)
  in

  (* We want to know the input and output parameters for each function. *)
  let functions = List.map (
    fun (name, input, output, _) ->
      (* What we're going to call this function in the OCaml interface. *)
      let wsdl_orig_name = to_string name in
      let name = escape_functionname wsdl_orig_name in

      (* The parameters. *)
      let params, params_unpacked =
        match input with
          | None | Some [] -> [], None
          | Some [PartElement part] ->
             (* Single part which is an element.  We expect the element
              * is actually a Sequence, which we unpack.
              *)
             let part = to_string part in
             let element_type = find_element_type part in
             (match element_type with
                | Element (Sequence fields) ->
                    List.map (
                      fun (_, eltype, nillable, min_occurs, max_occurs) ->
                        let eltype = to_string eltype in
                        let octype, is_option, is_list =
                          map_xsdtype_to_ocaml eltype
                            nillable min_occurs max_occurs in
                        let full_octype = sprintf "%s%s"
                          octype (if is_option then " option"
                                  else if is_list then " list"
                                  else "") in
                        (octype, is_option, is_list, full_octype)
                    ) fields
                | Element (Unit) ->
                    []
                | _ ->
                    assert false (* XXX not implemented *)
             ), Some (part, element_type)
          | Some parts ->
              let parts = List.map (function PartElement name -> name
                                      | PartType name -> name) parts in
              let parts = List.map to_string parts in
              let parts = List.map escape_typename parts in
              List.map (fun name -> name, false, false, name) parts, None in

      (* The result.  There may be multiple results - in OCaml these will
       * be represented as a tuple.
       *)
      let results, results_unpacked =
        match output with
          | None | Some [] -> [], None
          | Some [PartElement part] ->
             (* Single part which is an element.  We expect the element
              * is actually a Sequence, which we unpack.
              *)
             let part = to_string part in
             let element_type = find_element_type part in
             (match element_type with
                | Element (Sequence fields) ->
                    List.map (
                      fun (_, eltype, nillable, min_occurs, max_occurs) ->
                        let eltype = to_string eltype in
                        let octype, is_option, is_list =
                          map_xsdtype_to_ocaml eltype
                            nillable min_occurs max_occurs in
                        let full_octype = sprintf "%s%s"
                          octype (if is_option then " option"
                                  else if is_list then " list"
                                  else "") in
                        (octype, is_option, is_list, full_octype)
                    ) fields;
                | Element (Unit) ->
                    []
                | _ ->
                    assert false (* XXX not implemented *)
             ), Some (part, element_type)
          | Some parts ->
              let parts = List.map (function PartElement name -> name
                                      | PartType name -> name) parts in
              let parts = List.map to_string parts in
              let parts = List.map escape_typename parts in
              List.map (fun name -> name, false, false, name) parts, None in

      (name, wsdl_orig_name,
       params, params_unpacked, results, results_unpacked)
  ) port_type in

  (* Generate the interface. *)
  let output = dirname // basename ^ ".intf" in
  let chan = open_out output in

  fprintf chan
    ("(* Interface %s. -*- tuareg -*- \n" ^^
     "   WARNING: This file is automatically generated by wsdltointf. *)\n" ^^
     "open %s_conv\n" ^^
     "open %s_types\n\n")
    modname modname modname;

  List.iter (
    fun (name, _, params, _, results, _) ->
      fprintf chan "val %s : 'a OCSoap.service -> " name;
      (match params with
         | [] -> ()
         | _ ->
             List.iter (
               fun (_, _, _, full) -> fprintf chan "%s -> " full
             ) params
      );
      (match results with
         | [] -> fprintf chan "unit"
         | [_, _, _, full] -> output_string chan full
         | results ->
             fprintf chan "(";
             output_string chan
               (String.concat " * "
                  (List.map (fun (_, _, _, full) -> full) results));
             fprintf chan ")"
      );

      output_string chan "\n"
  ) functions;

  fprintf chan "(* End of file. *)\n";
  close_out chan;

  (* Generate the conversion functions. *)
  let output = dirname // basename ^ "_conv.ml" in
  let chan = open_out output in

  fprintf chan
    ("(* Conversion functions for module %s. -*- tuareg -*- \n" ^^
     "   WARNING: This file is automatically generated by wsdltointf. *)\n" ^^
     "open OCSoap\n" ^^
     "open %s_types\n\n")
    modname modname;

  List.iter (
    fun (name, wsdl_orig_name,
         params, params_unpacked, results, results_unpacked) ->
      (* Input conversion. *)
      let get_param_name =
        let i = ref 0 in fun () -> incr i; sprintf "p%d" !i
      in
      let param_names = List.map (fun _ -> get_param_name ()) params in
      fprintf chan "let %s__in (svc : %s service) (%s) =\n" name service_type
        (String.concat ", " param_names);
      fprintf chan "  let ctx = new_context svc in\n";
      fprintf chan "  let parts =\n";

      (match params_unpacked with
         | None -> (* Direct mapping of parameters to parts. *)
             fprintf chan "    [\n";
             List.iter (
               fun (param, (octype, _, _, _)) ->
                 fprintf chan "    node_of_%s ctx \"fn:%s\" %s;\n"
                   octype wsdl_orig_name param
             ) (List.combine param_names params);
             fprintf chan "    ] in\n";

         | Some (part, element_type) -> (* Parameters must be packed. *)
             match element_type with
               | Element (Sequence fields) ->
                   fprintf chan "    let r = { ";
                   List.iter (
                     fun (param, (elname, _, _, _, _)) ->
                       let elname = to_string elname in
                       fprintf chan "%s_%s = %s; "
                         (escape_typename part) (escape_fieldname elname) param
                   ) (List.combine param_names fields);
                   fprintf chan "} in\n";
                   fprintf chan "    [node_of_%s ctx \"fn:%s\" r] in\n"
                     (escape_typename part) part
               | Element (Unit) ->
                   fprintf chan "    [node_of_%s ctx \"fn:%s\" ()] in\n"
                     (escape_typename part) part;
               | _ ->
                   assert false (* XXX not implemented *)
      );

      output_string chan (
        "  let body = element ctx \"soap:Body\" parts in\n" ^
        "  let headers = service_headers svc ctx in\n" ^
        "  let header = element ctx \"soap:Header\" headers in\n" ^
        "  let envelope = element ctx \"soap:Envelope\" [header; body] in\n" ^
        "  create_xml ctx envelope\n"
      );

      (* Output conversion. *)
      fprintf chan "let %s__out (svc : %s service) data =\n"
        name service_type;
      output_string chan (
        "  let doc =\n" ^
        "    let config = Pxp_types.default_namespace_config in\n" ^
        "    let config = { config with Pxp_types.encoding = `Enc_utf8 } in\n"^
        "    let spec = Pxp_tree_parser.default_namespace_spec in\n" ^
        "    let src = Pxp_types.from_string data in\n" ^
        "    Pxp_tree_parser.parse_wfdocument_entity config src spec in\n" ^
        "  service_return_doc svc doc;\n" ^
        "  let dtd = doc#dtd in\n" ^
        "  let nm = dtd#namespace_manager in\n" ^
        "  let root = doc#root in\n" ^
        "  let soap_np = nm#get_normprefix soap_namespace in\n" ^
        "  let body =\n" ^
        "    try Pxp_document.find_element (soap_np ^ \":Body\") root\n" ^
        "    with Not_found ->\n" ^
        "      failwith \"no <soap:Body> in response from server\" in\n" ^
        "  let np = nm#get_normprefix (service_namespace svc) in\n"^
        "  let parts = body#sub_nodes in\n" ^
        "  let parts = List.filter (fun part ->\n" ^
        "                match part#node_type with\n" ^
        "                | Pxp_document.T_element _ -> true\n" ^
        "                | _ -> false\n" ^
        "              ) parts in\n" ^
        "  match parts with\n"
      );

      (match results_unpacked with
         | None -> (* Direct mapping of parts to results. *)
             let get_result_name =
               let i = ref 0 in fun () -> incr i; sprintf "r%d" !i
             in
             let result_names =
               List.map (fun _ -> get_result_name ()) results in
             fprintf chan "  | [ %s ] ->\n" (String.concat "; " result_names);
             let next = ref false in
             List.iter (
               fun (result, (octype, _, _, _)) ->
                 if !next then fprintf chan ", " else next := true;
                 fprintf chan "    %s_of_node np %s" octype result
             ) (List.combine result_names results);
             fprintf chan "\n";
         | Some (part, element_type) -> (* Result must be unpacked. *)
             match element_type with
               | Element (Sequence fields) ->
                   fprintf chan "  | [ r ] ->\n";
                   fprintf chan "    let r = %s_of_node np r in\n    "
                     (escape_typename part);
                   let next = ref false in
                   List.iter (
                     fun (elname, _, _, _, _) ->
                       let elname = to_string elname in
                       if !next then fprintf chan ", " else next := true;
                       fprintf chan "r.%s_%s"
                         (escape_typename part) (escape_fieldname elname);
                   ) fields;
                   fprintf chan "\n";
               | Element (Unit) ->
                   fprintf chan "  | [ r ] -> ()\n"
               | _ ->
                   assert false (* XXX not implemented *)
      );
      fprintf chan "  | _ -> failwith \"%s: wrong number of parts in response\"\n"
        name
  ) functions;

  fprintf chan "(* End of file. *)\n";
  close_out chan