2016-11-13 12:25:45 +00:00
|
|
|
open Import
|
2016-12-02 13:54:32 +00:00
|
|
|
open Future
|
|
|
|
|
2017-02-23 14:58:18 +00:00
|
|
|
type setup =
|
|
|
|
{ build_system : Build_system.t
|
2017-03-01 19:19:43 +00:00
|
|
|
; stanzas : (Path.t * Jbuild_types.Stanzas.t) list String_map.t
|
2017-02-25 02:38:41 +00:00
|
|
|
; contexts : Context.t list
|
2017-02-24 18:21:22 +00:00
|
|
|
; packages : Package.t String_map.t
|
2017-02-23 14:58:18 +00:00
|
|
|
}
|
|
|
|
|
|
|
|
let package_install_file { packages; _ } pkg =
|
|
|
|
match String_map.find pkg packages with
|
|
|
|
| None -> Error ()
|
2017-02-24 18:21:22 +00:00
|
|
|
| Some p -> Ok (Path.relative p.path (p.name ^ ".install"))
|
2017-02-23 14:58:18 +00:00
|
|
|
|
2017-03-10 12:32:27 +00:00
|
|
|
let setup ?(log=Log.no_log) ?filter_out_optional_stanzas_with_missing_deps
|
2017-03-01 13:25:18 +00:00
|
|
|
?workspace ?(workspace_file="jbuild-workspace")
|
2017-03-02 18:21:19 +00:00
|
|
|
?only_packages () =
|
2017-02-25 18:21:23 +00:00
|
|
|
let conf = Jbuild_load.load () in
|
2017-03-02 18:21:19 +00:00
|
|
|
Option.iter only_packages ~f:(fun set ->
|
|
|
|
String_set.iter set ~f:(fun pkg ->
|
|
|
|
if not (String_map.mem pkg conf.packages) then
|
|
|
|
die "@{<error>Error@}: I don't know about package %s \
|
|
|
|
(passed through --only-packages)%s"
|
|
|
|
pkg (hint pkg (String_map.keys conf.packages))));
|
2017-02-25 02:38:41 +00:00
|
|
|
let workspace =
|
|
|
|
match workspace with
|
|
|
|
| Some w -> w
|
|
|
|
| None ->
|
2017-02-27 15:04:49 +00:00
|
|
|
if Sys.file_exists workspace_file then
|
|
|
|
Workspace.load workspace_file
|
2017-02-25 02:38:41 +00:00
|
|
|
else
|
2017-02-26 20:53:32 +00:00
|
|
|
{ merlin_context = Some "default"; contexts = [Default] }
|
2017-02-25 02:38:41 +00:00
|
|
|
in
|
|
|
|
Future.all
|
2017-02-26 20:53:32 +00:00
|
|
|
(List.map workspace.contexts ~f:(function
|
|
|
|
| Workspace.Context.Default ->
|
|
|
|
Context.default ~merlin:(workspace.merlin_context = Some "default") ()
|
|
|
|
| Opam { name; switch; root; merlin } ->
|
|
|
|
Context.create_for_opam ~name ~switch ?root ~merlin ()))
|
2017-02-25 00:28:10 +00:00
|
|
|
>>= fun contexts ->
|
2017-03-10 12:32:27 +00:00
|
|
|
List.iter contexts ~f:(fun ctx ->
|
|
|
|
Log.infof log "@[<1>Jbuilder context:@,%a@]@." Sexp.pp (Context.sexp_of_t ctx));
|
2017-02-26 19:49:54 +00:00
|
|
|
Gen_rules.gen conf ~contexts
|
2017-03-02 18:21:19 +00:00
|
|
|
?only_packages
|
2017-02-26 19:49:54 +00:00
|
|
|
?filter_out_optional_stanzas_with_missing_deps
|
2017-03-01 19:19:43 +00:00
|
|
|
>>= fun (rules, stanzas) ->
|
2017-02-26 21:49:41 +00:00
|
|
|
let build_system = Build_system.create ~contexts ~file_tree:conf.file_tree ~rules in
|
2017-02-23 14:58:18 +00:00
|
|
|
return { build_system
|
2017-03-01 19:19:43 +00:00
|
|
|
; stanzas
|
2017-02-25 02:38:41 +00:00
|
|
|
; contexts
|
2017-02-25 18:21:23 +00:00
|
|
|
; packages = conf.packages
|
2017-02-23 14:58:18 +00:00
|
|
|
}
|
2016-12-02 13:54:32 +00:00
|
|
|
|
2017-02-24 13:08:37 +00:00
|
|
|
let external_lib_deps ?log ~packages () =
|
2017-02-23 11:45:03 +00:00
|
|
|
Future.Scheduler.go ?log
|
2016-12-15 13:00:30 +00:00
|
|
|
(setup () ~filter_out_optional_stanzas_with_missing_deps:false
|
2017-03-01 19:19:43 +00:00
|
|
|
>>| fun setup ->
|
2017-02-23 14:58:18 +00:00
|
|
|
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
|
2017-03-01 19:19:43 +00:00
|
|
|
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 _ ->
|
2017-02-26 19:49:54 +00:00
|
|
|
not (String_set.mem name internals))))
|
2016-12-02 13:54:32 +00:00
|
|
|
|
|
|
|
let report_error ?(map_fname=fun x->x) ppf exn ~backtrace =
|
|
|
|
match exn with
|
2016-11-13 12:32:12 +00:00
|
|
|
| Loc.Error ({ start; stop }, msg) ->
|
|
|
|
let start_c = start.pos_cnum - start.pos_bol in
|
|
|
|
let stop_c = stop.pos_cnum - start.pos_bol in
|
2016-12-02 13:54:32 +00:00
|
|
|
Format.fprintf ppf
|
2017-02-24 11:16:55 +00:00
|
|
|
"@{<loc>File \"%s\", line %d, characters %d-%d:@}\n\
|
|
|
|
@{<error>Error@}: %s\n"
|
2016-12-02 13:54:32 +00:00
|
|
|
(map_fname start.pos_fname) start.pos_lnum start_c stop_c msg
|
2017-02-23 11:55:14 +00:00
|
|
|
| Fatal_error "" -> ()
|
2016-12-02 13:54:32 +00:00
|
|
|
| Fatal_error msg ->
|
2017-02-27 11:37:28 +00:00
|
|
|
Format.fprintf ppf "%s\n" (String.capitalize_ascii msg)
|
2017-03-14 15:57:22 +00:00
|
|
|
| Findlib.Package_not_found { package; required_by } ->
|
2017-03-01 19:19:43 +00:00
|
|
|
Format.fprintf ppf
|
2017-03-14 15:57:22 +00:00
|
|
|
"@{<error>Error@}: Findlib package %S not found.\n" package;
|
|
|
|
List.iter required_by ~f:(Format.fprintf ppf "-> required by %S\n");
|
|
|
|
let cmdline_suggestion =
|
|
|
|
(* CR-someday jdimino: this is ugly *)
|
|
|
|
match Array.to_list Sys.argv with
|
|
|
|
| prog :: "build" :: args ->
|
|
|
|
prog :: "external-lib-deps" :: "--missing" :: args
|
|
|
|
| _ ->
|
|
|
|
["jbuilder"; "external-lib-deps"; "--missing"]
|
|
|
|
in
|
|
|
|
Format.fprintf ppf
|
|
|
|
"Hint: try: %s\n"
|
|
|
|
(List.map cmdline_suggestion ~f:quote_for_shell |> String.concat ~sep:" ")
|
2016-12-02 13:54:32 +00:00
|
|
|
| Code_error msg ->
|
|
|
|
let bt = Printexc.raw_backtrace_to_string backtrace in
|
2017-03-10 11:22:01 +00:00
|
|
|
Format.fprintf ppf "@{<error>Internal error, please report upstream \
|
|
|
|
including the contents of _build/log.@}\n\
|
2016-12-02 13:54:32 +00:00
|
|
|
Description: %s\n\
|
|
|
|
Backtrace:\n\
|
|
|
|
%s" msg bt
|
2017-03-01 11:27:58 +00:00
|
|
|
| Unix.Unix_error (err, func, fname) ->
|
|
|
|
Format.fprintf ppf "@{<error>Error@}: %s: %s: %s\n"
|
|
|
|
func fname (Unix.error_message err)
|
2016-12-02 13:54:32 +00:00
|
|
|
| _ ->
|
|
|
|
let s = Printexc.to_string exn in
|
|
|
|
let bt = Printexc.raw_backtrace_to_string backtrace in
|
|
|
|
if String.is_prefix s ~prefix:"File \"" then
|
|
|
|
Format.fprintf ppf "%s\nBacktrace:\n%s" s bt
|
|
|
|
else
|
2017-02-24 11:28:30 +00:00
|
|
|
Format.fprintf ppf "@{<error>Error@}: exception %s\nBacktrace:\n%s" s bt
|
2016-11-13 12:32:12 +00:00
|
|
|
|
2016-12-02 13:54:32 +00:00
|
|
|
let report_error ?map_fname ppf exn =
|
|
|
|
match exn with
|
|
|
|
| Build_system.Build_error.E err ->
|
|
|
|
let module E = Build_system.Build_error in
|
|
|
|
report_error ?map_fname ppf (E.exn err) ~backtrace:(E.backtrace err);
|
|
|
|
if !Clflags.debug_dep_path then
|
|
|
|
Format.fprintf ppf "Dependency path:\n %s\n"
|
|
|
|
(String.concat ~sep:"\n--> "
|
2017-03-15 11:49:31 +00:00
|
|
|
(List.map (E.dependency_path err) ~f:Utils.describe_target))
|
2016-12-02 13:54:32 +00:00
|
|
|
| exn ->
|
|
|
|
let backtrace = Printexc.get_raw_backtrace () in
|
|
|
|
report_error ?map_fname ppf exn ~backtrace
|
|
|
|
|
2017-02-21 15:09:58 +00:00
|
|
|
(* Called by the script generated by ../build.ml *)
|
|
|
|
let bootstrap () =
|
2017-02-24 12:20:07 +00:00
|
|
|
Ansi_color.setup_err_formatter_colors ();
|
2017-02-21 15:09:58 +00:00
|
|
|
let pkg = "jbuilder" in
|
|
|
|
let main () =
|
|
|
|
let anon s = raise (Arg.Bad (Printf.sprintf "don't know what to do with %s\n" s)) in
|
2017-02-24 12:19:02 +00:00
|
|
|
Arg.parse
|
2017-03-01 11:27:58 +00:00
|
|
|
[ "-j" , Set_int Clflags.concurrency, "JOBS concurrency"
|
|
|
|
; "--dev" , Set Clflags.dev_mode , " set development mode"
|
|
|
|
; "--debug-rules", Set Clflags.debug_rules , " print out rules"
|
2017-02-24 12:19:02 +00:00
|
|
|
]
|
|
|
|
anon "Usage: boot.exe [-j JOBS] [--dev]\nOptions are:";
|
2017-03-10 12:32:27 +00:00
|
|
|
let log = Log.create () in
|
|
|
|
Future.Scheduler.go ~log
|
|
|
|
(setup ~log ~workspace:{ merlin_context = Some "default"; contexts = [Default] } ()
|
2017-02-26 20:53:32 +00:00
|
|
|
>>= fun { build_system = bs; _ } ->
|
2017-02-21 15:09:58 +00:00
|
|
|
Build_system.do_build_exn bs [Path.(relative root) (pkg ^ ".install")])
|
|
|
|
in
|
2016-12-02 13:54:32 +00:00
|
|
|
try
|
|
|
|
main ()
|
|
|
|
with exn ->
|
|
|
|
Format.eprintf "%a@?" (report_error ?map_fname:None) exn;
|
|
|
|
exit 1
|