From 71dd8e09838926cdc2856a52cecf460e053a7329 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 16 Oct 2024 18:07:43 +0200 Subject: [PATCH] WIP --- src/document/sidebar.ml | 2 +- src/odoc/indexing.ml | 177 ++++++++++++++++++++++------------------ src/odoc/indexing.mli | 2 +- src/odoc/resolver.ml | 31 ++++--- src/odoc/resolver.mli | 5 +- src/search/index.ml | 8 +- 6 files changed, 129 insertions(+), 96 deletions(-) diff --git a/src/document/sidebar.ml b/src/document/sidebar.ml index 27c5b71adc..3e6840f760 100644 --- a/src/document/sidebar.ml +++ b/src/document/sidebar.ml @@ -133,7 +133,7 @@ type library = { name : string; units : Toc.t list } type t = { pages : pages list; libraries : library list } let of_lang (v : Odoc_index.Index.t) = - let { Odoc_index.Index.pages; libs } = v in + let { Odoc_index.Index.pages; libs; extra = _ } = v in let pages = let page_hierarchy { Odoc_index.Index.p_name; p_hierarchy } = let hierarchy = Toc.of_lang p_hierarchy in diff --git a/src/odoc/indexing.ml b/src/odoc/indexing.ml index be5db5fa1a..77c9acf8c5 100644 --- a/src/odoc/indexing.ml +++ b/src/odoc/indexing.ml @@ -9,7 +9,12 @@ 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 { libs; _ } -> Ok (occ (* index *) libs) + Odoc_file.load_index file >>= fun { extra (* libs *); _ } -> + Ok + (occ + (* index *) + (* libs *) + extra) | _ -> ( Odoc_file.load file >>= fun unit' -> match unit' with @@ -73,42 +78,43 @@ let compile_to_json ~output ~occurrences files = Format.fprintf output "]"; Ok () -let compile_to_marshall ~output sidebar files = - (* let final_index = H.create 10 in *) +let compile_to_marshall ~output (pages, libs) files = + let final_index = H.create 10 in let unit u = - let node = Odoc_index.Skeleton.from_unit u in - (* Odoc_model.Fold.unit *) - (* ~f:(fun () item -> *) - (* let entries = Odoc_search.Entry.entries_of_item item in *) - (* List.iter *) - (* (fun entry -> H.add final_index entry.Odoc_search.Entry.id entry) *) - (* entries) *) - (* () u *) - Some node + (* let node = Odoc_index.Skeleton.from_unit u in *) + Odoc_model.Fold.unit + ~f:(fun () item -> + let entries = Odoc_index.Entry.entries_of_item item in + List.iter + (fun entry -> H.add final_index entry.Odoc_index.Entry.id entry) + entries) + () u + (* Some node *) in - let page _p = - None - (* Odoc_model.Fold.page *) - (* ~f:(fun () item -> *) - (* let entries = Odoc_search.Entry.entries_of_item item in *) - (* List.iter *) - (* (fun entry -> H.add final_index entry.Odoc_search.Entry.id entry) *) - (* entries) *) - (* () p *) + let page p = + (* None *) + Odoc_model.Fold.page + ~f:(fun () item -> + let entries = Odoc_index.Entry.entries_of_item item in + List.iter + (fun entry -> H.add final_index entry.Odoc_index.Entry.id entry) + entries) + () p in - let index _i = (* H.iter (H.add final_index) i *) None in - let index = - List.filter_map + let index i = H.iter (H.add final_index) i (* None *) in + let (* index *) () = + List.iter (* filter_map *) (fun file -> match handle_file ~unit ~page ~occ:index file with - | Ok x -> x + | Ok () -> () | Error (`Msg m) -> Error.raise_warning ~non_fatal:true (Error.filename_only "%s" m (Fs.File.to_string file)); - None) + () (* None *)) files in - Ok (Odoc_file.save_index output { index; sidebar }) + let content = { Odoc_index.Index.pages; libs; extra = final_index } in + Ok (Odoc_file.save_index output (* { index; sidebar } *) content) let read_occurrences file = let ic = open_in_bin file in @@ -117,6 +123,52 @@ let read_occurrences file = open Odoc_model.Sidebar +module Id = Odoc_model.Paths.Identifier + +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 + PageToc.of_list page_toc_input + in + { Odoc_index.Index.p_name = page_root; p_hierarchy }) + page_roots + +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.Index.l_name = library; l_hierarchies }) + lib_roots + let compile out_format ~output ~warnings_options ~occurrences ~lib_roots ~page_roots ~inputs_in_file ~odocls = let handle_warnings f = @@ -132,60 +184,8 @@ let compile out_format ~output ~warnings_options ~occurrences ~lib_roots | None -> None | Some occurrences -> Some (read_occurrences (Fpath.to_string occurrences)) in - let resolver = - Resolver.create ~important_digests:false ~directories:[] - ~roots: - (Some - { - page_roots; - lib_roots; - current_lib = None; - current_package = None; - current_dir; - }) - ~open_modules:[] - in (* if files = [] && then Error (`Msg "No .odocl files were included") *) (* else *) - let pages = - List.map - (fun (page_root, _) -> - let pages = Resolver.all_pages ~root:page_root resolver in - let p_hierarchy = - let pages = - pages - |> List.filter_map - Paths.Identifier.( - function - | ({ iv = #LeafPage.t_pv; _ } as id), pl, fm -> - Some (id, pl, fm) - | _ -> None) - |> List.map (fun (id, title, fm) -> - let title = - match title with - | None -> - [ - Location_.at (Location_.span []) - (`Word (Paths.Identifier.name id)); - ] - | Some x -> x - in - let children_order = fm.Frontmatter.children_order in - (id, title, children_order)) - in - PageToc.of_list pages - in - { Odoc_index.Index.p_name = page_root; p_hierarchy }) - page_roots - in - let libraries = - List.map - (fun (library, _) -> - let units = Resolver.all_units ~library resolver in - let node = List.map Odoc_index.Skeleton.from_unit u in - { Odoc_index.Index.l_name = library; l_hierarchies = _ }) - lib_roots - in let includes_rec = List.rev_append (List.map snd page_roots) (List.map snd lib_roots) in @@ -198,7 +198,22 @@ let compile out_format ~output ~warnings_options ~occurrences ~lib_roots [] include_rec) |> List.concat) in - let content = { pages; libraries } in match out_format with | `JSON -> compile_to_json ~output ~occurrences files - | `Marshall -> compile_to_marshall ~output content 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:[] + in + let pages = pages resolver page_roots in + let libs = libs resolver lib_roots in + compile_to_marshall ~output (pages, libs) files diff --git a/src/odoc/indexing.mli b/src/odoc/indexing.mli index a175bae401..d484fbd730 100644 --- a/src/odoc/indexing.mli +++ b/src/odoc/indexing.mli @@ -4,7 +4,7 @@ val handle_file : Fpath.t -> unit:(Odoc_model.Lang.Compilation_unit.t -> 'a) -> page:(Odoc_model.Lang.Page.t -> 'a) -> - occ:(Odoc_index.Entry.t Odoc_utils.Tree.t list -> 'a) -> + occ:(Odoc_index.Entry.t Odoc_model.Paths.Identifier.Hashtbl.Any.t -> 'a) -> ('a, [> msg ]) result (** This function is exposed for custom indexers that uses [odoc] as a library to generate their search index *) diff --git a/src/odoc/resolver.ml b/src/odoc/resolver.ml index 347ad0e18e..56247a0bb3 100644 --- a/src/odoc/resolver.ml +++ b/src/odoc/resolver.ml @@ -493,14 +493,16 @@ let all_roots ?root named_roots = | Ok x -> x | Error (NoPackage | NoRoot) -> [] in - let load page = - match Odoc_file.load_root page with Error _ -> None | Ok root -> Some root + let load file = + match Odoc_file.load_root file with + | Error _ -> None + | Ok root -> Some (file, root) in Odoc_utils.List.filter_map load all_files let all_pages ?root ({ pages; _ } : t) = - let filter (root : Odoc_model.Root.t) = - match root with + let filter (root : _ * Odoc_model.Root.t) = + match snd root with | { file = Page { title; frontmatter; _ }; id = { iv = #Odoc_model.Paths.Identifier.Page.t_pv; _ } as id; @@ -514,14 +516,21 @@ let all_pages ?root ({ pages; _ } : t) = | Some pages -> Odoc_utils.List.filter_map filter @@ all_roots ?root pages let all_units ~library ({ libs; _ } : t) = - let filter (root : Odoc_model.Root.t) = + let filter (root : _ * Odoc_model.Root.t) = match root with - | { - file = Compilation_unit _; - id = { iv = #Odoc_model.Paths.Identifier.RootModule.t_pv; _ } as id; - _; - } -> - Some id + | ( file, + { + file = Compilation_unit _; + id = { iv = #Odoc_model.Paths.Identifier.RootModule.t_pv; _ } as id; + _; + } ) -> + let file () = + match Odoc_file.load file with + | Ok { content = Odoc_file.Unit_content u; _ } -> Some u + | Ok { content = _; _ } -> assert false + | Error _ as _e -> (* TODO *) None + in + Some (file, id) | _ -> None in match libs with diff --git a/src/odoc/resolver.mli b/src/odoc/resolver.mli index b63cb16782..39357114bf 100644 --- a/src/odoc/resolver.mli +++ b/src/odoc/resolver.mli @@ -52,7 +52,10 @@ val all_pages : (Paths.Identifier.Page.t * Comment.link_content option * Frontmatter.t) list val all_units : - library:string -> t -> Odoc_model.Paths.Identifier.RootModule.t list + library:string -> + t -> + ((unit -> Lang.Compilation_unit.t option) * Paths.Identifier.RootModule.t) + list (** Helpers for creating xref2 env. *) diff --git a/src/search/index.ml b/src/search/index.ml index 0d1afcedf5..03a4df0109 100644 --- a/src/search/index.ml +++ b/src/search/index.ml @@ -8,4 +8,10 @@ type page = { p_name : string; p_hierarchy : page_hierarchy } type lib_hierarchies = Entry.t Tree.t list type lib = { l_name : string; l_hierarchies : lib_hierarchies } -type t = { pages : page list; libs : lib list } +type t = { + pages : page list; + libs : lib list; + extra : Entry.t Paths.Identifier.Hashtbl.Any.t; + (** This extra table is used only for search. It was introduced before + Odoc 3 *) +}