[Sites] Add sites information in dune package

bin/install_uninstall.ml

@@ -159,12 +159,38 @@ module File_ops_real (W : Workspace) : File_operations = struct
           in
           Dune.Meta.pp ppf meta.entries)
 
-  let process_dune_package ic =
+  let replace_sites ~(get_location:(Dune.Section.t -> Package.Name.t -> Stdune.Path.t)) dp =
+    match List.find_map dp ~f:(function
+      | Dune_lang.List [Atom (A "name");Atom (A name)] -> Some name
+      | _ -> None) with
+    | None -> dp
+    | Some name ->
+      List.map dp ~f:(function
+        | Dune_lang.List (((Atom (A "sites")) as sexp_sites) :: sites) ->
+          let sites =
+            List.map sites ~f:(function
+              | Dune_lang.List [(Atom (A section)) as section_sexp;_] ->
+                let path =
+                  get_location
+                    (Option.value_exn (Dune.Section.of_string section))
+                    (Import.Package.Name.of_string name)
+                in
+                let open Dune_lang.Encoder in
+                pair sexp string (section_sexp,Path.to_absolute_filename path)
+              | _ -> assert false)
+          in
+          Dune_lang.List (sexp_sites :: sites)
+        | x -> x)
+
+  let process_dune_package ~get_location ic =
     let lb = Lexing.from_channel ic in
     let dp =
       Dune_lang.Parser.parse ~mode:Many lb
       |> List.map ~f:Dune_lang.Ast.remove_locs
     in
+    (* replace sites with external path in the file *)
+    let dp = replace_sites ~get_location dp in
+    (* replace version if needed in the file *)
     if
       List.exists dp ~f:(function
         | Dune_lang.List (Atom (A "version") :: _) -> true
@@ -208,7 +234,7 @@ module File_ops_real (W : Workspace) : File_operations = struct
         match (special_file : Special_file.t option) with
         | Some META -> copy_special_file ~src ~package ~ic ~oc ~f:process_meta
         | Some Dune_package ->
-          copy_special_file ~src ~package ~ic ~oc ~f:process_dune_package
+          copy_special_file ~src ~package ~ic ~oc ~f:(process_dune_package ~get_location)
         | None ->
           Dune.Artifact_substitution.copy ~get_vcs
             ~get_location

src/dune/build_system.ml

@@ -1582,15 +1582,9 @@ end = struct
                    source tree to be writable by the user, so we explicitly set
                    the user writable bit. *)
                 let chmod n = n lor 0o200 in
-                let get_location section package_name =
-                  (* check that we get the good path *)
+                let get_location =
                   let context = Option.value_exn context in
-                  let install_dir = Config.local_install_dir ~context:context.name in
-                  let install_dir = Path.build install_dir in
-                  let paths =
-                    Install.Section.Paths.make ~package:package_name ~destdir:install_dir ()
-                  in
-                  Install.Section.Paths.get paths section
+                  Install.Section.Paths.get_local_location context.name
                 in
                 Artifact_substitution.copy_file () ~src:path ~dst:in_source_tree
                   ~get_vcs:File_tree.nearest_vcs

src/dune/dune_package.ml

@@ -276,17 +276,15 @@ type t =
   { name : Package.Name.t
   ; entries : Entry.t list
   ; version : string option
-  ; share : Path.t option
-  ; lib : Path.t option
+  ; sites : Path.t Section.Map.t
   ; dir : Path.t
   }
 
 let decode ~lang ~dir =
   let open Dune_lang.Decoder in
   let+ name = field "name" Package.Name.decode
   and+ version = field_o "version" string
-  and+ share = field_o "location_share" string
-  and+ lib = field_o "location_lib" string
+  and+ (loc,sites) = located (field ~default:[] "sites" (repeat (pair Section.decode Dpath.decode)))
   and+ entries = leftover_fields_as_sums (Entry.cstrs ~lang ~dir) in
   let entries =
     List.map entries ~f:(fun e ->
@@ -297,8 +295,14 @@ let decode ~lang ~dir =
         | _ -> e)
   in
   { name; version; entries; dir
-  ; share = Option.map ~f:Path.of_string share
-  ; lib = Option.map ~f:Path.of_string lib
+  ; sites = Section.Map.of_list sites
+            |> (function
+              | Ok x -> x
+              | Error (s, _, _) ->
+                User_error.raise ~loc
+                  [ Pp.textf "The section %s appears multiple times"
+                      (Section.to_string s)]
+            )
   }
 
 let () = Vfile.Lang.register Stanza.syntax ()
@@ -314,22 +318,15 @@ let prepend_version ~dune_version sexps =
   ]
   @ sexps
 
-let encode ~dune_version { entries; name; version; dir; share; lib } =
+let encode ~dune_version { entries; name; version; dir; sites } =
+  let open Dune_lang.Encoder in
+  let sites = (Section.Map.to_list (Section.Map.map ~f:Path.to_absolute_filename sites)) in
+  let sexp = record_fields [
+    field "name" Package.Name.encode name;
+    field_o "version" string version;
+    field_l "sites" (pair Section.encode string) sites
+  ] in
   let list s = Dune_lang.List s in
-  let option sexp name conv = function
-    | None -> sexp
-    | Some v ->
-      sexp
-      @ [ list
-            [ Dune_lang.atom name
-            ; Dune_lang.atom_or_quoted_string (conv v)
-            ]
-        ]
-  in
-  let sexp = [ list [ Dune_lang.atom "name"; Package.Name.encode name ] ] in
-  let sexp = option sexp "version" (fun x -> x) version in
-  let sexp = option sexp "location_share" Path.to_absolute_filename share in
-  let sexp = option sexp "location_lib" Path.to_absolute_filename lib in
   let entries =
     List.map entries ~f:(function
       | Entry.Library lib ->
@@ -341,15 +338,14 @@ let encode ~dune_version { entries; name; version; dir; share; lib } =
   in
   prepend_version ~dune_version (List.concat [ sexp; entries ])
 
-let to_dyn { entries; name; version; dir; share; lib } =
+let to_dyn { entries; name; version; dir; sites } =
   let open Dyn.Encoder in
   record
     [ ("entries", list Entry.to_dyn entries)
     ; ("name", Package.Name.to_dyn name)
     ; ("version", option string version)
     ; ("dir", Path.to_dyn dir)
-    ; ("share", option Path.to_dyn share)
-    ; ("lib", option Path.to_dyn lib)
+    ; ("sites", Section.Map.to_dyn Path.to_dyn sites)
     ]
 
 module Or_meta = struct

src/dune/dune_package.mli

@@ -52,8 +52,7 @@ type t =
   { name : Package.Name.t
   ; entries : Entry.t list
   ; version : string option
-  ; share : Path.t option
-  ; lib : Path.t option
+  ; sites : Path.t Section.Map.t
   ; dir : Path.t
   }
 

src/dune/findlib/findlib.ml

@@ -490,8 +490,7 @@ module Discovered_package = struct
           ]
       ; version = None
       ; dir = Path.root
-      ; share = None
-      ; lib = None
+      ; sites = Section.Map.empty
       }
 end
 

src/dune/install.ml

@@ -162,6 +162,15 @@ module Section = struct
       | Man -> t.man
       | Misc -> Code_error.raise "Install.Paths.get" []
 
+    let get_local_location context section package_name =
+      (* check that we get the good path *)
+      let install_dir = Config.local_install_dir ~context in
+      let install_dir = Path.build install_dir in
+      let paths =
+        make ~package:package_name ~destdir:install_dir ()
+      in
+      get paths section
+
     let install_path t section p =
       Path.relative (get t section) (Dst.to_string p)
   end

src/dune/install.mli

@@ -56,6 +56,8 @@ module Section : sig
 
     val install_path : t -> section -> Dst.t -> Path.t
     val get: t -> section -> Path.t
+
+    val get_local_location: Context_name.t -> section -> Package.Name.t -> Path.t
   end
   with type section := t
 end

src/dune/install_rules.ml

@@ -359,13 +359,19 @@ let gen_dune_package sctx pkg =
                          ~dir:(Path.build (lib_root lib))
                          ~modules ~foreign_objects))))
         in
+        let sites =
+          let sections =
+            Section.Set.of_list (Package.Name.Map.values pkg.sites_locations)
+          in
+          Section.Map.mapi (Section.Set.to_map sections)
+            ~f:(fun section () -> Install.Section.Paths.get_local_location ctx.name section name)
+        in
         Dune_package.Or_meta.Dune_package
           { Dune_package.version = pkg.version
           ; name
           ; entries
           ; dir = Path.build pkg_root
-          ; share = None
-          ; lib = None
+          ; sites
           }
       in
       dune_package
@@ -404,8 +410,7 @@ let gen_dune_package sctx pkg =
         ; dir =
             Path.build
               (Config.local_install_lib_dir ~context:ctx.name ~package:name)
-        ; share = None
-        ; lib = None
+        ; sites = Section.Map.empty
         }
       in
       Build.write_file

src/dune/section.ml

@@ -18,6 +18,7 @@ type t =
 
 let compare : t -> t -> Ordering.t = Poly.compare
 
+
 let to_dyn x =
   let open Dyn.Encoder in
   match x with
@@ -36,6 +37,11 @@ let to_dyn x =
   | Man -> constr "Man" []
   | Misc -> constr "Misc" []
 
+module Key = struct type nonrec t = t let compare = compare let to_dyn = to_dyn end
+module O = Comparable.Make (Key)
+module Map = O.Map
+module Set = O.Set
+
 
 let to_string = function
   | Lib -> "lib"
@@ -93,3 +99,8 @@ let decode =
     ; ("man", Man)
     ; ("misc", Misc)
     ]
+
+
+let encode v =
+  let open Dune_lang.Encoder in
+  string (to_string v)

src/dune/section.mli

@@ -18,11 +18,14 @@ type t =
 
 val compare: t -> t -> Ordering.t
 
+include Comparable_intf.S with type Key.t = t
+
 val to_string : t -> string
 val of_string : string -> t option
 
 val parse_string : string -> (t, string) Result.t
 
 val decode : t Dune_lang.Decoder.t
+val encode : t Dune_lang.Encoder.t
 
 val to_dyn : t -> Dyn.t