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