Re: [Libguestfs] [PATCH 3/3] daemon: autogenerate most of OCaml interfaces
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_ 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.
>
[Libguestfs] [PATCH 3/3] daemon: autogenerate most of OCaml interfaces
Add a way to generate OCaml interfaces for a whilelist of modules in the daemon that implement APIs: this makes sure that for them the interface of each function matches the actual API specified in the generator. Only the modules specified in a list are generated for now, although this coverts almost all the daemon APIs implemented in OCaml. --- .gitignore | 15 ++ daemon/blkid.mli | 19 daemon/btrfs.mli | 20 - daemon/devsparts.mli | 25 daemon/file.mli | 19 daemon/filearch.mli | 19 daemon/findfs.mli| 20 - daemon/inspect.mli | 41 - daemon/is.mli| 21 - daemon/ldm.mli | 20 - daemon/link.mli | 19 daemon/listfs.mli| 19 daemon/md.mli| 20 - daemon/parted.mli| 27 - daemon/realpath.mli | 20 - daemon/statvfs.mli | 19 generator/daemon.ml | 85 generator/daemon.mli | 1 + generator/main.ml| 10 +++ 19 files changed, 111 insertions(+), 328 deletions(-) delete mode 100644 daemon/blkid.mli delete mode 100644 daemon/btrfs.mli delete mode 100644 daemon/devsparts.mli delete mode 100644 daemon/file.mli delete mode 100644 daemon/filearch.mli delete mode 100644 daemon/findfs.mli delete mode 100644 daemon/inspect.mli delete mode 100644 daemon/is.mli delete mode 100644 daemon/ldm.mli delete mode 100644 daemon/link.mli delete mode 100644 daemon/listfs.mli delete mode 100644 daemon/md.mli delete mode 100644 daemon/parted.mli delete mode 100644 daemon/realpath.mli delete mode 100644 daemon/statvfs.mli diff --git a/.gitignore b/.gitignore index bb7026537..6927b8bb5 100644 --- a/.gitignore +++ b/.gitignore @@ -185,21 +185,36 @@ Makefile.in /customize/virt-customize.1 /daemon/.depend /daemon/actions.h +/daemon/blkid.mli +/daemon/btrfs.mli /daemon/callbacks.ml /daemon/caml-stubs.c /daemon/daemon_config.ml /daemon/daemon_utils_tests +/daemon/devsparts.mli /daemon/dispatch.c +/daemon/file.mli +/daemon/filearch.mli +/daemon/findfs.mli /daemon/guestfsd /daemon/guestfsd.8 /daemon/guestfsd.exe +/daemon/inspect.mli +/daemon/is.mli +/daemon/ldm.mli +/daemon/link.mli +/daemon/listfs.mli /daemon/lvm-tokenization.c +/daemon/md.mli /daemon/names.c /daemon/optgroups.c /daemon/optgroups.h /daemon/optgroups.ml /daemon/optgroups.mli +/daemon/parted.mli +/daemon/realpath.mli /daemon/stamp-guestfsd.pod +/daemon/statvfs.mli /daemon/structs-cleanups.c /daemon/structs-cleanups.h /daemon/structs.ml diff --git a/daemon/blkid.mli b/daemon/blkid.mli deleted file mode 100644 index 65a61def4..0 --- a/daemon/blkid.mli +++ /dev/null @@ -1,19 +0,0 @@ -(* guestfs-inspection - * Copyright (C) 2009-2018 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. - *) - -val vfs_type : Mountable.t -> string diff --git a/daemon/btrfs.mli b/daemon/btrfs.mli deleted file mode 100644 index ce1c2b66f..0 --- a/daemon/btrfs.mli +++ /dev/null @@ -1,20 +0,0 @@ -(* guestfs-inspection - * Copyright (C) 2009-2018 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. - *) - -val btrfs_subvolume_list : Mountable.t -> Structs.btrfssubvolume list -val btrfs_subvolume_get_default : Mountable.t -> int64 diff --git a/daemon/devsparts.mli b/daemon/devsparts.mli deleted file mode 100644 index 7b669c269..0 --- a/daemon/devsparts.mli +++ /dev/null @@ -1,25 +0,0 @@ -(* guestfs-inspection - * Copyright (C) 2009-2018 Red Hat I
