Check that packages are correctly specified in jbuilds

bin/main.ml

@@ -2,9 +2,12 @@ open Jbuilder
 open Import
 open Jbuilder_cmdliner.Cmdliner
 
-module Suggest = Jbuilder_cmdliner.Cmdliner_suggest
 module Main = Jbuilder.Main
 
+(* Things in src/ don't depend on cmdliner to speed up the bootstrap, so we set this
+   reference here *)
+let () = suggest_function := Jbuilder_cmdliner.Cmdliner_suggest.value
+
 let (>>=) = Future.(>>=)
 
 let create_log = Main.create_log
@@ -81,18 +84,7 @@ let build_package pkg =
        Build_system.do_build_exn setup.build_system
          [path]
      | Error () ->
-       match Suggest.value pkg (String_map.keys setup.packages) with
-       | [] -> die "Unknown package %s!" pkg
-       | pkgs ->
-         let rec mk_hint = function
-           | [a; b] -> sprintf "%s or %s" a b
-           | [a] -> a
-           | a :: l -> sprintf "%s, %s" a (mk_hint l)
-           | [] -> ""
-         in
-         die "Unknown package %s!\nHint: did you mean %s?"
-           pkg
-           (mk_hint pkgs)
+       die "Unknown package %s!%s" pkg (hint pkg (String_map.keys setup.packages))
     )
 
 let build_package =

src/gen_rules.ml

@@ -1555,13 +1555,9 @@ module Gen(P : Params) = struct
         | Executables ({ object_public_name = Some name; _ } as exes)
           when Findlib.root_package_name name = package ->
           obj_install_files ~dir exes
-        | Install { section; files; package = p } -> begin
-            match p with
-            | Some p when p <> package -> []
-            | _ ->
-              List.map files ~f:(fun { Install_conf. src; dst } ->
-                Install.Entry.make section (Path.relative dir src) ?dst)
-          end
+        | Install { section; files; package = Some p } when p = package ->
+          List.map files ~f:(fun { Install_conf. src; dst } ->
+            Install.Entry.make section (Path.relative dir src) ?dst)
         | _ -> [])
     in
     let entries =

src/import.ml

@@ -363,3 +363,17 @@ let quote_for_shell s =
         | _ -> loop (i + 1)
     in
     loop 0
+
+let suggest_function : (string -> string list -> string list) ref = ref (fun _ _ -> [])
+
+let hint name candidates =
+  match !suggest_function name candidates with
+  | [] -> ""
+  | l ->
+    let rec mk_hint = function
+      | [a; b] -> sprintf "%s or %s" a b
+      | [a] -> a
+      | a :: l -> sprintf "%s, %s" a (mk_hint l)
+      | [] -> ""
+    in
+    sprintf "\nHint: did you mean %s?" (mk_hint l)

src/jbuild_load.ml

@@ -8,13 +8,47 @@ type conf =
   ; packages  : Path.t String_map.t
   }
 
-let load fn ~dir = (dir, Sexp_load.many fn Stanza.t)
+let load ~dir ~visible_packages =
+  let stanzas = Sexp_load.many (Path.relative dir "jbuild" |> Path.to_string) Stanza.t in
+  let stanzas = Stanza.resolve_packages stanzas ~dir ~visible_packages in
+  (dir, stanzas)
 
 let load () =
-  let rec walk dir stanzas packages =
+  let ftree = File_tree.load Path.root in
+  let packages =
+    File_tree.fold ftree ~init:[] ~f:(fun dir acc ->
+      let path = File_tree.Dir.path dir in
+      String_set.fold (File_tree.Dir.files dir) ~init:acc ~f:(fun fn acc ->
+        match Filename.split_ext fn with
+        | Some (pkg, ".opam") -> (pkg, path) :: acc
+        | _ -> acc))
+    |> String_map.of_alist_multi
+    |> String_map.mapi ~f:(fun pkg dirs ->
+      match dirs with
+      | [dir] -> dir
+      | _ ->
+        die "Too many opam files for package %S:\n%s"
+          pkg
+          (String.concat ~sep:"\n"
+             (List.map dirs ~f:(fun dir ->
+                sprintf "- %s.opam" (Path.to_string dir)))))
+  in
+  let packages_per_dir =
+    String_map.bindings packages
+    |> List.map ~f:(fun (pkg, path) -> (path, pkg))
+    |> Path.Map.of_alist_multi
+  in
+  let rec walk dir stanzas visible_packages =
     let path = File_tree.Dir.path dir in
     let files = File_tree.Dir.files dir in
     let sub_dirs = File_tree.Dir.sub_dirs dir in
+    let visible_packages =
+      match Path.Map.find path packages_per_dir with
+      | None -> visible_packages
+      | Some pkgs ->
+        List.fold_left pkgs ~init:visible_packages ~f:(fun acc pkg ->
+          String_map.add acc ~key:pkg ~data:path)
+    in
     let sub_dirs =
       if String_set.mem "jbuild-ignore" files then
         let ignore_set =
@@ -26,41 +60,23 @@ let load () =
       else
         sub_dirs
     in
-    let children, stanzas, packages =
-      String_map.fold sub_dirs ~init:([], stanzas, [])
-        ~f:(fun ~key:_ ~data:dir (children, stanzas, packages) ->
-          let child, stanzas, packages = walk dir stanzas packages in
-          (child :: children, stanzas, packages))
+    let children, stanzas =
+      String_map.fold sub_dirs ~init:([], stanzas)
+        ~f:(fun ~key:_ ~data:dir (children, stanzas) ->
+          let child, stanzas = walk dir stanzas visible_packages in
+          (child :: children, stanzas))
     in
     let stanzas =
       if String_set.mem "jbuild" files then
-        load (Path.to_string (Path.relative path "jbuild")) ~dir:path :: stanzas
+        load ~dir:path ~visible_packages
+        :: stanzas
       else
         stanzas
     in
-    let packages =
-      String_set.fold files ~init:packages ~f:(fun fn acc ->
-        match Filename.split_ext fn with
-        | Some (pkg, ".opam") -> (pkg, path) :: acc
-        | _ -> acc)
-    in
-    (Alias.Node (path, children), stanzas, packages)
+    (Alias.Node (path, children), stanzas)
   in
-  let ftree = File_tree.load Path.root in
   let root = File_tree.root ftree in
-  let tree, stanzas, packages = walk root [] [] in
-  let packages =
-    String_map.of_alist_multi packages
-    |> String_map.mapi ~f:(fun pkg dirs ->
-      match dirs with
-      | [dir] -> dir
-      | _ ->
-        die "Too many opam files for package %S:\n%s"
-          pkg
-          (String.concat ~sep:"\n"
-             (List.map dirs ~f:(fun dir ->
-                sprintf "- %s.opam" (Path.to_string dir)))))
-  in
+  let tree, stanzas = walk root [] String_map.empty in
   { file_tree = ftree
   ; tree
   ; stanzas

src/jbuild_types.ml

@@ -694,4 +694,54 @@ module Stanza = struct
              | None -> acc
              | Some n -> String_set.add n acc)
         | _ -> acc))
+
+  let resolve_packages ts ~dir ~visible_packages =
+    let error fmt =
+      die ("File \"%s\", line 1, characters 0-0:\n\
+            Error: " ^^ fmt)
+        (Path.to_string (Path.relative dir "jbuild"))
+    in
+    let known_packages () =
+      let visible_packages = String_map.bindings visible_packages in
+      let longest_pkg =
+        List.fold_left visible_packages ~init:0 ~f:(fun acc (pkg, _) ->
+          max (String.length pkg) acc)
+      in
+      String.concat ~sep:"\n"
+        (List.map visible_packages ~f:(fun (pkg, dir) ->
+           sprintf "- %-*s (because of %s)" longest_pkg pkg
+             (Path.to_string (Path.relative dir (pkg ^ ".opam")))))
+    in
+    let check pkg =
+      if not (String_map.mem pkg visible_packages) then
+        error "package %S is not visible here.\n\
+               The only packages I know of in %S are:\n\
+               %s%s"
+          pkg
+          (Path.to_string dir)
+          (known_packages ())
+          (hint pkg (String_map.keys visible_packages))
+    in
+    let default () =
+      match String_map.keys visible_packages with
+      | [pkg] -> pkg
+      | [] -> error "no packages are defined here"
+      | pkgs ->
+        error "there is more than one package visible here:\n\
+               %s\n\
+               You need to add a (package ...) field in your (install ...) stanzas"
+          (known_packages ())
+    in
+    List.map ts ~f:(fun stanza ->
+      match stanza with
+      | Library { public_name = Some name; _ }
+      | Executables { object_public_name = Some name; _ } ->
+        check (Findlib.root_package_name name);
+        stanza
+      | Install { package = Some pkg; _ } ->
+        check pkg;
+        stanza
+      | Install ({ package = None; _ } as install) ->
+        Install { install with package = Some (default ()) }
+      | _ -> stanza)
 end