From 704b7d1a2c381d421bc9424094905ed7189d3ec3 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 28 Aug 2024 14:59:37 +0200 Subject: [PATCH 01/22] Remove impossible page reference from the possible values Page don't and won't use dot references as in `page1.page2`. --- src/model/paths_types.ml | 1 - 1 file changed, 1 deletion(-) diff --git a/src/model/paths_types.ml b/src/model/paths_types.ml index 77cad0bdca..dc7b7ff1d3 100644 --- a/src/model/paths_types.ml +++ b/src/model/paths_types.ml @@ -756,7 +756,6 @@ module rec Reference : sig type page = [ `Resolved of Resolved_reference.page | `Root of string * [ `TPage | `TUnknown ] - | `Dot of label_parent * string | `Page_path of hierarchy ] (** @canonical Odoc_model.Paths.Reference.Page.t *) From bb05e6033ee58a847803814262f25a3996e087d2 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 28 Aug 2024 14:22:46 +0200 Subject: [PATCH 02/22] Frontmatter: Parse children order --- src/model/comment.ml | 8 +-- src/model/frontmatter.ml | 34 +++++++++++- src/model/odoc_model.ml | 1 + src/model_desc/lang_desc.ml | 12 ++++- test/pages/frontmatter.t/one_frontmatter.mld | 3 +- test/pages/frontmatter.t/run.t | 57 +++++++++++--------- 6 files changed, 81 insertions(+), 34 deletions(-) diff --git a/src/model/comment.ml b/src/model/comment.ml index b1204ac303..4280b31923 100644 --- a/src/model/comment.ml +++ b/src/model/comment.ml @@ -147,20 +147,16 @@ let find_zero_heading docs : link_content option = docs let extract_frontmatter docs : _ = - let parse_frontmatter s = - let lines = Astring.String.cuts ~sep:"\n" s in - List.filter_map (fun line -> Astring.String.cut ~sep:":" line) lines - in let fm, content = let fm, rev_content = List.fold_left (fun (fm_acc, content_acc) doc -> match doc.Location_.value with | `Code_block (Some "meta", content, None) -> - (parse_frontmatter content.Location_.value :: fm_acc, content_acc) + (content.Location_.value :: fm_acc, content_acc) | _ -> (fm_acc, doc :: content_acc)) ([], []) docs in - (List.concat fm, List.rev rev_content) + (fm |> String.concat "\n" |> Frontmatter.parse, List.rev rev_content) in (fm, content) diff --git a/src/model/frontmatter.ml b/src/model/frontmatter.ml index f50e98da1b..93b46b095b 100644 --- a/src/model/frontmatter.ml +++ b/src/model/frontmatter.ml @@ -1 +1,33 @@ -type t = (string * string) list +type line = + | Children_order of Paths.Reference.Page.t list + | KV of string * string + | V of string + +type t = { children_order : Paths.Reference.Page.t list } + +let empty = { children_order = [] } + +let apply fm line = + match (line, fm) with + | Children_order children_order, { children_order = [] } -> { children_order } + | Children_order _, { children_order = _ :: _ } -> + (* TODO raise warning about duplicate children field *) fm + | KV _, _ | V _, _ -> (* TODO raise warning *) fm + +let parse s = + let entries = + s |> String.split_on_char '\n' + |> List.map (fun l -> + l |> fun x -> + Astring.String.cut ~sep:":" x |> function + | Some ("children", v) -> + let refs = + Astring.String.fields v + |> List.map (fun name : Paths.Reference.Page.t -> + `Page_path (`TRelativePath, [ name ])) + in + Children_order refs + | Some (k, v) -> KV (k, v) + | None -> V x) + in + List.fold_left apply empty entries diff --git a/src/model/odoc_model.ml b/src/model/odoc_model.ml index f81a5fe1a7..43965ad14a 100644 --- a/src/model/odoc_model.ml +++ b/src/model/odoc_model.ml @@ -10,3 +10,4 @@ module Location_ = Location_ module Compat = Compat module Semantics = Semantics module Reference = Reference +module Frontmatter = Frontmatter diff --git a/src/model_desc/lang_desc.ml b/src/model_desc/lang_desc.ml index 93b5ea8335..bf36aff7fb 100644 --- a/src/model_desc/lang_desc.ml +++ b/src/model_desc/lang_desc.ml @@ -697,11 +697,21 @@ and page_t = [ F ("name", (fun t -> t.name), identifier); F ("root", (fun t -> t.root), root); - F ("frontmatter", (fun t -> t.frontmatter), List (Pair (string, string))); + F ("frontmatter", (fun t -> t.frontmatter), frontmatter); F ("content", (fun t -> t.content), docs); F ("digest", (fun t -> t.digest), Digest.t); ] +and frontmatter = + let open Odoc_model.Frontmatter in + Record + [ + F + ( "children", + (fun t -> (t.children_order :> Odoc_model.Paths.Reference.t list)), + List reference ); + ] + and implementation_t = let open Lang.Implementation in Record diff --git a/test/pages/frontmatter.t/one_frontmatter.mld b/test/pages/frontmatter.t/one_frontmatter.mld index 034fa592a6..e7f571eb11 100644 --- a/test/pages/frontmatter.t/one_frontmatter.mld +++ b/test/pages/frontmatter.t/one_frontmatter.mld @@ -1,6 +1,5 @@ {0 One frontmatter} {@meta[ -bli1: bloblobloblo1 -bli2: bloblobloblo2 +children: page1 page2 ]} \ No newline at end of file diff --git a/test/pages/frontmatter.t/run.t b/test/pages/frontmatter.t/run.t index 7e0c8a57c1..938525d5fc 100644 --- a/test/pages/frontmatter.t/run.t +++ b/test/pages/frontmatter.t/run.t @@ -2,22 +2,42 @@ When there is no frontmatter, everything is normal $ odoc compile zero_frontmatter.mld $ odoc_print page-zero_frontmatter.odoc | jq '.frontmatter' - [] + { + "children": [] + } When there is one frontmatter, it is extracted from the content: $ odoc compile one_frontmatter.mld $ odoc_print page-one_frontmatter.odoc | jq '.frontmatter' - [ - [ - "bli1", - " bloblobloblo1" - ], - [ - "bli2", - " bloblobloblo2" + { + "children": [ + { + "`Page_path": [ + "`TRelativePath", + [ + "" + ] + ] + }, + { + "`Page_path": [ + "`TRelativePath", + [ + "page1" + ] + ] + }, + { + "`Page_path": [ + "`TRelativePath", + [ + "page2" + ] + ] + } ] - ] + } $ odoc_print page-one_frontmatter.odoc | jq '.content' [ { @@ -54,20 +74,9 @@ When there is more than one frontmatter, they are all extracted from the content $ odoc compile two_frontmatters.mld $ odoc_print page-two_frontmatters.odoc | jq '.frontmatter' - [ - [ - "bli3", - " bloblobloblo1" - ], - [ - "bli1", - " bloblobloblo1" - ], - [ - "bli2", - " bloblobloblo2" - ] - ] + { + "children": [] + } $ odoc_print page-two_frontmatters.odoc | jq '.content' [ { From 14daab2e3fa919899cfc25862d01608b2a07e62d Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Wed, 28 Aug 2024 14:23:34 +0200 Subject: [PATCH 03/22] Link frontmatter by resolving page references --- src/document/sidebar.ml | 4 ++-- src/model/lang.ml | 7 +++---- src/odoc/indexing.ml | 6 +++--- src/xref2/link.ml | 16 ++++++++++++++++ src/xref2/ref_tools.ml | 10 ++++++++++ src/xref2/ref_tools.mli | 6 ++++++ 6 files changed, 40 insertions(+), 9 deletions(-) diff --git a/src/document/sidebar.ml b/src/document/sidebar.ml index 15f0a96145..8665e5bbb4 100644 --- a/src/document/sidebar.ml +++ b/src/document/sidebar.ml @@ -75,10 +75,10 @@ let of_lang (v : Odoc_model.Lang.Sidebar.t) = let page_hierarchy { Odoc_model.Lang.Sidebar.page_name; pages } = if pages = [] then None else - let prepare_for_hierarchy (link_content, id) = + let prepare_for_hierarchy { Odoc_model.Lang.Sidebar.title; id } = let path = Url.Path.from_identifier id in let payload = - let content = Comment.link_content link_content in + let content = Comment.link_content title in (path, sidebar_toc_entry id content) in (payload, path |> Url.Path.to_list |> List.map snd) diff --git a/src/model/lang.ml b/src/model/lang.ml index 4715481536..1482785cb3 100644 --- a/src/model/lang.ml +++ b/src/model/lang.ml @@ -542,10 +542,9 @@ end = module rec Sidebar : sig type library = { name : string; units : Paths.Identifier.RootModule.t list } - type pages = { - page_name : string; - pages : (Comment.link_content * Paths.Identifier.Page.t) list; - } + type page = { title : Comment.link_content; id : Paths.Identifier.Page.t } + + type pages = { page_name : string; pages : page list } type t = { pages : pages list; libraries : library list } end = diff --git a/src/odoc/indexing.ml b/src/odoc/indexing.ml index 086315f96f..6b12653c6e 100644 --- a/src/odoc/indexing.ml +++ b/src/odoc/indexing.ml @@ -148,18 +148,18 @@ let compile out_format ~output ~warnings_options ~occurrences ~lib_roots let pages = Resolver.all_pages ~root:page_root resolver in let pages = List.map - (fun (page_id, title) -> + (fun (id, title) -> let title = match title with | None -> [ Odoc_model.Location_.at (Odoc_model.Location_.span []) - (`Word (Odoc_model.Paths.Identifier.name page_id)); + (`Word (Odoc_model.Paths.Identifier.name id)); ] | Some x -> x in - (title, page_id)) + { title; id }) pages in { page_name = page_root; pages }) diff --git a/src/xref2/link.ml b/src/xref2/link.ml index e61f4958ba..b707b87b08 100644 --- a/src/xref2/link.ml +++ b/src/xref2/link.ml @@ -1133,10 +1133,26 @@ let page env page = | None -> Errors.report ~what:(`Child_module mod_) `Lookup)) page.Lang.Page.children in + let frontmatter = + let resolve r = + match Ref_tools.resolve_page_reference env r |> Error.raise_warnings with + | Ok (ref_, _c) -> `Resolved ref_ + | Error e -> + Errors.report + ~what:(`Reference (r :> Paths.Reference.t)) + ~tools_error:(`Reference e) `Resolve; + r + in + { + Frontmatter.children_order = + List.map resolve page.frontmatter.children_order; + } + in { page with Page.content = comment_docs env page.Page.name page.content; linked = true; + frontmatter; } let source_info env infos = diff --git a/src/xref2/ref_tools.ml b/src/xref2/ref_tools.ml index f41da8c2d5..eb899a5b33 100644 --- a/src/xref2/ref_tools.ml +++ b/src/xref2/ref_tools.ml @@ -816,6 +816,13 @@ and resolve_module_reference env (r : Module.t) : M.t ref_result = | `Root (name, _) -> M.in_env env name | `Module_path p -> Path.module_in_env env p +let resolve_page_reference env (r : Reference.Page.t) : + page_lookup_result ref_result = + match r with + | `Resolved _r -> failwith "What's going on!?" + | `Page_path p -> Path.page_in_env env p + | `Root (name, _) -> Page.in_env env name + let resolve_class_signature_reference env (r : ClassSignature.t) = (* Casting from ClassSignature to LabelParent. TODO: Add [resolve_class_signature_reference] when it's easier to implement. *) @@ -1004,6 +1011,9 @@ let resolve_reference : let resolve_module_reference env m = Odoc_model.Error.catch_warnings (fun () -> resolve_module_reference env m) +let resolve_page_reference env m = + Odoc_model.Error.catch_warnings (fun () -> resolve_page_reference env m) + let resolve_asset_reference env m = Odoc_model.Error.catch_warnings (fun () -> resolve_asset_reference env m) diff --git a/src/xref2/ref_tools.mli b/src/xref2/ref_tools.mli index 5b0924641f..a6b4127b25 100644 --- a/src/xref2/ref_tools.mli +++ b/src/xref2/ref_tools.mli @@ -2,6 +2,7 @@ open Odoc_model.Paths.Reference type module_lookup_result = Resolved.Module.t * Cpath.Resolved.module_ * Component.Module.t +type page_lookup_result = Resolved.Page.t * Odoc_model.Lang.Page.t type asset_lookup_result = Resolved.Asset.t @@ -13,6 +14,11 @@ val resolve_module_reference : Module.t -> module_lookup_result ref_result Odoc_model.Error.with_warnings +val resolve_page_reference : + Env.t -> + Page.t -> + page_lookup_result ref_result Odoc_model.Error.with_warnings + val resolve_asset_reference : Env.t -> Asset.t -> From 6c78a081020c1c8504aaa7fd1be7865ebd56904b Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Thu, 29 Aug 2024 15:42:30 +0200 Subject: [PATCH 04/22] Driver: log compile-index in their own list --- src/driver/cmd_outputs.ml | 2 ++ src/driver/odoc.ml | 2 +- 2 files changed, 3 insertions(+), 1 deletion(-) diff --git a/src/driver/cmd_outputs.ml b/src/driver/cmd_outputs.ml index f6bce2666e..f9d2be4ff0 100644 --- a/src/driver/cmd_outputs.ml +++ b/src/driver/cmd_outputs.ml @@ -11,6 +11,8 @@ let link_output = ref [ "" ] let generate_output = ref [ "" ] +let index_output = ref [ "" ] + let source_tree_output = ref [ "" ] let add_prefixed_output cmd list prefix lines = diff --git a/src/driver/odoc.ml b/src/driver/odoc.ml index 03edd03bc2..9fe020cab3 100644 --- a/src/driver/odoc.ml +++ b/src/driver/odoc.ml @@ -152,7 +152,7 @@ let compile_index ?(ignore_output = false) ~output_file ~json ~docs ~libs () = let lines = Cmd_outputs.submit desc cmd (Some output_file) in if not ignore_output then Cmd_outputs.( - add_prefixed_output cmd link_output (Fpath.to_string output_file) lines) + add_prefixed_output cmd index_output (Fpath.to_string output_file) lines) let html_generate ~output_dir ?index ?(ignore_output = false) ?(search_uris = []) ~input_file:file () = From b1dcac8d3ae5fed1281c910183b764b7143c391c Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Thu, 29 Aug 2024 09:13:07 +0200 Subject: [PATCH 05/22] Allow specification of children order in index page Use ``` children: page1 page2 page3 ``` in the frontmatter --- src/document/sidebar.ml | 126 ++++++++++++++++---------------- src/document/sidebar.mli | 2 +- src/model/frontmatter.ml | 9 ++- src/model/lang.ml | 19 +---- src/model/odoc_model.ml | 1 + src/model/paths.ml | 15 ++++ src/model/paths.mli | 9 +++ src/model/paths_types.ml | 9 ++- src/model/sidebar.ml | 142 ++++++++++++++++++++++++++++++++++++ src/model/sidebar.mli | 27 +++++++ src/model_desc/lang_desc.ml | 5 +- src/odoc/indexing.ml | 54 +++++++++----- src/odoc/rendering.ml | 2 +- src/odoc/resolver.ml | 10 ++- src/odoc/resolver.mli | 4 +- src/xref2/link.ml | 8 +- 16 files changed, 330 insertions(+), 112 deletions(-) create mode 100644 src/model/sidebar.ml create mode 100644 src/model/sidebar.mli diff --git a/src/document/sidebar.ml b/src/document/sidebar.ml index 8665e5bbb4..49b8e15adf 100644 --- a/src/document/sidebar.ml +++ b/src/document/sidebar.ml @@ -1,91 +1,91 @@ open Types -module Hierarchy : sig - type 'a dir - (** Directory in a filesystem-like abstraction, where files have a ['a] - payload and directory can also have a ['a] payload. *) +let sidebar_toc_entry id content = + let href = id |> Url.Path.from_identifier |> Url.from_path in + let target = Target.Internal (Resolved href) in + inline @@ Inline.Link { target; content; tooltip = None } - val make : ('a * string list) list -> 'a dir - (** Create a directory from a list of payload and file path (given as a - string list). Files named ["index"] give their payload to their - containing directory. *) +module Toc : sig + type t - val remove_common_root : 'a dir -> 'a dir + val of_lang : Odoc_model.Sidebar.toc -> t + + val remove_common_root : t -> t (** Returns the deepest subdir containing all files. *) - val to_sidebar : ?fallback:string -> ('a -> Block.one) -> 'a dir -> Block.t + val to_sidebar : + ?fallback:string -> (Url.Path.t * Inline.one -> Block.one) -> t -> Block.t end = struct - type 'a dir = 'a option * (string * 'a t) list - and 'a t = Leaf of 'a | Dir of 'a dir + type t = Item of (Url.Path.t * Inline.one) option * t list - let rec add_entry_to_dir (dir : 'a dir) payload path = - match (path, dir) with - | [], _ -> assert false - | [ "index" ], (None, l) -> (Some payload, l) - | [ name ], (p, l) -> (p, (name, Leaf payload) :: l) - | name :: rest, (p, l) -> - let rec add_to_dir (l : (string * 'a t) list) = - match l with - | [] -> [ (name, Dir (add_entry_to_dir (None, []) payload rest)) ] - | (name2, Dir d) :: q when name = name2 -> - (name2, Dir (add_entry_to_dir d payload rest)) :: q - | d :: q -> d :: add_to_dir q - in - (p, add_to_dir l) + open Odoc_model.Sidebar + open Odoc_model.Paths.Identifier - let make l = - let empty = (None, []) in - let add_entry_to_dir acc (path, payload) = - add_entry_to_dir acc path payload + let of_lang (dir : toc) = + let rec of_lang ~parent_id (dir : toc) = + let title, parent_id = + match PageToc.dir_payload dir with + | Some (title, index_id) -> (Some title, Some (index_id :> Page.t)) + | None -> (None, (parent_id :> Page.t option)) + in + let children_order = PageToc.contents dir 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)) + children_order + 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) + in + Item (payload, entries) in - List.fold_left add_entry_to_dir empty l + + of_lang ~parent_id:None dir let rec remove_common_root = function - | None, [ (_, Dir d) ] -> remove_common_root d + | Item (_, [ d ]) -> remove_common_root d | x -> x - let rec to_sidebar ?(fallback = "root") convert (name, content) = + 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) ]) in let content = - let content = List.map (t_to_sidebar convert) content in - block (Block.List (Block.Unordered, content)) + match content with + | [] -> [] + | _ :: _ -> + let content = List.map (to_sidebar convert) content in + [ block (Block.List (Block.Unordered, content)) ] in - [ name; content ] - - and t_to_sidebar convert = function - | _, Leaf payload -> [ convert payload ] - | fallback, Dir d -> to_sidebar ~fallback convert d + name :: content end -type pages = { name : string; pages : (Url.Path.t * Inline.one) Hierarchy.dir } +type pages = { name : string; pages : Toc.t } type library = { name : string; units : (Url.Path.t * Inline.one) list } type t = { pages : pages list; libraries : library list } -let of_lang (v : Odoc_model.Lang.Sidebar.t) = - let sidebar_toc_entry id content = - let href = id |> Url.Path.from_identifier |> Url.from_path in - let target = Target.Internal (Resolved href) in - inline @@ Inline.Link { target; content; tooltip = None } - in +let of_lang (v : Odoc_model.Sidebar.t) = let pages = - let page_hierarchy { Odoc_model.Lang.Sidebar.page_name; pages } = - if pages = [] then None - else - let prepare_for_hierarchy { Odoc_model.Lang.Sidebar.title; id } = - let path = Url.Path.from_identifier id in - let payload = - let content = Comment.link_content title in - (path, sidebar_toc_entry id content) - in - (payload, path |> Url.Path.to_list |> List.map snd) - in - let pages = List.map prepare_for_hierarchy pages in - let hierarchy = Hierarchy.make pages |> Hierarchy.remove_common_root in - Some { name = page_name; pages = hierarchy } + let page_hierarchy { Odoc_model.Sidebar.hierarchy_name; pages } = + let hierarchy = Toc.of_lang pages |> Toc.remove_common_root in + Some { name = hierarchy_name; pages = hierarchy } in Odoc_utils.List.filter_map page_hierarchy v.pages in @@ -96,7 +96,7 @@ let of_lang (v : Odoc_model.Lang.Sidebar.t) = in let units = List.map - (fun { Odoc_model.Lang.Sidebar.units; name } -> + (fun { Odoc_model.Sidebar.units; name } -> let units = List.map item units in { name; units }) v.libraries @@ -121,7 +121,7 @@ let to_block (sidebar : t) url = let pages = Odoc_utils.List.concat_map ~f:(fun (p : pages) -> - let pages = Hierarchy.to_sidebar render_entry p.pages in + let pages = Toc.to_sidebar render_entry p.pages in let pages = [ block (Block.List (Block.Unordered, [ pages ])) ] in let pages = [ title @@ p.name ^ "'s Pages" ] @ pages in pages) diff --git a/src/document/sidebar.mli b/src/document/sidebar.mli index 3eab9b64cb..6c926ad1fc 100644 --- a/src/document/sidebar.mli +++ b/src/document/sidebar.mli @@ -1,6 +1,6 @@ type t -val of_lang : Odoc_model.Lang.Sidebar.t -> t +val of_lang : Odoc_model.Sidebar.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/model/frontmatter.ml b/src/model/frontmatter.ml index 93b46b095b..30a82f4996 100644 --- a/src/model/frontmatter.ml +++ b/src/model/frontmatter.ml @@ -3,14 +3,15 @@ type line = | KV of string * string | V of string -type t = { children_order : Paths.Reference.Page.t list } +type t = { children_order : Paths.Reference.Page.t list option } -let empty = { children_order = [] } +let empty = { children_order = None } let apply fm line = match (line, fm) with - | Children_order children_order, { children_order = [] } -> { children_order } - | Children_order _, { children_order = _ :: _ } -> + | Children_order children_order, { children_order = None } -> + { children_order = Some children_order } + | Children_order _, { children_order = Some _ } -> (* TODO raise warning about duplicate children field *) fm | KV _, _ | V _, _ -> (* TODO raise warning *) fm diff --git a/src/model/lang.ml b/src/model/lang.ml index 1482785cb3..2d04ffbe2e 100644 --- a/src/model/lang.ml +++ b/src/model/lang.ml @@ -539,27 +539,16 @@ module rec Page : sig end = Page -module rec Sidebar : sig - type library = { name : string; units : Paths.Identifier.RootModule.t list } - - type page = { title : Comment.link_content; id : Paths.Identifier.Page.t } - - type pages = { page_name : string; pages : page list } - - type t = { pages : pages list; libraries : library list } +module rec Asset : sig + type t = { name : Identifier.AssetFile.t; root : Root.t } end = - Sidebar + Asset module rec Index : sig - type 'a t = Sidebar.t * 'a Paths.Identifier.Hashtbl.Any.t + 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 = - Asset - let umty_of_mty : ModuleType.expr -> ModuleType.U.expr option = function | Signature sg -> Some (Signature sg) | Path { p_path; _ } -> Some (Path p_path) diff --git a/src/model/odoc_model.ml b/src/model/odoc_model.ml index 43965ad14a..cfbc5969b0 100644 --- a/src/model/odoc_model.ml +++ b/src/model/odoc_model.ml @@ -1,4 +1,5 @@ module Lang = Lang +module Sidebar = Sidebar module Fold = Fold module Comment = Comment module Paths = Paths diff --git a/src/model/paths.ml b/src/model/paths.ml index e055b0202e..be120e4484 100644 --- a/src/model/paths.ml +++ b/src/model/paths.ml @@ -363,14 +363,27 @@ module Identifier = struct type t_pv = Id.page_pv end + module LeafPage = struct + type t = Id.leaf_page + type t_pv = Id.leaf_page_pv + let equal = equal + let hash = hash + end + module ContainerPage = struct type t = Id.container_page type t_pv = Id.container_page_pv + let equal = equal + let hash = hash end module NonSrc = struct type t = Paths_types.Identifier.non_src type t_pv = Paths_types.Identifier.non_src_pv + + let equal x y = x.ihash = y.ihash && x.ikey = y.ikey + + let hash x = x.ihash end module SourcePage = struct @@ -623,6 +636,8 @@ module Identifier = struct module Hashtbl = struct module Any = Hashtbl.Make (Any) + module ContainerPage = Hashtbl.Make (ContainerPage) + module LeafPage = Hashtbl.Make (LeafPage) end end diff --git a/src/model/paths.mli b/src/model/paths.mli index bca68307d2..f1abf58777 100644 --- a/src/model/paths.mli +++ b/src/model/paths.mli @@ -139,6 +139,11 @@ module Identifier : sig type t_pv = Id.page_pv end + module LeafPage : sig + type t = Id.leaf_page + type t_pv = Id.leaf_page_pv + end + module ContainerPage : sig type t = Id.container_page type t_pv = Id.container_page_pv @@ -147,6 +152,8 @@ module Identifier : sig module NonSrc : sig type t = Id.non_src type t_pv = Id.non_src_pv + val hash : t -> int + val equal : ([< t_pv ] id as 'a) -> 'a -> bool end module SourcePage : sig @@ -235,6 +242,8 @@ module Identifier : sig module Hashtbl : sig module Any : Hashtbl.S with type key = Any.t + module ContainerPage : Hashtbl.S with type key = ContainerPage.t + module LeafPage : Hashtbl.S with type key = LeafPage.t end module Mk : sig diff --git a/src/model/paths_types.ml b/src/model/paths_types.ml index dc7b7ff1d3..0da86d1554 100644 --- a/src/model/paths_types.ml +++ b/src/model/paths_types.ml @@ -11,8 +11,13 @@ module Identifier = struct and container_page = container_page_pv id (** @canonical Odoc_model.Paths.Identifier.ContainerPage.t *) - type page_pv = - [ container_page_pv | `LeafPage of container_page option * PageName.t ] + type leaf_page_pv = [ `LeafPage of container_page option * PageName.t ] + (** @canonical Odoc_model.Paths.Identifier.LeafPage.t_pv *) + + and leaf_page = leaf_page_pv id + (** @canonical Odoc_model.Paths.Identifier.LeafPage.t *) + + type page_pv = [ container_page_pv | leaf_page_pv ] (** @canonical Odoc_model.Paths.Identifier.Page.t_pv *) and page = page_pv id diff --git a/src/model/sidebar.ml b/src/model/sidebar.ml new file mode 100644 index 0000000000..f7f52e199d --- /dev/null +++ b/src/model/sidebar.ml @@ -0,0 +1,142 @@ +open Paths.Identifier + +module CPH = Hashtbl.ContainerPage +module LPH = Hashtbl.LeafPage + +type page = Page.t +type leaf_page = LeafPage.t +type container_page = ContainerPage.t + +module PageToc = struct + type title = Comment.link_content + type children_order = Paths.Identifier.Page.t list + + type payload = { title : title; children_order : children_order option } + + type dir_content = { leafs : payload LPH.t; dirs : t CPH.t } + and t = 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) : t) leaf_page = + try Some (LPH.find dir_content.leafs leaf_page) with Not_found -> None + + let find_dir (_, dir_content) container_page = + try Some (CPH.find dir_content.dirs container_page) with Not_found -> None + + type content = Entry of title | Dir of t + + type c_or_l = Container of ContainerPage.t | Leaf of LeafPage.t + + let classify = function + | { iv = `LeafPage _; _ } as id -> Leaf id + | { iv = `Page _; _ } as id -> Container id + + let find dir id = + let open Odoc_utils.OptionMonad in + match classify id with + | Leaf id -> find_leaf dir id >>= fun x -> Some (Entry x.title) + | Container id -> find_dir dir id >>= fun x -> Some (Dir x) + + 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 dir_payload ((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) + | None -> None + + let dirs (_, dir_content) = + CPH.fold (fun id payload acc -> (id, payload) :: acc) dir_content.dirs [] + + let contents dir = + let children_order = + match dir_payload dir with + | Some ({ children_order; _ }, _) -> children_order + | None -> None + in + let children_order = + match children_order with + | None -> + let contents = + let leafs = + leafs dir + |> List.map (fun (id, payload) -> ((id :> Page.t), Entry payload)) + in + let dirs = + dirs dir + |> List.map (fun (id, payload) -> ((id :> Page.t), Dir payload)) + in + leafs @ dirs + in + List.sort + (fun (x, _) (y, _) -> + String.compare (Paths.Identifier.name x) (Paths.Identifier.name y)) + contents + | Some ch -> + let open Odoc_utils.OptionMonad in + List.filter_map + (fun id -> find dir id >>= fun content -> Some (id, content)) + ch + in + children_order + + let dir_payload ((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.title, index_id) + | None -> None + + let rec get_or_create (dir : t) (id : container_page) : t = + 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 : t) ((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 of_list l = + let dir = empty_t None in + List.iter (add dir) l; + dir +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 new file mode 100644 index 0000000000..d076a56e1c --- /dev/null +++ b/src/model/sidebar.mli @@ -0,0 +1,27 @@ +open Paths.Identifier + +module PageToc : sig + type title = Comment.link_content + type children_order = Paths.Identifier.Page.t list + + type t + type content = Entry of title | Dir of t + + val of_list : (LeafPage.t * title * children_order option) list -> t + (** Uses the convention that the [index] children passes its payload to the + container directory to output a payload *) + + val find : t -> Page.t -> content option + val contents : t -> (Page.t * content) list + + val dir_payload : t -> (title * LeafPage.t) option + (** Gets a title and the ID from a potential [index] page *) +end + +type toc = PageToc.t + +type library = { name : string; units : 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_desc/lang_desc.ml b/src/model_desc/lang_desc.ml index bf36aff7fb..f8f62c1563 100644 --- a/src/model_desc/lang_desc.ml +++ b/src/model_desc/lang_desc.ml @@ -708,8 +708,9 @@ and frontmatter = [ F ( "children", - (fun t -> (t.children_order :> Odoc_model.Paths.Reference.t list)), - List reference ); + (fun t -> + (t.children_order :> Odoc_model.Paths.Reference.t list option)), + Option (List reference) ); ] and implementation_t = diff --git a/src/odoc/indexing.ml b/src/odoc/indexing.ml index 6b12653c6e..b4effba0fa 100644 --- a/src/odoc/indexing.ml +++ b/src/odoc/indexing.ml @@ -8,7 +8,7 @@ module H = Odoc_model.Paths.Identifier.Hashtbl.Any let handle_file file ~unit ~page ~occ = match Fpath.basename file with | s when String.is_prefix ~affix:"index-" s -> - Odoc_file.load_index file >>= fun (_sidebar, index) -> Ok (occ index) + Odoc_file.load_index file >>= fun { index; _ } -> Ok (occ index) | _ -> ( Odoc_file.load file >>= fun unit' -> match unit' with @@ -108,14 +108,14 @@ let compile_to_marshall ~output ~warnings_options sidebar files = in let result = Error.catch_warnings index in result |> Error.handle_warnings ~warnings_options >>= fun () -> - Ok (Odoc_file.save_index output (sidebar, final_index)) + Ok (Odoc_file.save_index output { index = final_index; sidebar }) 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.Lang.Sidebar +open Odoc_model.Sidebar let compile out_format ~output ~warnings_options ~occurrences ~lib_roots ~page_roots ~inputs_in_file ~odocls = @@ -147,22 +147,40 @@ let compile out_format ~output ~warnings_options ~occurrences ~lib_roots (fun (page_root, _) -> let pages = Resolver.all_pages ~root:page_root resolver in let pages = - List.map - (fun (id, title) -> - let title = - match title with - | None -> - [ - Odoc_model.Location_.at - (Odoc_model.Location_.span []) - (`Word (Odoc_model.Paths.Identifier.name id)); - ] - | Some x -> x - in - { title; id }) - pages + let pages = + 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 = + match fm.Frontmatter.children_order with + | None -> None + | Some co -> + Some + (List.filter_map + (function + | `Resolved (`Identifier id) -> Some id | _ -> None) + co) + in + (id, title, children_order)) + (List.filter_map + (function + | Paths.Identifier.( + ({ iv = #LeafPage.t_pv; _ } as id), pl, fm) -> + Some (id, pl, fm) + | _ -> None) + pages) + in + PageToc.of_list pages in - { page_name = page_root; pages }) + { hierarchy_name = page_root; pages }) page_roots in let libraries = diff --git a/src/odoc/rendering.ml b/src/odoc/rendering.ml index b373203b4e..a13deef882 100644 --- a/src/odoc/rendering.ml +++ b/src/odoc/rendering.ml @@ -79,7 +79,7 @@ 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, _) -> + Odoc_file.load_index x >>= fun { sidebar; index = _ } -> Ok (Some (Odoc_document.Sidebar.of_lang sidebar))) >>= fun sidebar -> document_of_odocl ~syntax file >>= fun doc -> diff --git a/src/odoc/resolver.ml b/src/odoc/resolver.ml index ad780a1100..e05f27f222 100644 --- a/src/odoc/resolver.ml +++ b/src/odoc/resolver.ml @@ -82,8 +82,10 @@ end = struct pkglist; let current_root_dir = match current_root with - | Some root -> ( - try Some (List.assq root pkglist) with Not_found -> None) + | Some root -> + List.fold_left + (fun acc (x, dir) -> if String.equal x root then Some dir else acc) + None pkglist | None -> None in { current_root; table = cache; current_root_dir } @@ -499,11 +501,11 @@ let all_pages ?root ({ pages; _ } : t) = let filter (root : Odoc_model.Root.t) = match root with | { - file = Page { title; _ }; + file = Page { title; frontmatter; _ }; id = { iv = #Odoc_model.Paths.Identifier.Page.t_pv; _ } as id; _; } -> - Some (id, title) + Some (id, title, frontmatter) | _ -> None in match pages with diff --git a/src/odoc/resolver.mli b/src/odoc/resolver.mli index 0cc5472829..cded02c2c4 100644 --- a/src/odoc/resolver.mli +++ b/src/odoc/resolver.mli @@ -47,7 +47,9 @@ val lookup_page : t -> string -> Odoc_model.Lang.Page.t option val all_pages : ?root:string -> t -> - (Odoc_model.Paths.Identifier.Page.t * Odoc_model.Comment.link_content option) + (Odoc_model.Paths.Identifier.Page.t + * Odoc_model.Comment.link_content option + * Odoc_model.Frontmatter.t) list val all_units : diff --git a/src/xref2/link.ml b/src/xref2/link.ml index b707b87b08..f81aea1bf6 100644 --- a/src/xref2/link.ml +++ b/src/xref2/link.ml @@ -1145,11 +1145,17 @@ let page env page = in { Frontmatter.children_order = - List.map resolve page.frontmatter.children_order; + Option.map (List.map resolve) page.frontmatter.children_order; } in + let root = + match page.root.file with + | Page p -> { page.root with file = Page { p with frontmatter } } + | _ -> assert false + in { page with + root; Page.content = comment_docs env page.Page.name page.content; linked = true; frontmatter; From 51bd63a7d53c675895b6a608c0e2a71aef100fa6 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Thu, 29 Aug 2024 18:51:23 +0200 Subject: [PATCH 06/22] Children order: do not model that with references Children order specifies order in an index page for the current directory. It has to specify what is a page and what is a directory, as we can have: ``` doc/ index foo foo/ index bar ``` In the specification of the order in `doc/index`, we must make the difference between the foo page and the foo directory. This was not practical with references. So instead, the order specification has its own type. --- src/model/frontmatter.ml | 21 +++++++++++---------- src/model/sidebar.ml | 13 ++++++++++--- src/model/sidebar.mli | 2 +- src/model_desc/lang_desc.ml | 14 ++++++-------- src/odoc/indexing.ml | 11 +---------- src/xref2/link.ml | 22 ---------------------- src/xref2/ref_tools.ml | 10 ---------- src/xref2/ref_tools.mli | 5 ----- 8 files changed, 29 insertions(+), 69 deletions(-) diff --git a/src/model/frontmatter.ml b/src/model/frontmatter.ml index 30a82f4996..211a3fef61 100644 --- a/src/model/frontmatter.ml +++ b/src/model/frontmatter.ml @@ -1,9 +1,8 @@ -type line = - | Children_order of Paths.Reference.Page.t list - | KV of string * string - | V of string +type child = Page of string | Dir of string -type t = { children_order : Paths.Reference.Page.t list option } +type line = Children_order of child list | KV of string * string | V of string + +type t = { children_order : child list option } let empty = { children_order = None } @@ -15,6 +14,12 @@ let apply fm line = (* TODO raise warning about duplicate children field *) fm | KV _, _ | V _, _ -> (* TODO raise warning *) fm +let parse_child c = + if Astring.String.is_suffix ~affix:"/" c then + let c = String.sub c 0 (String.length c - 1) in + Dir c + else Page c + let parse s = let entries = s |> String.split_on_char '\n' @@ -22,11 +27,7 @@ let parse s = l |> fun x -> Astring.String.cut ~sep:":" x |> function | Some ("children", v) -> - let refs = - Astring.String.fields v - |> List.map (fun name : Paths.Reference.Page.t -> - `Page_path (`TRelativePath, [ name ])) - in + let refs = Astring.String.fields v |> List.map parse_child in Children_order refs | Some (k, v) -> KV (k, v) | None -> V x) diff --git a/src/model/sidebar.ml b/src/model/sidebar.ml index f7f52e199d..a082c7b6ca 100644 --- a/src/model/sidebar.ml +++ b/src/model/sidebar.ml @@ -9,7 +9,7 @@ type container_page = ContainerPage.t module PageToc = struct type title = Comment.link_content - type children_order = Paths.Identifier.Page.t list + type children_order = Frontmatter.child list type payload = { title : title; children_order : children_order option } @@ -63,7 +63,7 @@ module PageToc = struct let dirs (_, dir_content) = CPH.fold (fun id payload acc -> (id, payload) :: acc) dir_content.dirs [] - let contents dir = + let contents ((dir_id, _) as dir) = let children_order = match dir_payload dir with | Some ({ children_order; _ }, _) -> children_order @@ -90,7 +90,14 @@ module PageToc = struct | Some ch -> let open Odoc_utils.OptionMonad in List.filter_map - (fun id -> find dir id >>= fun content -> Some (id, content)) + (fun c -> + let id = + match c with + | Frontmatter.Page name -> + Mk.leaf_page (dir_id, Names.PageName.make_std name) + | Dir name -> Mk.page (dir_id, Names.PageName.make_std name) + in + find dir id >>= fun content -> Some (id, content)) ch in children_order diff --git a/src/model/sidebar.mli b/src/model/sidebar.mli index d076a56e1c..8c61268b0c 100644 --- a/src/model/sidebar.mli +++ b/src/model/sidebar.mli @@ -2,7 +2,7 @@ open Paths.Identifier module PageToc : sig type title = Comment.link_content - type children_order = Paths.Identifier.Page.t list + type children_order = Frontmatter.child list type t type content = Entry of title | Dir of t diff --git a/src/model_desc/lang_desc.ml b/src/model_desc/lang_desc.ml index f8f62c1563..536e563400 100644 --- a/src/model_desc/lang_desc.ml +++ b/src/model_desc/lang_desc.ml @@ -704,14 +704,12 @@ and page_t = and frontmatter = let open Odoc_model.Frontmatter in - Record - [ - F - ( "children", - (fun t -> - (t.children_order :> Odoc_model.Paths.Reference.t list option)), - Option (List reference) ); - ] + Record [ F ("children", (fun t -> t.children_order), Option (List child)) ] + +and child = + let open Odoc_model.Frontmatter in + Variant + (function Page s -> C ("Page", s, string) | Dir s -> C ("Dir", s, string)) and implementation_t = let open Lang.Implementation in diff --git a/src/odoc/indexing.ml b/src/odoc/indexing.ml index b4effba0fa..ff564e2de1 100644 --- a/src/odoc/indexing.ml +++ b/src/odoc/indexing.ml @@ -159,16 +159,7 @@ let compile out_format ~output ~warnings_options ~occurrences ~lib_roots ] | Some x -> x in - let children_order = - match fm.Frontmatter.children_order with - | None -> None - | Some co -> - Some - (List.filter_map - (function - | `Resolved (`Identifier id) -> Some id | _ -> None) - co) - in + let children_order = fm.Frontmatter.children_order in (id, title, children_order)) (List.filter_map (function diff --git a/src/xref2/link.ml b/src/xref2/link.ml index f81aea1bf6..e61f4958ba 100644 --- a/src/xref2/link.ml +++ b/src/xref2/link.ml @@ -1133,32 +1133,10 @@ let page env page = | None -> Errors.report ~what:(`Child_module mod_) `Lookup)) page.Lang.Page.children in - let frontmatter = - let resolve r = - match Ref_tools.resolve_page_reference env r |> Error.raise_warnings with - | Ok (ref_, _c) -> `Resolved ref_ - | Error e -> - Errors.report - ~what:(`Reference (r :> Paths.Reference.t)) - ~tools_error:(`Reference e) `Resolve; - r - in - { - Frontmatter.children_order = - Option.map (List.map resolve) page.frontmatter.children_order; - } - in - let root = - match page.root.file with - | Page p -> { page.root with file = Page { p with frontmatter } } - | _ -> assert false - in { page with - root; Page.content = comment_docs env page.Page.name page.content; linked = true; - frontmatter; } let source_info env infos = diff --git a/src/xref2/ref_tools.ml b/src/xref2/ref_tools.ml index eb899a5b33..f41da8c2d5 100644 --- a/src/xref2/ref_tools.ml +++ b/src/xref2/ref_tools.ml @@ -816,13 +816,6 @@ and resolve_module_reference env (r : Module.t) : M.t ref_result = | `Root (name, _) -> M.in_env env name | `Module_path p -> Path.module_in_env env p -let resolve_page_reference env (r : Reference.Page.t) : - page_lookup_result ref_result = - match r with - | `Resolved _r -> failwith "What's going on!?" - | `Page_path p -> Path.page_in_env env p - | `Root (name, _) -> Page.in_env env name - let resolve_class_signature_reference env (r : ClassSignature.t) = (* Casting from ClassSignature to LabelParent. TODO: Add [resolve_class_signature_reference] when it's easier to implement. *) @@ -1011,9 +1004,6 @@ let resolve_reference : let resolve_module_reference env m = Odoc_model.Error.catch_warnings (fun () -> resolve_module_reference env m) -let resolve_page_reference env m = - Odoc_model.Error.catch_warnings (fun () -> resolve_page_reference env m) - let resolve_asset_reference env m = Odoc_model.Error.catch_warnings (fun () -> resolve_asset_reference env m) diff --git a/src/xref2/ref_tools.mli b/src/xref2/ref_tools.mli index a6b4127b25..17c0667342 100644 --- a/src/xref2/ref_tools.mli +++ b/src/xref2/ref_tools.mli @@ -14,11 +14,6 @@ val resolve_module_reference : Module.t -> module_lookup_result ref_result Odoc_model.Error.with_warnings -val resolve_page_reference : - Env.t -> - Page.t -> - page_lookup_result ref_result Odoc_model.Error.with_warnings - val resolve_asset_reference : Env.t -> Asset.t -> From 0812abe9b58195ec2ef9952dd7aa7158f9b4c580 Mon Sep 17 00:00:00 2001 From: Paul-Elliot Date: Thu, 29 Aug 2024 18:52:40 +0200 Subject: [PATCH 07/22] Children order: Add some tests --- test/pages/frontmatter.t/run.t | 43 ++++------ test/pages/toc_order.t/content.mld | 1 + .../pages/toc_order.t/dir1/content_in_dir.mld | 1 + test/pages/toc_order.t/dir1/index.mld | 5 ++ test/pages/toc_order.t/index.mld | 7 ++ test/pages/toc_order.t/run.t | 84 +++++++++++++++++++ test/parent_id/sidebar.t/run.t | 8 +- 7 files changed, 117 insertions(+), 32 deletions(-) create mode 100644 test/pages/toc_order.t/content.mld create mode 100644 test/pages/toc_order.t/dir1/content_in_dir.mld create mode 100644 test/pages/toc_order.t/dir1/index.mld create mode 100644 test/pages/toc_order.t/index.mld create mode 100644 test/pages/toc_order.t/run.t diff --git a/test/pages/frontmatter.t/run.t b/test/pages/frontmatter.t/run.t index 938525d5fc..9cdf6c2b97 100644 --- a/test/pages/frontmatter.t/run.t +++ b/test/pages/frontmatter.t/run.t @@ -3,7 +3,7 @@ When there is no frontmatter, everything is normal $ odoc compile zero_frontmatter.mld $ odoc_print page-zero_frontmatter.odoc | jq '.frontmatter' { - "children": [] + "children": "None" } When there is one frontmatter, it is extracted from the content: @@ -11,32 +11,19 @@ When there is one frontmatter, it is extracted from the content: $ odoc compile one_frontmatter.mld $ odoc_print page-one_frontmatter.odoc | jq '.frontmatter' { - "children": [ - { - "`Page_path": [ - "`TRelativePath", - [ - "" - ] - ] - }, - { - "`Page_path": [ - "`TRelativePath", - [ - "page1" - ] - ] - }, - { - "`Page_path": [ - "`TRelativePath", - [ - "page2" - ] - ] - } - ] + "children": { + "Some": [ + { + "Page": "" + }, + { + "Page": "page1" + }, + { + "Page": "page2" + } + ] + } } $ odoc_print page-one_frontmatter.odoc | jq '.content' [ @@ -75,7 +62,7 @@ When there is more than one frontmatter, they are all extracted from the content $ odoc compile two_frontmatters.mld $ odoc_print page-two_frontmatters.odoc | jq '.frontmatter' { - "children": [] + "children": "None" } $ odoc_print page-two_frontmatters.odoc | jq '.content' [ diff --git a/test/pages/toc_order.t/content.mld b/test/pages/toc_order.t/content.mld new file mode 100644 index 0000000000..e432a1b508 --- /dev/null +++ b/test/pages/toc_order.t/content.mld @@ -0,0 +1 @@ +{0 Ten reasons why} \ No newline at end of file diff --git a/test/pages/toc_order.t/dir1/content_in_dir.mld b/test/pages/toc_order.t/dir1/content_in_dir.mld new file mode 100644 index 0000000000..e1810f2ef3 --- /dev/null +++ b/test/pages/toc_order.t/dir1/content_in_dir.mld @@ -0,0 +1 @@ +{0 This is some content} diff --git a/test/pages/toc_order.t/dir1/index.mld b/test/pages/toc_order.t/dir1/index.mld new file mode 100644 index 0000000000..ee387651f7 --- /dev/null +++ b/test/pages/toc_order.t/dir1/index.mld @@ -0,0 +1,5 @@ +{0 Check this out} + +{@meta[ +children:content_in_dir +]} \ No newline at end of file diff --git a/test/pages/toc_order.t/index.mld b/test/pages/toc_order.t/index.mld new file mode 100644 index 0000000000..e7d5c6cb9b --- /dev/null +++ b/test/pages/toc_order.t/index.mld @@ -0,0 +1,7 @@ +{0 This index has a name} + +Hello + +{@meta[ +children: content dir1/ +]} \ No newline at end of file diff --git a/test/pages/toc_order.t/run.t b/test/pages/toc_order.t/run.t new file mode 100644 index 0000000000..fe41c8f9d0 --- /dev/null +++ b/test/pages/toc_order.t/run.t @@ -0,0 +1,84 @@ + $ odoc compile --parent-id pkg/doc --output-dir _odoc index.mld + $ odoc compile --parent-id pkg/doc --output-dir _odoc content.mld + $ odoc compile --parent-id pkg/doc/dir1 --output-dir _odoc dir1/index.mld + $ odoc compile --parent-id pkg/doc/dir1 --output-dir _odoc dir1/content_in_dir.mld + + $ odoc link _odoc/pkg/doc/page-index.odoc + $ odoc link _odoc/pkg/doc/page-content.odoc + $ odoc link _odoc/pkg/doc/dir1/page-index.odoc + $ odoc link _odoc/pkg/doc/dir1/page-content_in_dir.odoc + + $ odoc compile-index -P test:_odoc/pkg/doc + + $ ls + _odoc + content.mld + dir1 + index.mld + index.odoc-index + + $ odoc html-generate --index index.odoc-index -o _html _odoc/pkg/doc/page-index.odocl + $ odoc html-generate --index index.odoc-index -o _html _odoc/pkg/doc/page-content.odocl + $ odoc html-generate --index index.odoc-index -o _html _odoc/pkg/doc/dir1/page-index.odocl + $ odoc html-generate --index index.odoc-index -o _html _odoc/pkg/doc/dir1/page-content_in_dir.odocl + $ odoc support-files -o _html + + $ odoc_print _odoc/pkg/doc/page-index.odocl + { + "name": { + "`LeafPage": [ + { + "Some": { + "`Page": [ { "Some": { "`Page": [ "None", "pkg" ] } }, "doc" ] + } + }, + "index" + ] + }, + "root": "", + "frontmatter": { + "children": { + "Some": [ { "Page": "" }, { "Page": "content" }, { "Dir": "dir1" } ] + } + }, + "content": [ + { + "`Heading": [ + { "heading_level": "`Title", "heading_label_explicit": "false" }, + { + "`Label": [ + { + "`LeafPage": [ + { + "Some": { + "`Page": [ + { "Some": { "`Page": [ "None", "pkg" ] } }, "doc" + ] + } + }, + "index" + ] + }, + "this-index-has-a-name" + ] + }, + [ + { "`Word": "This" }, + "`Space", + { "`Word": "index" }, + "`Space", + { "`Word": "has" }, + "`Space", + { "`Word": "a" }, + "`Space", + { "`Word": "name" } + ] + ] + }, + { "`Paragraph": [ { "`Word": "Hello" } ] } + ], + "digest": "" + } + + + $ cp -r _html /tmp/html diff --git a/test/parent_id/sidebar.t/run.t b/test/parent_id/sidebar.t/run.t index 1186bf24b3..789f6d9141 100644 --- a/test/parent_id/sidebar.t/run.t +++ b/test/parent_id/sidebar.t/run.t @@ -23,10 +23,10 @@