From 99e3f280f99de7b750405296da92241eeda155ca Mon Sep 17 00:00:00 2001 From: Emile Trotignon Date: Wed, 16 Oct 2024 14:55:13 +0200 Subject: [PATCH 1/8] Add library list to package --- src/driver/landing_pages.ml | 44 ++++++++++++++++++++----------------- 1 file changed, 24 insertions(+), 20 deletions(-) diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml index eca5d59aa2..709f25fc55 100644 --- a/src/driver/landing_pages.ml +++ b/src/driver/landing_pages.ml @@ -26,7 +26,30 @@ let make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content kind = `Mld; } +module PackageLibLanding = struct + let library_list ppf pkg = + let print_lib (lib : Packages.libty) = + fpf ppf "- {{!/%s/%s/index}%s}@\n" pkg.name lib.lib_name lib.lib_name + in + List.iter print_lib pkg.libraries + let content pkg ppf = fpf ppf "{0 %s}@\n%a" pkg.name library_list pkg + let page ~pkg ~odoc_dir ~odocl_dir ~mld_dir ~output_dir = + let content = content pkg in + let rel_path = Fpath.(v pkg.name / "lib") in + let pkg_args = + { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } + in + make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content + ~pkgname:pkg.name ~pkg_args () +end + module PackageLanding = struct + let library_list ppf pkg = + let print_lib (lib : Packages.libty) = + fpf ppf "- {{!/%s/lib/%s/index}%s}@\n" pkg.name lib.lib_name lib.lib_name + in + List.iter print_lib pkg.libraries + let content pkg ppf = fpf ppf "{0 %s}\n" pkg.name; if not (List.is_empty pkg.mlds) then @@ -34,8 +57,7 @@ module PackageLanding = struct "{1 Documentation pages}@\n@\n{{!/%s/doc/index}Documentation for %s}@\n" pkg.name pkg.name; if not (List.is_empty pkg.libraries) then - fpf ppf "{1 Libraries}@\n@\n{{!/%s/lib/index}Libraries for %s}@\n" - pkg.name pkg.name + fpf ppf "{1 Libraries}@\n@\n%a@\n" library_list pkg let page ~odoc_dir ~odocl_dir ~mld_dir ~output_dir ~pkg = let content = content pkg in @@ -88,24 +110,6 @@ module LibraryLanding = struct ~pkgname:pkg.name ~include_dirs ~pkg_args () end -module PackageLibLanding = struct - let content pkg ppf = - fpf ppf "{0 %s}@\n" pkg.name; - let print_lib (lib : Packages.libty) = - fpf ppf "- {{!/%s/%s/index}%s}@\n" pkg.name lib.lib_name lib.lib_name - in - List.iter print_lib pkg.libraries - - let page ~pkg ~odoc_dir ~odocl_dir ~mld_dir ~output_dir = - let content = content pkg in - let rel_path = Fpath.(v pkg.name / "lib") in - let pkg_args = - { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } - in - make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content - ~pkgname:pkg.name ~pkg_args () -end - let of_package ~mld_dir ~odoc_dir ~odocl_dir ~output_dir pkg = let library_pages = List.map From 02c288533a9f2987f23e747b234b5f31677ca73d Mon Sep 17 00:00:00 2001 From: Emile Trotignon Date: Fri, 18 Oct 2024 12:08:14 +0200 Subject: [PATCH 2/8] english words in landing page --- src/driver/landing_pages.ml | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml index 709f25fc55..2c700821aa 100644 --- a/src/driver/landing_pages.ml +++ b/src/driver/landing_pages.ml @@ -44,11 +44,37 @@ module PackageLibLanding = struct end module PackageLanding = struct + let module_list ppf lib = + let module_link ppf m = + fpf ppf "{{:lib/%s/%s/index.html}[%s]}" lib.lib_name m.Packages.m_name + m.Packages.m_name + in + let modules = List.filter (fun m -> not m.m_hidden) lib.modules in + match modules with + | [] -> fpf ppf " with no toplevel module." + | [ m ] -> fpf ppf " with toplevel module %a" module_link m + | _ :: _ -> + let print_module m = fpf ppf " {- %a}@\n" module_link m in + fpf ppf " with toplevel modules : @\n {ul@\n"; + let modules = + List.sort (fun m m' -> String.compare m.m_name m'.m_name) modules + in + List.iter print_module modules; + fpf ppf " }@\n" + let library_list ppf pkg = let print_lib (lib : Packages.libty) = - fpf ppf "- {{!/%s/lib/%s/index}%s}@\n" pkg.name lib.lib_name lib.lib_name + fpf ppf "{- {{!/%s/lib/%s/index}%s}%a}@\n@\n" pkg.name lib.lib_name + lib.lib_name module_list lib in - List.iter print_lib pkg.libraries + fpf ppf "{ul@\n"; + let libraries = + List.sort + (fun lib lib' -> String.compare lib.lib_name lib'.lib_name) + pkg.libraries + in + List.iter print_lib libraries; + fpf ppf "}@\n" let content pkg ppf = fpf ppf "{0 %s}\n" pkg.name; From f4cc882e6568b657be8ee4b170ad68285fa7171f Mon Sep 17 00:00:00 2001 From: Emile Trotignon Date: Fri, 18 Oct 2024 15:57:22 +0200 Subject: [PATCH 3/8] package lib landing page also has a module list --- src/driver/landing_pages.ml | 30 ++++++++++++++++++++++++++++-- 1 file changed, 28 insertions(+), 2 deletions(-) diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml index 2c700821aa..f64bc6a710 100644 --- a/src/driver/landing_pages.ml +++ b/src/driver/landing_pages.ml @@ -27,11 +27,37 @@ let make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content } module PackageLibLanding = struct + let module_list ppf lib = + let module_link ppf m = + fpf ppf "{{:%s/%s/index.html}[%s]}" lib.lib_name m.Packages.m_name + m.Packages.m_name + in + let modules = List.filter (fun m -> not m.m_hidden) lib.modules in + match modules with + | [] -> fpf ppf " with no toplevel module." + | [ m ] -> fpf ppf " with toplevel module %a" module_link m + | _ :: _ -> + let print_module m = fpf ppf " {- %a}@\n" module_link m in + fpf ppf " with toplevel modules : @\n {ul@\n"; + let modules = + List.sort (fun m m' -> String.compare m.m_name m'.m_name) modules + in + List.iter print_module modules; + fpf ppf " }@\n" + let library_list ppf pkg = let print_lib (lib : Packages.libty) = - fpf ppf "- {{!/%s/%s/index}%s}@\n" pkg.name lib.lib_name lib.lib_name + fpf ppf "{- {{!/%s/%s/index}%s}%a}@\n@\n" pkg.name lib.lib_name + lib.lib_name module_list lib in - List.iter print_lib pkg.libraries + fpf ppf "{ul@\n"; + let libraries = + List.sort + (fun lib lib' -> String.compare lib.lib_name lib'.lib_name) + pkg.libraries + in + List.iter print_lib libraries; + fpf ppf "}@\n" let content pkg ppf = fpf ppf "{0 %s}@\n%a" pkg.name library_list pkg let page ~pkg ~odoc_dir ~odocl_dir ~mld_dir ~output_dir = let content = content pkg in From 9fed7ed6136d2be4a5cba2877f35652143fab7c9 Mon Sep 17 00:00:00 2001 From: Emile Trotignon Date: Mon, 21 Oct 2024 15:47:20 +0200 Subject: [PATCH 4/8] implement some of buenzli's recommandations --- src/driver/landing_pages.ml | 15 +++++---------- 1 file changed, 5 insertions(+), 10 deletions(-) diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml index f64bc6a710..abb3ba0bcc 100644 --- a/src/driver/landing_pages.ml +++ b/src/driver/landing_pages.ml @@ -78,10 +78,9 @@ module PackageLanding = struct let modules = List.filter (fun m -> not m.m_hidden) lib.modules in match modules with | [] -> fpf ppf " with no toplevel module." - | [ m ] -> fpf ppf " with toplevel module %a" module_link m | _ :: _ -> let print_module m = fpf ppf " {- %a}@\n" module_link m in - fpf ppf " with toplevel modules : @\n {ul@\n"; + fpf ppf "{ul@\n"; let modules = List.sort (fun m m' -> String.compare m.m_name m'.m_name) modules in @@ -90,26 +89,22 @@ module PackageLanding = struct let library_list ppf pkg = let print_lib (lib : Packages.libty) = - fpf ppf "{- {{!/%s/lib/%s/index}%s}%a}@\n@\n" pkg.name lib.lib_name - lib.lib_name module_list lib + fpf ppf "{2 Library %s}@\n%a@\n" lib.lib_name module_list lib in - fpf ppf "{ul@\n"; let libraries = List.sort (fun lib lib' -> String.compare lib.lib_name lib'.lib_name) pkg.libraries in - List.iter print_lib libraries; - fpf ppf "}@\n" + List.iter print_lib libraries let content pkg ppf = fpf ppf "{0 %s}\n" pkg.name; if not (List.is_empty pkg.mlds) then - fpf ppf - "{1 Documentation pages}@\n@\n{{!/%s/doc/index}Documentation for %s}@\n" + fpf ppf "{1 Documentation}@\n@\n{{!/%s/doc/index}Documentation for %s}@\n" pkg.name pkg.name; if not (List.is_empty pkg.libraries) then - fpf ppf "{1 Libraries}@\n@\n%a@\n" library_list pkg + fpf ppf "{1 API}@\n@\n%a@\n" library_list pkg let page ~odoc_dir ~odocl_dir ~mld_dir ~output_dir ~pkg = let content = content pkg in From be42317fcf78af52ee1acddce3eb237ea85143a7 Mon Sep 17 00:00:00 2001 From: Emile Trotignon Date: Mon, 21 Oct 2024 15:50:29 +0200 Subject: [PATCH 5/8] remove useless heading --- src/driver/landing_pages.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml index abb3ba0bcc..660c274717 100644 --- a/src/driver/landing_pages.ml +++ b/src/driver/landing_pages.ml @@ -101,7 +101,7 @@ module PackageLanding = struct let content pkg ppf = fpf ppf "{0 %s}\n" pkg.name; if not (List.is_empty pkg.mlds) then - fpf ppf "{1 Documentation}@\n@\n{{!/%s/doc/index}Documentation for %s}@\n" + fpf ppf "@\n{{!/%s/doc/index}Documentation for %s}@\n" pkg.name pkg.name; if not (List.is_empty pkg.libraries) then fpf ppf "{1 API}@\n@\n%a@\n" library_list pkg From a05b1b5b909afc1407289f0a5d0f7b218b02f1db Mon Sep 17 00:00:00 2001 From: Emile Trotignon Date: Wed, 23 Oct 2024 14:46:40 +0200 Subject: [PATCH 6/8] use {!modules ...} --- src/driver/landing_pages.ml | 22 +++++++++++----------- 1 file changed, 11 insertions(+), 11 deletions(-) diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml index 660c274717..660a4a1794 100644 --- a/src/driver/landing_pages.ml +++ b/src/driver/landing_pages.ml @@ -71,21 +71,16 @@ end module PackageLanding = struct let module_list ppf lib = - let module_link ppf m = - fpf ppf "{{:lib/%s/%s/index.html}[%s]}" lib.lib_name m.Packages.m_name - m.Packages.m_name - in let modules = List.filter (fun m -> not m.m_hidden) lib.modules in match modules with | [] -> fpf ppf " with no toplevel module." | _ :: _ -> - let print_module m = fpf ppf " {- %a}@\n" module_link m in - fpf ppf "{ul@\n"; let modules = List.sort (fun m m' -> String.compare m.m_name m'.m_name) modules in - List.iter print_module modules; - fpf ppf " }@\n" + fpf ppf " {!modules:"; + List.iter (fun m -> fpf ppf " %s" m.m_name) modules; + fpf ppf " }@\n" let library_list ppf pkg = let print_lib (lib : Packages.libty) = @@ -101,19 +96,24 @@ module PackageLanding = struct let content pkg ppf = fpf ppf "{0 %s}\n" pkg.name; if not (List.is_empty pkg.mlds) then - fpf ppf "@\n{{!/%s/doc/index}Documentation for %s}@\n" - pkg.name pkg.name; + fpf ppf "@\n{{!/%s/doc/index}Documentation for %s}@\n" pkg.name pkg.name; if not (List.is_empty pkg.libraries) then fpf ppf "{1 API}@\n@\n%a@\n" library_list pkg + let include_dirs ~odoc_dir pkg = + List.map + (fun lib -> Fpath.(odoc_dir // pkg.pkg_dir / "lib" / lib.lib_name)) + pkg.Packages.libraries + let page ~odoc_dir ~odocl_dir ~mld_dir ~output_dir ~pkg = let content = content pkg in let rel_path = Fpath.v pkg.name in let pkg_args = { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } in + let include_dirs = include_dirs ~odoc_dir pkg in make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content - ~pkgname:pkg.name ~pkg_args () + ~pkgname:pkg.name ~pkg_args ~include_dirs () end module PackageList = struct From 1beff18ff7c77d22eecc42effb8cd6c60e2bdf48 Mon Sep 17 00:00:00 2001 From: Emile Trotignon Date: Fri, 25 Oct 2024 15:12:33 +0200 Subject: [PATCH 7/8] Redirect generated pages to hand written ones --- src/driver/landing_pages.ml | 142 ++++++++++++++++++----------------- src/driver/landing_pages.mli | 2 +- src/driver/odoc_driver.ml | 13 +++- 3 files changed, 84 insertions(+), 73 deletions(-) diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml index 660a4a1794..60258baa70 100644 --- a/src/driver/landing_pages.ml +++ b/src/driver/landing_pages.ml @@ -1,6 +1,17 @@ open Packages open Odoc_unit +type unit_of_html = + | Html of { path : Fpath.t; content : string } + | Unit of [ `Mld ] Odoc_unit.unit + +let split_units_and_html li : + (Fpath.t * string) list * [> `Mld ] Odoc_unit.unit list = + List.partition_map + (function + | Html { path; content } -> Left (path, content) + | Unit unit -> Right (unit :> [< `Mld ] Odoc_unit.unit)) + li let fpf = Format.fprintf let make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content @@ -12,61 +23,31 @@ let make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content fpf (Format.formatter_of_out_channel oc) "%t@?" content) |> Result.get_ok; let parent_id = rel_path |> Odoc.Id.of_fpath in - { - parent_id; - odoc_dir; - input_file; - output_dir; - odoc_file; - odocl_file; - pkg_args; - pkgname; - include_dirs; - index = None; - kind = `Mld; - } + Unit + { + parent_id; + odoc_dir; + input_file; + output_dir; + odoc_file; + odocl_file; + pkg_args; + pkgname; + include_dirs; + index = None; + kind = `Mld; + } module PackageLibLanding = struct - let module_list ppf lib = - let module_link ppf m = - fpf ppf "{{:%s/%s/index.html}[%s]}" lib.lib_name m.Packages.m_name - m.Packages.m_name - in - let modules = List.filter (fun m -> not m.m_hidden) lib.modules in - match modules with - | [] -> fpf ppf " with no toplevel module." - | [ m ] -> fpf ppf " with toplevel module %a" module_link m - | _ :: _ -> - let print_module m = fpf ppf " {- %a}@\n" module_link m in - fpf ppf " with toplevel modules : @\n {ul@\n"; - let modules = - List.sort (fun m m' -> String.compare m.m_name m'.m_name) modules - in - List.iter print_module modules; - fpf ppf " }@\n" - - let library_list ppf pkg = - let print_lib (lib : Packages.libty) = - fpf ppf "{- {{!/%s/%s/index}%s}%a}@\n@\n" pkg.name lib.lib_name - lib.lib_name module_list lib + let page ~pkg = + let package_index = Fpath.(v ".." / "index.html") in + let path = Fpath.(v pkg.name / "lib" / "index.html") in + let content = + Format.asprintf + {||} + Fpath.pp package_index in - fpf ppf "{ul@\n"; - let libraries = - List.sort - (fun lib lib' -> String.compare lib.lib_name lib'.lib_name) - pkg.libraries - in - List.iter print_lib libraries; - fpf ppf "}@\n" - let content pkg ppf = fpf ppf "{0 %s}@\n%a" pkg.name library_list pkg - let page ~pkg ~odoc_dir ~odocl_dir ~mld_dir ~output_dir = - let content = content pkg in - let rel_path = Fpath.(v pkg.name / "lib") in - let pkg_args = - { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } - in - make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content - ~pkgname:pkg.name ~pkg_args () + Html { path; content } end module PackageLanding = struct @@ -94,9 +75,11 @@ module PackageLanding = struct List.iter print_lib libraries let content pkg ppf = - fpf ppf "{0 %s}\n" pkg.name; - if not (List.is_empty pkg.mlds) then - fpf ppf "@\n{{!/%s/doc/index}Documentation for %s}@\n" pkg.name pkg.name; + List.iter + (fun { mld_rel_path; _ } -> + let page = mld_rel_path |> Fpath.rem_ext |> Fpath.to_string in + fpf ppf "@\n{!/%s/doc/%s}@\n" pkg.name page) + pkg.mlds; if not (List.is_empty pkg.libraries) then fpf ppf "{1 API}@\n@\n%a@\n" library_list pkg @@ -105,15 +88,34 @@ module PackageLanding = struct (fun lib -> Fpath.(odoc_dir // pkg.pkg_dir / "lib" / lib.lib_name)) pkg.Packages.libraries - let page ~odoc_dir ~odocl_dir ~mld_dir ~output_dir ~pkg = - let content = content pkg in - let rel_path = Fpath.v pkg.name in - let pkg_args = - { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } + let page_exists pkg page = + List.exists + (fun Packages.{ mld_path = _; mld_rel_path } -> page = mld_rel_path) + pkg.mlds + + let pkg_has_index pkg = page_exists pkg Fpath.(v "index.mld") + + let pkg_redirect pkg = + let package_index = Fpath.(v "doc" / "index.html") in + let path = Fpath.(v pkg.name / "index.html") in + let content = + Format.asprintf + {||} + Fpath.pp package_index in - let include_dirs = include_dirs ~odoc_dir pkg in - make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content - ~pkgname:pkg.name ~pkg_args ~include_dirs () + Html { path; content } + + let page ~odoc_dir ~odocl_dir ~mld_dir ~output_dir ~pkg = + if pkg_has_index pkg then pkg_redirect pkg + else + let content = content pkg in + let rel_path = Fpath.v pkg.name in + let pkg_args = + { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] } + in + let include_dirs = include_dirs ~odoc_dir pkg in + make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content + ~pkgname:pkg.name ~pkg_args ~include_dirs () end module PackageList = struct @@ -166,11 +168,13 @@ let of_package ~mld_dir ~odoc_dir ~odocl_dir ~output_dir pkg = let package_landing_page = PackageLanding.page ~odoc_dir ~odocl_dir ~mld_dir ~output_dir ~pkg in - let library_list_page = - PackageLibLanding.page ~odoc_dir ~odocl_dir ~mld_dir ~output_dir ~pkg - in + let library_list_page = PackageLibLanding.page ~pkg in package_landing_page :: library_list_page :: library_pages -let of_packages ~mld_dir ~odoc_dir ~odocl_dir ~output_dir all = - PackageList.page ~mld_dir ~odoc_dir ~odocl_dir ~output_dir all - :: List.concat_map (of_package ~mld_dir ~odoc_dir ~odocl_dir ~output_dir) all +let of_packages ~mld_dir ~odoc_dir ~odocl_dir ~output_dir all : + (Fpath.t * string) list * [> `Mld ] Odoc_unit.unit list = + split_units_and_html + (PackageList.page ~mld_dir ~odoc_dir ~odocl_dir ~output_dir all + :: List.concat_map + (of_package ~mld_dir ~odoc_dir ~odocl_dir ~output_dir) + all) diff --git a/src/driver/landing_pages.mli b/src/driver/landing_pages.mli index ee44cf1880..c95a15d07f 100644 --- a/src/driver/landing_pages.mli +++ b/src/driver/landing_pages.mli @@ -4,4 +4,4 @@ val of_packages : odocl_dir:Fpath.t -> output_dir:Fpath.t -> Packages.t list -> - [> `Mld ] Odoc_unit.unit list + (Fpath.t * string) list * [ `Mld ] Odoc_unit.unit list diff --git a/src/driver/odoc_driver.ml b/src/driver/odoc_driver.ml index e01bdee765..72a4e3f6db 100644 --- a/src/driver/odoc_driver.ml +++ b/src/driver/odoc_driver.ml @@ -557,20 +557,27 @@ let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers let () = Eio.Fiber.both (fun () -> - let all = + let htmls, all = let all = Util.StringMap.bindings all |> List.map snd in let internal = Odoc_unit.of_packages ~output_dir:odoc_dir ~linked_dir:odocl_dir ~index_dir:None all in - let external_ = + let htmls, external_ = let mld_dir = odoc_dir in let odocl_dir = Option.value odocl_dir ~default:odoc_dir in Landing_pages.of_packages ~mld_dir ~odoc_dir ~odocl_dir ~output_dir:odoc_dir all in - internal @ external_ + (htmls, internal @ (external_ :> Odoc_unit.t list)) in + List.iter + (fun (path, content) -> + Format.eprintf "writing raw html to %a@." Fpath.pp path; + let path = Fpath.(v "_html" // path) in + Out_channel.with_open_text (Fpath.to_string path) (fun ch -> + output_string ch content)) + htmls; Compile.init_stats all; let compiled = Compile.compile ?partial ~partial_dir:odoc_dir ?linked_dir:odocl_dir From db1e7ac48b64301f33e1c3348cc01fdd6446ea5e Mon Sep 17 00:00:00 2001 From: Emile Trotignon Date: Fri, 25 Oct 2024 15:38:40 +0200 Subject: [PATCH 8/8] use debug instead of eprintf --- src/driver/odoc_driver.ml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/src/driver/odoc_driver.ml b/src/driver/odoc_driver.ml index 72a4e3f6db..69f556b618 100644 --- a/src/driver/odoc_driver.ml +++ b/src/driver/odoc_driver.ml @@ -573,7 +573,7 @@ let run libs verbose packages_dir odoc_dir odocl_dir html_dir stats nb_workers in List.iter (fun (path, content) -> - Format.eprintf "writing raw html to %a@." Fpath.pp path; + Logs.debug (fun m -> m "writing raw html to %a" Fpath.pp path); let path = Fpath.(v "_html" // path) in Out_channel.with_open_text (Fpath.to_string path) (fun ch -> output_string ch content))