From 82c4d012969c748e7592633fe2307dbc442723b1 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Fri, 11 Oct 2024 11:29:42 +0200 Subject: [PATCH] Sidebar and index overhaul This commit includes multiple modifications: Trees ---------- Odoc used to have several representations of trees: one for the page sidebar in the model, one for the document sidebar, and (in a squashed commit) one for the unit sidebar. All trees now have the same type, making the different passes (eg model -> document for pages and units) much easier, at a small cost (the type is less tailored to the usecase, eg the payload cannot be different in leafs than in node, which was the case before in the page hierarchy). Trees (and forests) have basic iterators defined. The index for units ------------------------ The index for the units values used to be a hashtable from ID to entry. The problem was that you cannot rebuild a sidebar from that: you lose the order between children. The index for units now is a tree of index entries. The sidebar for units ------------------------- The sidebar for units finally shows more than just the root module. However, it does not show the full hierarchy either, as that would be overwhelming in the case of big modules. The sidebar shows: - Only entries that could have had an expansion: modules, modules types, classes and class types. - The current page (highlighted), - The children of the current page, (highlighted differently), - The ancestors of the current page, - The children of the ancestors of the current page, - Nothing else. If you allow me, I like to use the github syntax for mathematics :smile:. The sidebar has the property that it displays the smallest set $S$ that: - Contains only modules, modules types, classes and class types. - Contains the current page: $current\_page\in S$, - Is ancestor-closed: if $e\in S$ then $parent(e)\in S$, - Is sibling-closed: if $e\in S$ and $parent(e)=parent(f)$, then $f\in S$ The last property is important to avoid displaying only part of the children of a parent, requiring to display some `...` to show that some entries were omitted. Organization in directories and libraries ----------------------------------------------------- The `search/` folder and its associated `odoc_search` library was separated in two: the original one and the new `index/` and `odoc_index` which contains everything that an index should contain: both the info for the sidebar and for the search index. --- src/document/dune | 2 +- src/document/renderer.ml | 3 +- src/document/sidebar.ml | 205 +++++++++------ src/document/sidebar.mli | 2 +- src/document/url.ml | 60 ++--- src/document/url.mli | 18 ++ src/driver/odoc_unit.ml | 48 ++-- src/html/generator.ml | 1 + src/html/generator.mli | 2 +- src/html/html_fragment_json.ml | 4 +- src/html/html_page.ml | 4 +- src/html_support_files/odoc.css | 14 +- src/index/dune | 4 + src/index/entry.ml | 68 +++++ src/{search => index}/entry.mli | 16 +- src/index/odoc_index.ml | 19 ++ src/index/page_hierarchy.ml | 190 ++++++++++++++ src/index/page_hierarchy.mli | 16 ++ src/index/skeleton.ml | 272 ++++++++++++++++++++ src/index/skeleton.mli | 12 + src/latex/generator.ml | 2 +- src/manpage/generator.ml | 2 +- src/model/fold.ml | 137 ---------- src/model/fold.mli | 99 ------- src/model/lang.ml | 5 - src/model/odoc_model.ml | 2 - src/model/sidebar.ml | 200 -------------- src/model/sidebar.mli | 20 -- src/odoc/indexing.ml | 164 ++++++------ src/odoc/indexing.mli | 2 +- src/odoc/odoc_file.mli | 6 +- src/odoc/rendering.ml | 24 +- src/odoc/resolver.ml | 31 ++- src/odoc/resolver.mli | 5 +- src/search/dune | 2 +- src/search/entry.ml | 216 ---------------- src/search/html.ml | 25 +- src/search/html.mli | 1 + src/search/json_index/dune | 2 +- src/search/json_index/json_display.mli | 1 + src/search/json_index/json_search.ml | 84 +++--- src/search/json_index/json_search.mli | 5 +- src/utils/odoc_utils.ml | 2 + src/utils/tree.ml | 32 +++ test/occurrences/double_wrapped.t/run.t | 10 +- test/parent_id/sidebar.t/run.t | 4 +- test/search/html_search.t/run.t | 46 +--- test/search/marshalled_version.t/run.t | 0 test/search/module_aliases.t/run.t | 4 +- test/xref2/references_to_assets.t/asset.mld | 1 + test/xref2/references_to_assets.t/run.t | 0 51 files changed, 1048 insertions(+), 1046 deletions(-) create mode 100644 src/index/dune create mode 100644 src/index/entry.ml rename src/{search => index}/entry.mli (83%) create mode 100644 src/index/odoc_index.ml create mode 100644 src/index/page_hierarchy.ml create mode 100644 src/index/page_hierarchy.mli create mode 100644 src/index/skeleton.ml create mode 100644 src/index/skeleton.mli delete mode 100644 src/model/fold.ml delete mode 100644 src/model/fold.mli delete mode 100644 src/model/sidebar.ml delete mode 100644 src/model/sidebar.mli delete mode 100644 src/search/entry.ml create mode 100644 src/utils/tree.ml create mode 100644 test/search/marshalled_version.t/run.t create mode 100644 test/xref2/references_to_assets.t/asset.mld create mode 100644 test/xref2/references_to_assets.t/run.t diff --git a/src/document/dune b/src/document/dune index b94949c4e2..89d9ac54a6 100644 --- a/src/document/dune +++ b/src/document/dune @@ -14,4 +14,4 @@ (backend bisect_ppx)) (instrumentation (backend landmarks --auto)) - (libraries odoc_model fpath astring syntax_highlighter odoc_utils)) + (libraries odoc_model fpath astring syntax_highlighter odoc_utils odoc_index)) diff --git a/src/document/renderer.ml b/src/document/renderer.ml index 270f70292d..f6f0fb4453 100644 --- a/src/document/renderer.ml +++ b/src/document/renderer.ml @@ -6,6 +6,7 @@ let string_of_syntax = function OCaml -> "ml" | Reason -> "re" type page = { filename : Fpath.t; + path : Url.Path.t; content : Format.formatter -> unit; children : page list; } @@ -23,7 +24,7 @@ type input = type 'a t = { name : string; - render : 'a -> Types.Block.t option -> Types.Document.t -> page list; + render : 'a -> Sidebar.t option -> Types.Document.t -> page list; filepath : 'a -> Url.Path.t -> Fpath.t; } diff --git a/src/document/sidebar.ml b/src/document/sidebar.ml index 5122b0f90e..bb9589cb56 100644 --- a/src/document/sidebar.ml +++ b/src/document/sidebar.ml @@ -2,118 +2,163 @@ open Odoc_utils open Types let sidebar_toc_entry id content = - let href = id |> Url.Path.from_identifier |> Url.from_path in + let href = + (id :> Odoc_model.Paths.Identifier.t) + |> Url.from_identifier ~stop_before:false + |> Result.get_ok + in let target = Target.Internal (Resolved href) in inline @@ Inline.Link { target; content; tooltip = None } module Toc : sig type t - val of_lang : Odoc_model.Sidebar.PageToc.t -> t + val of_page_hierarchy : Odoc_index.Page_hierarchy.t -> t + + val of_skeleton : Odoc_index.Skeleton.t -> t - val to_sidebar : - ?fallback:string -> (Url.Path.t * Inline.one -> Block.one) -> t -> Block.t + val to_block : prune:bool -> Url.Path.t -> t -> Block.t end = struct - type t = Item of (Url.Path.t * Inline.one) option * t list + type t = (Url.t * Inline.one) option Tree.t - open Odoc_model.Sidebar - open Odoc_model.Paths.Identifier + module Id = Odoc_model.Paths.Identifier - let of_lang (dir : PageToc.t) = - let rec of_lang ~parent_id ((content, index) : PageToc.t) = - let title, parent_id = + let of_page_hierarchy (dir : Odoc_index.Page_hierarchy.t) = + let fun_ index = + let payload = match index with - | Some (index_id, title) -> (Some title, Some (index_id :> Page.t)) - | None -> (None, (parent_id :> Page.t option)) + | None -> None + | Some (index_id, title) -> + let path = + Url.from_identifier ~stop_before:false (index_id :> Id.t) + |> Result.get_ok + in + let content = Comment.link_content title in + Some (path, sidebar_toc_entry index_id content) in - let entries = - List.filter_map - (fun id -> - match id with - | id, PageToc.Entry title -> - (* TODO warn on non empty children order if not index page somewhere *) - let payload = - let path = Url.Path.from_identifier id in - let content = Comment.link_content title in - Some (path, sidebar_toc_entry id content) - in - Some (Item (payload, [])) - | id, PageToc.Dir dir -> Some (of_lang ~parent_id:(Some id) dir)) - content + payload + in + Tree.map_t fun_ dir + + let rec is_prefix (url1 : Url.Path.t) (url2 : Url.Path.t) = + if url1 = url2 then true + else + match url2 with + | { parent = Some parent; _ } -> is_prefix url1 parent + | { parent = None; _ } -> false + + let parent (url : Url.t) = + match url with + | { anchor = ""; page = { parent = Some parent; _ }; _ } -> parent + | { page; _ } -> page + + let to_block ~prune (current_url : Url.Path.t) tree = + let block_tree_of_t (current_url : Url.Path.t) tree = + (* When transforming the tree, we use a filter_map to remove the nodes that + are irrelevant for the current url. However, we always want to keep the + root. So we apply the filter_map starting from the first children. *) + let convert ((url : Url.t), b) = + let link = + if url.page = current_url && String.equal url.anchor "" then + { b with Inline.attr = [ "current_unit" ] } + else b + in + Types.block @@ Inline [ link ] in - let payload = - match (title, parent_id) with - | None, _ | _, None -> None - | Some title, Some parent_id -> - let path = Url.Path.from_identifier parent_id in - let content = Comment.link_content title in - Some (path, sidebar_toc_entry parent_id content) + let fun_ name = + match name with + | Some ((url, _) as v) + when (not prune) || is_prefix (parent url) current_url -> + Some (convert v) + | _ -> None + in + let root_entry = + match tree.Tree.node with + | Some v -> convert v + | None -> block (Block.Inline [ inline (Text "root") ]) in - Item (payload, entries) + { + Tree.node = root_entry; + children = Tree.filter_map_f fun_ tree.children; + } in - of_lang ~parent_id:None dir + let rec block_of_block_tree { Tree.node = name; children = content } = + let content = + match content with + | [] -> [] + | _ :: _ -> + let content = List.map block_of_block_tree content in + [ block (Block.List (Block.Unordered, content)) ] + in + name :: content + in + let block_tree = block_tree_of_t current_url tree in + block_of_block_tree block_tree - let rec to_sidebar ?(fallback = "root") convert (Item (name, content)) = - let name = - match name with - | Some v -> convert v - | None -> block (Block.Inline [ inline (Text fallback) ]) + let of_skeleton ({ node = entry; children } : Odoc_index.Entry.t Tree.t) = + let map_entry entry = + let stop_before = + match entry.Odoc_index.Entry.kind with + | ModuleType { has_expansion } | Module { has_expansion } -> + not has_expansion + | _ -> false + in + let path = Url.from_identifier ~stop_before entry.id in + let name = Odoc_model.Paths.Identifier.name entry.id in + match path with + | Ok path -> + let content = + let target = Target.Internal (Resolved path) in + inline + (Link { target; content = [ inline (Text name) ]; tooltip = None }) + in + Some (path, content) + | Error _ -> None in - let content = - match content with - | [] -> [] - | _ :: _ -> - let content = List.map (to_sidebar convert) content in - [ block (Block.List (Block.Unordered, content)) ] + let fun_ entry = + match entry.Odoc_index.Entry.kind with + | Module _ | Class_type _ | Class _ | ModuleType _ -> + Some (map_entry entry) + | _ -> None in - name :: content + let entry = map_entry entry in + let children = Tree.filter_map_f fun_ children in + { Tree.node = entry; children } end + type pages = { name : string; pages : Toc.t } -type library = { name : string; units : (Url.Path.t * Inline.one) list } +type library = { name : string; units : Toc.t list } type t = { pages : pages list; libraries : library list } -let of_lang (v : Odoc_model.Sidebar.t) = +let of_lang (v : Odoc_index.t) = + let { Odoc_index.pages; libs; extra = _ } = v in let pages = - let page_hierarchy { Odoc_model.Sidebar.hierarchy_name; pages } = - let hierarchy = Toc.of_lang pages in - Some { name = hierarchy_name; pages = hierarchy } + let page_hierarchy { Odoc_index.p_name; p_hierarchy } = + let hierarchy = Toc.of_page_hierarchy p_hierarchy in + { name = p_name; pages = hierarchy } in - Odoc_utils.List.filter_map page_hierarchy v.pages + Odoc_utils.List.map page_hierarchy pages in - let units = - let item id = - let content = [ inline @@ Text (Odoc_model.Paths.Identifier.name id) ] in - (Url.Path.from_identifier id, sidebar_toc_entry id content) + let libraries = + let lib_hierarchies { Odoc_index.l_name; l_hierarchies } = + let hierarchies = List.map Toc.of_skeleton l_hierarchies in + { units = hierarchies; name = l_name } in - let units = - List.map - (fun { Odoc_model.Sidebar.units; name } -> - let units = List.map item units in - { name; units }) - v.libraries - in - units + Odoc_utils.List.map lib_hierarchies libs in - { pages; libraries = units } + { pages; libraries } -let to_block (sidebar : t) url = +let to_block (sidebar : t) path = let { pages; libraries } = sidebar in let title t = block (Inline [ inline (Inline.Styled (`Bold, [ inline (Inline.Text t) ])) ]) in - let render_entry (entry_path, b) = - let link = - if entry_path = url then { b with Inline.attr = [ "current_unit" ] } - else b - in - Types.block @@ Inline [ link ] - in let pages = Odoc_utils.List.concat_map ~f:(fun (p : pages) -> - let pages = Toc.to_sidebar render_entry p.pages in + let pages = Toc.to_block ~prune:false path p.pages in let pages = [ block (Block.List (Block.Unordered, [ pages ])) ] in let pages = [ title @@ p.name ^ "'s Pages" ] @ pages in pages) @@ -123,10 +168,12 @@ let to_block (sidebar : t) url = let units = List.map (fun { units; name } -> - [ - title name; - block (List (Block.Unordered, [ List.map render_entry units ])); - ]) + let units = + List.concat_map ~f:(Toc.to_block ~prune:true path) units + in + let units = [ block (Block.List (Block.Unordered, [ units ])) ] in + let units = [ title @@ name ^ "'s Units" ] @ units in + units) libraries in let units = block (Block.List (Block.Unordered, units)) in diff --git a/src/document/sidebar.mli b/src/document/sidebar.mli index 6c926ad1fc..eecb0c8c15 100644 --- a/src/document/sidebar.mli +++ b/src/document/sidebar.mli @@ -1,6 +1,6 @@ type t -val of_lang : Odoc_model.Sidebar.t -> t +val of_lang : Odoc_index.t -> t val to_block : t -> Url.Path.t -> Types.Block.t (** Generates the sidebar document given a global sidebar and the path at which diff --git a/src/document/url.ml b/src/document/url.ml index 0a7da90caa..7048d0f86b 100644 --- a/src/document/url.ml +++ b/src/document/url.ml @@ -1,11 +1,11 @@ +open Odoc_model.Lang open Odoc_model.Paths open Odoc_model.Names module Root = Odoc_model.Root -let render_path : Odoc_model.Paths.Path.t -> string = - let open Odoc_model.Paths.Path in - let rec render_resolved : Odoc_model.Paths.Path.Resolved.t -> string = - let open Resolved in +let render_path : Path.t -> string = + let rec render_resolved : Path.Resolved.t -> string = + let open Path.Resolved in function | `Identifier id -> Identifier.name id | `OpaqueModule p -> render_resolved (p :> t) @@ -13,16 +13,13 @@ let render_path : Odoc_model.Paths.Path.t -> string = | `Subst (_, p) -> render_resolved (p :> t) | `SubstT (_, p) -> render_resolved (p :> t) | `Alias (dest, `Resolved src) -> - if Odoc_model.Paths.Path.Resolved.(is_hidden (src :> t)) then - render_resolved (dest :> t) + if Path.Resolved.(is_hidden (src :> t)) then render_resolved (dest :> t) else render_resolved (src :> t) | `Alias (dest, src) -> - if Odoc_model.Paths.Path.is_hidden (src :> Path.t) then - render_resolved (dest :> t) + if Path.is_hidden (src :> Path.t) then render_resolved (dest :> t) else render_path (src :> Path.t) | `AliasModuleType (p1, p2) -> - if Odoc_model.Paths.Path.Resolved.(is_hidden (p2 :> t)) then - render_resolved (p1 :> t) + if Path.Resolved.(is_hidden (p2 :> t)) then render_resolved (p1 :> t) else render_resolved (p2 :> t) | `Hidden p -> render_resolved (p :> t) | `Module (p, s) -> render_resolved (p :> t) ^ "." ^ ModuleName.to_string s @@ -39,7 +36,7 @@ let render_path : Odoc_model.Paths.Path.t -> string = | `Apply (rp, p) -> render_resolved (rp :> t) ^ "(" - ^ render_resolved (p :> Odoc_model.Paths.Path.Resolved.t) + ^ render_resolved (p :> Path.Resolved.t) ^ ")" | `ModuleType (p, s) -> render_resolved (p :> t) ^ "." ^ ModuleTypeName.to_string s @@ -47,10 +44,8 @@ let render_path : Odoc_model.Paths.Path.t -> string = | `Value (p, s) -> render_resolved (p :> t) ^ "." ^ ValueName.to_string s | `Class (p, s) -> render_resolved (p :> t) ^ "." ^ TypeName.to_string s | `ClassType (p, s) -> render_resolved (p :> t) ^ "." ^ TypeName.to_string s - and dot p s = - render_path (p : Odoc_model.Paths.Path.Module.t :> Odoc_model.Paths.Path.t) - ^ "." ^ s - and render_path : Odoc_model.Paths.Path.t -> string = + and dot p s = render_path (p : Path.Module.t :> Path.t) ^ "." ^ s + and render_path : Path.t -> string = fun x -> match x with | `Identifier (id, _) -> Identifier.name id @@ -61,12 +56,12 @@ let render_path : Odoc_model.Paths.Path.t -> string = | `DotMT (p, s) -> dot p (ModuleTypeName.to_string s) | `DotV (p, s) -> dot p (ValueName.to_string s) | `Apply (p1, p2) -> - render_path (p1 :> t) ^ "(" ^ render_path (p2 :> t) ^ ")" + render_path (p1 :> Path.t) ^ "(" ^ render_path (p2 :> Path.t) ^ ")" | `Resolved rp -> render_resolved rp - | `Substituted m -> render_path (m :> t) - | `SubstitutedMT m -> render_path (m :> t) - | `SubstitutedT m -> render_path (m :> t) - | `SubstitutedCT m -> render_path (m :> t) + | `Substituted m -> render_path (m :> Path.t) + | `SubstitutedMT m -> render_path (m :> Path.t) + | `SubstitutedT m -> render_path (m :> Path.t) + | `SubstitutedCT m -> render_path (m :> Path.t) in render_path @@ -95,7 +90,7 @@ module Path = struct type any_pv = [ nonsrc_pv | Identifier.SourcePage.t_pv | Identifier.AssetFile.t_pv ] - and any = any_pv Odoc_model.Paths.Identifier.id + and any = any_pv Identifier.id type kind = [ `Module @@ -196,8 +191,7 @@ module Path = struct let name = AssetName.to_string name in mk ~parent kind name - let from_identifier p = - from_identifier (p : [< any_pv ] Odoc_model.Paths.Identifier.id :> any) + let from_identifier p = from_identifier (p : [< any_pv ] Identifier.id :> any) let to_list url = let rec loop acc { parent; name; kind } = @@ -415,7 +409,7 @@ module Anchor = struct let polymorphic_variant ~type_ident elt = let name_of_type_constr te = match te with - | Odoc_model.Lang.TypeExpr.Constr (path, _) -> + | TypeExpr.Constr (path, _) -> render_path (path :> Odoc_model.Paths.Path.t) | _ -> invalid_arg @@ -453,11 +447,19 @@ type t = Anchor.t let from_path page = { Anchor.page; anchor = ""; kind = (page.kind :> Anchor.kind) } -let from_identifier ~stop_before = function - | { Odoc_model.Paths.Identifier.iv = #Path.any_pv; _ } as p - when not stop_before -> - Ok (from_path @@ Path.from_identifier p) - | p -> Anchor.from_identifier p +let from_identifier ~stop_before x = + if Identifier.is_hidden x then + Ok + { + Anchor.page = { parent = None; kind = `Module; name = "blooooooo" }; + anchor = "bliiiiiiii"; + kind = `Module; + } + else + match x with + | { Identifier.iv = #Path.any_pv; _ } as p when not stop_before -> + Ok (from_path @@ Path.from_identifier p) + | p -> Anchor.from_identifier p let from_asset_identifier p = from_path @@ Path.from_identifier p diff --git a/src/document/url.mli b/src/document/url.mli index 3aaef7b0bc..6d19c1c5da 100644 --- a/src/document/url.mli +++ b/src/document/url.mli @@ -111,6 +111,24 @@ type t = Anchor.t val from_path : Path.t -> t val from_identifier : stop_before:bool -> Identifier.t -> (t, Error.t) result +(** [from_identifier] turns an identifier to an url. + + Some identifiers can be accessed in different ways. For instance, + submodules generate a dedicated page, but they can also be linked to at + their parent page, using a hash. + + The [stop_before] boolean controls that: with [~stop_before:true], the url + will point to the parent page when applicable. + + There are several wrong ways to use [from_identifier]: + - Using [~stop_before:false] with a module that does not contain an + expansion, such as a module alias. This will generate a 404 url. + - Using [~stop_before:true] with a module that does not contain a parent, + such as a root module. This will ouput return an [Error _] value. + - Calling it with an unlinkable id, such as a core type. This will ouput + return an [Error _] value. + + Please, reader, go and fix this API. Thanks. *) val from_asset_identifier : Identifier.AssetFile.t -> t diff --git a/src/driver/odoc_unit.ml b/src/driver/odoc_unit.ml index 274b713170..b17f026453 100644 --- a/src/driver/odoc_unit.ml +++ b/src/driver/odoc_unit.ml @@ -184,29 +184,33 @@ let of_packages ~output_dir ~linked_dir ~index_dir (pkgs : Packages.t list) : in let of_impl pkg libname (impl : Packages.impl) : impl unit option = - match impl.mip_src_info with - | None -> None - | Some { src_path } -> - let rel_dir = lib_dir pkg libname in - let include_dirs = - let deps = build_deps impl.mip_deps in - List.map (fun u -> u.odoc_dir) deps - in - let kind = - let src_name = Fpath.filename src_path in - let src_id = - Fpath.(pkg.pkg_dir / "src" / libname / src_name) |> Odoc.Id.of_fpath + let _ = + match impl.mip_src_info with + | None -> None + | Some { src_path } -> + let rel_dir = lib_dir pkg libname in + let include_dirs = + let deps = build_deps impl.mip_deps in + List.map (fun u -> u.odoc_dir) deps in - `Impl { src_id; src_path } - in - let name = - impl.mip_path |> Fpath.rem_ext |> Fpath.basename |> ( ^ ) "impl-" - in - let unit = - make_unit ~name ~kind ~rel_dir ~input_file:impl.mip_path ~pkg - ~include_dirs - in - Some unit + let kind = + let src_name = Fpath.filename src_path in + let src_id = + Fpath.(pkg.pkg_dir / "src" / libname / src_name) + |> Odoc.Id.of_fpath + in + `Impl { src_id; src_path } + in + let name = + impl.mip_path |> Fpath.rem_ext |> Fpath.basename |> ( ^ ) "impl-" + in + let unit = + make_unit ~name ~kind ~rel_dir ~input_file:impl.mip_path ~pkg + ~include_dirs + in + Some unit + in + None in let of_module pkg libname (m : Packages.modulety) : [ impl | intf ] unit list diff --git a/src/html/generator.ml b/src/html/generator.ml index b40f90b16d..dbed13d43b 100644 --- a/src/html/generator.ml +++ b/src/html/generator.ml @@ -542,6 +542,7 @@ module Page = struct match sidebar with | None -> None | Some sidebar -> + let sidebar = Odoc_document.Sidebar.to_block sidebar url in (* let sidebar = Odoc_document.Sidebar.to_block sidebar p in *) (Some (block ~config ~resolve sidebar) :> any Html.elt list option) in diff --git a/src/html/generator.mli b/src/html/generator.mli index 446d2346f7..fa95d3249b 100644 --- a/src/html/generator.mli +++ b/src/html/generator.mli @@ -1,6 +1,6 @@ val render : config:Config.t -> - sidebar:Odoc_document.Types.Block.t option -> + sidebar:Odoc_document.Sidebar.t option -> Odoc_document.Types.Document.t -> Odoc_document.Renderer.page list diff --git a/src/html/html_fragment_json.ml b/src/html/html_fragment_json.ml index 1deffdecf8..54dac13473 100644 --- a/src/html/html_fragment_json.ml +++ b/src/html/html_fragment_json.ml @@ -62,7 +62,7 @@ let make ~config ~preamble ~url ~breadcrumbs ~sidebar ~toc ~uses_katex ("content", `String (json_of_html content)); ])) in - { Odoc_document.Renderer.filename; content; children } + { Odoc_document.Renderer.filename; content; children; path = url } let make_src ~config ~url ~breadcrumbs content = let filename = Link.Path.as_filename ~config url in @@ -82,4 +82,4 @@ let make_src ~config ~url ~breadcrumbs content = (List.map (Format.asprintf "%a" htmlpp) content)) ); ])) in - { Odoc_document.Renderer.filename; content; children = [] } + { Odoc_document.Renderer.filename; content; children = []; path = url } diff --git a/src/html/html_page.ml b/src/html/html_page.ml index 3430c76348..54f02f727d 100644 --- a/src/html/html_page.ml +++ b/src/html/html_page.ml @@ -249,7 +249,7 @@ let make ~config ~url ~header ~breadcrumbs ~sidebar ~toc ~uses_katex content page_creator ~config ~url ~uses_katex ~global_toc:sidebar header breadcrumbs toc content in - { Odoc_document.Renderer.filename; content; children } + { Odoc_document.Renderer.filename; content; children; path = url } let path_of_module_of_source ppf url = match url.Url.Path.parent with @@ -289,4 +289,4 @@ let make_src ~config ~url ~breadcrumbs ~header title content = let content = src_page_creator ~breadcrumbs ~config ~url ~header title content in - { Odoc_document.Renderer.filename; content; children = [] } + { Odoc_document.Renderer.filename; content; children = []; path = url } diff --git a/src/html_support_files/odoc.css b/src/html_support_files/odoc.css index f9a207132c..8feb650484 100644 --- a/src/html_support_files/odoc.css +++ b/src/html_support_files/odoc.css @@ -297,13 +297,13 @@ body { } body.odoc { - max-width: 160ex; + max-width: 204ex; display: grid; grid-template-columns: min-content 1fr min-content; grid-template-areas: "search-bar nav ." - "toc-global preamble toc-local" - "toc-global content toc-local"; + "toc-global preamble toc-local" + "toc-global content toc-local"; column-gap: 4ex; grid-template-rows: auto auto 1fr; } @@ -886,7 +886,7 @@ body.odoc:has( .odoc-search) .odoc-toc { .odoc-toc { --toc-top: 20px; - width: 28ex; + width: 50ex; background: var(--toc-background); overflow: auto; color: var(--toc-color); @@ -1229,6 +1229,12 @@ body.odoc:has( .odoc-search) .odoc-toc { padding-left: 12px; } +.odoc-toc .current_unit + ul> li { + border-left: 3px solid var(--anchor-color); + margin-left: 5px; + padding-left: 12px; +} + /* Tables */ .odoc-table { diff --git a/src/index/dune b/src/index/dune new file mode 100644 index 0000000000..c5de6df7a4 --- /dev/null +++ b/src/index/dune @@ -0,0 +1,4 @@ +(library + (name odoc_index) + (public_name odoc.index) + (libraries odoc_model odoc_html_frontend tyxml odoc_utils)) diff --git a/src/index/entry.ml b/src/index/entry.ml new file mode 100644 index 0000000000..601af8daf5 --- /dev/null +++ b/src/index/entry.ml @@ -0,0 +1,68 @@ +open Odoc_model.Lang +open Odoc_model.Paths + +module Html = Tyxml.Html + +type type_decl_entry = { + canonical : Path.Type.t option; + equation : TypeDecl.Equation.t; + representation : TypeDecl.Representation.t option; +} + +type class_type_entry = { virtual_ : bool; params : TypeDecl.param list } + +type method_entry = { private_ : bool; virtual_ : bool; type_ : TypeExpr.t } + +type class_entry = { virtual_ : bool; params : TypeDecl.param list } + +type type_extension_entry = { + type_path : Path.Type.t; + type_params : TypeDecl.param list; + private_ : bool; +} + +type constructor_entry = { + args : TypeDecl.Constructor.argument; + res : TypeExpr.t; +} + +type field_entry = { + mutable_ : bool; + type_ : TypeExpr.t; + parent_type : TypeExpr.t; +} + +type instance_variable_entry = { + mutable_ : bool; + virtual_ : bool; + type_ : TypeExpr.t; +} + +type value_entry = { value : Value.value; type_ : TypeExpr.t } + +type module_entry = { has_expansion : bool } + +type kind = + | TypeDecl of type_decl_entry + | Module of module_entry + | Value of value_entry + | Doc + | Exception of constructor_entry + | Class_type of class_type_entry + | Method of method_entry + | Class of class_entry + | TypeExtension of type_extension_entry + | ExtensionConstructor of constructor_entry + | ModuleType of module_entry + | Constructor of constructor_entry + | Field of field_entry + +type t = { + id : Odoc_model.Paths.Identifier.Any.t; + doc : Odoc_model.Comment.docs; + kind : kind; +} + +let entry ~id ~doc ~kind = + let id = (id :> Odoc_model.Paths.Identifier.Any.t) in + { id; kind; doc } diff --git a/src/search/entry.mli b/src/index/entry.mli similarity index 83% rename from src/search/entry.mli rename to src/index/entry.mli index b44a0b98af..198c8fc68e 100644 --- a/src/search/entry.mli +++ b/src/index/entry.mli @@ -36,22 +36,22 @@ type instance_variable_entry = { type_ : TypeExpr.t; } -type doc_entry = Paragraph | Heading | CodeBlock | MathBlock | Verbatim - type value_entry = { value : Value.value; type_ : TypeExpr.t } +type module_entry = { has_expansion : bool } + type kind = | TypeDecl of type_decl_entry - | Module + | Module of module_entry | Value of value_entry - | Doc of doc_entry + | Doc | Exception of constructor_entry | Class_type of class_type_entry | Method of method_entry | Class of class_entry | TypeExtension of type_extension_entry | ExtensionConstructor of constructor_entry - | ModuleType + | ModuleType of module_entry | Constructor of constructor_entry | Field of field_entry @@ -61,4 +61,8 @@ type t = { kind : kind; } -val entries_of_item : Odoc_model.Fold.item -> t list +val entry : + id:[< Odoc_model.Paths.Identifier.Any.t_pv ] Odoc_model.Paths.Identifier.id -> + doc:Odoc_model.Comment.docs -> + kind:kind -> + t diff --git a/src/index/odoc_index.ml b/src/index/odoc_index.ml new file mode 100644 index 0000000000..1c2e4f2659 --- /dev/null +++ b/src/index/odoc_index.ml @@ -0,0 +1,19 @@ +open Odoc_model + +module Skeleton = Skeleton +module Entry = Entry +module Page_hierarchy = Page_hierarchy + +type title = Comment.link_content +type page = { p_name : string; p_hierarchy : Page_hierarchy.t } + +type lib_hierarchies = Skeleton.t list +type lib = { l_name : string; l_hierarchies : lib_hierarchies } + +type t = { + pages : page list; + libs : lib list; + extra : Skeleton.t list; + (** This extra table is used only for search. It was introduced before + Odoc 3 *) +} diff --git a/src/index/page_hierarchy.ml b/src/index/page_hierarchy.ml new file mode 100644 index 0000000000..2d6d65ee6a --- /dev/null +++ b/src/index/page_hierarchy.ml @@ -0,0 +1,190 @@ +open Odoc_utils +open Odoc_model + +(* Selective opens *) +module Id = Odoc_model.Paths.Identifier +module PageName = Odoc_model.Names.PageName + +module CPH = Id.Hashtbl.ContainerPage +module LPH = Id.Hashtbl.LeafPage + +type page = Id.Page.t +type leaf_page = Id.LeafPage.t +type container_page = Id.ContainerPage.t + +open Astring + +type title = Comment.link_content + +type payload = { + title : title; + children_order : Frontmatter.children_order option; +} + +type dir_content = { leafs : payload LPH.t; dirs : in_progress CPH.t } +and in_progress = container_page option * dir_content + +let empty_t dir_id = (dir_id, { leafs = LPH.create 10; dirs = CPH.create 10 }) + +let get_parent id : container_page option = + let id :> page = id in + match id.iv with + | `Page (Some parent, _) -> Some parent + | `LeafPage (Some parent, _) -> Some parent + | `Page (None, _) | `LeafPage (None, _) -> None + +let find_leaf ((_, dir_content) : in_progress) leaf_page = + try Some (LPH.find dir_content.leafs leaf_page) with Not_found -> None + +let leafs (_, dir_content) = + LPH.fold + (fun id { title = payload; _ } acc -> + if String.equal "index" (Id.name id) then acc else (id, payload) :: acc) + dir_content.leafs [] + +let dirs (_, dir_content) = + CPH.fold (fun id payload acc -> (id, payload) :: acc) dir_content.dirs [] + +let rec get_or_create (dir : in_progress) (id : container_page) : in_progress = + let _, { dirs = parent_dirs; _ } = + match get_parent id with + | Some parent -> get_or_create dir parent + | None -> dir + in + let current_item = + try Some (CPH.find parent_dirs id) with Not_found -> None + in + match current_item with + | Some item -> item + | None -> + let new_ = empty_t (Some id) in + CPH.add parent_dirs id new_; + new_ + +let add (dir : in_progress) ((id : leaf_page), title, children_order) = + let _, dir_content = + match get_parent id with + | Some parent -> get_or_create dir parent + | None -> dir + in + LPH.replace dir_content.leafs id { title; children_order } + +let dir_index ((parent_id, _) as dir) = + let index_id = Id.Mk.leaf_page (parent_id, PageName.make_std "index") in + match find_leaf dir index_id with + | Some payload -> Some (payload, index_id, payload.title) + | None -> None + +type index = Id.Page.t * title + +type t = index option Odoc_utils.Tree.t + +let rec t_of_in_progress (dir : in_progress) : t = + let children_order, index = + match dir_index dir with + | Some ({ children_order; _ }, index_id, index_title) -> + (children_order, Some (index_id, index_title)) + | None -> (None, None) + in + let pp_content fmt (id, _) = + match id.Id.iv with + | `LeafPage (_, name) -> Format.fprintf fmt "'%s'" (PageName.to_string name) + | `Page (_, name) -> Format.fprintf fmt "'%s/'" (PageName.to_string name) + in + let pp_children fmt c = + match c.Location_.value with + | Frontmatter.Page s -> Format.fprintf fmt "'%s'" s + | Dir s -> Format.fprintf fmt "'%s/'" s + in + let ordered, unordered = + let contents = + let leafs = + leafs dir + |> List.map (fun (id, payload) -> + let id :> Id.Page.t = id in + (id, Tree.leaf (Some (id, payload)))) + in + let dirs = + dirs dir + |> List.map (fun (id, payload) -> + let id :> Id.Page.t = id in + (id, t_of_in_progress payload)) + in + leafs @ dirs + in + match children_order with + | None -> ([], contents) + | Some children_order -> + let children_indexes = + List.mapi (fun i x -> (i, x)) children_order.value + in + let equal id ch = + match (ch, id.Id.iv) with + | (_, { Location_.value = Frontmatter.Dir c; _ }), `Page (_, name) -> + String.equal (PageName.to_string name) c + | (_, { Location_.value = Page c; _ }), `LeafPage (_, name) -> + String.equal (PageName.to_string name) c + | _ -> false + in + let children_indexes, indexed_content, unindexed_content = + List.fold_left + (fun (children_indexes, indexed_content, unindexed_content) + (((id : Id.Page.t), _) as entry) -> + let indexes_for_entry, children_indexes = + List.partition (equal id) children_indexes + in + match indexes_for_entry with + | [] -> + (children_indexes, indexed_content, entry :: unindexed_content) + | (i, _) :: rest -> + List.iter + (fun (_, c) -> + Error.raise_warning + (Error.make "Duplicate %a in (children)." pp_children c + (Location_.location c))) + rest; + ( children_indexes, + (i, entry) :: indexed_content, + unindexed_content )) + (children_indexes, [], []) contents + in + List.iter + (fun (_, c) -> + Error.raise_warning + (Error.make "%a in (children) does not correspond to anything." + pp_children c (Location_.location c))) + children_indexes; + (indexed_content, unindexed_content) + in + let () = + match (children_order, unordered) with + | Some x, (_ :: _ as l) -> + Error.raise_warning + (Error.make "(children) doesn't include %a." + (Format.pp_print_list pp_content) + l (Location_.location x)) + | _ -> () + in + let ordered = + ordered + |> List.sort (fun (i, _) (j, _) -> (compare : int -> int -> int) i j) + |> List.map snd + in + let unordered = + List.sort + (fun (x, _) (y, _) -> + String.compare (Paths.Identifier.name x) (Paths.Identifier.name y)) + unordered + in + let contents = ordered @ unordered |> List.map snd in + { Tree.node = index; children = contents } + +let rec remove_common_root (v : t) = + match v with + | { Tree.children = [ v ]; node = None } -> remove_common_root v + | _ -> v + +let of_list l = + let dir = empty_t None 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 new file mode 100644 index 0000000000..21cc2077c4 --- /dev/null +++ b/src/index/page_hierarchy.mli @@ -0,0 +1,16 @@ +open Odoc_model +open Odoc_model.Paths +open Odoc_utils + +(** Page hierarchies represent a hierarchy of pages. *) + +type title = Comment.link_content + +type index = Identifier.Page.t * title + +type t = index option Tree.t + +val of_list : + (Identifier.LeafPage.t * title * Frontmatter.children_order option) list -> t +(** Uses the convention that the [index] children passes its payload to the + container directory to output a payload *) diff --git a/src/index/skeleton.ml b/src/index/skeleton.ml new file mode 100644 index 0000000000..89352ced3a --- /dev/null +++ b/src/index/skeleton.ml @@ -0,0 +1,272 @@ +open Odoc_model.Lang +open Odoc_model.Paths + +open Odoc_utils + +type t = Entry.t Tree.t + +module Entry = struct + let of_comp_unit (u : Compilation_unit.t) = + let has_expansion = true in + let doc = match u.content with Pack _ -> [] | Module m -> m.doc in + Entry.entry ~id:u.id ~doc ~kind:(Module { has_expansion }) + + let of_module (m : Module.t) = + let has_expansion = + match m.type_ with Alias (_, None) -> false | _ -> true + in + Entry.entry ~id:m.id ~doc:m.doc ~kind:(Module { has_expansion }) + + let of_module_type (mt : ModuleType.t) = + let has_expansion = + match mt.expr with + | Some expr -> ( + match expr with + | Signature _ -> true + | Functor _ -> true + | Path { p_expansion = Some _; _ } -> true + | With { w_expansion = Some _; _ } -> true + | TypeOf { t_expansion = Some _; _ } -> true + | _ -> false) + | _ -> true + in + Entry.entry ~id:mt.id ~doc:mt.doc ~kind:(ModuleType { has_expansion }) + + let of_type_decl (td : TypeDecl.t) = + let kind = + Entry.TypeDecl + { + canonical = td.canonical; + equation = td.equation; + representation = td.representation; + } + in + let td_entry = Entry.entry ~id:td.id ~doc:td.doc ~kind in + td_entry + + let varify_params = + List.mapi (fun i param -> + match param.TypeDecl.desc with + | Var name -> TypeExpr.Var name + | Any -> Var (Printf.sprintf "tv_%i" i)) + + let of_constructor id_parent params (c : TypeDecl.Constructor.t) = + let args = c.args in + let res = + match c.res with + | Some res -> res + | None -> + let params = varify_params params in + TypeExpr.Constr + ( `Identifier + ((id_parent :> Odoc_model.Paths.Identifier.Path.Type.t), false), + params ) + in + let kind = Entry.Constructor { args; res } in + Entry.entry ~id:c.id ~doc:c.doc ~kind + + let of_field id_parent params (field : TypeDecl.Field.t) = + let params = varify_params params in + let parent_type = + TypeExpr.Constr + ( `Identifier + ((id_parent :> Odoc_model.Paths.Identifier.Path.Type.t), false), + params ) + in + let kind = + Entry.Field + { mutable_ = field.mutable_; type_ = field.type_; parent_type } + in + Entry.entry ~id:field.id ~doc:field.doc ~kind + + let of_exception (exc : Exception.t) = + let res = + match exc.res with + | None -> TypeExpr.Constr (Odoc_model.Predefined.exn_path, []) + | Some x -> x + in + let kind = Entry.Exception { args = exc.args; res } in + Entry.entry ~id:exc.id ~doc:exc.doc ~kind + + let of_value (v : Value.t) = + let kind = Entry.Value { value = v.value; type_ = v.type_ } in + Entry.entry ~id:v.id ~doc:v.doc ~kind + + let of_class (cl : Class.t) = + let kind = Entry.Class { virtual_ = cl.virtual_; params = cl.params } in + Entry.entry ~id:cl.id ~doc:cl.doc ~kind + + let of_class_type (ct : ClassType.t) = + let kind = + Entry.Class_type { virtual_ = ct.virtual_; params = ct.params } + in + Entry.entry ~id:ct.id ~doc:ct.doc ~kind + + let of_method (m : Method.t) = + let kind = + Entry.Method + { virtual_ = m.virtual_; private_ = m.private_; type_ = m.type_ } + in + Entry.entry ~id:m.id ~doc:m.doc ~kind + + let of_docs id doc = Entry.entry ~id ~doc ~kind:Doc +end + +let if_non_hidden id f = + if Identifier.is_hidden (id :> Identifier.t) then [] else f () + +let rec unit (u : Compilation_unit.t) = + let entry = Entry.of_comp_unit u in + let children = + match u.content with + | Pack _ -> [] + | Module m -> signature (u.id :> Identifier.LabelParent.t) m + in + { Tree.node = entry; children } + +and signature id (s : Signature.t) = + List.concat_map ~f:(signature_item (id :> Identifier.LabelParent.t)) s.items + +and signature_item id s_item = + match s_item with + | Module (_, m) -> module_ (m.id :> Identifier.LabelParent.t) m + | ModuleType mt -> module_type (mt.id :> Identifier.LabelParent.t) mt + | ModuleSubstitution _ -> [] + | ModuleTypeSubstitution _ -> [] + | Open _ -> [] + | Type (_, t_decl) -> type_decl t_decl + | TypeSubstitution _ -> [] + | TypExt _te -> [] + | Exception exc -> exception_ exc + | Value v -> value v + | Class (_, cl) -> class_ (cl.id :> Identifier.LabelParent.t) cl + | ClassType (_, clt) -> class_type (clt.id :> Identifier.LabelParent.t) clt + | Include i -> include_ id i + | Comment d -> docs id d + +and module_ id m = + if_non_hidden m.id @@ fun () -> + let entry = Entry.of_module m in + let children = + match m.type_ with + | Alias (_, None) -> [] + | Alias (_, Some s_e) -> simple_expansion id s_e + | ModuleType mte -> module_type_expr id mte + in + [ { Tree.node = entry; children } ] + +and module_type id mt = + if_non_hidden mt.id @@ fun () -> + let entry = Entry.of_module_type mt in + let children = + match mt.expr with + | None -> [] + | Some mt_expr -> module_type_expr id mt_expr + in + [ { Tree.node = entry; children } ] + +and type_decl td = + if_non_hidden td.id @@ fun () -> + let entry = Entry.of_type_decl td in + let children = + match td.representation with + | None -> [] + | Some (Variant cl) -> + List.concat_map ~f:(constructor td.id td.equation.params) cl + | Some (Record fl) -> List.concat_map ~f:(field td.id td.equation.params) fl + | Some Extensible -> [] + in + [ { Tree.node = entry; children } ] + +and constructor type_id params c = + let entry = Entry.of_constructor type_id params c in + [ Tree.leaf entry ] + +and field type_id params f = + let entry = Entry.of_field type_id params f in + [ Tree.leaf entry ] + +and _type_extension _te = [] + +and exception_ exc = + if_non_hidden exc.id @@ fun () -> + let entry = Entry.of_exception exc in + [ Tree.leaf entry ] + +and value v = + if_non_hidden v.id @@ fun () -> + let entry = Entry.of_value v in + [ Tree.leaf entry ] + +and class_ id cl = + if_non_hidden cl.id @@ fun () -> + let entry = Entry.of_class cl in + let children = + match cl.expansion with + | None -> [] + | Some cl_signature -> class_signature id cl_signature + in + [ { Tree.node = entry; children } ] + +and class_type id ct = + if_non_hidden ct.id @@ fun () -> + let entry = Entry.of_class_type ct in + let children = + match ct.expansion with None -> [] | Some cs -> class_signature id cs + in + [ { Tree.node = entry; children } ] + +and include_ id inc = signature id inc.expansion.content + +and docs id d = + match d with + | `Stop -> [] + | `Docs d -> + let entry = Entry.of_docs id d in + [ Tree.leaf entry ] + +and simple_expansion id s_e = + match s_e with + | Signature sg -> signature id sg + | Functor (p, s_e) -> + let _extra_entries = functor_parameter p in + simple_expansion id s_e + +and module_type_expr id mte = + match mte with + | Signature s -> signature id s + | Functor (fp, mt_expr) -> + let _extra_entries = functor_parameter fp in + module_type_expr id mt_expr + | With { w_expansion = Some sg; _ } -> simple_expansion id sg + | TypeOf { t_expansion = Some sg; _ } -> simple_expansion id sg + | Path { p_expansion = Some sg; _ } -> simple_expansion id sg + | Path { p_expansion = None; _ } -> [] + | With { w_expansion = None; _ } -> [] + | TypeOf { t_expansion = None; _ } -> [] + +and class_signature id ct_expr = + List.concat_map ~f:(class_signature_item id) ct_expr.items + +and class_signature_item id item = + match item with + | Method m -> + let entry = Entry.of_method m in + [ Tree.leaf entry ] + | InstanceVariable _ -> [] + | Constraint _ -> [] + | Inherit _ -> [] + | Comment d -> docs id d + +and functor_parameter fp = + match fp with + | Unit -> [] + | Named n -> module_type_expr (n.id :> Identifier.LabelParent.t) n.expr + +let from_unit u = unit u + +let from_page (p : Page.t) = + match p with + | { name; content; _ } -> + let entry = Entry.of_docs name content in + Tree.leaf entry diff --git a/src/index/skeleton.mli b/src/index/skeleton.mli new file mode 100644 index 0000000000..fcaea85b40 --- /dev/null +++ b/src/index/skeleton.mli @@ -0,0 +1,12 @@ +open Odoc_model.Lang +open Odoc_utils + +(** Skeletons represent a hierarchy of entries. It contains the least + information to create an index, represented in a uniform way (compared to + the [Lang] types) *) + +type t = Entry.t Tree.t + +val from_unit : Compilation_unit.t -> t + +val from_page : Page.t -> t diff --git a/src/latex/generator.ml b/src/latex/generator.ml index 515a6cbe32..58cd5c57d9 100644 --- a/src/latex/generator.ml +++ b/src/latex/generator.ml @@ -457,7 +457,7 @@ module Doc = struct if with_children then link_children ppf children else () in let content ppf = Fmt.pf ppf "@[%a@,%t@]@." pp content children_input in - { Odoc_document.Renderer.filename; content; children } + { Odoc_document.Renderer.filename; content; children; path = url } end module Page = struct diff --git a/src/manpage/generator.ml b/src/manpage/generator.ml index f18f3e70ee..ea39f2fd41 100644 --- a/src/manpage/generator.ml +++ b/src/manpage/generator.ml @@ -562,7 +562,7 @@ and render_page (p : Page.t) = and children = Utils.flatmap ~f:subpage @@ Subpages.compute p in let content ppf = Format.fprintf ppf "%a@." Roff.pp (page p) in let filename = Link.as_filename p.url in - { Renderer.filename; content; children } + { Renderer.filename; content; children; path = p.url } let render = function | Document.Page page -> [ render_page page ] diff --git a/src/model/fold.ml b/src/model/fold.ml deleted file mode 100644 index 2ee46ea6b9..0000000000 --- a/src/model/fold.ml +++ /dev/null @@ -1,137 +0,0 @@ -open Lang - -type item = - | CompilationUnit of Compilation_unit.t - | TypeDecl of TypeDecl.t - | Module of Module.t - | Value of Value.t - | Exception of Exception.t - | ClassType of ClassType.t - | Method of Method.t - | Class of Class.t - | Extension of Extension.t - | ModuleType of ModuleType.t - | Doc of Paths.Identifier.LabelParent.t * Comment.docs_or_stop - -let rec unit ~f acc u = - let acc = f acc (CompilationUnit u) in - match u.content with - | Module m -> signature ~f (u.id :> Paths.Identifier.LabelParent.t) acc m - | Pack _ -> acc - -and page ~f acc p = - let open Page in - docs ~f (p.name :> Paths.Identifier.LabelParent.t) acc (`Docs p.content) - -and signature ~f id acc (s : Signature.t) = - List.fold_left - (signature_item ~f (id :> Paths.Identifier.LabelParent.t)) - acc s.items - -and signature_item ~f id acc s_item = - match s_item with - | Module (_, m) -> module_ ~f (m.id :> Paths.Identifier.LabelParent.t) acc m - | ModuleType mt -> - module_type ~f (mt.id :> Paths.Identifier.LabelParent.t) acc mt - | ModuleSubstitution _ -> acc - | ModuleTypeSubstitution _ -> acc - | Open _ -> acc - | Type (_, t_decl) -> type_decl ~f acc t_decl - | TypeSubstitution _ -> acc - | TypExt te -> type_extension ~f acc te - | Exception exc -> exception_ ~f acc exc - | Value v -> value ~f acc v - | Class (_, cl) -> class_ ~f (cl.id :> Paths.Identifier.LabelParent.t) acc cl - | ClassType (_, clt) -> - class_type ~f (clt.id :> Paths.Identifier.LabelParent.t) acc clt - | Include i -> include_ ~f id acc i - | Comment d -> docs ~f id acc d - -and docs ~f id acc d = f acc (Doc (id, d)) - -and include_ ~f id acc inc = signature ~f id acc inc.expansion.content - -and class_type ~f id acc ct = - (* This check is important because [is_internal] does not work on children of - internal items. This means that if [Fold] did not make this check here, - it would be difficult to filter for internal items afterwards. This also - applies to the same check in functions bellow. *) - if Paths.Identifier.is_hidden ct.id then acc - else - let acc = f acc (ClassType ct) in - match ct.expansion with - | None -> acc - | Some cs -> class_signature ~f id acc cs - -and class_signature ~f id acc ct_expr = - List.fold_left (class_signature_item ~f id) acc ct_expr.items - -and class_signature_item ~f id acc item = - match item with - | Method m -> f acc (Method m) - | InstanceVariable _ -> acc - | Constraint _ -> acc - | Inherit _ -> acc - | Comment d -> docs ~f id acc d - -and class_ ~f id acc cl = - if Paths.Identifier.is_hidden cl.id then acc - else - let acc = f acc (Class cl) in - match cl.expansion with - | None -> acc - | Some cl_signature -> class_signature ~f id acc cl_signature - -and exception_ ~f acc exc = - if Paths.Identifier.is_hidden exc.id then acc else f acc (Exception exc) - -and type_extension ~f acc te = f acc (Extension te) - -and value ~f acc v = - if Paths.Identifier.is_hidden v.id then acc else f acc (Value v) - -and module_ ~f id acc m = - if Paths.Identifier.is_hidden m.id then acc - else - let acc = f acc (Module m) in - match m.type_ with - | Alias (_, None) -> acc - | Alias (_, Some s_e) -> simple_expansion ~f id acc s_e - | ModuleType mte -> module_type_expr ~f id acc mte - -and type_decl ~f acc td = - if Paths.Identifier.is_hidden td.id then acc else f acc (TypeDecl td) - -and module_type ~f id acc mt = - if Paths.Identifier.is_hidden mt.id then acc - else - let acc = f acc (ModuleType mt) in - match mt.expr with - | None -> acc - | Some mt_expr -> module_type_expr ~f id acc mt_expr - -and simple_expansion ~f id acc s_e = - match s_e with - | Signature sg -> signature ~f id acc sg - | Functor (p, s_e) -> - let acc = functor_parameter ~f acc p in - simple_expansion ~f id acc s_e - -and module_type_expr ~f id acc mte = - match mte with - | Signature s -> signature ~f id acc s - | Functor (fp, mt_expr) -> - let acc = functor_parameter ~f acc fp in - module_type_expr ~f id acc mt_expr - | With { w_expansion = Some sg; _ } -> simple_expansion ~f id acc sg - | TypeOf { t_expansion = Some sg; _ } -> simple_expansion ~f id acc sg - | Path { p_expansion = Some sg; _ } -> simple_expansion ~f id acc sg - | Path { p_expansion = None; _ } -> acc - | With { w_expansion = None; _ } -> acc - | TypeOf { t_expansion = None; _ } -> acc - -and functor_parameter ~f acc fp = - match fp with - | Unit -> acc - | Named n -> - module_type_expr ~f (n.id :> Paths.Identifier.LabelParent.t) acc n.expr diff --git a/src/model/fold.mli b/src/model/fold.mli deleted file mode 100644 index e5fc4a1473..0000000000 --- a/src/model/fold.mli +++ /dev/null @@ -1,99 +0,0 @@ -(** This module allows to fold over odoc values. It is notably used to construct - a search database of every relevant item. It appear to be very generic but - in reality it is quite specialized to fold over searchable items, and not - every kind of odoc value you could fold over.*) - -open Lang - -(** The type of items you can fold over *) -type item = - | CompilationUnit of Compilation_unit.t - | TypeDecl of TypeDecl.t - | Module of Module.t - | Value of Value.t - | Exception of Exception.t - | ClassType of ClassType.t - | Method of Method.t - | Class of Class.t - | Extension of Extension.t - | ModuleType of ModuleType.t - | Doc of Paths.Identifier.LabelParent.t * Comment.docs_or_stop - -(** Below are the folding functions. For items that may contain - others, such as [signature], it folds recursively on the - sub-items. It does not recurse into internal items. - - The LabelParent identifier is used to give an id to the doc entries. *) - -val unit : f:('a -> item -> 'a) -> 'a -> Compilation_unit.t -> 'a -val page : f:('a -> item -> 'a) -> 'a -> Page.t -> 'a - -val signature : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - Signature.t -> - 'a -val signature_item : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - Signature.item -> - 'a -val docs : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - Comment.docs_or_stop -> - 'a -val include_ : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - Include.t -> - 'a -val class_type : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - ClassType.t -> - 'a -val class_signature : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - ClassSignature.t -> - 'a -val class_signature_item : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - ClassSignature.item -> - 'a -val class_ : - f:('a -> item -> 'a) -> Paths.Identifier.LabelParent.t -> 'a -> Class.t -> 'a -val exception_ : f:('a -> item -> 'a) -> 'a -> Exception.t -> 'a -val type_extension : f:('a -> item -> 'a) -> 'a -> Extension.t -> 'a -val value : f:('a -> item -> 'a) -> 'a -> Value.t -> 'a -val module_ : - f:('a -> item -> 'a) -> Paths.Identifier.LabelParent.t -> 'a -> Module.t -> 'a -val type_decl : f:('a -> item -> 'a) -> 'a -> TypeDecl.t -> 'a -val module_type : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - ModuleType.t -> - 'a -val simple_expansion : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - ModuleType.simple_expansion -> - 'a -val module_type_expr : - f:('a -> item -> 'a) -> - Paths.Identifier.LabelParent.t -> - 'a -> - ModuleType.expr -> - 'a -val functor_parameter : f:('a -> item -> 'a) -> 'a -> FunctorParameter.t -> 'a diff --git a/src/model/lang.ml b/src/model/lang.ml index e1184c3b40..8dc917a407 100644 --- a/src/model/lang.ml +++ b/src/model/lang.ml @@ -539,11 +539,6 @@ module rec Page : sig end = Page -module rec Index : sig - type 'a t = { sidebar : Sidebar.t; index : 'a Paths.Identifier.Hashtbl.Any.t } -end = - Index - module rec Asset : sig type t = { name : Identifier.AssetFile.t; root : Root.t } end = diff --git a/src/model/odoc_model.ml b/src/model/odoc_model.ml index cfbc5969b0..0bf1becc3a 100644 --- a/src/model/odoc_model.ml +++ b/src/model/odoc_model.ml @@ -1,6 +1,4 @@ module Lang = Lang -module Sidebar = Sidebar -module Fold = Fold module Comment = Comment module Paths = Paths module Names = Names diff --git a/src/model/sidebar.ml b/src/model/sidebar.ml deleted file mode 100644 index 4780cb9ba1..0000000000 --- a/src/model/sidebar.ml +++ /dev/null @@ -1,200 +0,0 @@ -open Odoc_utils -module Id = Paths.Identifier - -module CPH = Id.Hashtbl.ContainerPage -module LPH = Id.Hashtbl.LeafPage - -type page = Id.Page.t -type leaf_page = Id.LeafPage.t -type container_page = Id.ContainerPage.t - -open Astring - -module PageToc = struct - type title = Comment.link_content - - type payload = { - title : title; - children_order : Frontmatter.children_order option; - } - - type dir_content = { leafs : payload LPH.t; dirs : in_progress CPH.t } - and in_progress = container_page option * dir_content - - let empty_t dir_id = (dir_id, { leafs = LPH.create 10; dirs = CPH.create 10 }) - - let get_parent id : container_page option = - let id :> page = id in - match id.iv with - | `Page (Some parent, _) -> Some parent - | `LeafPage (Some parent, _) -> Some parent - | `Page (None, _) | `LeafPage (None, _) -> None - - let find_leaf ((_, dir_content) : in_progress) leaf_page = - try Some (LPH.find dir_content.leafs leaf_page) with Not_found -> None - - let leafs (_, dir_content) = - LPH.fold - (fun id { title = payload; _ } acc -> - if String.equal "index" (Paths.Identifier.name id) then acc - else (id, payload) :: acc) - dir_content.leafs [] - - let dirs (_, dir_content) = - CPH.fold (fun id payload acc -> (id, payload) :: acc) dir_content.dirs [] - - let rec get_or_create (dir : in_progress) (id : container_page) : in_progress - = - let _, { dirs = parent_dirs; _ } = - match get_parent id with - | Some parent -> get_or_create dir parent - | None -> dir - in - let current_item = - try Some (CPH.find parent_dirs id) with Not_found -> None - in - match current_item with - | Some item -> item - | None -> - let new_ = empty_t (Some id) in - CPH.add parent_dirs id new_; - new_ - - let add (dir : in_progress) ((id : leaf_page), title, children_order) = - let _, dir_content = - match get_parent id with - | Some parent -> get_or_create dir parent - | None -> dir - in - LPH.replace dir_content.leafs id { title; children_order } - - let dir_index ((parent_id, _) as dir) = - let index_id = - Paths.Identifier.Mk.leaf_page (parent_id, Names.PageName.make_std "index") - in - match find_leaf dir index_id with - | Some payload -> Some (payload, index_id, payload.title) - | None -> None - - type index = Id.Page.t * title - type t = (Id.Page.t * content) list * index option - and content = Entry of title | Dir of t - - let rec t_of_in_progress (dir : in_progress) = - let children_order, index = - match dir_index dir with - | Some ({ children_order; _ }, index_id, index_title) -> - (children_order, Some (index_id, index_title)) - | None -> (None, None) - in - let pp_content fmt (id, _) = - match id.Id.iv with - | `LeafPage (_, name) -> - Format.fprintf fmt "'%s'" (Names.PageName.to_string name) - | `Page (_, name) -> - Format.fprintf fmt "'%s/'" (Names.PageName.to_string name) - in - let pp_children fmt c = - match c.Location_.value with - | Frontmatter.Page s -> Format.fprintf fmt "'%s'" s - | Dir s -> Format.fprintf fmt "'%s/'" s - in - let ordered, unordered = - let contents = - let leafs = - leafs dir - |> List.map (fun (id, payload) -> ((id :> Id.Page.t), Entry payload)) - in - let dirs = - dirs dir - |> List.map (fun (id, payload) -> - ((id :> Id.Page.t), Dir (t_of_in_progress payload))) - in - leafs @ dirs - in - match children_order with - | None -> ([], contents) - | Some children_order -> - let children_indexes = - List.mapi (fun i x -> (i, x)) children_order.value - in - let equal id ch = - match (ch, id.Id.iv) with - | (_, { Location_.value = Frontmatter.Dir c; _ }), `Page (_, name) - -> - String.equal (Names.PageName.to_string name) c - | (_, { Location_.value = Page c; _ }), `LeafPage (_, name) -> - String.equal (Names.PageName.to_string name) c - | _ -> false - in - let children_indexes, indexed_content, unindexed_content = - List.fold_left - (fun (children_indexes, indexed_content, unindexed_content) - (((id : Id.Page.t), _) as entry) -> - let indexes_for_entry, children_indexes = - List.partition (equal id) children_indexes - in - match indexes_for_entry with - | [] -> - ( children_indexes, - indexed_content, - entry :: unindexed_content ) - | (i, _) :: rest -> - List.iter - (fun (_, c) -> - Error.raise_warning - (Error.make "Duplicate %a in (children)." pp_children - c (Location_.location c))) - rest; - ( children_indexes, - (i, entry) :: indexed_content, - unindexed_content )) - (children_indexes, [], []) contents - in - List.iter - (fun (_, c) -> - Error.raise_warning - (Error.make "%a in (children) does not correspond to anything." - pp_children c (Location_.location c))) - children_indexes; - (indexed_content, unindexed_content) - in - let () = - match (children_order, unordered) with - | Some x, (_ :: _ as l) -> - Error.raise_warning - (Error.make "(children) doesn't include %a." - (Format.pp_print_list pp_content) - l (Location_.location x)) - | _ -> () - in - let ordered = - ordered - |> List.sort (fun (i, _) (j, _) -> (compare : int -> int -> int) i j) - |> List.map snd - in - let unordered = - List.sort - (fun (x, _) (y, _) -> - String.compare (Paths.Identifier.name x) (Paths.Identifier.name y)) - unordered - in - let contents = ordered @ unordered in - (contents, index) - - let rec remove_common_root (v : t) = - match v with [ (_, Dir v) ], None -> remove_common_root v | _ -> v - - let of_list l = - let dir = empty_t None in - List.iter (add dir) l; - t_of_in_progress dir |> remove_common_root -end - -type toc = PageToc.t - -type library = { name : string; units : Paths.Identifier.RootModule.t list } - -type page_hierarchy = { hierarchy_name : string; pages : toc } - -type t = { pages : page_hierarchy list; libraries : library list } diff --git a/src/model/sidebar.mli b/src/model/sidebar.mli deleted file mode 100644 index 838061c96c..0000000000 --- a/src/model/sidebar.mli +++ /dev/null @@ -1,20 +0,0 @@ -open Paths.Identifier - -module PageToc : sig - type title = Comment.link_content - - type index = Page.t * title - type t = (Page.t * content) list * index option - and content = Entry of title | Dir of t - - val of_list : - (LeafPage.t * title * Frontmatter.children_order option) list -> t - (** Uses the convention that the [index] children passes its payload to the - container directory to output a payload *) -end - -type library = { name : string; units : RootModule.t list } - -type page_hierarchy = { hierarchy_name : string; pages : PageToc.t } - -type t = { pages : page_hierarchy list; libraries : library list } diff --git a/src/odoc/indexing.ml b/src/odoc/indexing.ml index 6f9a3dc515..2823b74ad0 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 { index; _ } -> Ok (occ index) + Odoc_file.load_index file >>= fun { extra (* libs *); _ } -> + Ok + (occ + (* index *) + (* libs *) + extra) | _ -> ( Odoc_file.load file >>= fun unit' -> match unit' with @@ -60,7 +65,7 @@ let compile_to_json ~output ~occurrences files = handle_file ~unit:(print (Json_search.unit ?occurrences) acc) ~page:(print Json_search.page acc) - ~occ:(print Json_search.index acc) + ~occ:(print (Json_search.index ?occurrences) acc) file with | Ok acc -> acc @@ -73,46 +78,74 @@ 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 unit u = - 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 - in - let page p = - 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 - in - let index i = H.iter (H.add final_index) i in - let () = - List.fold_left - (fun acc file -> +let compile_to_marshall ~output (pages, libs) files = + let unit u = [ Odoc_index.Skeleton.from_unit u ] in + let page p = [ Odoc_index.Skeleton.from_page p ] in + let index i = i in + let extra = + List.concat_map + ~f:(fun file -> match handle_file ~unit ~page ~occ:index file with - | Ok acc -> acc + | Ok l -> l | Error (`Msg m) -> Error.raise_warning ~non_fatal:true (Error.filename_only "%s" m (Fs.File.to_string file)); - acc) - () files + []) + files in - Ok (Odoc_file.save_index output { index = final_index; sidebar }) + let content = { Odoc_index.pages; libs; extra } in + Ok (Odoc_file.save_index output content) let read_occurrences file = let ic = open_in_bin file in let htbl : Odoc_occurrences.Table.t = Marshal.from_channel ic in htbl -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 + Odoc_index.Page_hierarchy.of_list page_toc_input + in + { Odoc_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.l_name = library; l_hierarchies }) + lib_roots let compile out_format ~output ~warnings_options ~occurrences ~lib_roots ~page_roots ~inputs_in_file ~odocls = @@ -129,58 +162,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 pages = - 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 - { hierarchy_name = page_root; pages }) - page_roots - in - let libraries = - List.map - (fun (library, _) -> - { name = library; units = Resolver.all_units ~library resolver }) - lib_roots - in let includes_rec = List.rev_append (List.map snd page_roots) (List.map snd lib_roots) in @@ -193,7 +176,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 104a6e5aa5..2103b58f6a 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_search.Entry.t Odoc_model.Paths.Identifier.Hashtbl.Any.t -> 'a) -> + occ:(Odoc_index.Skeleton.t list -> '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/odoc_file.mli b/src/odoc/odoc_file.mli index 02ab278ed2..0f6c076efe 100644 --- a/src/odoc/odoc_file.mli +++ b/src/odoc/odoc_file.mli @@ -51,11 +51,9 @@ val load : Fs.File.t -> (t, [> msg ]) result val load_root : Fs.File.t -> (Root.t, [> msg ]) result (** Only load the root. Faster than {!load}, used for looking up imports. *) -val save_index : - Fs.File.t -> Odoc_search.Entry.t Odoc_model.Lang.Index.t -> unit +val save_index : Fs.File.t -> Odoc_index.t -> unit -val load_index : - Fs.File.t -> (Odoc_search.Entry.t Odoc_model.Lang.Index.t, [> msg ]) result +val load_index : Fs.File.t -> (Odoc_index.t, [> msg ]) result (** Load a [.odoc-index] file. *) val save_asset : Fpath.t -> warnings:Error.t list -> Lang.Asset.t -> unit diff --git a/src/odoc/rendering.ml b/src/odoc/rendering.ml index a13deef882..02b46886a0 100644 --- a/src/odoc/rendering.ml +++ b/src/odoc/rendering.ml @@ -49,16 +49,16 @@ let document_of_input ~resolver ~warnings_options ~syntax input = let render_document renderer ~sidebar ~output:root_dir ~extra_suffix ~extra doc = - let url = - match doc with - | Odoc_document.Types.Document.Page { url; _ } -> url - | Source_page { url; _ } -> url - in - let sidebar = - Odoc_utils.Option.map - (fun sb -> Odoc_document.Sidebar.to_block sb url) - sidebar - in + (* let url = *) + (* match doc with *) + (* | Odoc_document.Types.Document.Page { url; _ } -> url *) + (* | Source_page { url; _ } -> url *) + (* in *) + (* let sidebar = *) + (* Odoc_utils.Option.map *) + (* (fun sb -> Odoc_document.Sidebar.to_block sb url) *) + (* sidebar *) + (* in *) let pages = renderer.Renderer.render extra sidebar doc in Renderer.traverse pages ~f:(fun filename content -> let filename = prepare ~extra_suffix ~output_dir:root_dir filename in @@ -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; index = _ } -> - Ok (Some (Odoc_document.Sidebar.of_lang sidebar))) + Odoc_file.load_index x >>= fun index -> + Ok (Some (Odoc_document.Sidebar.of_lang index))) >>= fun sidebar -> document_of_odocl ~syntax file >>= fun doc -> render_document renderer ~output ~sidebar ~extra_suffix ~extra doc; diff --git a/src/odoc/resolver.ml b/src/odoc/resolver.ml index 347ad0e18e..a53bc30776 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 _ -> (* TODO: Report as warning or propagate error *) 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/dune b/src/search/dune index b1164bb744..13c8852e22 100644 --- a/src/search/dune +++ b/src/search/dune @@ -7,5 +7,5 @@ (library (name odoc_search) (public_name odoc.search) - (libraries odoc_html odoc_model odoc_html_frontend tyxml odoc_utils) + (libraries odoc_html odoc_model odoc_html_frontend tyxml odoc_utils odoc_index) (modules :standard \ odoc_html_frontend)) diff --git a/src/search/entry.ml b/src/search/entry.ml deleted file mode 100644 index 055f8ec813..0000000000 --- a/src/search/entry.ml +++ /dev/null @@ -1,216 +0,0 @@ -open Odoc_model.Lang -open Odoc_model.Paths - -type type_decl_entry = { - canonical : Path.Type.t option; - equation : TypeDecl.Equation.t; - representation : TypeDecl.Representation.t option; -} - -type class_type_entry = { virtual_ : bool; params : TypeDecl.param list } - -type method_entry = { private_ : bool; virtual_ : bool; type_ : TypeExpr.t } - -type class_entry = { virtual_ : bool; params : TypeDecl.param list } - -type type_extension_entry = { - type_path : Path.Type.t; - type_params : TypeDecl.param list; - private_ : bool; -} - -type constructor_entry = { - args : TypeDecl.Constructor.argument; - res : TypeExpr.t; -} - -type field_entry = { - mutable_ : bool; - type_ : TypeExpr.t; - parent_type : TypeExpr.t; -} - -type instance_variable_entry = { - mutable_ : bool; - virtual_ : bool; - type_ : TypeExpr.t; -} - -type doc_entry = Paragraph | Heading | CodeBlock | MathBlock | Verbatim - -type value_entry = { value : Value.value; type_ : TypeExpr.t } - -type kind = - | TypeDecl of type_decl_entry - | Module - | Value of value_entry - | Doc of doc_entry - | Exception of constructor_entry - | Class_type of class_type_entry - | Method of method_entry - | Class of class_entry - | TypeExtension of type_extension_entry - | ExtensionConstructor of constructor_entry - | ModuleType - | Constructor of constructor_entry - | Field of field_entry - -module Html = Tyxml.Html - -type t = { - id : Odoc_model.Paths.Identifier.Any.t; - doc : Odoc_model.Comment.docs; - kind : kind; -} - -let entry ~id ~doc ~kind = - let id = (id :> Odoc_model.Paths.Identifier.Any.t) in - { id; kind; doc } - -let varify_params = - List.mapi (fun i param -> - match param.TypeDecl.desc with - | Var name -> TypeExpr.Var name - | Any -> Var (Printf.sprintf "tv_%i" i)) - -let entry_of_constructor id_parent params (constructor : TypeDecl.Constructor.t) - = - let args = constructor.args in - let res = - match constructor.res with - | Some res -> res - | None -> - let params = varify_params params in - TypeExpr.Constr - ( `Identifier - ((id_parent :> Odoc_model.Paths.Identifier.Path.Type.t), false), - params ) - in - let kind = Constructor { args; res } in - entry ~id:constructor.id ~doc:constructor.doc ~kind - -let entry_of_extension_constructor id_parent params - (constructor : Extension.Constructor.t) = - let args = constructor.args in - let res = - match constructor.res with - | Some res -> res - | None -> - let params = varify_params params in - TypeExpr.Constr (id_parent, params) - in - let kind = ExtensionConstructor { args; res } in - entry ~id:constructor.id ~doc:constructor.doc ~kind - -let entry_of_field id_parent params (field : TypeDecl.Field.t) = - let params = varify_params params in - let parent_type = - TypeExpr.Constr - ( `Identifier - ((id_parent :> Odoc_model.Paths.Identifier.Path.Type.t), false), - params ) - in - let kind = - Field { mutable_ = field.mutable_; type_ = field.type_; parent_type } - in - entry ~id:field.id ~doc:field.doc ~kind - -let rec entries_of_docs id (d : Odoc_model.Comment.docs) = - Odoc_utils.List.concat_map ~f:(entries_of_doc id) d - -and entries_of_doc id d = - match d.value with - | `Paragraph _ -> [ entry ~id ~doc:[ d ] ~kind:(Doc Paragraph) ] - | `Tag _ -> [] - | `List (_, ds) -> - Odoc_utils.List.concat_map ~f:(entries_of_docs id) - (ds :> Odoc_model.Comment.docs list) - | `Heading (_, lbl, _) -> [ entry ~id:lbl ~doc:[ d ] ~kind:(Doc Heading) ] - | `Modules _ -> [] - | `Code_block (_, _, o) -> - let o = - match o with - | None -> [] - | Some o -> entries_of_docs id (o :> Odoc_model.Comment.docs) - in - entry ~id ~doc:[ d ] ~kind:(Doc CodeBlock) :: o - | `Verbatim _ -> [ entry ~id ~doc:[ d ] ~kind:(Doc Verbatim) ] - | `Math_block _ -> [ entry ~id ~doc:[ d ] ~kind:(Doc MathBlock) ] - | `Table _ -> [] - | `Media _ -> [] - -let entries_of_item (x : Odoc_model.Fold.item) = - match x with - | CompilationUnit u -> ( - match u.content with - | Module m -> [ entry ~id:u.id ~doc:m.doc ~kind:Module ] - | Pack _ -> []) - | TypeDecl td -> - let kind = - TypeDecl - { - canonical = td.canonical; - equation = td.equation; - representation = td.representation; - } - in - let td_entry = entry ~id:td.id ~doc:td.doc ~kind in - let subtype_entries = - match td.representation with - | None -> [] - | Some (Variant li) -> - List.map (entry_of_constructor td.id td.equation.params) li - | Some (Record fields) -> - List.map (entry_of_field td.id td.equation.params) fields - | Some Extensible -> [] - in - td_entry :: subtype_entries - | Module m -> [ entry ~id:m.id ~doc:m.doc ~kind:Module ] - | Value v -> - let kind = Value { value = v.value; type_ = v.type_ } in - [ entry ~id:v.id ~doc:v.doc ~kind ] - | Exception exc -> - let res = - match exc.res with - | None -> TypeExpr.Constr (Odoc_model.Predefined.exn_path, []) - | Some x -> x - in - let kind = Exception { args = exc.args; res } in - [ entry ~id:exc.id ~doc:exc.doc ~kind ] - | ClassType ct -> - let kind = Class_type { virtual_ = ct.virtual_; params = ct.params } in - [ entry ~id:ct.id ~doc:ct.doc ~kind ] - | Method m -> - let kind = - Method { virtual_ = m.virtual_; private_ = m.private_; type_ = m.type_ } - in - [ entry ~id:m.id ~doc:m.doc ~kind ] - | Class cl -> - let kind = Class { virtual_ = cl.virtual_; params = cl.params } in - [ entry ~id:cl.id ~doc:cl.doc ~kind ] - | Extension te -> ( - match te.constructors with - | [] -> [] - | c :: _ -> - (* Type extension do not have an ID yet... we use the first - constructor for the url. Unfortunately, this breaks the uniqueness - of the ID in the search index... *) - let type_entry = - let kind = - TypeExtension - { - type_path = te.type_path; - type_params = te.type_params; - private_ = te.private_; - } - in - entry ~id:c.id ~doc:te.doc ~kind - in - - type_entry - :: List.map - (entry_of_extension_constructor te.type_path te.type_params) - te.constructors) - | ModuleType mt -> [ entry ~id:mt.id ~doc:mt.doc ~kind:ModuleType ] - | Doc (_, `Stop) -> [] - | Doc (id, `Docs d) -> entries_of_docs id d diff --git a/src/search/html.ml b/src/search/html.ml index 2f1db78e03..d0322079b8 100644 --- a/src/search/html.ml +++ b/src/search/html.ml @@ -2,6 +2,7 @@ type html = Html_types.div_content Tyxml.Html.elt open Odoc_model open Lang +open Odoc_index let url { Entry.id; kind; doc = _ } = let open Entry in @@ -9,14 +10,12 @@ let url { Entry.id; kind; doc = _ } = (* Some module/module types/... might not have an expansion, so we need to be careful and set [stop_before] to [true] for those kind of search entries, to avoid linking to an inexistant page. - - Docstring do not have an ID in the model, and use the ID from the parent - signature in search entries. Therefore, links to doc comments need - [stop_before] to be [false] to point to the page where they are present. - - Values, types, ... are not sensitive to [stop_before], allowing us to - shorten the match. *) - match kind with Doc _ -> false | _ -> true + *) + match kind with + | Module { has_expansion = false; _ } + | ModuleType { has_expansion = false; _ } -> + true + | _ -> false in match Odoc_document.Url.from_identifier ~stop_before id with | Ok url -> @@ -159,15 +158,15 @@ let string_of_kind = | Field _ -> kind_field | ExtensionConstructor _ -> kind_extension_constructor | TypeDecl _ -> kind_typedecl - | Module -> kind_module + | Module _ -> kind_module | Value _ -> kind_value | Exception _ -> kind_exception | Class_type _ -> kind_class_type | Method _ -> kind_method | Class _ -> kind_class | TypeExtension _ -> kind_extension - | ModuleType -> kind_module_type - | Doc _ -> kind_doc + | ModuleType _ -> kind_module_type + | Doc -> kind_doc let value_rhs (t : Entry.value_entry) = " : " ^ Text.of_type t.type_ @@ -184,8 +183,8 @@ let rhs_of_kind (entry : Entry.kind) = | Constructor t | ExtensionConstructor t | Exception t -> Some (constructor_rhs t) | Field f -> Some (field_rhs f) - | Module | Class_type _ | Method _ | Class _ | TypeExtension _ | ModuleType - | Doc _ -> + | Module _ | Class_type _ | Method _ | Class _ | TypeExtension _ + | ModuleType _ | Doc -> None let names_of_id id = diff --git a/src/search/html.mli b/src/search/html.mli index dd66127908..2134584808 100644 --- a/src/search/html.mli +++ b/src/search/html.mli @@ -1,4 +1,5 @@ open Odoc_model +open Odoc_index type html = Html_types.div_content Tyxml.Html.elt diff --git a/src/search/json_index/dune b/src/search/json_index/dune index 9776729fde..4ebfa861ac 100644 --- a/src/search/json_index/dune +++ b/src/search/json_index/dune @@ -1,4 +1,4 @@ (library (name odoc_json_index) (public_name odoc.json_index) - (libraries tyxml odoc_model odoc_search odoc_occurrences)) + (libraries tyxml odoc_model odoc_search odoc_occurrences odoc_index)) diff --git a/src/search/json_index/json_display.mli b/src/search/json_index/json_display.mli index 0140744f8b..6f467faa44 100644 --- a/src/search/json_index/json_display.mli +++ b/src/search/json_index/json_display.mli @@ -1,4 +1,5 @@ open Odoc_search +open Odoc_index val of_entry : Entry.t -> diff --git a/src/search/json_index/json_search.ml b/src/search/json_index/json_search.ml index 0301e4039e..ee603603c9 100644 --- a/src/search/json_index/json_search.ml +++ b/src/search/json_index/json_search.ml @@ -1,4 +1,5 @@ open Odoc_search +open Odoc_index let json_of_args (args : Odoc_model.Lang.TypeDecl.Constructor.argument) = match args with @@ -125,14 +126,10 @@ let of_entry ({ Entry.id; doc; kind } as entry) html occurrences = ("manifest", manifest); ("constraints", constraints); ] - | Module -> return "Module" [] + | Module _ -> return "Module" [] | Value { value = _; type_ } -> return "Value" [ ("type", `String (Text.of_type type_)) ] - | Doc Paragraph -> return "Doc" [ ("subkind", `String "Paragraph") ] - | Doc Heading -> return "Doc" [ ("subkind", `String "Heading") ] - | Doc CodeBlock -> return "Doc" [ ("subkind", `String "CodeBlock") ] - | Doc MathBlock -> return "Doc" [ ("subkind", `String "MathBlock") ] - | Doc Verbatim -> return "Doc" [ ("subkind", `String "Verbatim") ] + | Doc -> return "Doc" [] | Exception { args; res } -> let args = json_of_args args in let res = `String (Text.of_type res) in @@ -155,7 +152,7 @@ let of_entry ({ Entry.id; doc; kind } as entry) html occurrences = let args = json_of_args args in let res = `String (Text.of_type res) in return "ExtensionConstructor" [ ("args", args); ("res", res) ] - | ModuleType -> return "ModuleType" [] + | ModuleType _ -> return "ModuleType" [] | Constructor { args; res } -> let args = json_of_args args in let res = `String (Text.of_type res) in @@ -189,23 +186,20 @@ let of_entry ({ Entry.id; doc; kind } as entry) html occurrences = @ occurrences)) | Error _ as e -> e -let output_json ppf first entries = +let output_json ppf first (entry, html, occurrences) = let output_json json = let str = Odoc_html.Json.to_string json in Format.fprintf ppf "%s\n" str in - List.fold_left - (fun first (entry, html, occurrences) -> - let json = of_entry entry html occurrences in - if not first then Format.fprintf ppf ","; - match json with - | Ok json -> - output_json json; - false - | Error e -> - Printf.eprintf "%S" (Odoc_document.Url.Error.to_string e); - true) - first entries + let json = of_entry entry html occurrences in + if not first then Format.fprintf ppf ","; + match json with + | Ok json -> + output_json json; + false + | Error e -> + Printf.eprintf "%S" (Odoc_document.Url.Error.to_string e); + true let unit ?occurrences ppf u = let get_occ id = @@ -216,38 +210,42 @@ let unit ?occurrences ppf u = | Some x -> Some x | None -> Some { direct = 0; indirect = 0 }) in - let f first i = - let entries = Entry.entries_of_item i in - let entries = - List.map - (fun entry -> - let occ = get_occ entry.Entry.id in - (entry, Html.of_entry entry, occ)) - entries + let f first entry = + let entry = + let occ = get_occ entry.Entry.id in + (entry, Html.of_entry entry, occ) in - let first = output_json ppf first entries in + let first = output_json ppf first entry in first in - let _first = Odoc_model.Fold.unit ~f true u in + let skel = Odoc_index.Skeleton.from_unit u in + let _first = Odoc_utils.Tree.fold_t f true skel in () let page ppf (page : Odoc_model.Lang.Page.t) = - let f first i = - let entries = Entry.entries_of_item i in - let entries = - List.map (fun entry -> (entry, Html.of_entry entry, None)) entries - in - output_json ppf first entries + let f first entry = + let entry = (entry, Html.of_entry entry, None) in + output_json ppf first entry in - let _first = Odoc_model.Fold.page ~f true page in + let skel = Odoc_index.Skeleton.from_page page in + let _first = Odoc_utils.Tree.fold_t f true skel in () -let index ppf (index : Entry.t Odoc_model.Paths.Identifier.Hashtbl.Any.t) = +let index ?occurrences ppf (index : Skeleton.t list) = + let get_occ id = + match occurrences with + | None -> None + | Some occurrences -> ( + match Odoc_occurrences.Table.get occurrences id with + | Some x -> Some x + | None -> Some { direct = 0; indirect = 0 }) + in let _first = - Odoc_model.Paths.Identifier.Hashtbl.Any.fold - (fun _id entry first -> - let entry = (entry, Html.of_entry entry, None) in - output_json ppf first [ entry ]) - index true + Odoc_utils.Tree.fold_f + (fun first entry -> + let occ = get_occ entry.Entry.id in + let entry = (entry, Html.of_entry entry, occ) in + output_json ppf first entry) + true index in () diff --git a/src/search/json_index/json_search.mli b/src/search/json_index/json_search.mli index 89d9e2e9d6..ebf223055a 100644 --- a/src/search/json_index/json_search.mli +++ b/src/search/json_index/json_search.mli @@ -1,5 +1,7 @@ (** This module generates json intended to be consumed by search engines. *) +open Odoc_index + val unit : ?occurrences:Odoc_occurrences.Table.t -> Format.formatter -> @@ -7,6 +9,7 @@ val unit : unit val page : Format.formatter -> Odoc_model.Lang.Page.t -> unit val index : + ?occurrences:Odoc_occurrences.Table.t -> Format.formatter -> - Odoc_search.Entry.t Odoc_model.Paths.Identifier.Hashtbl.Any.t -> + Skeleton.t list -> unit diff --git a/src/utils/odoc_utils.ml b/src/utils/odoc_utils.ml index a574797f75..4623fc9035 100644 --- a/src/utils/odoc_utils.ml +++ b/src/utils/odoc_utils.ml @@ -104,3 +104,5 @@ module Fun = struct finally_no_exn (); raise work_exn end + +module Tree = Tree diff --git a/src/utils/tree.ml b/src/utils/tree.ml new file mode 100644 index 0000000000..16785a8f32 --- /dev/null +++ b/src/utils/tree.ml @@ -0,0 +1,32 @@ +type 'a t = { node : 'a; children : 'a forest } +and 'a forest = 'a t list + +let leaf node = { node; children = [] } + +let rec fold_t fun_ acc { node; children } = + let acc = fun_ acc node in + fold_f fun_ acc children + +and fold_f fun_ acc f = List.fold_left (fold_t fun_) acc f + +let rec iter_t fun_ { node; children } = + let () = fun_ node in + iter_f fun_ children + +and iter_f fun_ f = List.iter (iter_t fun_) f + +let rec map_t fun_ { node; children } = + let node = fun_ node in + let children = map_f fun_ children in + { node; children } + +and map_f fun_ f = List.map (map_t fun_) f + +let rec filter_map_t fun_ { node; children } = + match fun_ node with + | None -> None + | Some node -> + let children = filter_map_f fun_ children in + Some { node; children } + +and filter_map_f fun_ f = List.filter_map (filter_map_t fun_) f diff --git a/test/occurrences/double_wrapped.t/run.t b/test/occurrences/double_wrapped.t/run.t index 1f1e71d24e..e4ea7d1da0 100644 --- a/test/occurrences/double_wrapped.t/run.t +++ b/test/occurrences/double_wrapped.t/run.t @@ -153,13 +153,13 @@ We can use the generated table when generating the json output: $ cat index.json | jq sort | jq '.[]' -c {"id":[{"kind":"Root","name":"Main"}],"doc":"Handwritten top-level module","kind":{"kind":"Module"},"display":{"url":"Main/index.html","html":"modMain

Handwritten top-level module

"},"occurrences":{"direct":0,"indirect":11}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"A"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/index.html#module-A","html":"modMain.A
"},"occurrences":{"direct":4,"indirect":6}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/index.html#module-B","html":"modMain.B
"},"occurrences":{"direct":1,"indirect":0}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"Module","name":"M"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/B/index.html#module-M","html":"modMain.B.M
"},"occurrences":{"direct":0,"indirect":0}} + {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"A"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/A/index.html","html":"modMain.A
"},"occurrences":{"direct":4,"indirect":6}} + {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/B/index.html","html":"modMain.B
"},"occurrences":{"direct":1,"indirect":0}} + {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"Module","name":"M"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/B/M/index.html","html":"modMain.B.M
"},"occurrences":{"direct":0,"indirect":0}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"Module","name":"Y"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/B/index.html#module-Y","html":"modMain.B.Y
"},"occurrences":{"direct":0,"indirect":0}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"Module","name":"Z"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/B/index.html#module-Z","html":"modMain.B.Z
"},"occurrences":{"direct":0,"indirect":0}} + {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"Module","name":"Z"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/B/Z/index.html","html":"modMain.B.Z
"},"occurrences":{"direct":0,"indirect":0}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"Module","name":"Z"},{"kind":"Module","name":"Y"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"Main/B/Z/index.html#module-Y","html":"modMain.B.Z.Y
"},"occurrences":{"direct":0,"indirect":0}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"A"},{"kind":"ModuleType","name":"M"}],"doc":"","kind":{"kind":"ModuleType"},"display":{"url":"Main/A/index.html#module-type-M","html":"sigMain.A.M
"},"occurrences":{"direct":2,"indirect":0}} + {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"A"},{"kind":"ModuleType","name":"M"}],"doc":"","kind":{"kind":"ModuleType"},"display":{"url":"Main/A/module-type-M/index.html","html":"sigMain.A.M
"},"occurrences":{"direct":2,"indirect":0}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"B"},{"kind":"ModuleType","name":"Y"}],"doc":"","kind":{"kind":"ModuleType"},"display":{"url":"Main/B/index.html#module-type-Y","html":"sigMain.B.Y
"},"occurrences":{"direct":0,"indirect":0}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"A"},{"kind":"Type","name":"t"}],"doc":"","kind":{"kind":"TypeDecl","private":false,"manifest":"string","constraints":[]},"display":{"url":"Main/A/index.html#type-t","html":"typeMain.A.t = string
"},"occurrences":{"direct":1,"indirect":0}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"A"},{"kind":"Value","name":"(||>)"}],"doc":"","kind":{"kind":"Value","type":"int -> int -> int"},"display":{"url":"Main/A/index.html#val-(||>)","html":"valMain.A.(||>) : int -> int -> int
"},"occurrences":{"direct":1,"indirect":0}} diff --git a/test/parent_id/sidebar.t/run.t b/test/parent_id/sidebar.t/run.t index 789f6d9141..1c01bbe703 100644 --- a/test/parent_id/sidebar.t/run.t +++ b/test/parent_id/sidebar.t/run.t @@ -31,7 +31,7 @@ Libraries @@ -50,7 +50,7 @@ Libraries diff --git a/test/search/html_search.t/run.t b/test/search/html_search.t/run.t index 0ad4994b72..6ad86a1cfc 100644 --- a/test/search/html_search.t/run.t +++ b/test/search/html_search.t/run.t @@ -81,31 +81,17 @@ The index file, one entry per line: $ cat index.json | jq sort | jq '.[]' -c {"id":[{"kind":"Root","name":"Main"},{"kind":"Type","name":"tdzdz"},{"kind":"Constructor","name":"A"}],"doc":"","kind":{"kind":"Constructor","args":{"kind":"Tuple","vals":["int","int"]},"res":"tdzdz"},"display":{"url":"page/Main/index.html#type-tdzdz.A","html":"consMain.tdzdz.A : int * int -> tdzdz
"}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Type","name":"tdzdz"},{"kind":"Constructor","name":"B"}],"doc":"Bliiiiiiiiiii","kind":{"kind":"Constructor","args":{"kind":"Tuple","vals":["int list","int"]},"res":"tdzdz"},"display":{"url":"page/Main/index.html#type-tdzdz.B","html":"consMain.tdzdz.B : int list * int -> tdzdz

Bliiiiiiiiiii

"}} - {"id":[{"kind":"Root","name":"J"}],"doc":"a paragraph two","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/J/index.html","html":"docJ

a paragraph two

"}} - {"id":[{"kind":"Root","name":"Main"}],"doc":"x + 1","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/index.html","html":"docMain

x + 1

"}} - {"id":[{"kind":"Root","name":"Main"}],"doc":"a paragraph two","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/index.html","html":"docMain

a paragraph two

"}} - {"id":[{"kind":"Root","name":"Main"}],"doc":"a paragraph","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/index.html","html":"docMain

a paragraph

"}} - {"id":[{"kind":"Root","name":"Main"}],"doc":"and another","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/index.html","html":"docMain

and another

"}} - {"id":[{"kind":"Root","name":"Main"}],"doc":"and this is a paragraph","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/index.html","html":"docMain

and this is a paragraph

"}} - {"id":[{"kind":"Root","name":"Main"}],"doc":"blibli","kind":{"kind":"Doc","subkind":"CodeBlock"},"display":{"url":"page/Main/index.html","html":"docMain
blibli
"}} - {"id":[{"kind":"Root","name":"Main"}],"doc":"verbatim","kind":{"kind":"Doc","subkind":"Verbatim"},"display":{"url":"page/Main/index.html","html":"docMain
verbatim
"}} - {"id":[{"kind":"Page","name":"page"}],"doc":"A paragraph","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/index.html","html":"docpage

A paragraph

"}} - {"id":[{"kind":"Page","name":"page"}],"doc":"a list of things","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/index.html","html":"docpage

a list of things

"}} - {"id":[{"kind":"Page","name":"page"}],"doc":"bliblib","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/index.html","html":"docpage

bliblib

"}} - {"id":[{"kind":"Page","name":"page"}],"doc":"and code","kind":{"kind":"Doc","subkind":"CodeBlock"},"display":{"url":"page/index.html","html":"docpage
and code
"}} - {"id":[{"kind":"Page","name":"page"}],"doc":"some verbatim","kind":{"kind":"Doc","subkind":"Verbatim"},"display":{"url":"page/index.html","html":"docpage
some verbatim
"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"x + 1","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/I/index.html","html":"docMain.I

x + 1

"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"a paragraph","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/I/index.html","html":"docMain.I

a paragraph

"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"and another","kind":{"kind":"Doc","subkind":"Paragraph"},"display":{"url":"page/Main/I/index.html","html":"docMain.I

and another

"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"blibli","kind":{"kind":"Doc","subkind":"CodeBlock"},"display":{"url":"page/Main/I/index.html","html":"docMain.I
blibli
"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"verbatim","kind":{"kind":"Doc","subkind":"Verbatim"},"display":{"url":"page/Main/I/index.html","html":"docMain.I
verbatim
"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Label","name":"this-is-a-title"}],"doc":"this is a title","kind":{"kind":"Doc","subkind":"Heading"},"display":{"url":"page/Main/index.html#this-is-a-title","html":"docMain.this-is-a-title

this is a title

"}} - {"id":[{"kind":"Page","name":"page"},{"kind":"Label","name":"a-title"}],"doc":"A title","kind":{"kind":"Doc","subkind":"Heading"},"display":{"url":"page/index.html#a-title","html":"docpage.a-title

A title

"}} + {"id":[{"kind":"Root","name":"J"}],"doc":"a paragraph two","kind":{"kind":"Doc"},"display":{"url":"page/J/index.html","html":"docJ

a paragraph two

"}} + {"id":[{"kind":"Root","name":"Main"}],"doc":"a paragraph two","kind":{"kind":"Doc"},"display":{"url":"page/Main/index.html","html":"docMain

a paragraph two

"}} + {"id":[{"kind":"Root","name":"Main"}],"doc":"a paragraph\nand another\nverbatim\nx + 1\nblibli","kind":{"kind":"Doc"},"display":{"url":"page/Main/index.html","html":"docMain

a paragraph

and another

verbatim

x + 1

blibli
"}} + {"id":[{"kind":"Root","name":"Main"}],"doc":"this is a title\nand this is a paragraph","kind":{"kind":"Doc"},"display":{"url":"page/Main/index.html","html":"docMain

this is a title

and this is a paragraph

"}} + {"id":[{"kind":"Page","name":"page"}],"doc":"A title\nA paragraph\nsome verbatim\nand code\na list of things bliblib","kind":{"kind":"Doc"},"display":{"url":"page/index.html","html":"docpage

A title

A paragraph

some verbatim
and code
  • a list of things
  • bliblib
"}} + {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"a paragraph\nand another\nverbatim\nx + 1\nblibli","kind":{"kind":"Doc"},"display":{"url":"page/Main/I/index.html","html":"docMain.I

a paragraph

and another

verbatim

x + 1

blibli
"}} {"id":[{"kind":"Root","name":"J"}],"doc":"a paragraph one","kind":{"kind":"Module"},"display":{"url":"page/J/index.html","html":"modJ

a paragraph one

"}} {"id":[{"kind":"Root","name":"Main"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"page/Main/index.html","html":"modMain
"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"page/Main/index.html#module-I","html":"modMain.I
"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"M"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"page/Main/index.html#module-M","html":"modMain.M
"}} - {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"X"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"page/Main/index.html#module-X","html":"modMain.X
"}} + {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"I"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"page/Main/I/index.html","html":"modMain.I
"}} + {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"M"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"page/Main/M/index.html","html":"modMain.M
"}} + {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"X"}],"doc":"","kind":{"kind":"Module"},"display":{"url":"page/Main/X/index.html","html":"modMain.X
"}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Type","name":"t"}],"doc":"A comment","kind":{"kind":"TypeDecl","private":false,"manifest":"int","constraints":[]},"display":{"url":"page/Main/index.html#type-t","html":"typeMain.t = int

A comment

"}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Type","name":"tdzdz"}],"doc":"A comment aaaaaaaaaa","kind":{"kind":"TypeDecl","private":false,"manifest":null,"constraints":[]},"display":{"url":"page/Main/index.html#type-tdzdz","html":"typeMain.tdzdz = A of int * int | B of int list * int

A comment aaaaaaaaaa

"}} {"id":[{"kind":"Root","name":"Main"},{"kind":"Module","name":"M"},{"kind":"Type","name":"t"}],"doc":"dsdsd","kind":{"kind":"TypeDecl","private":false,"manifest":null,"constraints":[]},"display":{"url":"page/Main/M/index.html#type-t","html":"typeMain.M.t

dsdsd

"}} @@ -165,11 +151,6 @@ themselves). $ cat index.json | jq -r '.[].id | map(.kind + "-" + .name) | join(".")' | sort Page-page - Page-page - Page-page - Page-page - Page-page - Page-page.Label-a-title Root-J Root-J Root-J.Value-uu @@ -177,15 +158,6 @@ themselves). Root-Main Root-Main Root-Main - Root-Main - Root-Main - Root-Main - Root-Main - Root-Main.Label-this-is-a-title - Root-Main.Module-I - Root-Main.Module-I - Root-Main.Module-I - Root-Main.Module-I Root-Main.Module-I Root-Main.Module-I Root-Main.Module-I.Value-x diff --git a/test/search/marshalled_version.t/run.t b/test/search/marshalled_version.t/run.t new file mode 100644 index 0000000000..e69de29bb2 diff --git a/test/search/module_aliases.t/run.t b/test/search/module_aliases.t/run.t index bd8e3e820d..451ab329df 100644 --- a/test/search/module_aliases.t/run.t +++ b/test/search/module_aliases.t/run.t @@ -13,13 +13,13 @@ expansions). Comments link to the expansion they are in. $ cat index.json | jq -r '.[] | "\(.id[-1].name) -> \(.display.url)"' Main -> Main/index.html - X -> Main/index.html#module-X + X -> Main/X/index.html x -> Main/X/index.html#val-x X -> Main/X/index.html Y -> Main/index.html#module-Y Z -> Main/index.html#module-Z L -> Main/index.html#module-L - X -> Main/index.html#module-type-X + X -> Main/module-type-X/index.html x -> Main/module-type-X/index.html#val-x Y -> Main/index.html#module-type-Y Z -> Main/index.html#module-type-Z diff --git a/test/xref2/references_to_assets.t/asset.mld b/test/xref2/references_to_assets.t/asset.mld new file mode 100644 index 0000000000..ce8c08f459 --- /dev/null +++ b/test/xref2/references_to_assets.t/asset.mld @@ -0,0 +1 @@ +A reference to an {!} \ No newline at end of file diff --git a/test/xref2/references_to_assets.t/run.t b/test/xref2/references_to_assets.t/run.t new file mode 100644 index 0000000000..e69de29bb2