Make build-package work
This commit is contained in:
parent
ddd7f182f1
commit
4ee2e74131
|
@ -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])
|
||||
|
||||
|
|
14
src/build.ml
14
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 _ ->
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue