From 9accb773784b7a2f474d6094f0b35649c39cb5a9 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Fri, 6 Sep 2024 17:51:43 +0200 Subject: [PATCH 1/9] Turn Lang.Index.t into a record --- src/model/lang.ml | 5 ++++- src/odoc/indexing.ml | 5 +++-- src/odoc/rendering.ml | 4 ++-- 3 files changed, 9 insertions(+), 5 deletions(-) diff --git a/src/model/lang.ml b/src/model/lang.ml index 4715481536..3db2617cc1 100644 --- a/src/model/lang.ml +++ b/src/model/lang.ml @@ -552,7 +552,10 @@ end = Sidebar module rec Index : sig - type 'a t = Sidebar.t * 'a Paths.Identifier.Hashtbl.Any.t + type 'a t = { + sidebar : Sidebar.t; + entries : 'a Paths.Identifier.Hashtbl.Any.t; + } end = Index diff --git a/src/odoc/indexing.ml b/src/odoc/indexing.ml index 086315f96f..c6dedd13e1 100644 --- a/src/odoc/indexing.ml +++ b/src/odoc/indexing.ml @@ -8,7 +8,7 @@ module H = Odoc_model.Paths.Identifier.Hashtbl.Any let handle_file file ~unit ~page ~occ = match Fpath.basename file with | s when String.is_prefix ~affix:"index-" s -> - Odoc_file.load_index file >>= fun (_sidebar, index) -> Ok (occ index) + Odoc_file.load_index file >>= fun index -> Ok (occ index.entries) | _ -> ( Odoc_file.load file >>= fun unit' -> match unit' with @@ -108,7 +108,8 @@ let compile_to_marshall ~output ~warnings_options sidebar files = in let result = Error.catch_warnings index in result |> Error.handle_warnings ~warnings_options >>= fun () -> - Ok (Odoc_file.save_index output (sidebar, final_index)) + let index = { Lang.Index.sidebar; entries = final_index } in + Ok (Odoc_file.save_index output index) let read_occurrences file = let ic = open_in_bin file in diff --git a/src/odoc/rendering.ml b/src/odoc/rendering.ml index b373203b4e..418d2506e6 100644 --- a/src/odoc/rendering.ml +++ b/src/odoc/rendering.ml @@ -79,8 +79,8 @@ let generate_odoc ~syntax ~warnings_options:_ ~renderer ~output ~extra_suffix (match sidebar with | None -> Ok None | Some x -> - Odoc_file.load_index x >>= fun (sidebar, _) -> - Ok (Some (Odoc_document.Sidebar.of_lang sidebar))) + Odoc_file.load_index x >>= fun index -> + Ok (Some (Odoc_document.Sidebar.of_lang index.sidebar))) >>= fun sidebar -> document_of_odocl ~syntax file >>= fun doc -> render_document renderer ~output ~sidebar ~extra_suffix ~extra doc; From 8d3b4a054863811f19f8e23ce7d8bdefa3e0d0c0 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Fri, 6 Sep 2024 19:29:08 +0200 Subject: [PATCH 2/9] Expose Odoc_model.Frontmatter --- src/model/odoc_model.ml | 1 + 1 file changed, 1 insertion(+) diff --git a/src/model/odoc_model.ml b/src/model/odoc_model.ml index f81a5fe1a7..43965ad14a 100644 --- a/src/model/odoc_model.ml +++ b/src/model/odoc_model.ml @@ -10,3 +10,4 @@ module Location_ = Location_ module Compat = Compat module Semantics = Semantics module Reference = Reference +module Frontmatter = Frontmatter From 2fe81387f47d8be5dd3a71e45ed4f7a6d479a73a Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Fri, 6 Sep 2024 20:10:52 +0200 Subject: [PATCH 3/9] Allow pages that do not belong to a doc hierarchy This is needed to link driver generated pages. --- src/odoc/bin/main.ml | 12 +++++++----- test/integration/link_opts.t/run.t | 4 +--- 2 files changed, 8 insertions(+), 8 deletions(-) diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml index e9936c3271..e9c378f3e4 100644 --- a/src/odoc/bin/main.ml +++ b/src/odoc/bin/main.ml @@ -644,11 +644,13 @@ end = struct | None -> Ok detected_package let current_package_of_page ~current_package page_roots input = - match find_root_of_input page_roots input with - | Ok detected_package -> - validate_current_package ?detected_package page_roots current_package - | Error `Not_found -> - Error (`Msg "The output file must be part of a directory passed as -P") + let detected_package = + (* Driver generated pages might not belong to a doc hierarchy. *) + match find_root_of_input page_roots input with + | Ok p -> p + | Error `Not_found -> None + in + validate_current_package ?detected_package page_roots current_package let is_page input = input |> Fpath.filename |> Astring.String.is_prefix ~affix:"page-" diff --git a/test/integration/link_opts.t/run.t b/test/integration/link_opts.t/run.t index fc49054607..34dd16ef09 100644 --- a/test/integration/link_opts.t/run.t +++ b/test/integration/link_opts.t/run.t @@ -17,12 +17,10 @@ Current library is not passed: [1] $ odoc link -P pkg:h/pkg/doc -L otherlib:h/otherpkg h/pkg/doc/page-page.odoc -Current package is not passed: +Current package is not passed, this is allowed: $ odoc link -P otherpkg:h/otherpkg/doc -L libname:h/pkg/lib/libname h/pkg/lib/libname/test.odoc $ odoc link -P otherpkg:h/otherpkg/doc -L libname:h/pkg/lib/libname h/pkg/doc/page-page.odoc - ERROR: The output file must be part of a directory passed as -P - [1] Specified current package is wrong: From eff3657195e4e5bcb2d31364597e2af382c08120 Mon Sep 17 00:00:00 2001 From: Jules Aguillon Date: Tue, 10 Sep 2024 15:32:37 +0200 Subject: [PATCH 4/9] WIP: Index page short titles --- src/model/frontmatter.ml | 2 + src/model/lang.ml | 1 + src/model/paths.ml | 3 + src/model/paths.mli | 1 + src/odoc/indexing.ml | 46 ++++++++++--- src/odoc/resolver.ml | 4 +- src/odoc/resolver.mli | 3 +- .../pkg/doc/index.mld | 5 ++ .../pkg/doc/subdir/foo.mld | 5 ++ .../pkg/doc/subdir/index.mld | 5 ++ .../breadcrumbs_short_title.t/pkg/index.mld | 5 ++ .../pkg/lib/index.mld | 5 ++ .../pkg/lib/lname/index.mld | 5 ++ .../pkg/lib/lname/lname.mli | 1 + .../parent_id/breadcrumbs_short_title.t/run.t | 69 +++++++++++++++++++ 15 files changed, 146 insertions(+), 14 deletions(-) create mode 100644 test/parent_id/breadcrumbs_short_title.t/pkg/doc/index.mld create mode 100644 test/parent_id/breadcrumbs_short_title.t/pkg/doc/subdir/foo.mld create mode 100644 test/parent_id/breadcrumbs_short_title.t/pkg/doc/subdir/index.mld create mode 100644 test/parent_id/breadcrumbs_short_title.t/pkg/index.mld create mode 100644 test/parent_id/breadcrumbs_short_title.t/pkg/lib/index.mld create mode 100644 test/parent_id/breadcrumbs_short_title.t/pkg/lib/lname/index.mld create mode 100644 test/parent_id/breadcrumbs_short_title.t/pkg/lib/lname/lname.mli create mode 100644 test/parent_id/breadcrumbs_short_title.t/run.t diff --git a/src/model/frontmatter.ml b/src/model/frontmatter.ml index f50e98da1b..5517a643f0 100644 --- a/src/model/frontmatter.ml +++ b/src/model/frontmatter.ml @@ -1 +1,3 @@ type t = (string * string) list + +let get = List.assoc_opt diff --git a/src/model/lang.ml b/src/model/lang.ml index 3db2617cc1..db0c95efeb 100644 --- a/src/model/lang.ml +++ b/src/model/lang.ml @@ -555,6 +555,7 @@ module rec Index : sig type 'a t = { sidebar : Sidebar.t; entries : 'a Paths.Identifier.Hashtbl.Any.t; + pages_short_title : string Paths.Identifier.Hashtbl.Page.t; } end = Index diff --git a/src/model/paths.ml b/src/model/paths.ml index e055b0202e..1f893b08a2 100644 --- a/src/model/paths.ml +++ b/src/model/paths.ml @@ -361,6 +361,8 @@ module Identifier = struct module Page = struct type t = Id.page type t_pv = Id.page_pv + let equal = equal + let hash = hash end module ContainerPage = struct @@ -623,6 +625,7 @@ module Identifier = struct module Hashtbl = struct module Any = Hashtbl.Make (Any) + module Page = Hashtbl.Make (Page) end end diff --git a/src/model/paths.mli b/src/model/paths.mli index bca68307d2..7a9644e7ea 100644 --- a/src/model/paths.mli +++ b/src/model/paths.mli @@ -235,6 +235,7 @@ module Identifier : sig module Hashtbl : sig module Any : Hashtbl.S with type key = Any.t + module Page : Hashtbl.S with type key = Page.t end module Mk : sig diff --git a/src/odoc/indexing.ml b/src/odoc/indexing.ml index c6dedd13e1..2ca521b103 100644 --- a/src/odoc/indexing.ml +++ b/src/odoc/indexing.ml @@ -3,8 +3,6 @@ open Odoc_json_index open Or_error open Odoc_model -module H = Odoc_model.Paths.Identifier.Hashtbl.Any - let handle_file file ~unit ~page ~occ = match Fpath.basename file with | s when String.is_prefix ~affix:"index-" s -> @@ -74,7 +72,9 @@ let compile_to_json ~output ~warnings_options ~occurrences files = Format.fprintf output "]"; Ok () -let compile_to_marshall ~output ~warnings_options sidebar files = +let compile_to_marshall ~output ~warnings_options ~pages_short_title sidebar + files = + let module H = Odoc_model.Paths.Identifier.Hashtbl.Any in let final_index = H.create 10 in let unit u = Odoc_model.Fold.unit @@ -108,7 +108,9 @@ let compile_to_marshall ~output ~warnings_options sidebar files = in let result = Error.catch_warnings index in result |> Error.handle_warnings ~warnings_options >>= fun () -> - let index = { Lang.Index.sidebar; entries = final_index } in + let index = + { Lang.Index.sidebar; entries = final_index; pages_short_title } + in Ok (Odoc_file.save_index output index) let read_occurrences file = @@ -143,15 +145,20 @@ let compile out_format ~output ~warnings_options ~occurrences ~lib_roots in (* if files = [] && then Error (`Msg "No .odocl files were included") *) (* else *) - let pages = + let all_pages_of_roots = List.map (fun (page_root, _) -> - let pages = Resolver.all_pages ~root:page_root resolver in + (page_root, Resolver.all_pages ~root:page_root resolver)) + page_roots + in + let pages = + List.map + (fun (page_root, pages) -> let pages = List.map - (fun (page_id, title) -> + (fun (page_id, page_info) -> let title = - match title with + match page_info.Root.Odoc_file.title with | None -> [ Odoc_model.Location_.at @@ -164,7 +171,7 @@ let compile out_format ~output ~warnings_options ~occurrences ~lib_roots pages in { page_name = page_root; pages }) - page_roots + all_pages_of_roots in let libraries = List.map @@ -184,7 +191,26 @@ let compile out_format ~output ~warnings_options ~occurrences ~lib_roots [] include_rec) |> List.concat) in + let pages_short_title = + let module H = Odoc_model.Paths.Identifier.Hashtbl.Page in + let dst = H.create 8 in + List.iter + (fun (_, pages) -> + List.iter + (fun (id, page_info) -> + match + Odoc_model.Frontmatter.get "short_title" + page_info.Root.Odoc_file.frontmatter + with + | Some short_title -> H.replace dst id short_title + | None -> ()) + pages) + all_pages_of_roots; + dst + in let content = { pages; libraries } in match out_format with | `JSON -> compile_to_json ~output ~warnings_options ~occurrences files - | `Marshall -> compile_to_marshall ~output ~warnings_options content files + | `Marshall -> + compile_to_marshall ~output ~warnings_options ~pages_short_title content + files diff --git a/src/odoc/resolver.ml b/src/odoc/resolver.ml index ad780a1100..b7c9f3a6f7 100644 --- a/src/odoc/resolver.ml +++ b/src/odoc/resolver.ml @@ -499,11 +499,11 @@ let all_pages ?root ({ pages; _ } : t) = let filter (root : Odoc_model.Root.t) = match root with | { - file = Page { title; _ }; + file = Page info; id = { iv = #Odoc_model.Paths.Identifier.Page.t_pv; _ } as id; _; } -> - Some (id, title) + Some (id, info) | _ -> None in match pages with diff --git a/src/odoc/resolver.mli b/src/odoc/resolver.mli index 0cc5472829..15d63abc71 100644 --- a/src/odoc/resolver.mli +++ b/src/odoc/resolver.mli @@ -47,8 +47,7 @@ val lookup_page : t -> string -> Odoc_model.Lang.Page.t option val all_pages : ?root:string -> t -> - (Odoc_model.Paths.Identifier.Page.t * Odoc_model.Comment.link_content option) - list + (Odoc_model.Paths.Identifier.Page.t * Odoc_model.Root.Odoc_file.page) list val all_units : library:string -> t -> Odoc_model.Paths.Identifier.RootModule.t list diff --git a/test/parent_id/breadcrumbs_short_title.t/pkg/doc/index.mld b/test/parent_id/breadcrumbs_short_title.t/pkg/doc/index.mld new file mode 100644 index 0000000000..895e102151 --- /dev/null +++ b/test/parent_id/breadcrumbs_short_title.t/pkg/doc/index.mld @@ -0,0 +1,5 @@ +{0 Doc index page} + +{@meta[ +short_title: Short title doc +]} diff --git a/test/parent_id/breadcrumbs_short_title.t/pkg/doc/subdir/foo.mld b/test/parent_id/breadcrumbs_short_title.t/pkg/doc/subdir/foo.mld new file mode 100644 index 0000000000..5078dcc340 --- /dev/null +++ b/test/parent_id/breadcrumbs_short_title.t/pkg/doc/subdir/foo.mld @@ -0,0 +1,5 @@ +{0 subdir/foo} + +{@meta[ +short_title: Short title foo +]} diff --git a/test/parent_id/breadcrumbs_short_title.t/pkg/doc/subdir/index.mld b/test/parent_id/breadcrumbs_short_title.t/pkg/doc/subdir/index.mld new file mode 100644 index 0000000000..1f46a4ee5f --- /dev/null +++ b/test/parent_id/breadcrumbs_short_title.t/pkg/doc/subdir/index.mld @@ -0,0 +1,5 @@ +{0 doc/subdir index page} + +{@meta[ +short_title: Short title subdir +]} diff --git a/test/parent_id/breadcrumbs_short_title.t/pkg/index.mld b/test/parent_id/breadcrumbs_short_title.t/pkg/index.mld new file mode 100644 index 0000000000..291943c6e0 --- /dev/null +++ b/test/parent_id/breadcrumbs_short_title.t/pkg/index.mld @@ -0,0 +1,5 @@ +{0 Package 'pkg' index page} + +{@meta[ +short_title: Short title 'pkg' +]} diff --git a/test/parent_id/breadcrumbs_short_title.t/pkg/lib/index.mld b/test/parent_id/breadcrumbs_short_title.t/pkg/lib/index.mld new file mode 100644 index 0000000000..1da65b90f6 --- /dev/null +++ b/test/parent_id/breadcrumbs_short_title.t/pkg/lib/index.mld @@ -0,0 +1,5 @@ +{0 Library list} + +{@meta[ +short_title: Short title library list +]} diff --git a/test/parent_id/breadcrumbs_short_title.t/pkg/lib/lname/index.mld b/test/parent_id/breadcrumbs_short_title.t/pkg/lib/lname/index.mld new file mode 100644 index 0000000000..1ecf327758 --- /dev/null +++ b/test/parent_id/breadcrumbs_short_title.t/pkg/lib/lname/index.mld @@ -0,0 +1,5 @@ +{0 Library index page} + +{@meta[ +short_title: Short title lname +]} diff --git a/test/parent_id/breadcrumbs_short_title.t/pkg/lib/lname/lname.mli b/test/parent_id/breadcrumbs_short_title.t/pkg/lib/lname/lname.mli new file mode 100644 index 0000000000..48451390c0 --- /dev/null +++ b/test/parent_id/breadcrumbs_short_title.t/pkg/lib/lname/lname.mli @@ -0,0 +1 @@ +val x : int diff --git a/test/parent_id/breadcrumbs_short_title.t/run.t b/test/parent_id/breadcrumbs_short_title.t/run.t new file mode 100644 index 0000000000..f1ff9566dd --- /dev/null +++ b/test/parent_id/breadcrumbs_short_title.t/run.t @@ -0,0 +1,69 @@ +Index pages in a directory might specify a 'short_title' that must appear in the breadcrumbs. +This applies to package and library index pages. + + $ LINK_OPTS="-P pkg:_odoc/pkg/doc -L lname:_odoc/pkg/lib/lname" + +It's not possible to link a page that is not part of a package's doc hierarchy. +This restriction should be lifted in the future. + +$ LINK_OPTS="$LINK_OPTS -P root_of_pkg:_odoc/pkg" + + $ ocamlc -c -bin-annot pkg/lib/lname/lname.mli + + $ alias compile="odoc compile --output-dir _odoc/ --parent-id" + $ compile pkg pkg/index.mld + $ compile pkg/lib pkg/lib/index.mld + $ compile pkg/lib/lname pkg/lib/lname/index.mld + $ compile pkg/lib/lname pkg/lib/lname/lname.cmti + $ compile pkg/doc pkg/doc/index.mld + $ compile pkg/doc/subdir pkg/doc/subdir/index.mld + $ compile pkg/doc/subdir pkg/doc/subdir/foo.mld + + $ find _odoc -name '*.odoc' -exec odoc link $LINK_OPTS {} ';' + $ odoc compile-index $LINK_OPTS -o _odoc/pkg/package-index.odoc-index + $ find _odoc -name '*.odocl' -exec odoc html-generate --indent --index _odoc/pkg/package-index.odoc-index -o html {} ';' + + $ nav() { sed -n '\#