Allows package to define sites of installation

bin/exec.ml

@@ -40,7 +40,8 @@ let term =
   and+ args = Arg.(value & pos_right 0 string [] (Arg.info [] ~docv:"ARGS")) in
   Common.set_common common ~targets:[ Arg.Dep.file prog ];
   let setup = Scheduler.go ~common (fun () -> Import.Main.setup common) in
-  let context = Import.Main.find_context_exn setup.workspace ~name:context in
+  let sctx = Import.Main.find_scontext_exn setup ~name:context in
+  let context = Dune.Super_context.context sctx in
   let path_relative_to_build_root p =
     Common.prefix_target common p
     |> Path.Build.relative context.build_dir
@@ -126,6 +127,6 @@ let term =
   | Some real_prog, _ ->
     let real_prog = Path.to_string real_prog in
     let argv = prog :: args in
-    restore_cwd_and_execve common real_prog argv context.env
+    restore_cwd_and_execve common real_prog argv (Super_context.context_env sctx)
 
 let command = (term, info)

bin/install_uninstall.ml

@@ -72,6 +72,7 @@ module type File_operations = sig
     -> executable:bool
     -> special_file:Special_file.t option
     -> package:Package.Name.t
+    -> get_location:(Dune.Section.t -> Package.Name.t -> Stdune.Path.t)
     -> unit Fiber.t
 
   val mkdir_p : Path.t -> unit
@@ -86,7 +87,7 @@ module type Workspace = sig
 end
 
 module File_ops_dry_run : File_operations = struct
-  let copy_file ~src ~dst ~executable ~special_file:_ ~package:_ =
+  let copy_file ~src ~dst ~executable ~special_file:_ ~package:_ ~get_location:_ =
     Format.printf "Copying %a to %a (executable: %b)\n" Path.pp src Path.pp dst
       executable;
     Fiber.return ()
@@ -118,7 +119,7 @@ module File_ops_real (W : Workspace) : File_operations = struct
     match f ic with
     | exception _ ->
       User_warning.emit ~loc:(Loc.in_file src)
-        [ Pp.text "Failed to parse file, not adding version information." ];
+        [ Pp.text "Failed to parse file, not adding version and locations information." ];
       plain_copy ()
     | No_version_needed -> plain_copy ()
     | Need_version print -> (
@@ -191,7 +192,7 @@ module File_ops_real (W : Workspace) : File_operations = struct
               Format.pp_print_cut ppf ());
           Format.pp_close_box ppf ())
 
-  let copy_file ~src ~dst ~executable ~special_file ~package =
+  let copy_file ~src ~dst ~executable ~special_file ~package ~get_location =
     let chmod =
       if executable then
         set_executable_bits
@@ -209,7 +210,9 @@ module File_ops_real (W : Workspace) : File_operations = struct
         | Some Dune_package ->
           copy_special_file ~src ~package ~ic ~oc ~f:process_dune_package
         | None ->
-          Dune.Artifact_substitution.copy ~get_vcs ~input:(input ic)
+          Dune.Artifact_substitution.copy ~get_vcs
+            ~get_location
+            ~input:(input ic)
             ~output:(output oc))
 
   let remove_if_exists dst =
@@ -447,8 +450,15 @@ let install_uninstall ~what =
                           Install.Section.should_set_executable_bit
                             entry.section
                         in
+                        let get_location section package =
+                          let paths =
+                            Install.Section.Paths.make ~package ~destdir:prefix ?libdir
+                              ?mandir ()
+                          in
+                          Install.Section.Paths.get paths section
+                        in
                         Ops.copy_file ~src:entry.src ~dst ~executable
-                          ~special_file ~package
+                          ~special_file ~package ~get_location
                       ) else (
                         Ops.remove_if_exists dst;
                         files_deleted_in := Path.Set.add !files_deleted_in dir;

dune-action-plugin.opam

@@ -17,7 +17,7 @@ homepage: "https://github.com/ocaml/dune"
 doc: "https://dune.readthedocs.io/"
 bug-reports: "https://github.com/ocaml/dune/issues"
 depends: [
-  "dune" {>= "2.0"}
+  "dune" {>= "2.2"}
   "dune-glob"
   "ppx_expect" {with-test}
   "dune-private-libs" {= version}

dune-build-info.opam

@@ -16,7 +16,7 @@ homepage: "https://github.com/ocaml/dune"
 doc: "https://dune.readthedocs.io/"
 bug-reports: "https://github.com/ocaml/dune/issues"
 depends: [
-  "dune" {>= "2.0"}
+  "dune" {>= "2.2"}
 ]
 dev-repo: "git+https://github.com/ocaml/dune.git"
 build: [

dune-configurator.opam

@@ -18,7 +18,7 @@ homepage: "https://github.com/ocaml/dune"
 doc: "https://dune.readthedocs.io/"
 bug-reports: "https://github.com/ocaml/dune/issues"
 depends: [
-  "dune" {>= "2.0"}
+  "dune" {>= "2.2"}
   "dune-private-libs" {= version}
 ]
 dev-repo: "git+https://github.com/ocaml/dune.git"

dune-glob.opam

@@ -10,7 +10,7 @@ homepage: "https://github.com/ocaml/dune"
 doc: "https://dune.readthedocs.io/"
 bug-reports: "https://github.com/ocaml/dune/issues"
 depends: [
-  "dune" {>= "2.0"}
+  "dune" {>= "2.2"}
   "dune-private-libs" {= version}
 ]
 dev-repo: "git+https://github.com/ocaml/dune.git"

dune-private-libs.opam

@@ -17,7 +17,7 @@ homepage: "https://github.com/ocaml/dune"
 doc: "https://dune.readthedocs.io/"
 bug-reports: "https://github.com/ocaml/dune/issues"
 depends: [
-  "dune" {>= "2.0"}
+  "dune" {>= "2.2"}
   "ocaml" {>= "4.07"}
 ]
 dev-repo: "git+https://github.com/ocaml/dune.git"

dune-project

@@ -1,4 +1,4 @@
-(lang dune 2.0)
+(lang dune 2.2)
 (name dune)
 
 (generate_opam_files true)
@@ -114,3 +114,9 @@ execution of the action.
  (description "\
 dune-glob provides a parser and interpreter for globs as \
 understood by dune language."))
+
+(package
+ (name dune-sites-locations)
+ (synopsis "Embed locations informations inside executable and libraries")
+ (description "\
+"))

dune-sites-locations.opam

@@ -0,0 +1,28 @@
+# This file is generated by dune, edit dune-project instead
+opam-version: "2.0"
+synopsis: "Embed locations informations inside executable and libraries"
+description: ""
+maintainer: ["Jane Street Group, LLC <[email protected]>"]
+authors: ["Jane Street Group, LLC <[email protected]>"]
+license: "MIT"
+homepage: "https://github.com/ocaml/dune"
+doc: "https://dune.readthedocs.io/"
+bug-reports: "https://github.com/ocaml/dune/issues"
+depends: [
+  "dune" {>= "2.2"}
+]
+build: [
+  ["dune" "subst"] {pinned}
+  [
+    "dune"
+    "build"
+    "-p"
+    name
+    "-j"
+    jobs
+    "@install"
+    "@runtest" {with-test}
+    "@doc" {with-doc}
+  ]
+]
+dev-repo: "git+https://github.com/ocaml/dune.git"

otherlibs/sites_locations/src/dune

@@ -0,0 +1,4 @@
+(library
+ (name sites_locations)
+ (public_name dune-sites-locations)
+)

otherlibs/sites_locations/src/sites_locations.ml

@@ -0,0 +1,91 @@
+module V1 = struct
+  module Location = struct
+    type t = string
+  end
+
+  module Section = struct
+    type t =
+      | Lib
+      | Lib_root
+      | Libexec
+      | Libexec_root
+      | Bin
+      | Sbin
+      | Toplevel
+      | Share
+      | Share_root
+      | Etc
+      | Doc
+      | Stublibs
+      | Man
+      | Misc
+
+    let of_string = function
+      | "lib" -> Lib
+      | "lib_root" -> Lib_root
+      | "libexec" -> Libexec
+      | "libexec_root" -> Libexec_root
+      | "bin" -> Bin
+      | "sbin" -> Sbin
+      | "toplevel" -> Toplevel
+      | "share" -> Share
+      | "share_root" -> Share_root
+      | "etc" -> Etc
+      | "doc" -> Doc
+      | "stublibs" -> Stublibs
+      | "man" -> Man
+      | "misc" -> Misc
+      | _ -> assert false (* since produced by Section.to_string *)
+  end
+
+  module Private_ = struct
+
+    let dirs : (string*Section.t,string) Hashtbl.t = Hashtbl.create 10
+    (* multi-bindings first is the one with least priority *)
+
+    let path_sep =
+      if Sys.win32 then
+        ';'
+      else
+        ':'
+
+    let () =
+      match Sys.getenv_opt "DUNE_DIR_LOCATIONS" with
+      | None -> ()
+      | Some s ->
+        let rec aux = function
+          | [] -> ()
+          | package::section::dir::l ->
+            let section = Section.of_string section in
+            Hashtbl.add dirs (package,section) dir;
+            aux l
+          | _ -> invalid_arg "Error parsing DUNE_DIR_LOCATIONS"
+        in
+        let l = String.split_on_char path_sep s in
+        aux l
+
+    (* Parse the replacement format described in [artifact_substitution.ml]. *)
+    let eval s =
+      let len = String.length s in
+      if s.[0] = '=' then
+        let colon_pos = String.index_from s 1 ':' in
+        let vlen = int_of_string (String.sub s 1 (colon_pos - 1)) in
+        (* This [min] is because the value might have been truncated
+           if it was too large *)
+        let vlen = min vlen (len - colon_pos - 1) in
+        Some (String.sub s (colon_pos + 1) vlen)
+      else
+        None
+    [@@inline never]
+
+    let get_dir ~package ~section =
+      Hashtbl.find_all dirs (package,section)
+
+    let site ~package ~section ~suffix ~encoded =
+      let dirs = get_dir ~package ~section in
+      let dirs = match eval encoded with None -> dirs | Some d -> d::dirs in
+      List.rev_map (fun dir -> Filename.concat dir suffix) dirs
+    [@@inline never]
+  end
+
+end

otherlibs/sites_locations/src/sites_locations.mli

@@ -0,0 +1,31 @@
+(** Provide locations information *)
+
+module V1 : sig
+
+  module Location : sig
+    type t = string
+  end
+
+  module Section : sig
+    type t =
+      | Lib
+      | Lib_root
+      | Libexec
+      | Libexec_root
+      | Bin
+      | Sbin
+      | Toplevel
+      | Share
+      | Share_root
+      | Etc
+      | Doc
+      | Stublibs
+      | Man
+      | Misc
+  end
+
+  module Private_ : sig
+    val site : package:string -> section:Section.t ->
+      suffix:string -> encoded:string -> Location.t list
+  end
+end

otherlibs/sites_locations/test/dune

@@ -0,0 +1,9 @@
+(rule
+ (alias runtest)
+ (deps
+  (package dune)
+  (package dune-sites-locations))
+ (action
+  (progn
+   (run cram -test %{dep:run.t})
+   (diff? run.t run.t.corrected))))