diff --git a/src/driver/landing_pages.ml b/src/driver/landing_pages.ml
index eca5d59aa2..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,39 +23,99 @@ 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 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
+ Html { path; content }
+end
module PackageLanding = struct
+ let module_list ppf lib =
+ let modules = List.filter (fun m -> not m.m_hidden) lib.modules in
+ match modules with
+ | [] -> fpf ppf " with no toplevel module."
+ | _ :: _ ->
+ let modules =
+ List.sort (fun m m' -> String.compare m.m_name m'.m_name) modules
+ in
+ 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) =
+ fpf ppf "{2 Library %s}@\n%a@\n" lib.lib_name module_list lib
+ in
+ let libraries =
+ List.sort
+ (fun lib lib' -> String.compare lib.lib_name lib'.lib_name)
+ pkg.libraries
+ in
+ 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"
- 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 Libraries}@\n@\n{{!/%s/lib/index}Libraries for %s}@\n"
- pkg.name pkg.name
+ 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
- let rel_path = Fpath.v pkg.name in
- let pkg_args =
- { pages = [ (pkg.name, Fpath.( // ) odoc_dir rel_path) ]; libs = [] }
+ 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_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
- make_unit ~odoc_dir ~odocl_dir ~mld_dir ~output_dir rel_path ~content
- ~pkgname:pkg.name ~pkg_args ()
+ 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
@@ -88,24 +159,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
@@ -115,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..69f556b618 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) ->
+ 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))
+ htmls;
Compile.init_stats all;
let compiled =
Compile.compile ?partial ~partial_dir:odoc_dir ?linked_dir:odocl_dir