Make build-package work

bin/main.ml

@@ -34,8 +34,8 @@ let set_common c =
 module Main = struct
   include Jbuilder.Main
 
-  let setup common =
-    setup ?workspace_file:common.workspace_file ()
+  let setup ?only_package common =
+    setup ?workspace_file:common.workspace_file ?only_package ()
 end
 
 let create_log = Main.create_log
@@ -208,7 +208,7 @@ let resolve_package_install setup pkg =
 
 let build_package common pkg =
   Future.Scheduler.go ~log:(create_log ())
-    (Main.setup common >>= fun setup ->
+    (Main.setup common ~only_package:pkg >>= fun setup ->
      Build_system.do_build_exn setup.build_system
        [resolve_package_install setup pkg])
 

src/build.ml

@@ -301,12 +301,14 @@ let symlink ~src ~dst =
           Path.reach ~from:(Path.parent dst) src
       in
       let dst = Path.to_string dst in
-      begin
-        match Unix.lstat dst with
-        | exception _ -> ()
-        | _ -> Sys.remove dst
-      end;
-      Unix.symlink src dst)
+      match Unix.readlink dst with
+      | target ->
+        if target <> src then begin
+          Unix.unlink dst;
+          Unix.symlink src dst
+        end
+      | exception _ ->
+        Unix.symlink src dst)
 
 let touch target =
   create_file ~target (fun _ ->

src/build_system.ml

@@ -322,13 +322,17 @@ let remove_old_artifacts t =
       Path.readdir dir
       |> List.filter ~f:(fun fn ->
         let fn = Path.relative dir fn in
-        if Path.is_directory fn then
+        match Unix.lstat (Path.to_string fn) with
+        | { st_kind = S_DIR; _ } ->
           walk fn
-        else begin
+        | exception _ ->
           let keep = Hashtbl.mem t.files fn in
           if not keep then Path.unlink fn;
           keep
-        end)
+        | _ ->
+          let keep = Hashtbl.mem t.files fn in
+          if not keep then Path.unlink fn;
+          keep)
       |> function
       | [] -> false
       | _  -> true

src/gen_rules.ml

@@ -1789,12 +1789,27 @@ module Gen(P : Params) = struct
       end)
 end
 
-let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true) conf =
+let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true)
+      ?only_package conf =
   let open Future in
   let { Jbuild_load. file_tree; tree; jbuilds; packages } = conf in
   let alias_store = Alias.Store.create () in
   List.map contexts ~f:(fun context ->
     Jbuild_load.Jbuilds.eval ~context jbuilds >>| fun stanzas ->
+    let stanzas =
+      match only_package with
+      | None -> stanzas
+      | Some pkg ->
+        List.map stanzas ~f:(fun (dir, stanzas) ->
+          (dir,
+           List.filter stanzas ~f:(fun stanza ->
+             match (stanza : Stanza.t) with
+             | Library { public_name = Some name; _ }
+             | Executables { object_public_name = Some name; _ } ->
+               Findlib.root_package_name name = pkg
+             | Install { package = Some name; _ } -> name = pkg
+             | _ -> true)))
+    in
     let module M =
       Gen(struct
         let context  = context

src/gen_rules.mli

@@ -3,5 +3,6 @@ open! Import
 val gen
   :  contexts:Context.t list
   -> ?filter_out_optional_stanzas_with_missing_deps:bool (** default: true *)
+  -> ?only_package:string
   -> Jbuild_load.conf
   -> Build_interpret.Rule.t list Future.t

src/main.ml

@@ -14,7 +14,8 @@ let package_install_file { packages; _ } pkg =
   | Some p -> Ok (Path.relative p.path (p.name ^ ".install"))
 
 let setup ?filter_out_optional_stanzas_with_missing_deps
-      ?workspace ?(workspace_file="jbuild-workspace") () =
+      ?workspace ?(workspace_file="jbuild-workspace")
+      ?only_package () =
   let conf = Jbuild_load.load () in
   let workspace =
     match workspace with
@@ -33,6 +34,7 @@ let setup ?filter_out_optional_stanzas_with_missing_deps
        Context.create_for_opam ~name ~switch ?root ~merlin ()))
   >>= fun contexts ->
   Gen_rules.gen conf ~contexts
+    ?only_package
     ?filter_out_optional_stanzas_with_missing_deps
   >>= fun rules ->
   let build_system = Build_system.create ~contexts ~file_tree:conf.file_tree ~rules in

src/main.mli

@@ -14,6 +14,7 @@ val setup
   :  ?filter_out_optional_stanzas_with_missing_deps:bool
   -> ?workspace:Workspace.t
   -> ?workspace_file:string
+  -> ?only_package:string
   -> unit
   -> setup Future.t
 val external_lib_deps

src/path.ml

@@ -267,6 +267,6 @@ let exists t = Sys.file_exists (to_string t)
 let readdir t = Sys.readdir (to_string t) |> Array.to_list
 let is_directory t = Sys.is_directory (to_string t)
 let rmdir t = Unix.rmdir (to_string t)
-let unlink t = Sys.remove (to_string t)
+let unlink t = Unix.unlink (to_string t)
 
 let extend_basename t ~suffix = t ^ suffix