From 96ed63f872d5ceee878721cf52565a3e85f44a8a Mon Sep 17 00:00:00 2001 From: Guillaume Petiot Date: Wed, 13 Nov 2024 13:46:10 +0000 Subject: [PATCH] odoc_index: Replace -P/-L with --root arguments Co-authored-by: Paul-Elliot --- src/index/page_hierarchy.ml | 19 ++++ src/index/page_hierarchy.mli | 4 +- src/odoc/bin/main.ml | 33 ++----- src/odoc/indexing.ml | 97 +++++++------------ src/odoc/indexing.mli | 3 +- src/utils/odoc_utils.ml | 2 + test/frontmatter/toc_order.t/run.t | 2 +- test/parent_id/missing_indexes.t/run.t | 2 +- .../canonical_hierarchy.t/run.t | 2 +- .../separate_doc_lib_folders.t/run.t | 2 +- test/roots_and_hierarchy/sidebar.t/run.t | 2 +- .../sidebar_with_indexes.t/run.t | 5 +- test/search/html_search.t/run.t | 10 +- test/search/id_standalone_comments.t/run.t | 2 +- test/search/module_aliases.t/run.t | 2 +- 15 files changed, 82 insertions(+), 105 deletions(-) diff --git a/src/index/page_hierarchy.ml b/src/index/page_hierarchy.ml index 1784f4c03a..7295dd0346 100644 --- a/src/index/page_hierarchy.ml +++ b/src/index/page_hierarchy.ml @@ -188,5 +188,24 @@ let rec remove_common_root (v : t) = let of_list l = let dir = empty_t None in + let l = + List.filter_map + (fun (page : Lang.Page.t) -> + match page.name with + | { iv = #Paths.Identifier.LeafPage.t_pv; _ } as id -> + let title = + match Odoc_model.Comment.find_zero_heading page.content with + | None -> + [ + Location_.at (Location_.span []) + (`Word (Paths.Identifier.name id)); + ] + | Some title -> title + in + let children_order = page.frontmatter.Frontmatter.children_order in + Some (id, title, children_order) + | _ -> None) + l + in List.iter (add dir) l; t_of_in_progress dir |> remove_common_root diff --git a/src/index/page_hierarchy.mli b/src/index/page_hierarchy.mli index d24f8287bc..f68581e3d9 100644 --- a/src/index/page_hierarchy.mli +++ b/src/index/page_hierarchy.mli @@ -1,5 +1,4 @@ open Odoc_model -open Odoc_model.Paths open Odoc_utils (** Page hierarchies represent a hierarchy of pages. *) @@ -12,7 +11,6 @@ type index = type t = index Tree.t -val of_list : - (Identifier.LeafPage.t * title * Frontmatter.children_order option) list -> t +val of_list : Lang.Page.t list -> t (** Uses the convention that the [index] children passes its payload to the container directory to output a payload *) diff --git a/src/odoc/bin/main.ml b/src/odoc/bin/main.ml index 2549eb3ce2..26e2606190 100644 --- a/src/odoc/bin/main.ml +++ b/src/odoc/bin/main.ml @@ -468,14 +468,12 @@ module Indexing = struct | None, `JSON -> Ok (Fs.File.of_string "index.json") | None, `Marshall -> Ok (Fs.File.of_string "index.odoc-index") - let index dst json warnings_options page_roots lib_roots inputs_in_file inputs - occurrences = + let index dst json warnings_options roots inputs_in_file inputs occurrences = let marshall = if json then `JSON else `Marshall in output_file ~dst marshall >>= fun output -> - Antichain.check (page_roots |> List.map ~f:snd) ~opt:"-P" >>= fun () -> - Antichain.check (lib_roots |> List.map ~f:snd) ~opt:"-L" >>= fun () -> - Indexing.compile marshall ~output ~warnings_options ~occurrences ~lib_roots - ~page_roots ~inputs_in_file ~odocls:inputs + Antichain.check (roots |> List.map ~f:snd) ~opt:"--root" >>= fun () -> + Indexing.compile marshall ~output ~warnings_options ~occurrences ~roots + ~inputs_in_file ~odocls:inputs let cmd = let dst = let doc = @@ -510,31 +508,20 @@ module Indexing = struct let doc = ".odocl file to index" in Arg.(value & pos_all convert_fpath [] & info ~doc ~docv:"FILE" []) in - let page_roots = - let doc = - "Specifies a directory PATH containing pages that should be included \ - in the sidebar, under the NAME section." - in - Arg.( - value - & opt_all convert_named_root [] - & info ~docs ~docv:"NAME:PATH" ~doc [ "P" ]) - in - let lib_roots = + let roots = let doc = - "Specifies a directory PATH containing units that should be included \ - in the sidebar, as part of the LIBNAME library." + "Specifies a directory PATH containing pages or units that should be \ + included in the sidebar." in - Arg.( value & opt_all convert_named_root [] - & info ~docs ~docv:"LIBNAME:PATH" ~doc [ "L" ]) + & info ~docs ~docv:"NAME:PATH" ~doc [ "root" ]) in Term.( const handle_error - $ (const index $ dst $ json $ warnings_options $ page_roots $ lib_roots - $ inputs_in_file $ inputs $ occurrences)) + $ (const index $ dst $ json $ warnings_options $ roots $ inputs_in_file + $ inputs $ occurrences)) let info ~docs = let doc = diff --git a/src/odoc/indexing.ml b/src/odoc/indexing.ml index efb848912b..77beccc6a1 100644 --- a/src/odoc/indexing.ml +++ b/src/odoc/indexing.ml @@ -98,58 +98,35 @@ let read_occurrences file = let htbl : Odoc_occurrences.Table.t = Marshal.from_channel ic in htbl -let pages resolver page_roots = - List.map - (fun (page_root, _) -> - let pages = Resolver.all_pages ~root:page_root resolver in - let p_hierarchy = - let page_toc_input = - (* To create a page toc, we need a list with id, title and children - order. We generate this list from *) - let prepare_input (id, title, frontmatter) = - (* We filter non-leaf pages *) - match id with - | { Id.iv = #Id.LeafPage.t_pv; _ } as id -> - (* We generate a title if needed *) - let title = - match title with - | None -> Location_.[ at (span []) (`Word (Id.name id)) ] - | Some x -> x - in - let children_order = frontmatter.Frontmatter.children_order in - Some (id, title, children_order) - | _ -> None - in - List.filter_map prepare_input pages - in - Odoc_index.Page_hierarchy.of_list page_toc_input - in - { Odoc_index.p_name = page_root; p_hierarchy }) - page_roots +let find_pages_and_units root = + Fs.Directory.fold_files_rec_result ~ext:".odocl" + (fun (pages, units) path -> + Odoc_file.load path >>= fun { Odoc_file.content; warnings = _ } -> + match content with + | Page_content p -> Ok (p :: pages, units) + | Impl_content _ | Asset_content _ -> Ok (pages, units) + | Unit_content u -> Ok (pages, u :: units)) + ([], []) root -let libs resolver lib_roots = - List.map - (fun (library, _) -> - let units = Resolver.all_units ~library resolver in - let l_hierarchies = - List.filter_map - (fun (file, _id) -> - match file () with - | Some unit -> Some (Odoc_index.Skeleton.from_unit unit) - | None -> None) - units - in - { Odoc_index.l_name = library; l_hierarchies }) - lib_roots +let page_index ~name = function + | [] -> None + | pages -> + let p_hierarchy = Odoc_index.Page_hierarchy.of_list pages in + Some { Odoc_index.p_name = name; p_hierarchy } -let compile out_format ~output ~warnings_options ~occurrences ~lib_roots - ~page_roots ~inputs_in_file ~odocls = +let lib_index ~name = function + | [] -> None + | units -> + let l_hierarchies = List.map Odoc_index.Skeleton.from_unit units in + Some { Odoc_index.l_name = name; l_hierarchies } + +let compile out_format ~output ~warnings_options ~occurrences ~roots + ~inputs_in_file ~odocls = let handle_warnings f = let res = Error.catch_warnings f in Error.handle_warnings ~warnings_options res |> Result.join in handle_warnings @@ fun () -> - let current_dir = Fs.File.dirname output in parse_input_files inputs_in_file >>= fun files -> let files = List.rev_append odocls files in let occurrences = @@ -157,9 +134,7 @@ let compile out_format ~output ~warnings_options ~occurrences ~lib_roots | None -> None | Some occurrences -> Some (read_occurrences (Fpath.to_string occurrences)) in - let includes_rec = - List.rev_append (List.map snd page_roots) (List.map snd lib_roots) - in + let includes_rec = List.map snd roots in let files = List.rev_append files (includes_rec @@ -172,19 +147,15 @@ let compile out_format ~output ~warnings_options ~occurrences ~lib_roots match out_format with | `JSON -> compile_to_json ~output ~occurrences files | `Marshall -> - let resolver = - Resolver.create ~important_digests:false ~directories:[] - ~roots: - (Some - { - page_roots; - lib_roots; - current_lib = None; - current_package = None; - current_dir; - }) - ~open_modules:[] + let indexes = + List.fold_left + (fun (pages_acc, libs_acc) (name, root) -> + match find_pages_and_units root with + | Ok (p, m) -> + let p = Option.to_list @@ page_index ~name p in + let l = Option.to_list @@ lib_index ~name m in + (pages_acc @ p, libs_acc @ l) + | Error _ -> (pages_acc, libs_acc)) + ([], []) roots in - let pages = pages resolver page_roots in - let libs = libs resolver lib_roots in - compile_to_marshall ~output (pages, libs) files + compile_to_marshall ~output indexes files diff --git a/src/odoc/indexing.mli b/src/odoc/indexing.mli index 2103b58f6a..48cb4d0cc3 100644 --- a/src/odoc/indexing.mli +++ b/src/odoc/indexing.mli @@ -14,8 +14,7 @@ val compile : output:Fs.file -> warnings_options:Odoc_model.Error.warnings_options -> occurrences:Fs.file option -> - lib_roots:(string * Fs.directory) list -> - page_roots:(string * Fs.directory) list -> + roots:(string * Fs.directory) list -> inputs_in_file:Fs.file list -> odocls:Fs.file list -> (unit, [> msg ]) result diff --git a/src/utils/odoc_utils.ml b/src/utils/odoc_utils.ml index 41294e1785..d77dd58eac 100644 --- a/src/utils/odoc_utils.ml +++ b/src/utils/odoc_utils.ml @@ -51,6 +51,8 @@ module Option = struct let map f = function None -> None | Some x -> Some (f x) let is_some = function None -> false | Some _ -> true + + let to_list = function None -> [] | Some x -> [ x ] end module Result = struct diff --git a/test/frontmatter/toc_order.t/run.t b/test/frontmatter/toc_order.t/run.t index 87078ffbf7..093dc7116d 100644 --- a/test/frontmatter/toc_order.t/run.t +++ b/test/frontmatter/toc_order.t/run.t @@ -12,7 +12,7 @@ $ odoc link _odoc/pkg/dir1/page-content_in_dir.odoc $ odoc link _odoc/pkg/dir1/page-dontent.odoc - $ odoc compile-index -P test:_odoc/pkg + $ odoc compile-index --root test:_odoc/pkg File "index.mld", line 1, characters 30-35: Warning: Duplicate 'dir1/' in (children). File "index.mld", line 1, characters 36-40: diff --git a/test/parent_id/missing_indexes.t/run.t b/test/parent_id/missing_indexes.t/run.t index d95367923b..79ed8c854f 100644 --- a/test/parent_id/missing_indexes.t/run.t +++ b/test/parent_id/missing_indexes.t/run.t @@ -7,7 +7,7 @@ $ odoc link _odoc/page-foo.odoc $ odoc link _odoc/page-bar.odoc $ odoc link _odoc/baz/page-bli.odoc - $ odoc compile-index -P _:_odoc + $ odoc compile-index --root _:_odoc $ odoc html-generate --index index.odoc-index --indent --output-dir _html _odoc/page-foo.odocl diff --git a/test/roots_and_hierarchy/canonical_hierarchy.t/run.t b/test/roots_and_hierarchy/canonical_hierarchy.t/run.t index 7ddd5a0d48..4cb1351386 100644 --- a/test/roots_and_hierarchy/canonical_hierarchy.t/run.t +++ b/test/roots_and_hierarchy/canonical_hierarchy.t/run.t @@ -23,7 +23,7 @@ Let's link it: Let's html-generate it (with a sidebar): - $ odoc compile-index -P pkg:_odoc/pkg/ -L libname:_odoc/pkg/libname -o sidebar.odoc-index + $ odoc compile-index --root pkg:_odoc/pkg/ -o sidebar.odoc-index $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/page-file.odocl $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/dir1/page-my_page.odocl $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/dir1/page-index.odocl diff --git a/test/roots_and_hierarchy/separate_doc_lib_folders.t/run.t b/test/roots_and_hierarchy/separate_doc_lib_folders.t/run.t index eea1616534..c6aefdf165 100644 --- a/test/roots_and_hierarchy/separate_doc_lib_folders.t/run.t +++ b/test/roots_and_hierarchy/separate_doc_lib_folders.t/run.t @@ -23,7 +23,7 @@ Let's link it: Let's html-generate it (with a sidebar): - $ odoc compile-index -P pkg:_odoc/pkg/doc/ -L libname:_odoc/pkg/lib/libname -o sidebar.odoc-index + $ odoc compile-index --root pkg:_odoc/pkg/doc/ --root libname:_odoc/pkg/lib/libname -o sidebar.odoc-index $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/doc/page-file.odocl $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/doc/dir1/page-my_page.odocl $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/doc/dir1/page-index.odocl diff --git a/test/roots_and_hierarchy/sidebar.t/run.t b/test/roots_and_hierarchy/sidebar.t/run.t index 8c0ec9d6b2..90d17f1b9b 100644 --- a/test/roots_and_hierarchy/sidebar.t/run.t +++ b/test/roots_and_hierarchy/sidebar.t/run.t @@ -12,7 +12,7 @@ $ odoc link -P pkg:_odoc/pkg/ _odoc/pkg/page-index.odoc $ odoc link -P pkg:_odoc/pkg/ _odoc/pkg/libname/unit.odoc - $ odoc compile-index -P pkg:_odoc/pkg/ -L libname:_odoc/pkg/libname -o sidebar.odoc-index + $ odoc compile-index --root libname:_odoc/pkg/ -o sidebar.odoc-index $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/page-file.odocl $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/dir1/page-my_page.odocl $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/dir1/page-index.odocl diff --git a/test/roots_and_hierarchy/sidebar_with_indexes.t/run.t b/test/roots_and_hierarchy/sidebar_with_indexes.t/run.t index 245c99e61f..5baf6e557b 100644 --- a/test/roots_and_hierarchy/sidebar_with_indexes.t/run.t +++ b/test/roots_and_hierarchy/sidebar_with_indexes.t/run.t @@ -18,7 +18,7 @@ Since -L subfolders are omitted from -P roots, the index page should not be adde $ odoc link -P pkg:_odoc/pkg/ _odoc/pkg/libname/unit.odoc $ odoc link -P pkg:_odoc/pkg/ _odoc/pkg/libname/page-index.odoc - $ odoc compile-index -P pkg:_odoc/pkg/ -L libname:_odoc/pkg/libname -o sidebar.odoc-index + $ odoc compile-index --root libname:_odoc/pkg/ -o sidebar.odoc-index $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/page-file.odocl $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/dir1/page-my_page.odocl $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/dir1/page-index.odocl @@ -26,7 +26,7 @@ Since -L subfolders are omitted from -P roots, the index page should not be adde $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/libname/unit.odocl $ odoc html-generate --indent --index sidebar.odoc-index -o html _odoc/pkg/libname/page-index.odocl - $ cat html/pkg/index.html | grep odoc-global-toc -A 15 + $ cat html/pkg/index.html | grep odoc-global-toc -A 16