matthieu
/
dune
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Improve the external-lib-deps command

This commit is contained in:
Jeremie Dimino 2017-03-01 19:19:43 +00:00
parent 27e44cd72b
commit 97de72c8dd
7 changed files with 139 additions and 65 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

123
bin/main.ml
View File

@ -38,6 +38,9 @@ module Main = struct
setup ?workspace_file:common.workspace_file ?only_package ()
end
let do_build (setup : Main.setup) targets =
Build_system.do_build_exn setup.build_system targets
let create_log = Main.create_log
type ('a, 'b) walk_result =
@ -209,8 +212,7 @@ let resolve_package_install setup pkg =
let build_package common pkg =
Future.Scheduler.go ~log:(create_log ())
(Main.setup common ~only_package:pkg >>= fun setup ->
Build_system.do_build_exn setup.build_system
[resolve_package_install setup pkg])
do_build setup [resolve_package_install setup pkg])
let build_package =
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_))
, 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 =
| File of Path.t
| Alias of Path.t * Alias.t
@ -317,7 +288,7 @@ let resolve_targets common (setup : Main.setup) user_targets =
| l -> l
)
in
Printf.printf "Building the following targets:\n";
Printf.printf "Actual targets:\n";
List.iter targets ~f:(function
| File path ->
Printf.printf "- %s\n" (Path.to_string path)
@ -342,7 +313,7 @@ let build_targets =
Future.Scheduler.go ~log:(create_log ())
(Main.setup common >>= fun setup ->
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
$ common
$ Arg.(non_empty & pos_all string [] name_))
@ -367,12 +338,92 @@ let runtest =
let dir = Path.(relative root) (prefix_target common dir) in
Alias.file (Alias.runtest ~dir))
in
Build_system.do_build_exn setup.build_system targets) in
do_build setup targets) in
( Term.(const go
$ common
$ Arg.(value & pos_all string ["."] name_))
, 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 () =
match Bin.which "opam-installer" with
| None ->

28
src/build_system.ml
View File

@ -373,17 +373,31 @@ module File_closure =
let deps (_, rule) bs = rules_for_files bs (Pset.elements rule.Rule.deps)
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
| Ok l ->
List.fold_left l ~init:Pmap.empty ~f:(fun acc (_, rule) ->
| Ok l -> l
| 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 ->
match a, b with
| None, None -> None
| Some a, None -> Some a
| None, Some b -> Some b
| Some a, Some b -> Some (Build.merge_lib_deps a b)))
| 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_by_context t targets =
List.fold_left (rules_for_targets t targets) ~init:[] ~f:(fun acc (_, rule) ->
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)

4
src/build_system.mli
View File

@ -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
targets *)
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

11
src/gen_rules.ml
View File

@ -1837,8 +1837,11 @@ let gen ~contexts ?(filter_out_optional_stanzas_with_missing_deps=true)
let alias_store = alias_store
end)
in
!M.all_rules)
(!M.all_rules, (context.name, stanzas)))
|> Future.all
>>| fun rules ->
Alias.rules alias_store ~prefixes:(Path.root :: List.map contexts ~f:(fun c -> c.Context.build_dir)) ~tree
@ List.concat rules
>>| fun l ->
let rules, context_names_and_stanzas = List.split l in
(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)

4
src/gen_rules.mli
View File

@ -5,4 +5,6 @@ val gen
-> ?filter_out_optional_stanzas_with_missing_deps:bool (** default: true *)
-> ?only_package:string
-> 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
View File

@ -3,7 +3,7 @@ open Future
type setup =
{ 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
; packages : Package.t String_map.t
}
@ -36,10 +36,10 @@ let setup ?filter_out_optional_stanzas_with_missing_deps
Gen_rules.gen conf ~contexts
?only_package
?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
return { build_system
; jbuilds = conf.jbuilds
; stanzas
; contexts
; packages = conf.packages
}
@ -47,24 +47,20 @@ let setup ?filter_out_optional_stanzas_with_missing_deps
let external_lib_deps ?log ~packages () =
Future.Scheduler.go ?log
(setup () ~filter_out_optional_stanzas_with_missing_deps:false
>>= fun ({ build_system = bs; jbuilds; contexts; _ } as setup) ->
>>| fun setup ->
let install_files =
List.map packages ~f:(fun pkg ->
match package_install_file setup pkg with
| Ok path -> path
| Error () -> die "Unknown package %S" pkg)
in
let context =
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"
| Some context -> context
in
Jbuild_load.Jbuilds.eval ~context jbuilds
>>| fun stanzas ->
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 _ ->
match String_map.find "default" setup.stanzas with
| None -> die "You need to set a default context to use external-lib-deps"
| Some stanzas ->
let internals = Jbuild_types.Stanza.lib_names stanzas in
Path.Map.map
(Build_system.all_lib_deps setup.build_system install_files)
~f:(String_map.filter ~f:(fun name _ ->
not (String_set.mem name internals))))
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 ->
Format.fprintf ppf "%s\n" (String.capitalize_ascii msg)
| 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 ->
let bt = Printexc.raw_backtrace_to_string backtrace in
Format.fprintf ppf "@{<error>Internal error, please report upstream.@}\n\

3
src/main.mli
View File

@ -2,7 +2,8 @@ open! Import
type setup =
{ 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
; packages : Package.t String_map.t
}