[Libguestfs] [PATCH 3/3] daemon: autogenerate most of OCaml interfaces

[Richard W.M. Jones]

On Mon, Apr 09, 2018 at 04:06:32PM +0200, Pino Toscano wrote:
> diff --git a/generator/daemon.ml b/generator/daemon.ml
> index 7fb7052a0..03b191ac8 100644
> --- a/generator/daemon.ml
> +++ b/generator/daemon.ml
> @@ -490,6 +490,91 @@ let generate_daemon_caml_callbacks_ml () =
>    else
>      pr "let init_callbacks () = ()\n"
>  
> +let rec generate_daemon_caml_interface modname () =
> +  generate_header OCamlStyle GPLv2plus;
> +
> +  let is_ocaml_module_function = function
> +    | { impl = OCaml m } when String.is_prefix m (modname ^ ".") -> true
> +    | { impl = OCaml _ } -> false
> +    | { impl = C } -> false
> +  in
> +
> +  let ocaml_actions = actions |> (List.filter is_ocaml_module_function) in
> +  if ocaml_actions == [] then
> +    failwithf "no OCaml implementations for module %s" modname;
> +
> +  let prefix_length = String.length modname + 1 in
> +  List.iter (
> +    fun ({ name; style } as f) ->
> +      let ocaml_function =
> +        match f.impl with
> +        | OCaml f -> String.sub f prefix_length (String.length f - prefix_length)
> +        | C -> assert false in
> +
> +      generate_ocaml_daemon_prototype ocaml_function style
> +  ) ocaml_actions
> +
> +and generate_ocaml_daemon_prototype name style =
> +  pr "val %s : " name;
> +  generate_ocaml_daemon_function_type style;
> +  pr "\n"
> +
> +and generate_ocaml_daemon_function_type (ret, args, optargs) =
> +  let type_for_stringt = function
> +    | Mountable
> +    | Mountable_or_Path -> "Mountable.t"
> +    | PlainString
> +    | Device
> +    | Pathname
> +    | FileIn
> +    | FileOut
> +    | Key
> +    | GUID
> +    | Filename
> +    | Dev_or_Path -> "string"
> +  in
> +  let type_for_rstringt = function
> +    | RMountable -> "Mountable.t"
> +    | RPlainString
> +    | RDevice -> "string"
> +  in
> +  List.iter (
> +    function
> +    | OBool n -> pr "?%s:bool -> " n
> +    | OInt n -> pr "?%s:int -> " n
> +    | OInt64 n -> pr "?%s:int64 -> " n
> +    | OString n -> pr "?%s:string -> " n
> +    | OStringList n -> pr "?%s:string array -> " n
> +  ) optargs;
> +  if args <> [] then
> +    List.iter (
> +      function
> +      | String (typ, _)-> pr "%s -> " (type_for_stringt typ)
> +      | BufferIn _ -> pr "string -> "
> +      | OptString _ -> pr "string option -> "
> +      | StringList (typ, _)-> pr "%s array -> " (type_for_stringt typ)
> +      | Bool _ -> pr "bool -> "
> +      | Int _ -> pr "int -> "
> +      | Int64 _ | Pointer _ -> pr "int64 -> "
> +    ) args
> +  else
> +    pr "unit -> ";
> +  (match ret with
> +   | RErr -> pr "unit" (* all errors are turned into exceptions *)
> +   | RInt _ -> pr "int"
> +   | RInt64 _ -> pr "int64"
> +   | RBool _ -> pr "bool"
> +   | RConstString _ -> pr "string"
> +   | RConstOptString _ -> pr "string option"
> +   | RString (typ, _) -> pr "%s" (type_for_rstringt typ)
> +   | RBufferOut _ -> pr "string"
> +   | RStringList (typ, _) -> pr "%s list" (type_for_rstringt typ)
> +   | RStruct (_, typ) -> pr "Structs.%s" typ
> +   | RStructList (_, typ) -> pr "Structs.%s list" typ
> +   | RHashtable (typea, typeb, _) ->
> +       pr "(%s * %s) list" (type_for_rstringt typea) (type_for_rstringt typeb)
> +  )
> +
>  (* Generate stubs for the functions implemented in OCaml.
>   * Basically we implement the do_<name> function here, and
>   * have it call out to OCaml code.

> diff --git a/generator/main.ml b/generator/main.ml
> index 34bca68d9..ed75d1005 100644
> --- a/generator/main.ml
> +++ b/generator/main.ml
> @@ -46,6 +46,11 @@ let output_to_subset fs f =
>    for i = 0 to nr_actions_files-1 do
>      ksprintf (fun filename -> output_to filename (f actions_subsets.(i))) fs i
>    done
> +let output_to_ocaml_daemon modname =
> +  let fn = Char.escaped (Char.lowercase_ascii (String.unsafe_get modname 0)) ^
> +           String.sub modname 1 (String.length modname - 1) in
> +  output_to (sprintf "daemon/%s.mli" fn)
> +            (Daemon.generate_daemon_caml_interface modname)
>  
>  (* Main program. *)
>  let () =
> @@ -155,6 +160,11 @@ Run it from the top source directory using the command
>              Daemon.generate_daemon_structs_cleanups_c;
>    output_to "daemon/structs-cleanups.h"
>              Daemon.generate_daemon_structs_cleanups_h;
> +  let daemon_ocaml_interfaces = [
> +    "Blkid"; "Btrfs"; "Devsparts"; "File"; "Filearch"; "Findfs"; "Inspect";
> +    "Is"; "Ldm"; "Link"; "Listfs"; "Md"; "Parted"; "Realpath"; "Statvfs";
> +  ] in

This list should be generated from the list of APIs, splitting the
OCaml "module.function" fields to get module name.

Also "Mount" is not included in this list (and possibly others, I
didn't check).  Mount has a non-generated interface (umount_all) which
I guess is the reason, but unfortunately this reduces the value of
generating these interfaces.

> +  List.iter output_to_ocaml_daemon daemon_ocaml_interfaces;

Is there a reason this isn't inlined?  It seems a bit awkward
to have the actual body elsewhere in the file.

Rich.

>    output_to "fish/cmds-gperf.gperf"
>              Fish.generate_fish_cmds_gperf;
> -- 
> 2.14.3
> 
> _______________________________________________
> Libguestfs mailing list
> Libguestfs at redhat.com
> https://www.redhat.com/mailman/listinfo/libguestfs

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-p2v converts physical machines to virtual machines.  Boot with a
live CD or over the network (PXE) and turn machines into KVM guests.
http://libguestfs.org/virt-v2v