From a84c1359ed0943e5140e9170fa05126b590c2873 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" 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 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 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