[Sites] Better localisation of error

        Fixes ocaml#4325

Signed-off-by: François Bobot <francois.bobot@cea.fr>

otherlibs/site/test/run.t

@@ -415,6 +415,20 @@ Test %{version:installed-pkg}
 Test error location
 ---------------------------------
 
+  $ cat >>a/dune <<EOF
+  > (install
+  >  (section (site (non-existent foo)))
+  >  (files a.ml)
+  > )
+  > EOF
+
+  $ dune build @install
+  File "a/dune", line 6, characters 16-34:
+  6 |  (section (site (non-existent foo)))
+                      ^^^^^^^^^^^^^^^^^^
+  Error: The package non-existent is not found
+  [1]
+
   $ cat >a/dune <<EOF
   > (library
   >  (public_name a)

src/dune_engine/install.ml

@@ -86,6 +86,7 @@ module Section_with_site = struct
     | Site of
         { pkg : Package.Name.t
         ; site : Section.Site.t
+        ; loc : Loc.t
         }
 
   (* let compare : t -> t -> Ordering.t = Poly.compare *)
@@ -94,12 +95,12 @@ module Section_with_site = struct
     let open Dyn.Encoder in
     match x with
     | Section s -> constr "Section" [ Section.to_dyn s ]
-    | Site { pkg; site } ->
+    | Site { pkg; site; loc = _ } ->
       constr "Section" [ Package.Name.to_dyn pkg; Section.Site.to_dyn site ]
 
   let to_string = function
     | Section s -> Section.to_string s
-    | Site { pkg; site } ->
+    | Site { pkg; site; loc = _ } ->
       sprintf "(site %s %s)"
         (Package.Name.to_string pkg)
         (Section.Site.to_string site)
@@ -111,15 +112,15 @@ module Section_with_site = struct
        |> List.map ~f:(fun (k, d) -> (k, return (Section d))))
       @ [ ( "site"
           , Dune_lang.Syntax.since Section.dune_site_syntax (0, 1)
-            >>> pair Package.Name.decode Section.Site.decode
-            >>| fun (pkg, site) -> Site { pkg; site } )
+            >>> located (pair Package.Name.decode Section.Site.decode)
+            >>| fun (loc, (pkg, site)) -> Site { pkg; site; loc } )
         ])
 
   let encode =
     let open Dune_lang.Encoder in
     function
     | Section s -> Section.encode s
-    | Site { pkg; site } ->
+    | Site { pkg; site; loc = _ } ->
       constr "site" (pair Package.Name.encode Section.Site.encode) (pkg, site)
 end
 
@@ -275,8 +276,8 @@ module Entry = struct
   let make_with_site section ?dst get_section src =
     match section with
     | Section_with_site.Section section -> make section ?dst src
-    | Site { pkg; site } ->
-      let section = get_section ~pkg ~site in
+    | Site { pkg; site; loc } ->
+      let section = get_section ~loc ~pkg ~site in
       let dst = adjust_dst' ~src ~dst ~section in
       let dst = Dst.add_prefix (Section.Site.to_string site) dst in
       let dst_with_pkg_prefix =

src/dune_engine/install.mli

@@ -21,6 +21,7 @@ module Section_with_site : sig
     | Site of
         { pkg : Package.Name.t
         ; site : Section.Site.t
+        ; loc : Loc.t
         }
 
   val to_string : t -> string
@@ -83,7 +84,10 @@ module Entry : sig
   val make_with_site :
        Section_with_site.t
     -> ?dst:string
-    -> (pkg:Package.Name.t -> site:Dune_section.Site.t -> Section.t)
+    -> (   loc:Loc.t
+        -> pkg:Package.Name.t
+        -> site:Dune_section.Site.t
+        -> Section.t)
     -> Path.Build.t
     -> Path.Build.t t
 

src/dune_rules/plugin_rules.ml

@@ -41,7 +41,7 @@ let install_rules ~sctx ~dir ({ name; site = loc, (pkg, site); _ } as t) =
     [ ( Some loc
       , Install.Entry.make_with_site
           ~dst:(sprintf "%s/%s" (Package.Name.to_string name) Findlib.meta_fn)
-          (Site { pkg; site })
+          (Site { pkg; site; loc })
           (Super_context.get_site_of_packages sctx)
           meta )
     ]

src/dune_rules/super_context.ml

@@ -256,12 +256,12 @@ let any_package_aux ~packages ~context pkg =
 let any_package t pkg =
   any_package_aux ~packages:t.packages ~context:t.context pkg
 
-let get_site_of_packages_aux ~any_package ~pkg ~site =
+let get_site_of_packages_aux ~loc ~any_package ~pkg ~site =
   let find_site sites ~pkg ~site =
     match Section.Site.Map.find sites site with
     | Some section -> section
     | None ->
-      User_error.raise
+      User_error.raise ~loc
         [ Pp.textf "Package %s doesn't define a site %s"
             (Package.Name.to_string pkg)
             (Section.Site.to_string site)
@@ -271,11 +271,11 @@ let get_site_of_packages_aux ~any_package ~pkg ~site =
   | Some (Expander.Local p) -> find_site p.Package.sites ~pkg ~site
   | Some (Expander.Installed p) -> find_site p.sites ~pkg ~site
   | None ->
-    User_error.raise
+    User_error.raise ~loc
       [ Pp.textf "The package %s is not found" (Package.Name.to_string pkg) ]
 
-let get_site_of_packages t ~pkg ~site =
-  get_site_of_packages_aux ~any_package:(any_package t) ~pkg ~site
+let get_site_of_packages t ~loc ~pkg ~site =
+  get_site_of_packages_aux ~loc ~any_package:(any_package t) ~pkg ~site
 
 let lib_entries_of_package t pkg_name =
   Package.Name.Map.find t.lib_entries_by_package pkg_name
@@ -583,15 +583,15 @@ let create ~(context : Context.t) ~host ~projects ~packages ~stanzas =
   let package_sections =
     Dir_with_dune.deep_fold stanzas ~init:Package.Name.Map.empty
       ~f:(fun _ stanza acc ->
-        let add_in_package_sites acc pkg site =
-          let section = get_site_of_packages_aux ~any_package ~pkg ~site in
+        let add_in_package_sites acc pkg site loc =
+          let section = get_site_of_packages_aux ~loc ~any_package ~pkg ~site in
           add_in_package_section acc pkg section
         in
         match stanza with
-        | Dune_file.Install { section = Site { pkg; site }; _ } ->
-          add_in_package_sites acc pkg site
-        | Dune_file.Plugin { site = _, (pkg, site); _ } ->
-          add_in_package_sites acc pkg site
+        | Dune_file.Install { section = Site { pkg; site; loc }; _ } ->
+          add_in_package_sites acc pkg site loc
+        | Dune_file.Plugin { site = loc, (pkg, site); _ } ->
+          add_in_package_sites acc pkg site loc
         | _ -> acc)
   in
   (* Add the site of the local package: it should only useful for making sure

src/dune_rules/super_context.mli

@@ -37,7 +37,7 @@ val host : t -> t
 val any_package : t -> Package.Name.t -> Expander.any_package option
 
 val get_site_of_packages :
-  t -> pkg:Package.Name.t -> site:Section.Site.t -> Section.t
+  t -> loc:Loc.t -> pkg:Package.Name.t -> site:Section.Site.t -> Section.t
 
 module Lib_entry : sig
   type t =