From dff53edc5dc266433fca0d9baa5b7868875f098f Mon Sep 17 00:00:00 2001
From: Rudi Grinberg <me@rgrinberg.com>
Date: Sun, 1 Dec 2024 20:13:11 +0000
Subject: [PATCH] feature: add --prefix to configure script

In symmetric with --prefix in the install command.

Fix #10229

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>

<!-- ps-id: 0a9b3e1e-91d9-4ccf-8780-2210fe3d656c -->

Signed-off-by: Rudi Grinberg <me@rgrinberg.com>
---
 boot/configure.ml         |  5 ++++-
 src/dune_rules/context.ml | 15 ++++++++++++++-
 src/dune_rules/setup.mli  |  1 +
 src/install/roots.mli     |  3 ++-
 4 files changed, 21 insertions(+), 3 deletions(-)

diff --git a/boot/configure.ml b/boot/configure.ml
index 2423ebf9274..42e25d29564 100644
--- a/boot/configure.ml
+++ b/boot/configure.ml
@@ -35,6 +35,7 @@ let toggle =
 
 let () =
   let bad fmt = ksprintf (fun s -> raise (Arg.Bad s)) fmt in
+  let prefix = ref None in
   let library_path = ref [] in
   let library_destdir = ref None in
   let mandir = ref None in
@@ -58,7 +59,8 @@ let () =
     v := Some dir
   in
   let args =
-    [ ( "--libdir"
+    [ "--prefix", Arg.String (set_dir prefix), "DIR where files are copied"
+    ; ( "--libdir"
       , Arg.String set_libdir
       , "DIR where public libraries are looked up in the default build context. Can be \
          specified multiple times new one taking precedence. The last is used as default \
@@ -120,6 +122,7 @@ let () =
   pr "  ; libexec_root = %s" (option string !libexecdir);
   pr "  }";
   pr "";
+  pr "let prefix : string option = %s" (option string !prefix);
   List.iter !toggles ~f:(fun (name, value) ->
     pr
       "let %s = `%s"
diff --git a/src/dune_rules/context.ml b/src/dune_rules/context.ml
index 70f924355a1..943a568c9d0 100644
--- a/src/dune_rules/context.ml
+++ b/src/dune_rules/context.ml
@@ -743,6 +743,19 @@ let map_exe (context : t) =
        | _ -> exe)
 ;;
 
+let roots =
+  lazy
+    (let open Setup in
+     match prefix with
+     | None -> roots
+     | Some prefix ->
+       let prefix = Install.Roots.make prefix ~relative:Filename.concat in
+       Install.Roots.map2 roots prefix ~f:(fun root prefix ->
+         match root with
+         | None -> Some prefix
+         | Some _ -> root))
+;;
+
 let roots t =
   let module Roots = Install.Roots in
   let+ prefix_roots =
@@ -756,7 +769,7 @@ let roots t =
   in
   match t.kind with
   | Lock _ | Default ->
-    let setup_roots = Roots.map ~f:(Option.map ~f:Path.of_string) Setup.roots in
+    let setup_roots = Roots.map ~f:(Option.map ~f:Path.of_string) (Lazy.force roots) in
     Roots.first_has_priority setup_roots prefix_roots
   | Opam _ -> prefix_roots
 ;;
diff --git a/src/dune_rules/setup.mli b/src/dune_rules/setup.mli
index 6863d42ca4b..4666b18ec25 100644
--- a/src/dune_rules/setup.mli
+++ b/src/dune_rules/setup.mli
@@ -13,3 +13,4 @@ val roots : string option Install.Roots.t
 val toolchains : Dune_config.Config.Toggle.t
 val pkg_build_progress : Dune_config.Config.Toggle.t
 val lock_dev_tool : Dune_config.Config.Toggle.t
+val prefix : string option
diff --git a/src/install/roots.mli b/src/install/roots.mli
index f75aa5bb9bd..6d9b62e8b54 100644
--- a/src/install/roots.mli
+++ b/src/install/roots.mli
@@ -20,11 +20,12 @@ val opam_from_prefix : 'a -> relative:('a -> string -> 'a) -> 'a t
 val complete : 'a option t -> 'a option t
 
 val map : f:('a -> 'b) -> 'a t -> 'b t
+val map2 : f:('a -> 'b -> 'c) -> 'a t -> 'b t -> 'c t
 
 (** return the roots of the first argument if present *)
 val first_has_priority : 'a option t -> 'a option t -> 'a option t
 
 val to_env_without_path : 'a t -> relative:('a -> string -> 'a) -> (Env.Var.t * 'a) list
 val add_to_env : Path.Build.t t -> Env.t -> Env.t
-val make : 'a -> relative:('a -> string -> 'a) -> 'a t
+val make : 'base -> relative:('base -> string -> 'a) -> 'a t
 val make_all : 'a -> 'a t