Improve alias management
This commit is contained in:
parent
7538fd8263
commit
9fe0e9c87d
14
bin/main.ml
14
bin/main.ml
|
@ -129,11 +129,6 @@ type target =
|
|||
| File of Path.t
|
||||
| Alias of Path.t * Alias.t
|
||||
|
||||
let aliases_in_source_tree =
|
||||
String_set.of_list
|
||||
[ "install"
|
||||
]
|
||||
|
||||
let resolve_targets (setup : Main.setup) user_targets =
|
||||
match user_targets with
|
||||
| [] -> []
|
||||
|
@ -146,15 +141,8 @@ let resolve_targets (setup : Main.setup) user_targets =
|
|||
if Path.is_root path then
|
||||
die "@ on the command line must be followed by a valid alias name"
|
||||
else
|
||||
let name = Path.basename path in
|
||||
let path =
|
||||
if Path.is_in_build_dir path ||
|
||||
String_set.mem name aliases_in_source_tree then
|
||||
path
|
||||
else
|
||||
Path.append setup.context.build_dir path
|
||||
in
|
||||
let dir = Path.parent path in
|
||||
let name = Path.basename path in
|
||||
Alias (path, Alias.make ~dir name)
|
||||
else
|
||||
File (
|
||||
|
|
|
@ -130,12 +130,10 @@ Jbuilder doesn't read =<package>.opam= files, however when a
|
|||
=<package>.opam= is present, Jbuilder will knows that the package
|
||||
named =<package>= exists. It will know how to construct a
|
||||
=<package>.install= file in the same directory, to handle installation
|
||||
via [[https://opam.ocaml.org/][opam]]. In addition, Jbuilder will also know how to build
|
||||
=<package>.install= at the root of the workspace, for
|
||||
convenience. Jbuilder also defines the =install= alias, which depends
|
||||
on all the buildable =<package>.install= at the root of the
|
||||
workspace. So for instance to build everything that is installable in
|
||||
a workspace, run:
|
||||
via [[https://opam.ocaml.org/][opam]]. Jbuilder also defines the recursive =install= alias, which depends
|
||||
on all the buildable =<package>.install= files in the workspace. So
|
||||
for instance to build everything that is installable in a workspace,
|
||||
run at the root:
|
||||
|
||||
#+begin_src
|
||||
$ jbuilder build @install
|
||||
|
|
75
src/alias.ml
75
src/alias.ml
|
@ -1,39 +1,66 @@
|
|||
open! Import
|
||||
|
||||
type t = Path.t
|
||||
module Name : sig
|
||||
type t
|
||||
val make : Path.t -> t
|
||||
val path : t -> Path.t
|
||||
end = struct
|
||||
type t = Path.t
|
||||
let make t = t
|
||||
let path t = t
|
||||
end
|
||||
|
||||
type t =
|
||||
{ name : Name.t
|
||||
; file : Path.t
|
||||
}
|
||||
|
||||
let aliases_path = Path.(relative root) "_build/.aliases"
|
||||
|
||||
let make name ~dir =
|
||||
if not (Path.is_local dir) then
|
||||
let of_path path =
|
||||
if not (Path.is_local path) then
|
||||
die "Aliases are only supported for local paths!\n\
|
||||
Tried to reference alias %S in %s"
|
||||
name (Path.to_string dir);
|
||||
Path.append aliases_path (Path.relative dir name)
|
||||
Tried to reference alias %S"
|
||||
(Path.to_string path);
|
||||
{ name = Name.make path
|
||||
; file = Path.append aliases_path path
|
||||
}
|
||||
|
||||
let dep = Build.path
|
||||
let make name ~dir = of_path (Path.relative dir name)
|
||||
|
||||
let file t = t
|
||||
let dep t = Build.path t.file
|
||||
|
||||
let file t = t.file
|
||||
|
||||
let default = make "DEFAULT"
|
||||
let runtest = make "runtest"
|
||||
let install = make "install"
|
||||
|
||||
let recursive_aliases =
|
||||
[ default
|
||||
; runtest
|
||||
; install
|
||||
]
|
||||
|
||||
module Store = struct
|
||||
type nonrec t = (t, Path.Set.t ref) Hashtbl.t
|
||||
type entry =
|
||||
{ alias : t
|
||||
; mutable deps : Path.Set.t
|
||||
}
|
||||
type t = (Name.t, entry) Hashtbl.t
|
||||
|
||||
let create () = Hashtbl.create 1024
|
||||
end
|
||||
|
||||
let add_deps store t deps =
|
||||
let deps = Path.Set.of_list deps in
|
||||
match Hashtbl.find store t with
|
||||
| None -> Hashtbl.add store ~key:t ~data:(ref deps)
|
||||
| Some r -> r := Path.Set.union deps !r
|
||||
match Hashtbl.find store t.name with
|
||||
| None ->
|
||||
Hashtbl.add store ~key:t.name
|
||||
~data:{ Store.alias = t
|
||||
; deps = deps
|
||||
}
|
||||
| Some e -> e.deps <- Path.Set.union deps e.deps
|
||||
|
||||
type tree = Node of Path.t * tree list
|
||||
|
||||
|
@ -41,19 +68,29 @@ let rec setup_rec_alias store ~make_alias ~prefix ~tree:(Node (dir, children)) =
|
|||
let alias = make_alias ~dir:(Path.append prefix dir) in
|
||||
add_deps store alias (List.map children ~f:(fun child ->
|
||||
setup_rec_alias store ~make_alias ~prefix ~tree:child));
|
||||
alias
|
||||
alias.file
|
||||
|
||||
let setup_rec_aliases store ~prefix ~tree =
|
||||
List.iter recursive_aliases ~f:(fun make_alias ->
|
||||
ignore (setup_rec_alias store ~make_alias ~prefix ~tree : t))
|
||||
ignore (setup_rec_alias store ~make_alias ~prefix ~tree : Path.t))
|
||||
|
||||
let rules store ~prefix ~tree =
|
||||
setup_rec_aliases store ~prefix ~tree;
|
||||
Hashtbl.fold store ~init:[] ~f:(fun ~key:alias ~data:deps acc ->
|
||||
let rules store ~prefixes ~tree =
|
||||
List.iter prefixes ~f:(fun prefix ->
|
||||
setup_rec_aliases store ~prefix ~tree);
|
||||
|
||||
(* For each alias @_build/blah/../x, add a dependency: @../x --> @_build/blah/../x *)
|
||||
Hashtbl.fold store ~init:[] ~f:(fun ~key:_ ~data:{ Store. alias; _ } acc ->
|
||||
match Path.extract_build_context (Name.path alias.name) with
|
||||
| None -> acc
|
||||
| Some (_, in_src) -> (of_path in_src, alias) :: acc)
|
||||
|> List.iter ~f:(fun (in_src, in_build_dir) ->
|
||||
add_deps store in_src [in_build_dir.file]);
|
||||
|
||||
Hashtbl.fold store ~init:[] ~f:(fun ~key:_ ~data:{ Store. alias; deps } acc ->
|
||||
let open Build.O in
|
||||
let rule =
|
||||
Build_interpret.Rule.make
|
||||
(Build.path_set !deps >>>
|
||||
Build.touch alias)
|
||||
(Build.path_set deps >>>
|
||||
Build.touch alias.file)
|
||||
in
|
||||
rule :: acc)
|
||||
|
|
|
@ -4,6 +4,7 @@ val make : string -> dir:Path.t -> t
|
|||
|
||||
val default : dir:Path.t -> t
|
||||
val runtest : dir:Path.t -> t
|
||||
val install : dir:Path.t -> t
|
||||
|
||||
val dep : t -> ('a, 'a) Build.t
|
||||
val file : t -> Path.t
|
||||
|
@ -19,6 +20,6 @@ type tree = Node of Path.t * tree list
|
|||
|
||||
val rules
|
||||
: Store.t
|
||||
-> prefix:Path.t
|
||||
-> prefixes:Path.t list
|
||||
-> tree:tree
|
||||
-> Build_interpret.Rule.t list
|
||||
|
|
|
@ -96,10 +96,10 @@ let obj_name_of_basename fn =
|
|||
module type Params = sig
|
||||
val context : Context.t
|
||||
val file_tree : File_tree.t
|
||||
val tree : Alias.tree
|
||||
val stanzas : (Path.t * Jbuild_types.Stanza.t list) list
|
||||
val packages : Package.t String_map.t
|
||||
val filter_out_optional_stanzas_with_missing_deps : bool
|
||||
val alias_store : Alias.Store.t
|
||||
end
|
||||
|
||||
module Gen(P : Params) = struct
|
||||
|
@ -264,12 +264,9 @@ module Gen(P : Params) = struct
|
|||
module Alias = struct
|
||||
include Alias
|
||||
|
||||
let store = Store.create ()
|
||||
let add_deps t deps = add_deps store t deps
|
||||
let rules () = rules store ~prefix:ctx.build_dir ~tree:P.tree
|
||||
let add_deps t deps = add_deps P.alias_store t deps
|
||||
end
|
||||
|
||||
|
||||
let all_rules = ref []
|
||||
let known_targets_by_dir_so_far = ref Path.Map.empty
|
||||
|
||||
|
@ -1679,38 +1676,40 @@ module Gen(P : Params) = struct
|
|||
install_file pkg.Package.path pkg.name)
|
||||
|
||||
let () =
|
||||
let install_alias = Alias.make ~dir:ctx.build_dir "install" in
|
||||
let global_install_alias = Alias.make ~dir:Path.root "install" in
|
||||
let is_default = Path.basename ctx.build_dir = "default" in
|
||||
String_map.iter P.packages ~f:(fun ~key:pkg ~data:{ Package.path; _ } ->
|
||||
String_map.iter P.packages ~f:(fun ~key:pkg ~data:{ Package.path = src_path; _ } ->
|
||||
let install_fn = pkg ^ ".install" in
|
||||
let in_source_dir = Path.relative path install_fn in
|
||||
let orig = Path.append ctx.build_dir in_source_dir in
|
||||
let at_root_of_build_context = Path.relative ctx.build_dir install_fn in
|
||||
if not (Path.is_root path) then
|
||||
add_rule (Build.copy ~src:orig ~dst:at_root_of_build_context);
|
||||
Alias.add_deps install_alias [at_root_of_build_context];
|
||||
|
||||
let ctx_path = Path.append ctx.build_dir src_path in
|
||||
let ctx_install_alias = Alias.install ~dir:ctx_path in
|
||||
let ctx_install_file = Path.relative ctx_path install_fn in
|
||||
Alias.add_deps ctx_install_alias [ctx_install_file];
|
||||
|
||||
if is_default then begin
|
||||
add_rule (Build.copy ~src:orig ~dst:in_source_dir);
|
||||
let at_root = Path.relative Path.root install_fn in
|
||||
if not (Path.is_root path) then
|
||||
add_rule (Build.copy ~src:orig ~dst:at_root);
|
||||
Alias.add_deps global_install_alias [at_root]
|
||||
let src_install_alias = Alias.install ~dir:src_path in
|
||||
let src_install_file = Path.relative src_path install_fn in
|
||||
add_rule (Build.copy ~src:ctx_install_file ~dst:src_install_file);
|
||||
Alias.add_deps src_install_alias [src_install_file]
|
||||
end)
|
||||
end
|
||||
|
||||
let gen ~context ~file_tree ~tree ~stanzas ~packages
|
||||
?(filter_out_optional_stanzas_with_missing_deps=true) () =
|
||||
let module M =
|
||||
Gen(struct
|
||||
let context = context
|
||||
let file_tree = file_tree
|
||||
let tree = tree
|
||||
let stanzas = stanzas
|
||||
let packages = packages
|
||||
let filter_out_optional_stanzas_with_missing_deps =
|
||||
filter_out_optional_stanzas_with_missing_deps
|
||||
end)
|
||||
let gen ~contexts ~file_tree ~tree ~stanzas ~packages
|
||||
?(filter_out_optional_stanzas_with_missing_deps=true) () =
|
||||
let alias_store = Alias.Store.create () in
|
||||
let rules =
|
||||
List.concat_map contexts ~f:(fun context ->
|
||||
let module M =
|
||||
Gen(struct
|
||||
let context = context
|
||||
let file_tree = file_tree
|
||||
let stanzas = stanzas
|
||||
let packages = packages
|
||||
let filter_out_optional_stanzas_with_missing_deps =
|
||||
filter_out_optional_stanzas_with_missing_deps
|
||||
let alias_store = alias_store
|
||||
end)
|
||||
in
|
||||
!M.all_rules)
|
||||
in
|
||||
M.Alias.rules () @ !M.all_rules
|
||||
Alias.rules alias_store ~prefixes:(Path.root :: List.map contexts ~f:(fun c -> c.Context.build_dir)) ~tree
|
||||
@ rules
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
open Import
|
||||
|
||||
val gen
|
||||
: context:Context.t
|
||||
: contexts:Context.t list
|
||||
-> file_tree:File_tree.t
|
||||
-> tree:Alias.tree
|
||||
-> stanzas:(Path.t * Jbuild_types.Stanza.t list) list
|
||||
|
|
|
@ -28,9 +28,8 @@ let setup ?filter_out_optional_stanzas_with_missing_deps () =
|
|||
| Some c -> return c)
|
||||
>>= fun default_context ->
|
||||
let rules =
|
||||
List.concat_map contexts ~f:(fun context ->
|
||||
Gen_rules.gen ~context ~file_tree ~tree ~stanzas ~packages
|
||||
?filter_out_optional_stanzas_with_missing_deps ())
|
||||
Gen_rules.gen ~contexts ~file_tree ~tree ~stanzas ~packages
|
||||
?filter_out_optional_stanzas_with_missing_deps ()
|
||||
in
|
||||
let build_system = Build_system.create ~file_tree ~rules in
|
||||
return { build_system
|
||||
|
|
Loading…
Reference in New Issue