diff --git a/doc/manual.org b/doc/manual.org index f4053cf5..95e9cb4a 100644 --- a/doc/manual.org +++ b/doc/manual.org @@ -780,3 +780,35 @@ The following constructions are available: * Usage TODO + +* Advanced topics + +This section describes some details of Jbuilder for advanced users. + +** META file generation + +Jbuilder uses =META= files from the [[http://projects.camlcity.org/projects/findlib.html][findlib library manager]] in order +to inter-operate with the rest of the world when installing +libraries. It is able to generate them automatically. However, for the +rare cases where you would need a specific =META= file, or to ease the +transition of a project to Jbuilder, it is allowed to write/generate a +specific one. + +In order to do that, write or setup a rule to generate a +=META.= file in the same directory as the =.opam= +file. If you do that, Jbuilder will still generate a =META= file but +it will be called =META..from-jbuilder=. So for instance if +you want to extend the =META= file generated by Jbuilder you can +write: + +#+begin_src scheme +(rule + ((targets (META.foo)) + (deps (META.foo.from-jbuilder)) + (action "{ cat ${<}; echo blah } > ${@}"))) +#+end_src + +Additionally, Jbuilder provides a simpler mechanism for this scheme: +just write or generate a =META..template= file containing a +line of the form =# JBUILDER_GEN=. Jbuilder will automatically insert +its generated =META= contents in place of this line. diff --git a/src/alias.ml b/src/alias.ml index 6149f21a..1484812c 100644 --- a/src/alias.ml +++ b/src/alias.ml @@ -46,7 +46,8 @@ let rules store ~prefix ~tree = Hashtbl.fold store ~init:[] ~f:(fun ~key:alias ~data:deps acc -> let open Build.O in let rule = - Build.path_set !deps >>> - Build.touch alias + Build_interpret.Rule.make + (Build.path_set !deps >>> + Build.touch alias) in rule :: acc) diff --git a/src/alias.mli b/src/alias.mli index 7742ee0b..d9a8c8d2 100644 --- a/src/alias.mli +++ b/src/alias.mli @@ -21,4 +21,4 @@ val rules : Store.t -> prefix:Path.t -> tree:tree - -> (unit, unit) Build.t list + -> Build_interpret.Rule.t list diff --git a/src/build_interpret.ml b/src/build_interpret.ml index cf7e10c8..5899f177 100644 --- a/src/build_interpret.ml +++ b/src/build_interpret.ml @@ -92,3 +92,15 @@ let targets = | Fail _ -> acc in fun t -> loop (Build.repr t) [] + +module Rule = struct + type t = + { build : (unit, unit) Build.t + ; targets : Target.t list + } + + let make build = + { build + ; targets = targets build + } +end diff --git a/src/build_interpret.mli b/src/build_interpret.mli index c4805eee..304badea 100644 --- a/src/build_interpret.mli +++ b/src/build_interpret.mli @@ -9,6 +9,15 @@ module Target : sig val paths : t list -> Path.Set.t end +module Rule : sig + type t = + { build : (unit, unit) Build.t + ; targets : Target.t list + } + + val make : (unit, unit) Build.t -> t +end + val deps : (_, _) Build.t -> all_targets_by_dir:Path.Set.t Path.Map.t Lazy.t diff --git a/src/build_system.ml b/src/build_system.ml index b44871ed..ff7db75f 100644 --- a/src/build_system.ml +++ b/src/build_system.ml @@ -200,17 +200,7 @@ let create_file_specs t targets rule ~allow_override = | Target.Vfile (Vspec.T (fn, kind)) -> add_spec t fn (File_spec.create rule (Sexp_file kind)) ~allow_override) -module Pre_rule = struct - type t = - { build : (unit, unit) Build.t - ; targets : Target.t list - } - - let make build = - { build - ; targets = Build_interpret.targets build - } -end +module Pre_rule = Build_interpret.Rule let compile_rule t ~all_targets_by_dir ?(allow_override=false) pre_rule = let { Pre_rule. build; targets = target_specs } = pre_rule in @@ -276,7 +266,6 @@ let setup_copy_rules t ~all_non_target_source_files ~all_targets_by_dir = ~allow_override:true)) let create ~file_tree ~rules = - let rules = List.map rules ~f:Pre_rule.make in let all_source_files = File_tree.fold file_tree ~init:Pset.empty ~f:(fun dir acc -> let path = File_tree.Dir.path dir in diff --git a/src/build_system.mli b/src/build_system.mli index e42a5b97..1728d7f2 100644 --- a/src/build_system.mli +++ b/src/build_system.mli @@ -4,7 +4,7 @@ open! Import type t -val create : file_tree:File_tree.t -> rules:(unit, unit) Build.t list -> t +val create : file_tree:File_tree.t -> rules:Build_interpret.Rule.t list -> t val is_target : t -> Path.t -> bool diff --git a/src/gen_rules.ml b/src/gen_rules.ml index e8c43a49..370d6688 100644 --- a/src/gen_rules.ml +++ b/src/gen_rules.ml @@ -244,8 +244,34 @@ module Gen(P : Params) = struct let rules () = rules store ~prefix:ctx.build_dir ~tree:P.tree end + let all_rules = ref [] - let add_rule rule = all_rules := rule :: !all_rules + let known_targets_by_dir_so_far = ref Path.Map.empty + + let add_rule build = + let rule = Build_interpret.Rule.make build in + all_rules := rule :: !all_rules; + known_targets_by_dir_so_far := + List.fold_left rule.targets ~init:!known_targets_by_dir_so_far ~f:(fun acc target -> + let path = Build_interpret.Target.path target in + let dir = Path.parent path in + let fn = Path.basename path in + let files = + match Path.Map.find dir acc with + | None -> String_set.singleton fn + | Some set -> String_set.add fn set + in + Path.Map.add acc ~key:dir ~data:files) + + let sources_and_targets_known_so_far ~src_path = + let sources = + match File_tree.find_dir P.file_tree src_path with + | None -> String_set.empty + | Some dir -> File_tree.Dir.files dir + in + match Path.Map.find src_path !known_targets_by_dir_so_far with + | None -> sources + | Some set -> String_set.union sources set (* +-----------------------------------------------------------------+ | Tools | @@ -1350,76 +1376,6 @@ module Gen(P : Params) = struct ; obj_name = "" }) - (* +-----------------------------------------------------------------+ - | META | - +-----------------------------------------------------------------+ *) - - let stanzas_to_consider_for_install = - if P.filter_out_optional_stanzas_with_missing_deps then - List.concat_map P.stanzas ~f:(fun { ctx_dir; stanzas; _ } -> - List.filter_map stanzas ~f:(function - | Library _ -> None - | stanza -> Some (ctx_dir, stanza))) - @ List.map (Lib_db.internal_libs_without_non_installable_optional_ones) - ~f:(fun (dir, lib) -> (dir, Stanza.Library lib)) - else - List.concat_map P.stanzas ~f:(fun { ctx_dir; stanzas; _ } -> - List.map stanzas ~f:(fun s -> (ctx_dir, s))) - - let () = - String_map.iter P.packages ~f:(fun ~key:package ~data:src_path -> - let path = Path.append ctx.build_dir src_path in - let meta_fn = "META." ^ package in - let meta_path = Path.relative path meta_fn in - let template = - let templ_fn = meta_fn ^ ".template" in - let templ_path = Path.relative src_path templ_fn in - if File_tree.exists P.file_tree templ_path then - Build.path templ_path - >>^ fun () -> - lines_of_file (Path.to_string templ_path) - else - Build.return ["# JBUILDER_GEN"] - in - let meta = - Gen_meta.gen ~package - ~stanzas:stanzas_to_consider_for_install - ~lib_deps:(fun ~dir jbuild -> - match jbuild with - | Library lib -> - Lib_db.load_requires ~dir ~item:lib.name - >>^ List.map ~f:Lib.best_name - | Executables exes -> - let item = List.hd exes.names in - Lib_db.load_requires ~dir ~item - >>^ List.map ~f:Lib.best_name - | _ -> Build.return []) - ~ppx_runtime_deps:(fun ~dir jbuild -> - match jbuild with - | Library lib -> - Lib_db.load_runtime_deps ~dir ~item:lib.name - >>^ List.map ~f:Lib.best_name - | _ -> Build.return []) - in - add_rule - (Build.fanout meta template - >>> - Build.create_file ~target:meta_path (fun ((meta : Meta.t), template) -> - with_file_out (Path.to_string meta_path) ~f:(fun oc -> - let ppf = Format.formatter_of_out_channel oc in - Format.pp_open_vbox ppf 0; - List.iter template ~f:(fun s -> - if String.is_prefix s ~prefix:"#" then - match - String.split_words (String.sub s ~pos:1 ~len:(String.length s - 1)) - with - | ["JBUILDER_GEN"] -> Format.fprintf ppf "%a@," Meta.pp meta.entries - | _ -> Format.fprintf ppf "%s@," s - else - Format.fprintf ppf "%s@," s); - Format.pp_close_box ppf (); - Format.pp_print_flush ppf ())))) - (* +-----------------------------------------------------------------+ | Stanza | +-----------------------------------------------------------------+ *) @@ -1465,21 +1421,104 @@ module Gen(P : Params) = struct let () = List.iter P.stanzas ~f:rules (* +-----------------------------------------------------------------+ - | Installation | + | META | +-----------------------------------------------------------------+ *) - let known_targets_by_dir_so_far = - List.fold_left !all_rules ~init:Path.Map.empty ~f:(fun acc rule -> - List.fold_left (Build_interpret.targets rule) ~init:acc ~f:(fun acc target -> - let path = Build_interpret.Target.path target in - let dir = Path.parent path in - let fn = Path.basename path in - let files = - match Path.Map.find dir acc with - | None -> String_set.singleton fn - | Some set -> String_set.add fn set - in - Path.Map.add acc ~key:dir ~data:files)) + (* The rules for META files must come after the interpretation of the jbuild stanzas + since a user rule might generate a META. file *) + + let stanzas_to_consider_for_install = + if P.filter_out_optional_stanzas_with_missing_deps then + List.concat_map P.stanzas ~f:(fun { ctx_dir; stanzas; _ } -> + List.filter_map stanzas ~f:(function + | Library _ -> None + | stanza -> Some (ctx_dir, stanza))) + @ List.map (Lib_db.internal_libs_without_non_installable_optional_ones) + ~f:(fun (dir, lib) -> (dir, Stanza.Library lib)) + else + List.concat_map P.stanzas ~f:(fun { ctx_dir; stanzas; _ } -> + List.map stanzas ~f:(fun s -> (ctx_dir, s))) + + (* META files that must be installed. Either because there is an explicit or user + generated one, or because *) + let packages_with_explicit_or_user_generated_meta = + String_map.bindings P.packages + |> List.filter_map ~f:(fun (package, src_path) -> + let path = Path.append ctx.build_dir src_path in + let meta_fn = "META." ^ package in + let meta_templ_fn = meta_fn ^ ".template" in + + let has_meta, has_meta_tmpl = + let files = sources_and_targets_known_so_far ~src_path in + (String_set.mem meta_fn files, + String_set.mem meta_templ_fn files) + in + + let meta_fn = + if has_meta then + meta_fn ^ ".from-jbuilder" + else + meta_fn + in + let meta_path = Path.relative path meta_fn in + + let template = + if has_meta_tmpl then + let meta_templ_path = Path.relative src_path meta_templ_fn in + Build.path meta_templ_path + >>^ fun () -> + lines_of_file (Path.to_string meta_templ_path) + else + Build.return ["# JBUILDER_GEN"] + in + let meta = + Gen_meta.gen ~package + ~stanzas:stanzas_to_consider_for_install + ~lib_deps:(fun ~dir jbuild -> + match jbuild with + | Library lib -> + Lib_db.load_requires ~dir ~item:lib.name + >>^ List.map ~f:Lib.best_name + | Executables exes -> + let item = List.hd exes.names in + Lib_db.load_requires ~dir ~item + >>^ List.map ~f:Lib.best_name + | _ -> Build.return []) + ~ppx_runtime_deps:(fun ~dir jbuild -> + match jbuild with + | Library lib -> + Lib_db.load_runtime_deps ~dir ~item:lib.name + >>^ List.map ~f:Lib.best_name + | _ -> Build.return []) + in + add_rule + (Build.fanout meta template + >>> + Build.create_file ~target:meta_path (fun ((meta : Meta.t), template) -> + with_file_out (Path.to_string meta_path) ~f:(fun oc -> + let ppf = Format.formatter_of_out_channel oc in + Format.pp_open_vbox ppf 0; + List.iter template ~f:(fun s -> + if String.is_prefix s ~prefix:"#" then + match + String.split_words (String.sub s ~pos:1 ~len:(String.length s - 1)) + with + | ["JBUILDER_GEN"] -> Format.fprintf ppf "%a@," Meta.pp meta.entries + | _ -> Format.fprintf ppf "%s@," s + else + Format.fprintf ppf "%s@," s); + Format.pp_close_box ppf (); + Format.pp_print_flush ppf ()))); + + if has_meta || has_meta_tmpl then + Some package + else + None) + |> String_set.of_list + + (* +-----------------------------------------------------------------+ + | Installation | + +-----------------------------------------------------------------+ *) let lib_install_files ~dir (lib : Library.t) = let byte = List.mem Mode.Byte ~set:lib.modes in @@ -1561,13 +1600,8 @@ module Gen(P : Params) = struct | _ -> []) in let entries = - let root_listing = File_tree.Dir.files (File_tree.root P.file_tree) in - let root_targets = - match Path.Map.find ctx.build_dir known_targets_by_dir_so_far with - | None -> root_listing - | Some set -> String_set.union root_listing set - in - String_set.fold root_targets ~init:entries ~f:(fun fn acc -> + let files = sources_and_targets_known_so_far ~src_path:Path.root in + String_set.fold files ~init:entries ~f:(fun fn acc -> if is_odig_doc_file fn then Install.Entry.make Doc (Path.relative ctx.build_dir fn) :: acc else @@ -1578,9 +1612,10 @@ module Gen(P : Params) = struct Install.Entry.make Lib opam ~dst:"opam" :: entries in let entries = + (* Install a META file if the user wrote one or setup a rule to generate one, or if + we have at least another file to install in the lib/ directory *) let meta_fn = "META." ^ package in - if File_tree.file_exists P.file_tree package_path meta_fn || - File_tree.file_exists P.file_tree package_path (meta_fn ^ ".template") || + if String_set.mem package packages_with_explicit_or_user_generated_meta || List.exists entries ~f:(fun (e : Install.Entry.t) -> e.section = Lib) then let meta = Path.append ctx.build_dir (Path.relative package_path meta_fn) in Install.Entry.make Lib meta ~dst:"META" :: entries diff --git a/src/gen_rules.mli b/src/gen_rules.mli index 461f07d9..c12bac3a 100644 --- a/src/gen_rules.mli +++ b/src/gen_rules.mli @@ -8,4 +8,4 @@ val gen -> packages:Path.t String_map.t -> ?filter_out_optional_stanzas_with_missing_deps:bool (** default: true *) -> unit - -> (unit, unit) Build.t list + -> Build_interpret.Rule.t list