diff --git a/bin/main.ml b/bin/main.ml index a4a6adee..8c93fb4a 100644 --- a/bin/main.ml +++ b/bin/main.ml @@ -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,.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,.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@}: 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 -> diff --git a/src/build_system.ml b/src/build_system.ml index 425b6e37..91e7dd24 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -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) diff --git a/src/build_system.mli b/src/build_system.mli index b0d3bf4d..fc7b4d58 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -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 diff --git a/src/gen_rules.ml b/src/gen_rules.ml index 71cfefbe..0ffd3dfc 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -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) diff --git a/src/gen_rules.mli b/src/gen_rules.mli index 191c985e..b8e46f8f 100644 --- a/src/gen_rules.mli +++ b/src/gen_rules.mli @@ -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 diff --git a/src/main.ml b/src/main.ml index 51570be7..8506f3f8 100644 --- a/src/main.ml +++ b/src/main.ml @@ -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 "@{Findlib package %S not found.@}\n" pkg + Format.fprintf ppf + "@{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 "@{Internal error, please report upstream.@}\n\ diff --git a/src/main.mli b/src/main.mli index ee98c170..4f39ebe5 100644 --- a/src/main.mli +++ b/src/main.mli @@ -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 }