diff --git a/src/index/skeleton_of.ml b/src/index/skeleton_of.ml index 2b19a0314b..6c6a898b96 100644 --- a/src/index/skeleton_of.ml +++ b/src/index/skeleton_of.ml @@ -4,6 +4,7 @@ open Odoc_model (* Selective opens *) module Id = Odoc_model.Paths.Identifier module PageName = Odoc_model.Names.PageName +module ModuleName = Odoc_model.Names.ModuleName type t = Entry.t Tree.t @@ -42,28 +43,36 @@ let rec t_of_in_progress (dir : In_progress.in_progress) : t = 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) + | `Root (_, name) -> + Format.fprintf fmt "'module-%s'" (ModuleName.to_string name) + | _ -> Format.fprintf fmt "'unsupported'" 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 + | Module s -> Format.fprintf fmt "'module-%s'" s in let ordered, unordered = let contents = let leafs = In_progress.leafs dir |> List.map (fun (_, page) -> - let id :> Id.Page.t = page.Lang.Page.name in + let id :> Id.t = page.Lang.Page.name in let entry = entry_of_page page in (id, Tree.leaf entry)) in let dirs = In_progress.dirs dir |> List.map (fun (id, payload) -> - let id :> Id.Page.t = id in + let id :> Id.t = id in (id, t_of_in_progress payload)) in - leafs @ dirs + let modules = + In_progress.modules dir + |> List.map (fun (id, payload) -> ((id :> Id.t), payload)) + in + leafs @ dirs @ modules in match children_order with | None -> ([], contents) @@ -77,12 +86,14 @@ let rec t_of_in_progress (dir : In_progress.in_progress) : t = String.equal (PageName.to_string name) c | (_, { Location_.value = Page c; _ }), `LeafPage (_, name) -> String.equal (PageName.to_string name) c + | (_, { Location_.value = Module c; _ }), `Root (_, name) -> + String.equal (ModuleName.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) -> + ((id, _) as entry) -> let indexes_for_entry, children_indexes = List.partition (equal id) children_indexes in @@ -129,9 +140,8 @@ let rec t_of_in_progress (dir : In_progress.in_progress) : t = String.compare (Paths.Identifier.name x) (Paths.Identifier.name y)) unordered in - let modules = In_progress.modules dir |> List.map snd in let contents = ordered @ unordered |> List.map snd in - { Tree.node = index; children = contents @ modules } + { Tree.node = index; children = contents } let rec remove_common_root (v : t) = match v with diff --git a/src/model/frontmatter.ml b/src/model/frontmatter.ml index 00c4e9497c..fc7a2ced88 100644 --- a/src/model/frontmatter.ml +++ b/src/model/frontmatter.ml @@ -1,4 +1,4 @@ -type child = Page of string | Dir of string +type child = Page of string | Dir of string | Module of string type short_title = Comment.link_content @@ -38,9 +38,14 @@ let apply fm line = { fm with children_order } let parse_child c = + let mod_prefix = "module-" in if Astring.String.is_suffix ~affix:"/" c then let c = String.sub c 0 (String.length c - 1) in Dir c + else if Astring.String.is_prefix ~affix:mod_prefix c then + let l = String.length mod_prefix in + let c = String.sub c l (String.length c - l) in + Module c else Page c let parse_children_order loc co = diff --git a/src/model/frontmatter.mli b/src/model/frontmatter.mli index 8cf0f715c0..816ebbdbf1 100644 --- a/src/model/frontmatter.mli +++ b/src/model/frontmatter.mli @@ -1,4 +1,4 @@ -type child = Page of string | Dir of string +type child = Page of string | Dir of string | Module of string type short_title = Comment.link_content diff --git a/src/model_desc/lang_desc.ml b/src/model_desc/lang_desc.ml index eb32d6a9c0..70f2d6d1b3 100644 --- a/src/model_desc/lang_desc.ml +++ b/src/model_desc/lang_desc.ml @@ -725,7 +725,8 @@ and child = Variant (function | { Location_.value = Page s; _ } -> C ("Page", s, string) - | { Location_.value = Dir s; _ } -> C ("Dir", s, string)) + | { Location_.value = Dir s; _ } -> C ("Dir", s, string) + | { Location_.value = Module s; _ } -> C ("Module", s, string)) and implementation_t = let open Lang.Implementation in diff --git a/test/frontmatter/toc_order.t/index.mld b/test/frontmatter/toc_order.t/index.mld index 30817cc9f1..388bdfac93 100644 --- a/test/frontmatter/toc_order.t/index.mld +++ b/test/frontmatter/toc_order.t/index.mld @@ -1,4 +1,4 @@ -@children_order content dir1/ dir1/ typo +@children_order content module-Unit dir1/ dir1/ typo {0 This is the main index} diff --git a/test/frontmatter/toc_order.t/run.t b/test/frontmatter/toc_order.t/run.t index f7a88c75b2..444344b24c 100644 --- a/test/frontmatter/toc_order.t/run.t +++ b/test/frontmatter/toc_order.t/run.t @@ -1,3 +1,6 @@ + $ ocamlc -c -bin-annot unit.ml + + $ odoc compile --parent-id pkg --output-dir _odoc unit.cmt $ odoc compile --parent-id pkg --output-dir _odoc index.mld $ odoc compile --parent-id pkg --output-dir _odoc content.mld $ odoc compile --parent-id pkg --output-dir _odoc omitted.mld @@ -6,6 +9,7 @@ $ odoc compile --parent-id pkg/dir1 --output-dir _odoc dir1/dontent.mld $ odoc link _odoc/pkg/page-index.odoc + $ odoc link _odoc/pkg/unit.odoc $ odoc link _odoc/pkg/page-content.odoc $ odoc link _odoc/pkg/page-omitted.odoc $ odoc link _odoc/pkg/dir1/page-index.odoc @@ -13,11 +17,11 @@ $ odoc link _odoc/pkg/dir1/page-dontent.odoc $ odoc compile-index --root _odoc/pkg - File "index.mld", line 1, characters 30-35: + File "index.mld", line 1, characters 42-47: Warning: Duplicate 'dir1/' in (children). - File "index.mld", line 1, characters 36-40: + File "index.mld", line 1, characters 48-52: Warning: 'typo' in (children) does not correspond to anything. - File "index.mld", line 1, characters 0-40: + File "index.mld", line 1, characters 0-52: Warning: (children) doesn't include 'omitted'. Turn the index into a sidebar (removes all unnecessary entries) @@ -38,6 +42,9 @@ Turn the index into a sidebar (removes all unnecessary entries) { "Page": "content" }, + { + "Module": "Unit" + }, { "Dir": "dir1" }, @@ -65,6 +72,7 @@ but this should be a warning!