Make build-package work
This commit is contained in:
parent
ddd7f182f1
commit
4ee2e74131
|
@ -34,8 +34,8 @@ let set_common c =
|
||||||
module Main = struct
|
module Main = struct
|
||||||
include Jbuilder.Main
|
include Jbuilder.Main
|
||||||
|
|
||||||
let setup common =
|
let setup ?only_package common =
|
||||||
setup ?workspace_file:common.workspace_file ()
|
setup ?workspace_file:common.workspace_file ?only_package ()
|
||||||
end
|
end
|
||||||
|
|
||||||
let create_log = Main.create_log
|
let create_log = Main.create_log
|
||||||
|
@ -208,7 +208,7 @@ let resolve_package_install setup pkg =
|
||||||
|
|
||||||
let build_package common pkg =
|
let build_package common pkg =
|
||||||
Future.Scheduler.go ~log:(create_log ())
|
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
|
Build_system.do_build_exn setup.build_system
|
||||||
[resolve_package_install setup pkg])
|
[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
|
Path.reach ~from:(Path.parent dst) src
|
||||||
in
|
in
|
||||||
let dst = Path.to_string dst in
|
let dst = Path.to_string dst in
|
||||||
begin
|
match Unix.readlink dst with
|
||||||
match Unix.lstat dst with
|
| target ->
|
||||||
| exception _ -> ()
|
if target <> src then begin
|
||||||
| _ -> Sys.remove dst
|
Unix.unlink dst;
|
||||||
end;
|
Unix.symlink src dst
|
||||||
Unix.symlink src dst)
|
end
|
||||||
|
| exception _ ->
|
||||||
|
Unix.symlink src dst)
|
||||||
|
|
||||||
let touch target =
|
let touch target =
|
||||||
create_file ~target (fun _ ->
|
create_file ~target (fun _ ->
|
||||||
|
|
|
@ -322,13 +322,17 @@ let remove_old_artifacts t =
|
||||||
Path.readdir dir
|
Path.readdir dir
|
||||||
|> List.filter ~f:(fun fn ->
|
|> List.filter ~f:(fun fn ->
|
||||||
let fn = Path.relative dir fn in
|
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
|
walk fn
|
||||||
else begin
|
| exception _ ->
|
||||||
let keep = Hashtbl.mem t.files fn in
|
let keep = Hashtbl.mem t.files fn in
|
||||||
if not keep then Path.unlink fn;
|
if not keep then Path.unlink fn;
|
||||||
keep
|
keep
|
||||||
end)
|
| _ ->
|
||||||
|
let keep = Hashtbl.mem t.files fn in
|
||||||
|
if not keep then Path.unlink fn;
|
||||||
|
keep)
|
||||||
|> function
|
|> function
|
||||||
| [] -> false
|
| [] -> false
|
||||||
| _ -> true
|
| _ -> true
|
||||||
|
|
|
@ -1789,12 +1789,27 @@ module Gen(P : Params) = struct
|
||||||
end)
|
end)
|
||||||
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 open Future in
|
||||||
let { Jbuild_load. file_tree; tree; jbuilds; packages } = conf in
|
let { Jbuild_load. file_tree; tree; jbuilds; packages } = conf in
|
||||||
let alias_store = Alias.Store.create () in
|
let alias_store = Alias.Store.create () in
|
||||||
List.map contexts ~f:(fun context ->
|
List.map contexts ~f:(fun context ->
|
||||||
Jbuild_load.Jbuilds.eval ~context jbuilds >>| fun stanzas ->
|
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 =
|
let module M =
|
||||||
Gen(struct
|
Gen(struct
|
||||||
let context = context
|
let context = context
|
||||||
|
|
|
@ -3,5 +3,6 @@ open! Import
|
||||||
val gen
|
val gen
|
||||||
: contexts:Context.t list
|
: contexts:Context.t list
|
||||||
-> ?filter_out_optional_stanzas_with_missing_deps:bool (** default: true *)
|
-> ?filter_out_optional_stanzas_with_missing_deps:bool (** default: true *)
|
||||||
|
-> ?only_package:string
|
||||||
-> Jbuild_load.conf
|
-> Jbuild_load.conf
|
||||||
-> Build_interpret.Rule.t list Future.t
|
-> 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"))
|
| Some p -> Ok (Path.relative p.path (p.name ^ ".install"))
|
||||||
|
|
||||||
let setup ?filter_out_optional_stanzas_with_missing_deps
|
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 conf = Jbuild_load.load () in
|
||||||
let workspace =
|
let workspace =
|
||||||
match workspace with
|
match workspace with
|
||||||
|
@ -33,6 +34,7 @@ let setup ?filter_out_optional_stanzas_with_missing_deps
|
||||||
Context.create_for_opam ~name ~switch ?root ~merlin ()))
|
Context.create_for_opam ~name ~switch ?root ~merlin ()))
|
||||||
>>= fun contexts ->
|
>>= fun contexts ->
|
||||||
Gen_rules.gen conf ~contexts
|
Gen_rules.gen conf ~contexts
|
||||||
|
?only_package
|
||||||
?filter_out_optional_stanzas_with_missing_deps
|
?filter_out_optional_stanzas_with_missing_deps
|
||||||
>>= fun rules ->
|
>>= fun rules ->
|
||||||
let build_system = Build_system.create ~contexts ~file_tree:conf.file_tree ~rules in
|
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
|
: ?filter_out_optional_stanzas_with_missing_deps:bool
|
||||||
-> ?workspace:Workspace.t
|
-> ?workspace:Workspace.t
|
||||||
-> ?workspace_file:string
|
-> ?workspace_file:string
|
||||||
|
-> ?only_package:string
|
||||||
-> unit
|
-> unit
|
||||||
-> setup Future.t
|
-> setup Future.t
|
||||||
val external_lib_deps
|
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 readdir t = Sys.readdir (to_string t) |> Array.to_list
|
||||||
let is_directory t = Sys.is_directory (to_string t)
|
let is_directory t = Sys.is_directory (to_string t)
|
||||||
let rmdir t = Unix.rmdir (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
|
let extend_basename t ~suffix = t ^ suffix
|
||||||
|
|
Loading…
Reference in New Issue