From c0f4c894bfe1b86f22f737420aceaca0b83f0d4e Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Tue, 29 Oct 2024 14:28:21 +0000 Subject: [PATCH] Driver: Slightly nicer pkg_args --- src/driver/compile.ml | 12 ++-- src/driver/landing_pages.ml | 26 ++++----- src/driver/odoc_unit.ml | 112 ++++++++++++++++++------------------ src/driver/odoc_unit.mli | 27 ++++++--- 4 files changed, 93 insertions(+), 84 deletions(-) diff --git a/src/driver/compile.ml b/src/driver/compile.ml index 4b373289f5..00450c5a63 100644 --- a/src/driver/compile.ml +++ b/src/driver/compile.ml @@ -214,7 +214,8 @@ let link : compiled list -> _ = let link : compiled -> linked = fun c -> let link input_file output_file = - let { Odoc_unit.libs; pages; _ } = c.pkg_args in + let libs = Odoc_unit.Pkg_args.compiled_libs c.pkg_args in + let pages = Odoc_unit.Pkg_args.compiled_pages c.pkg_args in let includes = c.include_dirs in Odoc.link ~input_file ~output_file ~includes ~libs ~docs:pages ~current_package:c.pkgname () @@ -251,13 +252,10 @@ let html_generate ~occurrence_file output_dir linked = let compile_index : Odoc_unit.index -> _ = fun index -> let compile_index_one - ({ - pkg_args = { pages_linked; libs_linked; _ }; - output_file; - json; - search_dir = _; - } as index : + ({ pkg_args; output_file; json; search_dir = _ } as index : Odoc_unit.index) = + let libs_linked = Odoc_unit.Pkg_args.linked_libs pkg_args in + let pages_linked = Odoc_unit.Pkg_args.linked_pages pkg_args in let () = Odoc.compile_index ~json ~occurrence_file ~output_file ~libs:libs_linked ~docs:pages_linked () diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml index 2f6fee1a6d..2a45787724 100644 --- a/src/driver/landing_pages.ml +++ b/src/driver/landing_pages.ml @@ -3,8 +3,6 @@ open Odoc_unit let fpf = Format.fprintf -let make_rel dir l = List.map (fun (x, y) -> (x, Fpath.(dir // y))) l - let make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content ?(include_dirs = Fpath.Set.empty) ~pkgname ~pkg_args () = let input_file = Fpath.(mld_dir // rel_path / "index.mld") in @@ -45,10 +43,10 @@ module PackageLanding = struct let pages_rel = [ (pkg.name, rel_path) ] in let pkg_args = { - pages = make_rel output_dir pages_rel; + Pkg_args.pages = pages_rel; libs = []; - pages_linked = make_rel odocl_dir pages_rel; - libs_linked = []; + compile_dir = output_dir; + link_dir = odocl_dir; } in make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content @@ -73,10 +71,10 @@ module PackageList = struct let pages_rel = [ (pkgname, rel_path) ] in let pkg_args = { - pages = make_rel odoc_dir pages_rel; + Pkg_args.pages = pages_rel; libs = []; - pages_linked = make_rel odocl_dir pages_rel; - libs_linked = []; + compile_dir = output_dir; + link_dir = odocl_dir; } in make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir ~content ~pkgname @@ -97,10 +95,10 @@ module LibraryLanding = struct let pages_rel = [ (pkg.name, rel_path) ] in let pkg_args = { - pages = make_rel odoc_dir pages_rel; + Pkg_args.pages = pages_rel; libs = []; - pages_linked = make_rel odocl_dir pages_rel; - libs_linked = []; + link_dir = odocl_dir; + compile_dir = output_dir; } in let include_dirs = Fpath.Set.singleton Fpath.(odoc_dir // rel_path) in @@ -122,10 +120,10 @@ module PackageLibLanding = struct let pages_rel = [ (pkg.name, rel_path) ] in let pkg_args = { - pages = make_rel odoc_dir pages_rel; + Pkg_args.pages = pages_rel; libs = []; - pages_linked = make_rel odocl_dir pages_rel; - libs_linked = []; + compile_dir = output_dir; + link_dir = odocl_dir; } in make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content diff --git a/src/driver/odoc_unit.ml b/src/driver/odoc_unit.ml index 936375f426..048a97b621 100644 --- a/src/driver/odoc_unit.ml +++ b/src/driver/odoc_unit.ml @@ -1,21 +1,43 @@ -type pkg_args = { - pages : (string * Fpath.t) list; - libs : (string * Fpath.t) list; - pages_linked : (string * Fpath.t) list; - libs_linked : (string * Fpath.t) list; -} +module Pkg_args = struct + type t = { + compile_dir : Fpath.t; + link_dir : Fpath.t; + pages : (string * Fpath.t) list; + libs : (string * Fpath.t) list; + } -let pp_pkg_args fmt x = - let sfp_pp = - Fmt.( - list ~sep:comma (fun fmt (a, b) -> - Format.fprintf fmt "(%s, %a)" a Fpath.pp b)) - in - Format.fprintf fmt "@[pages: [%a]@;libs: [%a]@]" sfp_pp x.pages sfp_pp - x.libs + let map_rel dir = List.map (fun (a, b) -> (a, Fpath.(dir // b))) + + let compiled_pages v = map_rel v.compile_dir v.pages + let compiled_libs v = map_rel v.compile_dir v.libs + let linked_pages v = map_rel v.link_dir v.pages + let linked_libs v = map_rel v.link_dir v.libs + + let combine v1 v2 = + if v1.compile_dir <> v2.compile_dir then + Fmt.invalid_arg "combine: compile_dir differs"; + if v1.link_dir <> v2.link_dir then + Fmt.invalid_arg "combine: link_dir differs"; + { + compile_dir = v1.compile_dir; + link_dir = v1.link_dir; + pages = v1.pages @ v2.pages; + libs = v1.libs @ v2.libs; + } + + let pp fmt x = + let sfp_pp = + Fmt.( + list ~sep:comma (fun fmt (a, b) -> + Format.fprintf fmt "(%s, %a)" a Fpath.pp b)) + in + Format.fprintf fmt + "@[compile_dir: %a@;link_dir: %a@;pages: [%a]@;libs: [%a]@]" Fpath.pp + x.compile_dir Fpath.pp x.link_dir sfp_pp x.pages sfp_pp x.libs +end type index = { - pkg_args : pkg_args; + pkg_args : Pkg_args.t; output_file : Fpath.t; json : bool; search_dir : Fpath.t; @@ -24,7 +46,7 @@ type index = { let pp_index fmt x = Format.fprintf fmt "@[pkg_args: %a@;output_file: %a@;json: %b@;search_dir: %a@]" - pp_pkg_args x.pkg_args Fpath.pp x.output_file x.json Fpath.pp x.search_dir + Pkg_args.pp x.pkg_args Fpath.pp x.output_file x.json Fpath.pp x.search_dir type 'a unit = { parent_id : Odoc.Id.t; @@ -33,7 +55,7 @@ type 'a unit = { output_dir : Fpath.t; odoc_file : Fpath.t; odocl_file : Fpath.t; - pkg_args : pkg_args; + pkg_args : Pkg_args.t; pkgname : string; include_dirs : Fpath.Set.t; index : index option; @@ -89,7 +111,7 @@ and pp : all_kinds unit Fmt.t = @]" (Odoc.Id.to_string x.parent_id) Fpath.pp x.odoc_dir Fpath.pp x.input_file Fpath.pp x.output_dir Fpath.pp - x.odoc_file Fpath.pp x.odocl_file pp_pkg_args x.pkg_args x.pkgname + x.odoc_file Fpath.pp x.odocl_file Pkg_args.pp x.pkg_args x.pkgname Fmt.(list ~sep:comma Fpath.pp) (Fpath.Set.to_list x.include_dirs) (Fmt.option pp_index) x.index pp_kind @@ -143,17 +165,17 @@ let of_packages ~output_dir ~linked_dir ~index_dir ~extra_libs_paths [] in (* Given a pkg, *) - let base_args pkg lib_deps : pkg_args = + let base_args pkg lib_deps : Pkg_args.t = let own_page = dash_p pkg in let own_libs = List.concat_map dash_l (Util.StringSet.to_list lib_deps) in - let map_rel dir = List.map (fun (a, b) -> (a, Fpath.(dir // b))) in - let pages = map_rel output_dir [ own_page ] in - let libs = map_rel output_dir own_libs in - let pages_linked = map_rel linked_dir [ own_page ] in - let libs_linked = map_rel linked_dir own_libs in - { pages; libs; pages_linked; libs_linked } + { + pages = [ own_page ]; + libs = own_libs; + compile_dir = output_dir; + link_dir = linked_dir; + } in - let args_of_config config : pkg_args = + let args_of_config config : Pkg_args.t = let { Global_config.deps = { packages; libraries } } = config in let pages_rel = List.filter_map @@ -164,42 +186,22 @@ let of_packages ~output_dir ~linked_dir ~index_dir ~extra_libs_paths packages in let libs_rel = List.concat_map dash_l libraries in - let map_rel dir = List.map (fun (a, b) -> (a, Fpath.(dir // b))) in - let pages = map_rel output_dir pages_rel in - let libs = map_rel output_dir libs_rel in - let pages_linked = map_rel linked_dir pages_rel in - let libs_linked = map_rel linked_dir libs_rel in - { pages; libs; pages_linked; libs_linked } + { + pages = pages_rel; + libs = libs_rel; + compile_dir = output_dir; + link_dir = linked_dir; + } in let args_of = let cache = Hashtbl.create 10 in - fun pkg lib_deps : pkg_args -> + fun pkg lib_deps : Pkg_args.t -> match Hashtbl.find_opt cache (pkg, lib_deps) with | Some res -> res | None -> - let { - pages = own_page; - libs = own_libs; - pages_linked = own_p_l; - libs_linked = own_l_l; - } = - base_args pkg lib_deps - in - let { - pages = config_pages; - libs = config_libs; - pages_linked = cfg_p_l; - libs_linked = cfg_l_l; - } = - args_of_config pkg.Packages.config - in let result = - { - pages = own_page @ config_pages; - libs = own_libs @ config_libs; - pages_linked = own_p_l @ cfg_p_l; - libs_linked = own_l_l @ cfg_l_l; - } + Pkg_args.combine (base_args pkg lib_deps) + (args_of_config pkg.Packages.config) in Hashtbl.add cache (pkg, lib_deps) result; result diff --git a/src/driver/odoc_unit.mli b/src/driver/odoc_unit.mli index fba79dc60a..d375e726fc 100644 --- a/src/driver/odoc_unit.mli +++ b/src/driver/odoc_unit.mli @@ -1,12 +1,23 @@ -type pkg_args = { - pages : (string * Fpath.t) list; - libs : (string * Fpath.t) list; - pages_linked : (string * Fpath.t) list; - libs_linked : (string * Fpath.t) list; -} +module Pkg_args : sig + type t = { + compile_dir : Fpath.t; + link_dir : Fpath.t; + pages : (string * Fpath.t) list; + libs : (string * Fpath.t) list; + } + + val compiled_pages : t -> (string * Fpath.t) list + val compiled_libs : t -> (string * Fpath.t) list + val linked_pages : t -> (string * Fpath.t) list + val linked_libs : t -> (string * Fpath.t) list + + val combine : t -> t -> t + + val pp : t Fmt.t +end type index = { - pkg_args : pkg_args; + pkg_args : Pkg_args.t; output_file : Fpath.t; json : bool; search_dir : Fpath.t; @@ -19,7 +30,7 @@ type 'a unit = { output_dir : Fpath.t; odoc_file : Fpath.t; odocl_file : Fpath.t; - pkg_args : pkg_args; + pkg_args : Pkg_args.t; pkgname : string; include_dirs : Fpath.Set.t; index : index option;