rpms/guestfs-tools
7
0
Fork 0
Code Issues Pull Requests Releases Activity
0fc67208a3
guestfs-tools/0005-Rework-Std_utils.Option-so-it-works-like-the-OCaml-s.patch
Richard W.M. Jones 0fc67208a3 Rebase to guestfs-tools 1.50.0 
resolves: rhbz#2168626
2023-03-02 13:05:53 +00:00

313 lines
12 KiB
Diff
Raw Blame History

From a84c1359ed0943e5140e9170fa05126b590c2873 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones@redhat.com>
Date: Mon, 20 Feb 2023 12:01:21 +0000
Subject: [PATCH] Rework Std_utils.Option so it works like the OCaml stdlib
module
OCaml 4.08 introduces a stdlib Option module which looks a bit like
ours but has a number of differences. In particular our functions
Option.may and Option.default have no corresponding functions in
stdlib, although there are close enough equivalents.
This change was automated using this command:
$ perl -pi.bak \
-e 's/Option.may/Option.iter/g; s/Option.default /Option.value ~default:/g' \
`git ls-files`
Update common module to include:
commit cffa077323fafcdfcf78e230c022afa891a6b3ff
Author: Richard W.M. Jones <rjones@redhat.com>
Date: Mon Feb 20 12:11:51 2023 +0000
mlstdutils: Rework the Option module to be compatible with stdlib
commit 007d0506c538db0a43fec7e9986a95ecdcd48b56
Author: Richard W.M. Jones <rjones@redhat.com>
Date: Mon Feb 20 12:18:29 2023 +0000
mltools: Replace Option.may with Option.iter
(cherry picked from commit 65bde3b531a2bcb7891a940a692c5a249c2f9340)
---
builder/builder.ml | 6 +++---
builder/index.ml | 18 +++++++++---------
builder/index_parser.ml | 14 +++++++-------
builder/list_entries.ml | 8 ++++----
common | 2 +-
customize/customize_main.ml | 4 ++--
resize/resize.ml | 8 ++++----
sysprep/sysprep_operation.ml | 4 ++--
8 files changed, 32 insertions(+), 32 deletions(-)
diff --git a/builder/builder.ml b/builder/builder.ml
index 727aa8b23..15ece4e60 100644
--- a/builder/builder.ml
+++ b/builder/builder.ml
@@ -723,8 +723,8 @@ let main () =
let g =
let g = open_guestfs () in
- Option.may g#set_memsize cmdline.memsize;
- Option.may g#set_smp cmdline.smp;
+ Option.iter g#set_memsize cmdline.memsize;
+ Option.iter g#set_smp cmdline.smp;
g#set_network cmdline.network;
(* The output disk is being created, so use cache=unsafe here. *)
@@ -818,6 +818,6 @@ let main () =
Pervasives.flush Pervasives.stdout;
Pervasives.flush Pervasives.stderr;
- Option.may print_string stats
+ Option.iter print_string stats
let () = run_main_and_handle_errors main
diff --git a/builder/index.ml b/builder/index.ml
index 03680f051..341a62356 100644
--- a/builder/index.ml
+++ b/builder/index.ml
@@ -58,12 +58,12 @@ let print_entry chan (name, { printable_name; file_uri; arch; osinfo;
notes; aliases; hidden }) =
let fp fs = fprintf chan fs in
fp "[%s]\n" name;
- Option.may (fp "name=%s\n") printable_name;
- Option.may (fp "osinfo=%s\n") osinfo;
+ Option.iter (fp "name=%s\n") printable_name;
+ Option.iter (fp "osinfo=%s\n") osinfo;
fp "file=%s\n" file_uri;
fp "arch=%s\n" (string_of_arch arch);
- Option.may (fp "sig=%s\n") signature_uri;
- Option.may (
+ Option.iter (fp "sig=%s\n") signature_uri;
+ Option.iter (
List.iter (
fun c ->
fp "checksum[%s]=%s\n"
@@ -71,16 +71,16 @@ let print_entry chan (name, { printable_name; file_uri; arch; osinfo;
)
) checksums;
fp "revision=%s\n" (string_of_revision revision);
- Option.may (fp "format=%s\n") format;
+ Option.iter (fp "format=%s\n") format;
fp "size=%Ld\n" size;
- Option.may (fp "compressed_size=%Ld\n") compressed_size;
- Option.may (fp "expand=%s\n") expand;
- Option.may (fp "lvexpand=%s\n") lvexpand;
+ Option.iter (fp "compressed_size=%Ld\n") compressed_size;
+ Option.iter (fp "expand=%s\n") expand;
+ Option.iter (fp "lvexpand=%s\n") lvexpand;
List.iter (
fun (lang, notes) ->
match lang with
| "" -> fp "notes=%s\n" notes
| lang -> fp "notes[%s]=%s\n" lang notes
) notes;
- Option.may (fun l -> fp "aliases=%s\n" (String.concat " " l)) aliases;
+ Option.iter (fun l -> fp "aliases=%s\n" (String.concat " " l)) aliases;
if hidden then fp "hidden=true\n"
diff --git a/builder/index_parser.ml b/builder/index_parser.ml
index b4cb81e78..1c5bc26ca 100644
--- a/builder/index_parser.ml
+++ b/builder/index_parser.ml
@@ -284,11 +284,11 @@ let write_entry chan (name, { Index.printable_name; file_uri; arch; osinfo;
aliases; hidden}) =
let fp fs = fprintf chan fs in
fp "[%s]\n" name;
- Option.may (fp "name=%s\n") printable_name;
- Option.may (fp "osinfo=%s\n") osinfo;
+ Option.iter (fp "name=%s\n") printable_name;
+ Option.iter (fp "osinfo=%s\n") osinfo;
fp "file=%s\n" file_uri;
fp "arch=%s\n" (Index.string_of_arch arch);
- Option.may (fp "sig=%s\n") signature_uri;
+ Option.iter (fp "sig=%s\n") signature_uri;
(match checksums with
| None -> ()
| Some checksums ->
@@ -299,11 +299,11 @@ let write_entry chan (name, { Index.printable_name; file_uri; arch; osinfo;
) checksums
);
fp "revision=%s\n" (string_of_revision revision);
- Option.may (fp "format=%s\n") format;
+ Option.iter (fp "format=%s\n") format;
fp "size=%Ld\n" size;
- Option.may (fp "compressed_size=%Ld\n") compressed_size;
- Option.may (fp "expand=%s\n") expand;
- Option.may (fp "lvexpand=%s\n") lvexpand;
+ Option.iter (fp "compressed_size=%Ld\n") compressed_size;
+ Option.iter (fp "expand=%s\n") expand;
+ Option.iter (fp "lvexpand=%s\n") lvexpand;
let format_notes notes =
String.concat "\n " (String.nsplit "\n" notes) in
diff --git a/builder/list_entries.ml b/builder/list_entries.ml
index 470d1b6ed..0690d5858 100644
--- a/builder/list_entries.ml
+++ b/builder/list_entries.ml
@@ -47,7 +47,7 @@ and list_entries_short index =
if not hidden then (
printf "%-24s" name;
printf " %-10s" (Index.string_of_arch arch);
- Option.may (printf " %s") printable_name;
+ Option.iter (printf " %s") printable_name;
printf "\n"
)
) index
@@ -73,13 +73,13 @@ and list_entries_long ~sources index =
notes; aliases; hidden }) ->
if not hidden then (
printf "%-24s %s\n" "os-version:" name;
- Option.may (printf "%-24s %s\n" (s_"Full name:")) printable_name;
+ Option.iter (printf "%-24s %s\n" (s_"Full name:")) printable_name;
printf "%-24s %s\n" (s_"Architecture:") (Index.string_of_arch arch);
printf "%-24s %s\n" (s_"Minimum/default size:") (human_size size);
- Option.may (fun size ->
+ Option.iter (fun size ->
printf "%-24s %s\n" (s_"Download size:") (human_size size)
) compressed_size;
- Option.may (
+ Option.iter (
fun l -> printf "%-24s %s\n" (s_"Aliases:") (String.concat " " l)
) aliases;
let notes = Languages.find_notes langs notes in
Submodule common 53713420b..007d0506c:
diff --git a/common/mlstdutils/std_utils.ml b/common/mlstdutils/std_utils.ml
index ab6e71c..323bfec 100644
--- a/common/mlstdutils/std_utils.ml
+++ b/common/mlstdutils/std_utils.ml
@@ -368,7 +368,7 @@ module List = struct
end
module Option = struct
- let may f = function
+ let iter f = function
| None -> ()
| Some x -> f x
@@ -376,8 +376,9 @@ module Option = struct
| None -> None
| Some x -> Some (f x)
- let default def = function
- | None -> def
+ let value x ~default =
+ match x with
+ | None -> default
| Some x -> x
end
diff --git a/common/mlstdutils/std_utils.mli b/common/mlstdutils/std_utils.mli
index 782d8fd..d576243 100644
--- a/common/mlstdutils/std_utils.mli
+++ b/common/mlstdutils/std_utils.mli
@@ -277,16 +277,19 @@ end
(** Override the List module from stdlib. *)
module Option : sig
- val may : ('a -> unit) -> 'a option -> unit
- (** [may f (Some x)] runs [f x]. [may f None] does nothing. *)
+ val iter : ('a -> unit) -> 'a option -> unit
+ (** [iter f o] is [f v] if [o] is [Some v] and [()] otherwise *)
val map : ('a -> 'b) -> 'a option -> 'b option
(** [map f (Some x)] returns [Some (f x)]. [map f None] returns [None]. *)
- val default : 'a -> 'a option -> 'a
- (** [default x (Some y)] returns [y]. [default x None] returns [x]. *)
+ val value : 'a option -> default:'a -> 'a
+ (** [value o ~default] is [v] if [o] is [Some v] and [default] otherwise. *)
end
-(** Functions for dealing with option types. *)
+(** Functions for dealing with option types.
+
+ This module will be removed when we can use baseline OCaml 4.08
+ since that version introduces a compatible [Option] module. *)
val ( // ) : string -> string -> string
(** Concatenate directory and filename. *)
diff --git a/common/mltools/tools_utils.ml b/common/mltools/tools_utils.ml
index 562bfad..8b611e7 100644
--- a/common/mltools/tools_utils.ml
+++ b/common/mltools/tools_utils.ml
@@ -218,7 +218,7 @@ let open_guestfs ?identifier () =
g#parse_environment ();
if trace () then g#set_trace true;
if verbose () then g#set_verbose true;
- Option.may g#set_identifier identifier;
+ Option.iter g#set_identifier identifier;
g
(* All the OCaml virt-* programs use this wrapper to catch exceptions
@@ -523,8 +523,8 @@ and do_run ?(echo_cmd = true) ?stdout_fd ?stderr_fd args =
Or 127
and do_teardown app outfd errfd exitstat =
- Option.may Unix.close outfd;
- Option.may Unix.close errfd;
+ Option.iter Unix.close outfd;
+ Option.iter Unix.close errfd;
match exitstat with
| Unix.WEXITED i ->
i
diff --git a/customize/customize_main.ml b/customize/customize_main.ml
index f05375e1d..8622715ab 100644
--- a/customize/customize_main.ml
+++ b/customize/customize_main.ml
@@ -163,8 +163,8 @@ read the man page virt-customize(1).
(* Connect to libguestfs. *)
let g =
let g = open_guestfs () in
- Option.may g#set_memsize memsize;
- Option.may g#set_smp smp;
+ Option.iter g#set_memsize memsize;
+ Option.iter g#set_smp smp;
(* [--no-network] from the command line takes precedence over the automatic
* network enablement for [--key ID:clevis], so here we intentionally
* don't check [key_store_requires_network opthandle.ks].
diff --git a/resize/resize.ml b/resize/resize.ml
index ee2fb2d92..3c3a5d7e3 100644
--- a/resize/resize.ml
+++ b/resize/resize.ml
@@ -1072,7 +1072,7 @@ read the man page virt-resize(1).
let ok =
try
g#part_init "/dev/sdb" parttype_string;
- Option.may (g#part_set_disk_guid "/dev/sdb") disk_guid;
+ Option.iter (g#part_set_disk_guid "/dev/sdb") disk_guid;
true
with G.Error error -> last_error := error; false in
if ok then g, true
@@ -1266,9 +1266,9 @@ read the man page virt-resize(1).
if p.p_bootable then
g#part_set_bootable "/dev/sdb" p.p_target_partnum true;
- Option.may (g#part_set_name "/dev/sdb" p.p_target_partnum) p.p_label;
- Option.may (g#part_set_gpt_guid "/dev/sdb" p.p_target_partnum) p.p_guid;
- Option.may (g#part_set_gpt_attributes "/dev/sdb" p.p_target_partnum)
+ Option.iter (g#part_set_name "/dev/sdb" p.p_target_partnum) p.p_label;
+ Option.iter (g#part_set_gpt_guid "/dev/sdb" p.p_target_partnum) p.p_guid;
+ Option.iter (g#part_set_gpt_attributes "/dev/sdb" p.p_target_partnum)
p.p_attributes;
match parttype, p.p_id with
diff --git a/sysprep/sysprep_operation.ml b/sysprep/sysprep_operation.ml
index 17c0440d4..0a5fce065 100644
--- a/sysprep/sysprep_operation.ml
+++ b/sysprep/sysprep_operation.ml
@@ -190,8 +190,8 @@ let dump_pod () =
if op.enabled_by_default then printf "*\n";
printf "\n";
printf "%s.\n\n" op.heading;
- Option.may (printf "%s\n\n") op.pod_description;
- Option.may (fun notes ->
+ Option.iter (printf "%s\n\n") op.pod_description;
+ Option.iter (fun notes ->
printf "=head3 ";
printf (f_"Notes on %s") op.name;
printf "\n\n";
--
2.31.1
Reference in New Issue View Git Blame Copy Permalink