[Install] Stop calling opam binary use OPAM_SWITCH_PREFIX

        - Fix ocaml#5455
        - Installation can fail if OPAM_SWITCH_PREFIX is not present,
          ./configure has not been fully populated, and the missing directories
          are not given on the command line

Signed-off-by: François Bobot <[email protected]>

bin/install_uninstall.ml

@@ -10,22 +10,33 @@ let interpret_destdir ~destdir path =
   | Some destdir -> Path.append_local destdir (Path.local_part path)
 
 let get_dirs context ~prefix_from_command_line ~from_command_line =
-  let open Fiber.O in
+  let open Dune_engine.Install.Section.Paths.Roots in
   let prefix_from_command_line =
     Option.map ~f:Path.of_string prefix_from_command_line
   in
-  let+ roots =
+  let roots =
     match prefix_from_command_line with
-    | Some prefix ->
-      Fiber.return
-        (Dune_engine.Install.Section.Paths.Roots.opam_from_prefix prefix)
+    | Some prefix -> opam_from_prefix prefix |> map ~f:(fun s -> Some s)
     | None -> Context.roots context
   in
-  Dune_engine.Install.Section.Paths.Roots.map2 from_command_line roots
-    ~f:(fun from_command_line from_prefix ->
-      match (from_command_line, from_prefix) with
-      | Some dir, _ -> dir
-      | None, dir -> dir)
+  let roots = first_has_priority from_command_line roots in
+  let must_be_defined name v =
+    match v with
+    | Some v -> v
+    | None ->
+      User_error.raise
+        [ Pp.textf "The %s installation directory is unknown." name ]
+        ~hints:[ Pp.textf "It could be specified with --%s" name ]
+  in
+  { lib_root = must_be_defined "libdir" roots.lib_root
+  ; libexec_root = must_be_defined "libexecdir" roots.libexec_root
+  ; bin = must_be_defined "bindir" roots.bin
+  ; sbin = must_be_defined "sbindir" roots.sbin
+  ; etc_root = must_be_defined "etcdir" roots.etc_root
+  ; doc_root = must_be_defined "docdir" roots.doc_root
+  ; share_root = must_be_defined "datadir" roots.share_root
+  ; man = must_be_defined "mandir" roots.man
+  }
 
 module Workspace = struct
   type t =
@@ -599,7 +610,7 @@ let install_uninstall ~what =
         let+ () =
           Fiber.sequential_iter install_files_by_context
             ~f:(fun (context, entries_per_package) ->
-              let* roots =
+              let roots =
                 get_dirs context ~prefix_from_command_line ~from_command_line
               in
               let conf =

src/dune_engine/install.ml

@@ -190,16 +190,11 @@ module Section = struct
         ; man = f x.man y.man
         }
 
-      let map3 ~f x y z =
-        { lib_root = f x.lib_root y.lib_root z.lib_root
-        ; libexec_root = f x.libexec_root y.libexec_root z.libexec_root
-        ; bin = f x.bin y.bin z.bin
-        ; sbin = f x.sbin y.sbin z.sbin
-        ; share_root = f x.share_root y.share_root z.share_root
-        ; etc_root = f x.etc_root y.etc_root z.etc_root
-        ; doc_root = f x.doc_root y.doc_root z.doc_root
-        ; man = f x.man y.man z.man
-        }
+      let first_has_priority x y =
+        map2 x y ~f:(fun x y ->
+            match x with
+            | Some _ -> x
+            | None -> y)
     end
 
     let make ~package ~(roots : Path.t Roots.t) =

src/dune_engine/install.mli

@@ -68,9 +68,8 @@ module Section : sig
 
       val map : f:('a -> 'b) -> 'a t -> 'b t
 
-      val map2 : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
-
-      val map3 : f:('a -> 'b -> 'c -> 'd) -> 'a t -> 'b t -> 'c t -> 'd t
+      (** return the roots of the first argument if present *)
+      val first_has_priority : 'a option t -> 'a option t -> 'a option t
     end
 
     type section = t

src/dune_rules/context.ml

@@ -156,8 +156,6 @@ module Opam : sig
     -> root:string option
     -> switch:string
     -> string Env.Map.t Memo.Build.t
-
-  val opam_binary_exn : unit -> Path.t Memo.Build.t
 end = struct
   let opam =
     Memo.Lazy.create ~name:"context-opam" (fun () ->
@@ -863,24 +861,27 @@ let map_exe (context : t) =
       | _ -> exe)
 
 let roots t =
-  let open Fiber.O in
-  let+ prefix_roots =
-    let* opam = Memo.Build.run (Opam.opam_binary_exn ()) in
-    let+ s = Process.run_capture Strict opam ~env:t.env [ "var"; "prefix" ] in
-    let prefix = Path.of_filename_relative_to_initial_cwd (String.trim s) in
-    Dune_engine.Install.Section.Paths.Roots.opam_from_prefix prefix
+  let open Dune_engine.Install.Section.Paths.Roots in
+  let prefix_roots =
+    match Env.get t.env Build_environment_kind.opam_switch_prefix_var_name with
+    | None ->
+      { lib_root = None
+      ; libexec_root = None
+      ; bin = None
+      ; sbin = None
+      ; etc_root = None
+      ; doc_root = None
+      ; share_root = None
+      ; man = None
+      }
+    | Some prefix ->
+      let prefix = Path.of_filename_relative_to_initial_cwd prefix in
+      opam_from_prefix prefix |> map ~f:(fun s -> Some s)
   in
   match t.kind with
   | Default ->
-    let setup_roots =
-      Dune_engine.Install.Section.Paths.Roots.map
-        ~f:(Option.map ~f:Path.of_filename_relative_to_initial_cwd)
-        Setup.roots
-    in
-    Dune_engine.Install.Section.Paths.Roots.map2 prefix_roots setup_roots
-      ~f:(fun from_prefix -> function
-      | Some dir -> dir
-      | None -> from_prefix)
+    let setup_roots = map ~f:(Option.map ~f:Path.of_string) Setup.roots in
+    first_has_priority setup_roots prefix_roots
   | Opam _ -> prefix_roots
 
 let dot_dune_dir t = Path.Build.relative t.build_dir ".dune"

src/dune_rules/context.mli

@@ -136,7 +136,7 @@ val build_context : t -> Build_context.t
 
 (** Query where build artifacts should be installed if the user doesn't specify
     an explicit installation directory. *)
-val roots : t -> Path.t Dune_engine.Install.Section.Paths.Roots.t Fiber.t
+val roots : t -> Path.t option Dune_engine.Install.Section.Paths.Roots.t
 
 (** Generate the rules for producing the files needed by configurator. *)
 val gen_configurator_rules : t -> unit Memo.Build.t

src/dune_rules/setup.mli

@@ -8,5 +8,5 @@ open! Dune_engine
     auto-detect it using standard tools such as [ocamlfind]. *)
 val library_path : string list
 
-(** Where to install files. *)
+(** Where to install files. All the directories are absolute path *)
 val roots : string option Install.Section.Paths.Roots.t