Improve the external-lib-deps command
This commit is contained in:
parent
27e44cd72b
commit
97de72c8dd
123
bin/main.ml
123
bin/main.ml
|
@ -38,6 +38,9 @@ module Main = struct
|
||||||
setup ?workspace_file:common.workspace_file ?only_package ()
|
setup ?workspace_file:common.workspace_file ?only_package ()
|
||||||
end
|
end
|
||||||
|
|
||||||
|
let do_build (setup : Main.setup) targets =
|
||||||
|
Build_system.do_build_exn setup.build_system targets
|
||||||
|
|
||||||
let create_log = Main.create_log
|
let create_log = Main.create_log
|
||||||
|
|
||||||
type ('a, 'b) walk_result =
|
type ('a, 'b) walk_result =
|
||||||
|
@ -209,8 +212,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 ~only_package:pkg >>= fun setup ->
|
(Main.setup common ~only_package:pkg >>= fun setup ->
|
||||||
Build_system.do_build_exn setup.build_system
|
do_build setup [resolve_package_install setup pkg])
|
||||||
[resolve_package_install setup pkg])
|
|
||||||
|
|
||||||
let build_package =
|
let build_package =
|
||||||
let doc = "Build a single package in release mode." in
|
let doc = "Build a single package in release mode." in
|
||||||
|
@ -235,37 +237,6 @@ let build_package =
|
||||||
$ Arg.(required & pos 0 (some string) None name_))
|
$ Arg.(required & pos 0 (some string) None name_))
|
||||||
, Term.info "build-package" ~doc ~man)
|
, Term.info "build-package" ~doc ~man)
|
||||||
|
|
||||||
let external_lib_deps packages =
|
|
||||||
let log = create_log () in
|
|
||||||
let deps =
|
|
||||||
Path.Map.fold (Main.external_lib_deps ~log ~packages ()) ~init:String_map.empty
|
|
||||||
~f:(fun ~key:_ ~data:deps acc -> Build.merge_lib_deps deps acc)
|
|
||||||
in
|
|
||||||
String_map.iter deps ~f:(fun ~key:n ~data ->
|
|
||||||
match (data : Build.lib_dep_kind) with
|
|
||||||
| Required -> Printf.printf "%s\n" n
|
|
||||||
| Optional -> Printf.printf "%s (optional)\n" n)
|
|
||||||
|
|
||||||
let external_lib_deps =
|
|
||||||
let doc = "Print out external library dependencies." in
|
|
||||||
let man =
|
|
||||||
[ `S "DESCRIPTION"
|
|
||||||
; `P {|Print out the external libraries needed to build the given packages.|}
|
|
||||||
; `P {|The output should be included in what is written in
|
|
||||||
your $(i,<package>.opam) file.|}
|
|
||||||
; `Blocks help_secs
|
|
||||||
]
|
|
||||||
in
|
|
||||||
let name_ = Arg.info [] ~docv:"PACKAGE-NAME" in
|
|
||||||
let go common packages =
|
|
||||||
set_common common;
|
|
||||||
external_lib_deps packages
|
|
||||||
in
|
|
||||||
( Term.(const go
|
|
||||||
$ common
|
|
||||||
$ Arg.(non_empty & pos_all string [] name_))
|
|
||||||
, Term.info "external-lib-deps" ~doc ~man)
|
|
||||||
|
|
||||||
type target =
|
type target =
|
||||||
| File of Path.t
|
| File of Path.t
|
||||||
| Alias of Path.t * Alias.t
|
| Alias of Path.t * Alias.t
|
||||||
|
@ -317,7 +288,7 @@ let resolve_targets common (setup : Main.setup) user_targets =
|
||||||
| l -> l
|
| l -> l
|
||||||
)
|
)
|
||||||
in
|
in
|
||||||
Printf.printf "Building the following targets:\n";
|
Printf.printf "Actual targets:\n";
|
||||||
List.iter targets ~f:(function
|
List.iter targets ~f:(function
|
||||||
| File path ->
|
| File path ->
|
||||||
Printf.printf "- %s\n" (Path.to_string path)
|
Printf.printf "- %s\n" (Path.to_string path)
|
||||||
|
@ -342,7 +313,7 @@ let build_targets =
|
||||||
Future.Scheduler.go ~log:(create_log ())
|
Future.Scheduler.go ~log:(create_log ())
|
||||||
(Main.setup common >>= fun setup ->
|
(Main.setup common >>= fun setup ->
|
||||||
let targets = resolve_targets common setup targets in
|
let targets = resolve_targets common setup targets in
|
||||||
Build_system.do_build_exn setup.build_system targets) in
|
do_build setup targets) in
|
||||||
( Term.(const go
|
( Term.(const go
|
||||||
$ common
|
$ common
|
||||||
$ Arg.(non_empty & pos_all string [] name_))
|
$ Arg.(non_empty & pos_all string [] name_))
|
||||||
|
@ -367,12 +338,92 @@ let runtest =
|
||||||
let dir = Path.(relative root) (prefix_target common dir) in
|
let dir = Path.(relative root) (prefix_target common dir) in
|
||||||
Alias.file (Alias.runtest ~dir))
|
Alias.file (Alias.runtest ~dir))
|
||||||
in
|
in
|
||||||
Build_system.do_build_exn setup.build_system targets) in
|
do_build setup targets) in
|
||||||
( Term.(const go
|
( Term.(const go
|
||||||
$ common
|
$ common
|
||||||
$ Arg.(value & pos_all string ["."] name_))
|
$ Arg.(value & pos_all string ["."] name_))
|
||||||
, Term.info "runtest" ~doc ~man)
|
, Term.info "runtest" ~doc ~man)
|
||||||
|
|
||||||
|
let external_lib_deps =
|
||||||
|
let doc = "Print out external libraries needed to build the given targets." in
|
||||||
|
let man =
|
||||||
|
[ `S "DESCRIPTION"
|
||||||
|
; `P {|Print out the external libraries needed to build the given targets.|}
|
||||||
|
; `P {|The output of $(b,jbuild external-lib-deps @install) should be included
|
||||||
|
in what is written in your $(i,<package>.opam) file.|}
|
||||||
|
; `Blocks help_secs
|
||||||
|
]
|
||||||
|
in
|
||||||
|
let go common only_missing targets =
|
||||||
|
set_common common;
|
||||||
|
Future.Scheduler.go ~log:(create_log ())
|
||||||
|
(Main.setup common >>= fun setup ->
|
||||||
|
let targets = resolve_targets common setup targets in
|
||||||
|
let failure =
|
||||||
|
String_map.fold ~init:false
|
||||||
|
(Build_system.all_lib_deps_by_context setup.build_system targets)
|
||||||
|
~f:(fun ~key:context_name ~data:lib_deps acc ->
|
||||||
|
let internals =
|
||||||
|
Jbuild_types.Stanza.lib_names
|
||||||
|
(match String_map.find context_name setup.Main.stanzas with
|
||||||
|
| None -> assert false
|
||||||
|
| Some x -> x)
|
||||||
|
in
|
||||||
|
let externals =
|
||||||
|
String_map.filter lib_deps ~f:(fun name _ ->
|
||||||
|
not (String_set.mem name internals))
|
||||||
|
in
|
||||||
|
if only_missing then begin
|
||||||
|
let context =
|
||||||
|
match List.find setup.contexts ~f:(fun c -> c.name = context_name) with
|
||||||
|
| None -> assert false
|
||||||
|
| Some c -> c
|
||||||
|
in
|
||||||
|
let missing =
|
||||||
|
String_map.filter externals ~f:(fun name _ ->
|
||||||
|
not (Findlib.available context.findlib name))
|
||||||
|
in
|
||||||
|
if String_map.is_empty missing then
|
||||||
|
acc
|
||||||
|
else begin
|
||||||
|
Format.eprintf
|
||||||
|
"@{<error>Error@}: The following required libraries are missing \
|
||||||
|
in the %s context:\n\
|
||||||
|
%s@."
|
||||||
|
context_name
|
||||||
|
(String_map.keys missing
|
||||||
|
|> List.map ~f:(sprintf "- %s")
|
||||||
|
|> String.concat ~sep:"\n");
|
||||||
|
true
|
||||||
|
end
|
||||||
|
end else begin
|
||||||
|
Printf.printf
|
||||||
|
"These are the external library dependencies in the %s context:\n\
|
||||||
|
%s\n%!"
|
||||||
|
context_name
|
||||||
|
(String_map.bindings externals
|
||||||
|
|> List.map ~f:(fun (name, kind) ->
|
||||||
|
match (kind : Build.lib_dep_kind) with
|
||||||
|
| Optional -> sprintf "- %s (optional)" name
|
||||||
|
| Required -> sprintf "- %s" name)
|
||||||
|
|> String.concat ~sep:"\n");
|
||||||
|
acc
|
||||||
|
end)
|
||||||
|
in
|
||||||
|
if failure then die "";
|
||||||
|
Future.return ())
|
||||||
|
in
|
||||||
|
( Term.(const go
|
||||||
|
$ common
|
||||||
|
$ Arg.(value
|
||||||
|
& flag
|
||||||
|
& info ["missing"]
|
||||||
|
~doc:{|Only print out missing dependencies|})
|
||||||
|
$ Arg.(non_empty
|
||||||
|
& pos_all string []
|
||||||
|
& Arg.info [] ~docv:"TARGET"))
|
||||||
|
, Term.info "external-lib-deps" ~doc ~man)
|
||||||
|
|
||||||
let opam_installer () =
|
let opam_installer () =
|
||||||
match Bin.which "opam-installer" with
|
match Bin.which "opam-installer" with
|
||||||
| None ->
|
| None ->
|
||||||
|
|
|
@ -373,17 +373,31 @@ module File_closure =
|
||||||
let deps (_, rule) bs = rules_for_files bs (Pset.elements rule.Rule.deps)
|
let deps (_, rule) bs = rules_for_files bs (Pset.elements rule.Rule.deps)
|
||||||
end)
|
end)
|
||||||
|
|
||||||
let all_lib_deps t targets =
|
let rules_for_targets t targets =
|
||||||
match File_closure.top_closure t (rules_for_files t targets) with
|
match File_closure.top_closure t (rules_for_files t targets) with
|
||||||
| Ok l ->
|
| Ok l -> l
|
||||||
List.fold_left l ~init:Pmap.empty ~f:(fun acc (_, rule) ->
|
| Error cycle ->
|
||||||
|
die "dependency cycle detected:\n %s"
|
||||||
|
(List.map cycle ~f:(fun (path, _) -> Path.to_string path)
|
||||||
|
|> String.concat ~sep:"\n-> ")
|
||||||
|
|
||||||
|
let all_lib_deps t targets =
|
||||||
|
List.fold_left (rules_for_targets t targets) ~init:Pmap.empty
|
||||||
|
~f:(fun acc (_, rule) ->
|
||||||
Pmap.merge acc rule.Rule.lib_deps ~f:(fun _ a b ->
|
Pmap.merge acc rule.Rule.lib_deps ~f:(fun _ a b ->
|
||||||
match a, b with
|
match a, b with
|
||||||
| None, None -> None
|
| None, None -> None
|
||||||
| Some a, None -> Some a
|
| Some a, None -> Some a
|
||||||
| None, Some b -> Some b
|
| None, Some b -> Some b
|
||||||
| Some a, Some b -> Some (Build.merge_lib_deps a b)))
|
| Some a, Some b -> Some (Build.merge_lib_deps a b)))
|
||||||
| Error cycle ->
|
|
||||||
die "dependency cycle detected:\n %s"
|
let all_lib_deps_by_context t targets =
|
||||||
(List.map cycle ~f:(fun (path, _) -> Path.to_string path)
|
List.fold_left (rules_for_targets t targets) ~init:[] ~f:(fun acc (_, rule) ->
|
||||||
|> String.concat ~sep:"\n-> ")
|
Path.Map.fold rule.Rule.lib_deps ~init:acc ~f:(fun ~key:path ~data:lib_deps acc ->
|
||||||
|
match Path.extract_build_context path with
|
||||||
|
| None -> acc
|
||||||
|
| Some (context, _) -> (context, lib_deps) :: acc))
|
||||||
|
|> String_map.of_alist_multi
|
||||||
|
|> String_map.map ~f:(function
|
||||||
|
| [] -> String_map.empty
|
||||||
|
| x :: l -> List.fold_left l ~init:x ~f:Build.merge_lib_deps)
|
||||||
|
|
|
@ -29,3 +29,7 @@ val do_build_exn : t -> Path.t list -> unit Future.t
|
||||||
(** Return all the library dependencies (as written by the user) needed to build these
|
(** Return all the library dependencies (as written by the user) needed to build these
|
||||||
targets *)
|
targets *)
|
||||||
val all_lib_deps : t -> Path.t list -> Build.lib_deps Path.Map.t
|
val all_lib_deps : t -> Path.t list -> Build.lib_deps Path.Map.t
|
||||||
|
|
||||||
|
(** Return all the library dependencies required to build these targets, by context
|
||||||
|
name *)
|
||||||
|
val all_lib_deps_by_context : t -> Path.t list -> Build.lib_deps String_map.t
|
||||||
|
|
|
@ -1837,8 +1837,11 @@ let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true)
|
||||||
let alias_store = alias_store
|
let alias_store = alias_store
|
||||||
end)
|
end)
|
||||||
in
|
in
|
||||||
!M.all_rules)
|
(!M.all_rules, (context.name, stanzas)))
|
||||||
|> Future.all
|
|> Future.all
|
||||||
>>| fun rules ->
|
>>| fun l ->
|
||||||
Alias.rules alias_store ~prefixes:(Path.root :: List.map contexts ~f:(fun c -> c.Context.build_dir)) ~tree
|
let rules, context_names_and_stanzas = List.split l in
|
||||||
@ List.concat rules
|
(Alias.rules alias_store
|
||||||
|
~prefixes:(Path.root :: List.map contexts ~f:(fun c -> c.Context.build_dir)) ~tree
|
||||||
|
@ List.concat rules,
|
||||||
|
String_map.of_alist_exn context_names_and_stanzas)
|
||||||
|
|
|
@ -5,4 +5,6 @@ val gen
|
||||||
-> ?filter_out_optional_stanzas_with_missing_deps:bool (** default: true *)
|
-> ?filter_out_optional_stanzas_with_missing_deps:bool (** default: true *)
|
||||||
-> ?only_package:string
|
-> ?only_package:string
|
||||||
-> Jbuild_load.conf
|
-> Jbuild_load.conf
|
||||||
-> Build_interpret.Rule.t list Future.t
|
-> (Build_interpret.Rule.t list *
|
||||||
|
(* Evaluated jbuilds per context names *)
|
||||||
|
(Path.t * Jbuild_types.Stanzas.t) list String_map.t) Future.t
|
||||||
|
|
31
src/main.ml
31
src/main.ml
|
@ -3,7 +3,7 @@ open Future
|
||||||
|
|
||||||
type setup =
|
type setup =
|
||||||
{ build_system : Build_system.t
|
{ build_system : Build_system.t
|
||||||
; jbuilds : Jbuild_load.Jbuilds.t
|
; stanzas : (Path.t * Jbuild_types.Stanzas.t) list String_map.t
|
||||||
; contexts : Context.t list
|
; contexts : Context.t list
|
||||||
; packages : Package.t String_map.t
|
; packages : Package.t String_map.t
|
||||||
}
|
}
|
||||||
|
@ -36,10 +36,10 @@ let setup ?filter_out_optional_stanzas_with_missing_deps
|
||||||
Gen_rules.gen conf ~contexts
|
Gen_rules.gen conf ~contexts
|
||||||
?only_package
|
?only_package
|
||||||
?filter_out_optional_stanzas_with_missing_deps
|
?filter_out_optional_stanzas_with_missing_deps
|
||||||
>>= fun rules ->
|
>>= fun (rules, stanzas) ->
|
||||||
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
|
||||||
return { build_system
|
return { build_system
|
||||||
; jbuilds = conf.jbuilds
|
; stanzas
|
||||||
; contexts
|
; contexts
|
||||||
; packages = conf.packages
|
; packages = conf.packages
|
||||||
}
|
}
|
||||||
|
@ -47,24 +47,20 @@ let setup ?filter_out_optional_stanzas_with_missing_deps
|
||||||
let external_lib_deps ?log ~packages () =
|
let external_lib_deps ?log ~packages () =
|
||||||
Future.Scheduler.go ?log
|
Future.Scheduler.go ?log
|
||||||
(setup () ~filter_out_optional_stanzas_with_missing_deps:false
|
(setup () ~filter_out_optional_stanzas_with_missing_deps:false
|
||||||
>>= fun ({ build_system = bs; jbuilds; contexts; _ } as setup) ->
|
>>| fun setup ->
|
||||||
let install_files =
|
let install_files =
|
||||||
List.map packages ~f:(fun pkg ->
|
List.map packages ~f:(fun pkg ->
|
||||||
match package_install_file setup pkg with
|
match package_install_file setup pkg with
|
||||||
| Ok path -> path
|
| Ok path -> path
|
||||||
| Error () -> die "Unknown package %S" pkg)
|
| Error () -> die "Unknown package %S" pkg)
|
||||||
in
|
in
|
||||||
let context =
|
match String_map.find "default" setup.stanzas with
|
||||||
match List.find contexts ~f:(fun c -> c.name = "default") with
|
| None -> die "You need to set a default context to use external-lib-deps"
|
||||||
| None -> die "You need to set a default context to use external-lib-deps"
|
| Some stanzas ->
|
||||||
| Some context -> context
|
let internals = Jbuild_types.Stanza.lib_names stanzas in
|
||||||
in
|
Path.Map.map
|
||||||
Jbuild_load.Jbuilds.eval ~context jbuilds
|
(Build_system.all_lib_deps setup.build_system install_files)
|
||||||
>>| fun stanzas ->
|
~f:(String_map.filter ~f:(fun name _ ->
|
||||||
let internals = Jbuild_types.Stanza.lib_names stanzas in
|
|
||||||
Path.Map.map
|
|
||||||
(Build_system.all_lib_deps bs install_files)
|
|
||||||
~f:(String_map.filter ~f:(fun name _ ->
|
|
||||||
not (String_set.mem name internals))))
|
not (String_set.mem name internals))))
|
||||||
|
|
||||||
let report_error ?(map_fname=fun x->x) ppf exn ~backtrace =
|
let report_error ?(map_fname=fun x->x) ppf exn ~backtrace =
|
||||||
|
@ -80,7 +76,10 @@ let report_error ?(map_fname=fun x->x) ppf exn ~backtrace =
|
||||||
| Fatal_error msg ->
|
| Fatal_error msg ->
|
||||||
Format.fprintf ppf "%s\n" (String.capitalize_ascii msg)
|
Format.fprintf ppf "%s\n" (String.capitalize_ascii msg)
|
||||||
| Findlib.Package_not_found pkg ->
|
| Findlib.Package_not_found pkg ->
|
||||||
Format.fprintf ppf "@{<error>Findlib package %S not found.@}\n" pkg
|
Format.fprintf ppf
|
||||||
|
"@{<error>Error@}: Findlib package %S not found.\n\
|
||||||
|
Hint: try 'jbuilder external-lib-deps --missing'\n"
|
||||||
|
pkg
|
||||||
| Code_error msg ->
|
| Code_error msg ->
|
||||||
let bt = Printexc.raw_backtrace_to_string backtrace in
|
let bt = Printexc.raw_backtrace_to_string backtrace in
|
||||||
Format.fprintf ppf "@{<error>Internal error, please report upstream.@}\n\
|
Format.fprintf ppf "@{<error>Internal error, please report upstream.@}\n\
|
||||||
|
|
|
@ -2,7 +2,8 @@ open! Import
|
||||||
|
|
||||||
type setup =
|
type setup =
|
||||||
{ build_system : Build_system.t
|
{ build_system : Build_system.t
|
||||||
; jbuilds : Jbuild_load.Jbuilds.t
|
; (* Evaluated jbuilds per context names *)
|
||||||
|
stanzas : (Path.t * Jbuild_types.Stanzas.t) list String_map.t
|
||||||
; contexts : Context.t list
|
; contexts : Context.t list
|
||||||
; packages : Package.t String_map.t
|
; packages : Package.t String_map.t
|
||||||
}
|
}
|
||||||
|
|
Loading…
Reference in New Issue