From d288ab425f05fe15426512287f578fa588e499b2 Mon Sep 17 00:00:00 2001 From: Raja Boujbel Date: Fri, 10 Nov 2023 16:50:13 +0100 Subject: [PATCH] use env_update function constructor --- src/client/opamAction.ml | 82 +++++++++++------------------- src/client/opamAdminRepoUpgrade.ml | 36 ++++--------- src/client/opamCliMain.ml | 14 ++--- src/client/opamConfigCommand.ml | 9 +--- src/format/opamTypesBase.ml | 18 +++++++ src/format/opamTypesBase.mli | 15 ++++++ src/state/opamEnv.ml | 68 +++++++++---------------- 7 files changed, 105 insertions(+), 137 deletions(-) diff --git a/src/client/opamAction.ml b/src/client/opamAction.ml index 35e8632f702..359b41a3ad5 100644 --- a/src/client/opamAction.ml +++ b/src/client/opamAction.ml @@ -521,7 +521,6 @@ let prepare_package_source st nv dir = let compilation_env t opam = let open OpamParserTypes in - let empty = Some (SPF_Resolved None) in let build_env = List.map (fun env -> @@ -532,58 +531,39 @@ let compilation_env t opam = let cygwin_env = match OpamSysInteract.Cygwin.cygbin_opt t.switch_global.config with | Some cygbin -> - [{ envu_var = "PATH"; - envu_op = EqPlus; - envu_value = OpamFilename.Dir.to_string cygbin; - envu_comment = Some "Cygwin path"; - envu_rewrite = empty; - }] + [ OpamTypesBase.env_update_resolved "PATH" EqPlus + (OpamFilename.Dir.to_string cygbin) + ~comment:"Cygwin path" ] | None -> [] in - let shell_sanitization = Some "shell env sanitization" in - let build_env_def = Some "build environment definition" in - let cdpath = { - envu_var = "CDPATH"; - envu_op = Eq; - envu_value = ""; - envu_comment = shell_sanitization; - envu_rewrite = empty; - } in - let makeflags = { - envu_var = "MAKEFLAGS"; - envu_op = Eq; - envu_value = ""; - envu_comment = shell_sanitization; - envu_rewrite = empty; - } in - let makelevel = { - envu_var = "MAKELEVEL"; - envu_op = Eq; - envu_value = ""; - envu_comment = Some "make env sanitization"; - envu_rewrite = empty; - } in - let pkg_name = { - envu_var = "OPAM_PACKAGE_NAME"; - envu_op = Eq; - envu_value = OpamPackage.Name.to_string (OpamFile.OPAM.name opam); - envu_comment = build_env_def; - envu_rewrite = empty; - } in - let pkg_version = { - envu_var = "OPAM_PACKAGE_VERSION"; - envu_op = Eq; - envu_value = OpamPackage.Version.to_string (OpamFile.OPAM.version opam); - envu_comment = build_env_def; - envu_rewrite = empty; - } in - let cli = { - envu_var = "OPAMCLI"; - envu_op = Eq; - envu_value = "2.0"; - envu_comment = Some "opam CLI version"; - envu_rewrite = empty; - } in + let shell_sanitization = "shell env sanitization" in + let build_env_def = "build environment definition" in + let cdpath = + OpamTypesBase.env_update_resolved "CDPATH" Eq "" + ~comment:shell_sanitization + in + let makeflags = + OpamTypesBase.env_update_resolved "MAKEFLAGS" Eq "" + ~comment:shell_sanitization + in + let makelevel = + OpamTypesBase.env_update_resolved "MAKELEVEL" Eq "" + ~comment:"make env sanitization" + in + let pkg_name = + OpamTypesBase.env_update_resolved "OPAM_PACKAGE_NAME" Eq + (OpamPackage.Name.to_string (OpamFile.OPAM.name opam)) + ~comment:build_env_def + in + let pkg_version = + OpamTypesBase.env_update_resolved "OPAM_PACKAGE_VERSION" Eq + (OpamPackage.Version.to_string (OpamFile.OPAM.version opam)) + ~comment:build_env_def + in + let cli = + OpamTypesBase.env_update_resolved "OPAMCLI" Eq "2.0" + ~comment:"opam CLI version" + in let scrub = OpamClientConfig.(!r.scrubbed_environment_variables) in OpamEnv.get_full ~scrub ~set_opamroot:true ~set_opamswitch:true ~force_path:true t ~updates:([ diff --git a/src/client/opamAdminRepoUpgrade.ml b/src/client/opamAdminRepoUpgrade.ml index ffa908d8b04..6d8938e6793 100644 --- a/src/client/opamAdminRepoUpgrade.ml +++ b/src/client/opamAdminRepoUpgrade.ml @@ -357,7 +357,6 @@ let do_upgrade repo_root = (string_of_int (1 + int_of_string sn)) ^ "~" with Not_found -> str_version ^ "a" in - let empty = Some (SPF_Unresolved (Empty, Empty)) in let wrapper_opam = O.create wrapper_nv |> O.with_substs [OpamFilename.Base.of_string conf_script_name] |> @@ -367,31 +366,18 @@ let do_upgrade repo_root = None ] |> O.with_maintainer [ "platform@lists.ocaml.org" ] |> - O.with_build_env [{ - envu_var = "CAML_LD_LIBRARY_PATH"; envu_op = Eq; - envu_value = ""; envu_comment = None; - envu_rewrite = empty; - }] |> + O.with_build_env [ + OpamTypesBase.env_update_unresolved + "CAML_LD_LIBRARY_PATH" Eq "" + ] |> O.with_env [ - { envu_var = "CAML_LD_LIBRARY_PATH"; - envu_op = Eq; - envu_value = "%{_:stubsdir}%"; - envu_comment = None; - envu_rewrite = empty; - }; - { envu_var = "CAML_LD_LIBRARY_PATH"; - envu_op = PlusEq; - envu_value = "%{lib}%/stublibs"; - envu_comment = None; - envu_rewrite = empty; - }; - { envu_var = "OCAML_TOPLEVEL_PATH"; - envu_op =Eq; - envu_value = "%{toplevel}%"; - envu_comment = None; - envu_rewrite = empty; - }] |> - (* XXX Rewrite rules ?? *) + OpamTypesBase.env_update_unresolved + "CAML_LD_LIBRARY_PATH" Eq "%{_:stubsdir}%"; + OpamTypesBase.env_update_unresolved + "CAML_LD_LIBRARY_PATH" PlusEq "%{lib}%/stublibs"; + OpamTypesBase.env_update_unresolved + "OCAML_TOPLEVEL_PATH" Eq "%{toplevel}%" + ] |> (* leave the Compiler flag to the implementations (since the user needs to select one) O.with_flags [Pkgflag_Compiler] |> *) diff --git a/src/client/opamCliMain.ml b/src/client/opamCliMain.ml index 38f546c4a03..4c5d468cf99 100644 --- a/src/client/opamCliMain.ml +++ b/src/client/opamCliMain.ml @@ -206,15 +206,11 @@ let check_and_run_external_commands () = in let env = if has_init then - let open OpamTypes in - let empty = Some (SPF_Resolved None) in - let updates = [{ - envu_var = "PATH"; - envu_op = OpamParserTypes.PlusEq; - envu_value = OpamFilename.Dir.to_string plugins_bin; - envu_comment = None; - envu_rewrite = empty; - }] in + let updates = [ + OpamTypesBase.env_update_resolved + "PATH" OpamParserTypes.PlusEq + (OpamFilename.Dir.to_string plugins_bin) + ] in OpamStateConfig.init ~root_dir (); match OpamStateConfig.get_switch_opt () with | None -> env_array (OpamEnv.get_pure ~updates ()) diff --git a/src/client/opamConfigCommand.ml b/src/client/opamConfigCommand.ml index 5d26a76fcf5..cd5e8fa026c 100644 --- a/src/client/opamConfigCommand.ml +++ b/src/client/opamConfigCommand.ml @@ -283,15 +283,10 @@ let ensure_env_aux ?(base=[]) ?(set_opamroot=false) ?(set_opamswitch=false) updates in let last_env_file = write_last_env_file gt switch updates in - let empty = Some (SPF_Resolved None) in let updates = OpamStd.Option.map_default (fun target -> - { envu_var = "OPAM_LAST_ENV"; - envu_op = OpamParserTypes.Eq; - envu_value = OpamFilename.to_string target; - envu_comment = None; - envu_rewrite = empty; - } ::updates) + (env_update_resolved "OPAM_LAST_ENV" Eq (OpamFilename.to_string target)) + :: updates) updates last_env_file in OpamEnv.add base updates diff --git a/src/format/opamTypesBase.ml b/src/format/opamTypesBase.ml index a2b3c6d1e6f..a188430d2c3 100644 --- a/src/format/opamTypesBase.ml +++ b/src/format/opamTypesBase.ml @@ -232,3 +232,21 @@ let string_of_path_format = function let char_of_separator = function | SSemiColon -> ';' | SColon -> ':' + +let env_update ?comment:envu_comment ~rewrite:envu_rewrite + envu_var envu_op envu_value = + { envu_var; envu_op; envu_value; envu_comment; envu_rewrite } + +let env_update_resolved ?comment:envu_comment ?rewrite + envu_var envu_op envu_value = + { envu_var; envu_op; envu_value; envu_comment; + envu_rewrite = OpamStd.Option.default (Some (SPF_Resolved None)) rewrite; + } + +let env_update_unresolved ?comment:envu_comment ?rewrite + envu_var envu_op envu_value = + { envu_var; envu_op; envu_value; envu_comment; + envu_rewrite = + OpamStd.Option.default (Some (SPF_Unresolved (Empty, Empty))) + rewrite; + } diff --git a/src/format/opamTypesBase.mli b/src/format/opamTypesBase.mli index 1d30d649739..27a4aca41ac 100644 --- a/src/format/opamTypesBase.mli +++ b/src/format/opamTypesBase.mli @@ -80,3 +80,18 @@ val iter_success: ('a -> unit) -> ('a, 'b) result -> unit (** Environment update path transformers functions *) val string_of_path_format: path_format -> string val char_of_separator: separator -> char + +val env_update: + ?comment:string -> rewrite:'a separator_path_format option + -> string -> env_update_op_kind -> string + -> 'a env_update + +val env_update_resolved: + ?comment:string -> ?rewrite:spf_resolved separator_path_format option + -> string -> env_update_op_kind -> string + -> spf_resolved env_update + +val env_update_unresolved: + ?comment:string -> ?rewrite:spf_unresolved separator_path_format option + -> string -> env_update_op_kind -> string + -> spf_unresolved env_update diff --git a/src/state/opamEnv.ml b/src/state/opamEnv.ml index ffb794032d9..29a4b82d143 100644 --- a/src/state/opamEnv.ml +++ b/src/state/opamEnv.ml @@ -482,39 +482,32 @@ let compute_updates ?(force_path=false) st = let bindir = OpamPath.Switch.bin st.switch_global.root st.switch st.switch_config in - let empty = Some (SPF_Resolved None) in - let path = { - envu_var = "PATH"; - envu_op = (if force_path then PlusEq else EqPlusEq); - envu_value = OpamFilename.Dir.to_string bindir; - envu_comment = - Some ("Binary dir for opam switch "^OpamSwitch.to_string st.switch); - envu_rewrite = empty; - } in + let path = + env_update_resolved "PATH" + (if force_path then PlusEq else EqPlusEq) + (OpamFilename.Dir.to_string bindir) + ~comment: ("Binary dir for opam switch "^OpamSwitch.to_string st.switch) + in let man_path = let open OpamStd.Sys in match os () with | OpenBSD | NetBSD | FreeBSD | Darwin | DragonFly -> [] (* MANPATH is a global override on those, so disabled for now *) | _ -> - [{ envu_var = "MANPATH"; - envu_op = EqColon; - envu_value = OpamFilename.Dir.to_string + [ + env_update_resolved "MANPATH" EqColon + (OpamFilename.Dir.to_string (OpamPath.Switch.man_dir - st.switch_global.root st.switch st.switch_config); - envu_comment = Some "Current opam switch man dir"; - envu_rewrite = empty; - }] + st.switch_global.root st.switch st.switch_config)) + ~comment:"Current opam switch man dir" + ] in let switch_env = - { envu_var = "OPAM_SWITCH_PREFIX"; - envu_op = Eq ; - envu_value = OpamFilename.Dir.to_string - (OpamPath.Switch.root st.switch_global.root st.switch); - envu_comment = Some "Prefix of the current opam switch"; - envu_rewrite = empty; - } :: - List.map (env_expansion st) st.switch_config.OpamFile.Switch_config.env + (env_update_resolved "OPAM_SWITCH_PREFIX" Eq + (OpamFilename.Dir.to_string + (OpamPath.Switch.root st.switch_global.root st.switch)) + ~comment:"Prefix of the current opam switch") + :: List.map (env_expansion st) st.switch_config.OpamFile.Switch_config.env in let pkg_env = (* XXX: Does this need a (costly) topological sort? *) let updates = @@ -530,25 +523,15 @@ let compute_updates ?(force_path=false) st = switch_env @ pkg_env @ man_path @ [path] let updates_common ~set_opamroot ~set_opamswitch root switch = - let empty = Some (SPF_Resolved None) in let root = if set_opamroot then - [{ envu_var = "OPAMROOT"; - envu_op = Eq; - envu_value = OpamFilename.Dir.to_string root; - envu_comment = Some "Opam root in use"; - envu_rewrite = empty; - }] + [ env_update_resolved "OPAMROOT" Eq (OpamFilename.Dir.to_string root) + ~comment:"Opam root in use" ] else [] in let switch = if set_opamswitch then - [{ envu_var = "OPAMSWITCH"; - envu_op = Eq; - envu_value = OpamSwitch.to_string switch; - envu_comment = None; - envu_rewrite = empty; - }] + [ env_update_resolved "OPAMSWITCH" Eq (OpamSwitch.to_string switch) ] else [] in root @ switch @@ -664,14 +647,9 @@ let switch_path_update ~force_path root switch = (OpamStateConfig.Switch.safe_load_t ~lock_kind:`Lock_read root switch) in - let empty = Some (SPF_Resolved None) in - [{ - envu_var = "PATH"; - envu_op = (if force_path then PlusEq else EqPlusEq); - envu_value = OpamFilename.Dir.to_string bindir; - envu_comment = Some "Current opam switch binary dir"; - envu_rewrite = empty; - }] + [ env_update_resolved "PATH" (if force_path then PlusEq else EqPlusEq) + (OpamFilename.Dir.to_string bindir) + ~comment:"Current opam switch binary dir" ] let path ~force_path root switch = let env = expand (switch_path_update ~force_path root switch) in