Don't require packages to be defined at the root

To match the manual

bin/main.ml

@@ -2,6 +2,7 @@ open Jbuilder
 open Import
 open Jbuilder_cmdliner.Cmdliner
 
+module Suggest = Jbuilder_cmdliner.Cmdliner_suggest
 module Main = Jbuilder.Main
 
 let (>>=) = Future.(>>=)
@@ -74,8 +75,25 @@ let common =
 
 let build_package pkg =
   Future.Scheduler.go ~log:(create_log ())
-    (Main.setup () >>= fun (bs, _, _) ->
+    (Main.setup () >>= fun setup ->
-     Build_system.do_build_exn bs [Path.(relative root) (pkg ^ ".install")])
+     match Main.package_install_file setup pkg with
+     | Ok path ->
+       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)
+    )
 
 let build_package =
   let doc = "build a package in release mode" in
@@ -112,7 +130,7 @@ let external_lib_deps =
           $ Arg.(non_empty & pos_all string [] name_))
   , Term.info "external-lib-deps" ~doc ~man:help_secs)
 
-let resolve_targets bs (ctx : Context.t) user_targets =
+let resolve_targets (setup : Main.setup)user_targets =
   match user_targets with
   | [] -> []
   | _ ->
@@ -122,9 +140,9 @@ let resolve_targets bs (ctx : Context.t) user_targets =
         if Path.is_in_build_dir path then
           path
         else if Path.is_local path &&
-                not (Build_system.is_target bs path) &&
+                not (Build_system.is_target setup.build_system path) &&
                 not (Path.exists path) then
-          Path.append ctx.build_dir path
+          Path.append setup.context.build_dir path
         else
           path)
     in
@@ -140,9 +158,9 @@ let build_targets ~name =
   let go common targets =
     set_common common;
     Future.Scheduler.go ~log:(create_log ())
-      (Main.setup () >>= fun (bs, _, ctx) ->
+      (Main.setup () >>= fun setup ->
-       let targets = resolve_targets bs ctx targets in
+       let targets = resolve_targets setup targets in
-       Build_system.do_build_exn bs targets) in
+       Build_system.do_build_exn setup.build_system targets) in
   ( Term.(const go
           $ common
           $ Arg.(non_empty & pos_all string [] name_))
@@ -154,7 +172,7 @@ let runtest =
   let go common dirs =
     set_common common;
     Future.Scheduler.go ~log:(create_log ())
-      (Main.setup () >>= fun (bs, _, ctx) ->
+      (Main.setup () >>= fun setup ->
        let dirs =
          match dirs with
          | [] -> [Path.root]
@@ -166,11 +184,11 @@ let runtest =
              if Path.is_in_build_dir dir then
                dir
              else
-               Path.append ctx.build_dir dir
+               Path.append setup.context.build_dir dir
            in
            Alias.file (Alias.runtest ~dir))
        in
-       Build_system.do_build_exn bs targets) in
+       Build_system.do_build_exn setup.build_system targets) in
   ( Term.(const go
           $ common
           $ Arg.(value & pos_all string [] name_))

src/file_tree.ml

@@ -65,3 +65,12 @@ let fold t ~init ~f =
 
 let find_dir t path =
   Path.Map.find path t.dirs
+
+let file_exists t path fn =
+  match Path.Map.find path t.dirs with
+  | None -> false
+  | Some { files; _ } -> String_set.mem fn files
+
+let exists t path =
+  Path.Map.mem path t.dirs ||
+  file_exists t (Path.parent path) (Path.basename path)

src/file_tree.mli

@@ -18,3 +18,6 @@ val fold : t -> init:'a -> f:(Dir.t -> 'a -> 'a) -> 'a
 val root : t -> Dir.t
 
 val find_dir : t -> Path.t -> Dir.t option
+
+val exists : t -> Path.t -> bool
+val file_exists : t -> Path.t -> string -> bool

src/gen_rules.ml

@@ -73,7 +73,7 @@ module type Params = sig
   val file_tree : File_tree.t
   val tree      : Alias.tree
   val stanzas   : (Path.t * Jbuild_types.Stanza.t list) list
-  val packages  : string list
+  val packages  : Path.t String_map.t
   val filter_out_optional_stanzas_with_missing_deps : bool
 end
 
@@ -1367,15 +1367,17 @@ module Gen(P : Params) = struct
         List.map stanzas ~f:(fun s -> (ctx_dir, s)))
 
   let () =
-    List.iter P.packages ~f:(fun package ->
+    String_map.iter P.packages ~f:(fun ~key:package ~data:src_path ->
+      let path = Path.append ctx.build_dir src_path in
       let meta_fn = "META." ^ package in
-      let meta_path = Path.relative ctx.build_dir meta_fn in
+      let meta_path = Path.relative path meta_fn in
-      let templ_fn = meta_fn ^ ".template" in
       let template =
-        if Sys.file_exists templ_fn then
+        let templ_fn = meta_fn ^ ".template" in
-          Build.path (Path.(relative root) templ_fn)
+        let templ_path = Path.relative src_path templ_fn in
+        if File_tree.exists P.file_tree templ_path then
+          Build.path templ_path
           >>^ fun () ->
-          lines_of_file templ_fn
+          lines_of_file (Path.to_string templ_path)
         else
           Build.return ["# JBUILDER_GEN"]
       in
@@ -1543,7 +1545,7 @@ module Gen(P : Params) = struct
     List.exists [ "README"; "LICENSE"; "CHANGE"; "HISTORY"]
       ~f:(fun prefix -> String.is_prefix fn ~prefix)
 
-  let install_file package =
+  let install_file package_path package =
     let entries =
       List.concat_map stanzas_to_consider_for_install ~f:(fun (dir, stanza) ->
         match stanza with
@@ -1576,18 +1578,15 @@ module Gen(P : Params) = struct
           acc)
     in
     let entries =
-      let opam = Path.of_string "opam" in
+      let opam = Path.relative package_path (package ^ ".opam") in
-      if Path.exists opam then
+      Install.Entry.make Lib opam ~dst:"opam" :: entries
-        Install.Entry.make Lib opam :: entries
-      else
-        entries
     in
     let entries =
       let meta_fn = "META." ^ package in
-      if Sys.file_exists meta_fn                 ||
+      if File_tree.file_exists P.file_tree package_path meta_fn ||
-         Sys.file_exists (meta_fn ^ ".template") ||
+         File_tree.file_exists P.file_tree package_path (meta_fn ^ ".template") ||
          List.exists entries ~f:(fun (e : Install.Entry.t) -> e.section = Lib) then
-        let meta = Path.relative ctx.build_dir meta_fn in
+        let meta = Path.append ctx.build_dir (Path.relative package_path meta_fn) in
         Install.Entry.make Lib meta ~dst:"META" :: entries
       else
         entries
@@ -1598,16 +1597,17 @@ module Gen(P : Params) = struct
        Build.create_file ~target:fn (fun () ->
          Install.write_install_file fn entries))
 
-  let () = List.iter P.packages ~f:install_file
+  let () = String_map.iter P.packages ~f:(fun ~key:package ~data:package_path ->
+    install_file package_path package)
 
   let () =
     if Path.basename ctx.build_dir = "default" then
-      List.iter P.packages ~f:(fun pkg ->
+      String_map.iter P.packages ~f:(fun ~key:pkg ~data:path ->
-        let fn = pkg ^ ".install" in
+        let install_file = Path.relative path (pkg ^ ".install") in
         add_rule
           (Build.copy
-             ~src:(Path.relative ctx.build_dir fn)
+             ~src:(Path.append ctx.build_dir install_file)
-             ~dst:(Path.relative Path.root     fn)))
+             ~dst:install_file))
 end
 
 let gen ~context ~file_tree ~tree ~stanzas ~packages

src/gen_rules.mli

@@ -1,9 +1,11 @@
+open Import
+
 val gen
   :  context:Context.t
   -> file_tree:File_tree.t
   -> tree:Alias.tree
   -> stanzas:(Path.t * Jbuild_types.Stanza.t list) list
-  -> packages:string list
+  -> packages:Path.t String_map.t
   -> ?filter_out_optional_stanzas_with_missing_deps:bool (** default: true *)
   -> unit
   -> (unit, unit) Build.t list

src/jbuild_load.ml

@@ -5,13 +5,13 @@ type conf =
   { file_tree : File_tree.t
   ; tree      : Alias.tree
   ; stanzas   : (Path.t * Jbuild_types.Stanza.t list) list
-  ; packages  : string list
+  ; packages  : Path.t String_map.t
   }
 
 let load fn ~dir = (dir, Sexp_load.many fn Stanza.t)
 
 let load () =
-  let rec walk dir stanzas =
+  let rec walk dir stanzas 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
@@ -22,14 +22,15 @@ let load () =
             (lines_of_file (Path.to_string (Path.relative path "jbuild-ignore")))
         in
         String_map.filter sub_dirs ~f:(fun fn _ ->
-            not (String_set.mem fn ignore_set))
+          not (String_set.mem fn ignore_set))
       else
         sub_dirs
     in
-    let children, stanzas =
+    let children, stanzas, packages =
-      String_map.fold sub_dirs ~init:([], stanzas) ~f:(fun ~key:_ ~data:dir (children, stanzas) ->
+      String_map.fold sub_dirs ~init:([], stanzas, [])
-          let child, stanzas = walk dir stanzas in
+        ~f:(fun ~key:_ ~data:dir (children, stanzas, packages) ->
-          (child :: children, stanzas))
+          let child, stanzas, packages = walk dir stanzas packages in
+          (child :: children, stanzas, packages))
     in
     let stanzas =
       if String_set.mem "jbuild" files then
@@ -37,16 +38,28 @@ let load () =
       else
         stanzas
     in
-    (Alias.Node (path, children), stanzas)
+    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)
   in
   let ftree = File_tree.load Path.root in
   let root = File_tree.root ftree in
-  let tree, stanzas = walk root [] in
+  let tree, stanzas, packages = walk root [] [] in
   let packages =
-    String_set.fold (File_tree.Dir.files root) ~init:[] ~f:(fun fn acc ->
+    String_map.of_alist_multi packages
-      match Filename.split_ext fn with
+    |> String_map.mapi ~f:(fun pkg dirs ->
-      | Some (pkg, ".opam") -> pkg :: acc
+      match dirs with
-      | _ -> acc)
+      | [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
   { file_tree = ftree
   ; tree

src/jbuild_load.mli

@@ -1,9 +1,10 @@
+open Import
 
 type conf =
   { file_tree : File_tree.t
   ; tree      : Alias.tree
   ; stanzas   : (Path.t * Jbuild_types.Stanza.t list) list
-  ; packages  : string list
+  ; packages  : Path.t String_map.t
   }
 
 val load : unit -> conf

src/main.ml

@@ -1,24 +1,44 @@
 open Import
 open Future
 
+type setup =
+  { build_system : Build_system.t
+  ; stanzas      : (Path.t * Jbuild_types.Stanza.t list) list
+  ; context      : Context.t
+  ; packages     : Path.t String_map.t
+  }
+
+let package_install_file { packages; _ } pkg =
+  match String_map.find pkg packages with
+  | None -> Error ()
+  | Some path -> Ok (Path.relative path (pkg ^ ".install"))
+
 let setup ?filter_out_optional_stanzas_with_missing_deps () =
   let { Jbuild_load. file_tree; tree; stanzas; packages } = Jbuild_load.load () in
-  Lazy.force Context.default >>= fun ctx ->
+  Lazy.force Context.default >>= fun context ->
   let rules =
-    Gen_rules.gen ~context:ctx ~file_tree ~tree ~stanzas ~packages
+    Gen_rules.gen ~context ~file_tree ~tree ~stanzas ~packages
       ?filter_out_optional_stanzas_with_missing_deps ()
   in
-  let bs = Build_system.create ~file_tree ~rules in
+  let build_system = Build_system.create ~file_tree ~rules in
-  return (bs, stanzas, ctx)
+  return { build_system
+         ; stanzas
+         ; context
+         ; packages
+         }
 
 let external_lib_deps ?log ~packages =
   Future.Scheduler.go ?log
     (setup () ~filter_out_optional_stanzas_with_missing_deps:false
-     >>| fun (bs, stanzas, _) ->
+     >>| fun ({ build_system = bs; stanzas; _ } as setup) ->
+     let install_files =
+       List.map packages ~f:(fun pkg ->
+         match package_install_file setup pkg with
+         | Ok path -> path
+         | Error () -> die "Unknown package %S" pkg)
+     in
      Path.Map.map
-       (Build_system.all_lib_deps bs
+       (Build_system.all_lib_deps bs install_files)
-          (List.map packages ~f:(fun pkg ->
-             Path.(relative root) (pkg ^ ".install"))))
        ~f:(fun deps ->
          let internals = Jbuild_types.Stanza.lib_names stanzas in
          String_map.filter deps ~f:(fun name _ -> not (String_set.mem name internals))))
@@ -80,7 +100,7 @@ let bootstrap () =
     Arg.parse [ "-j", Set_int Clflags.concurrency, "JOBS concurrency" ]
       anon "Usage: boot.exe [-j JOBS]\nOptions are:";
     Future.Scheduler.go ~log:(create_log ())
-      (setup () >>= fun (bs, _, _) ->
+      (setup () >>= fun { build_system = bs; _ } ->
        Build_system.do_build_exn bs [Path.(relative root) (pkg ^ ".install")])
   in
   try

src/main.mli

@@ -1,9 +1,19 @@
 open! Import
+
+type setup =
+  { build_system : Build_system.t
+  ; stanzas      : (Path.t * Jbuild_types.Stanza.t list) list
+  ; context      : Context.t
+  ; packages     : Path.t String_map.t
+  }
+
+(* Returns [Error ()] if [pkg] is unknown *)
+val package_install_file : setup -> string -> (Path.t, unit) result
+
 val setup
   :  ?filter_out_optional_stanzas_with_missing_deps:bool
   -> unit
-  -> (Build_system.t * (Path.t * Jbuild_types.Stanza.t list) list * Context.t)
+  -> setup Future.t
-       Future.t
 val external_lib_deps
   : ?log:out_channel
   -> packages:string list