Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Driver: Fix hierarchical pages being given wrong parent id #1148

Merged
merged 1 commit into from
Jun 27, 2024
Merged
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
39 changes: 24 additions & 15 deletions src/driver/packages.ml
Original file line number Diff line number Diff line change
Expand Up @@ -297,23 +297,32 @@ let of_libs libs =
in
ignore libname_of_archive;
let mk_mlds pkg_name libraries odoc_pages =
let prefix = Fpath.(v (Opam.prefix ()) / "doc" / pkg_name / "odoc-pages") in
Fpath.Set.fold
(fun mld_path acc ->
let mld_parent_id = Printf.sprintf "%s/doc" pkg_name in
let page_name = Fpath.(rem_ext mld_path |> filename) in
let odoc_file =
Fpath.(v mld_parent_id / ("page-" ^ page_name ^ ".odoc"))
in
let odocl_file = Fpath.(set_ext "odocl" odoc_file) in
let mld_deps = List.map (fun l -> l.odoc_dir) libraries in
{
mld_odoc_file = odoc_file;
mld_odocl_file = odocl_file;
mld_parent_id;
mld_path;
mld_deps;
}
:: acc)
let rel_path = Fpath.rem_prefix prefix mld_path in
match rel_path with
| None -> acc
| Some rel_path ->
let id = Fpath.(v pkg_name / "doc" // rel_path) in
let mld_parent_id =
Format.asprintf "%a" Fpath.pp
(id |> Fpath.parent |> Fpath.rem_empty_seg)
in
let page_name = Fpath.(rem_ext mld_path |> filename) in
let odoc_file =
Fpath.(v mld_parent_id / ("page-" ^ page_name ^ ".odoc"))
in
let odocl_file = Fpath.(set_ext "odocl" odoc_file) in
let mld_deps = List.map (fun l -> l.odoc_dir) libraries in
{
mld_odoc_file = odoc_file;
mld_odocl_file = odocl_file;
mld_parent_id;
mld_path;
mld_deps;
}
:: acc)
odoc_pages []
in
let update_mlds mlds libraries =
Expand Down
Loading