2403

Committed 02 Oct 2024 03:15PM UTC coverage: 72.971% (+0.1%) from 72.848%

Build # 2403

Build Type

Pull #1193

github

Committed by

web-flow

Commit Message

Merge 93aa604a2 into 0ba1fdbe6

Pull Request Pull Request #1193: Specify children order in frontmatter

Run Details

140 of 154 new or added lines in 10 files covered. (90.91%)

60 existing lines in 5 files now uncovered.

10248 of 14044 relevant lines covered (72.97%)

2965.35 hits per line

Source File
Press 'n' to go to next uncovered line, 'b' for previous

96.0

/src/document/sidebar.ml

open Odoc_utils
open Types

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 }

module Toc : sig
  type t

  val of_lang : Odoc_model.Sidebar.PageToc.t -> t

  val remove_common_root : t -> t
  (** Returns the deepest subdir containing all files. *)

  val to_sidebar :
    ?fallback:string -> (Url.Path.t * Inline.one -> Block.one) -> t -> Block.t
end = struct
  type t = Item of (Url.Path.t * Inline.one) option * t list

  open Odoc_model.Sidebar
  open Odoc_model.Paths.Identifier

  let of_lang (dir : PageToc.t) =
    let rec of_lang ~parent_id ((content, index) : PageToc.t) =
      let title, parent_id =
        match index with
        | Some (index_id, title) -> (Some title, Some (index_id :> Page.t))
        | None -> (None, (parent_id :> Page.t option))
      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
      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
    of_lang ~parent_id:None dir

  let rec remove_common_root = function
    | Item (_, [ d ]) -> remove_common_root d
    | x -> x

  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 =
      match content with
      | [] -> []
      | _ :: _ ->
          let content = List.map (to_sidebar convert) content in
          [ block (Block.List (Block.Unordered, content)) ]
    in
    name :: content
end
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.Sidebar.t) =
  let pages =
    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
  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)
    in
    let units =
      List.map
        (fun { Odoc_model.Sidebar.units; name } ->
          let units = List.map item units in
          { name; units })
        v.libraries
    in
    units
  in
  { pages; libraries = units }

let to_block (sidebar : t) url =
  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 = [ block (Block.List (Block.Unordered, [ pages ])) ] in
        let pages = [ title @@ p.name ^ "'s Pages" ] @ pages in
        pages)
      pages
  in
  let units =
    let units =
      List.map
        (fun { units; name } ->
          [
            title name;
            block (List (Block.Unordered, [ List.map render_entry units ]));
          ])
        libraries
    in
    let units = block (Block.List (Block.Unordered, units)) in
    [ title "Libraries"; units ]
  in
  pages @ units

1	open Odoc_utils
2	open Types
3
4	let sidebar_toc_entry id content =
5	let href = id \|> Url.Path.from_identifier \|> Url.from_path in	61✔
6	let target = Target.Internal (Resolved href) in	61✔
7	inline @@ Inline.Link { target; content; tooltip = None }
8
9	module Toc : sig
10	type t
11
12	val of_lang : Odoc_model.Sidebar.PageToc.t -> t
13
14	val remove_common_root : t -> t
15	(** Returns the deepest subdir containing all files. *)
16
17	val to_sidebar :
18	?fallback:string -> (Url.Path.t * Inline.one -> Block.one) -> t -> Block.t
19	end = struct
20	type t = Item of (Url.Path.t * Inline.one) option * t list
21
22	open Odoc_model.Sidebar
23	open Odoc_model.Paths.Identifier
24
25	let of_lang (dir : PageToc.t) =
26	let rec of_lang ~parent_id ((content, index) : PageToc.t) =	11✔
27	let title, parent_id =	44✔
28	match index with
29	\| Some (index_id, title) -> (Some title, Some (index_id :> Page.t))	22✔
30	\| None -> (None, (parent_id :> Page.t option))	22✔
31	in
32	let entries =
33	List.filter_map
34	(fun id ->
35	match id with	67✔
36	\| id, PageToc.Entry title ->	34✔
37	(* TODO warn on non empty children order if not index page somewhere *)
38	let payload =
39	let path = Url.Path.from_identifier id in
40	let content = Comment.link_content title in	34✔
41	Some (path, sidebar_toc_entry id content)	34✔
42	in
43	Some (Item (payload, []))
44	\| id, PageToc.Dir dir -> Some (of_lang ~parent_id:(Some id) dir))	33✔
45	content
46	in
47	let payload =	44✔
48	match (title, parent_id) with
NEW 49	\| None, _ \| _, None -> None	×
50	\| Some title, Some parent_id ->	22✔
51	let path = Url.Path.from_identifier parent_id in
52	let content = Comment.link_content title in	22✔
53	Some (path, sidebar_toc_entry parent_id content)	22✔
54	in
55	Item (payload, entries)
56	in
57	of_lang ~parent_id:None dir
58
59	let rec remove_common_root = function
60	\| Item (_, [ d ]) -> remove_common_root d	22✔
61	\| x -> x	11✔
62
63	let rec to_sidebar ?(fallback = "root") convert (Item (name, content)) =	56✔
64	let name =	56✔
65	match name with
66	\| Some v -> convert v	56✔
67	\| None -> block (Block.Inline [ inline (Text fallback) ])	×
68	in
69	let content =
70	match content with
71	\| [] -> []	34✔
72	\| _ :: _ ->	22✔
73	let content = List.map (to_sidebar convert) content in	22✔
74	[ block (Block.List (Block.Unordered, content)) ]	22✔
75	in
76	name :: content
77	end
78	type pages = { name : string; pages : Toc.t }
79	type library = { name : string; units : (Url.Path.t * Inline.one) list }
80
81	type t = { pages : pages list; libraries : library list }
82
83	let of_lang (v : Odoc_model.Sidebar.t) =
84	let pages =	11✔
85	let page_hierarchy { Odoc_model.Sidebar.hierarchy_name; pages } =
86	let hierarchy = Toc.of_lang pages \|> Toc.remove_common_root in	11✔
87	Some { name = hierarchy_name; pages = hierarchy }	11✔
88	in
89	Odoc_utils.List.filter_map page_hierarchy v.pages	11✔
90	in
91	let units =
92	let item id =
93	let content = [ inline @@ Text (Odoc_model.Paths.Identifier.name id) ] in	5✔
94	(Url.Path.from_identifier id, sidebar_toc_entry id content)	5✔
95	in
96	let units =
97	List.map
98	(fun { Odoc_model.Sidebar.units; name } ->
99	let units = List.map item units in	5✔
100	{ name; units })	5✔
101	v.libraries
102	in
103	units	11✔
104	in
105	{ pages; libraries = units }
106
107	let to_block (sidebar : t) url =
108	let { pages; libraries } = sidebar in	11✔
109	let title t =
110	block	27✔
111	(Inline [ inline (Inline.Styled (`Bold, [ inline (Inline.Text t) ])) ])	27✔
112	in
113	let render_entry (entry_path, b) =
114	let link =	61✔
115	if entry_path = url then { b with Inline.attr = [ "current_unit" ] }	11✔
116	else b	50✔
117	in
118	Types.block @@ Inline [ link ]
119	in
120	let pages =
121	Odoc_utils.List.concat_map
122	~f:(fun (p : pages) ->
123	let pages = Toc.to_sidebar render_entry p.pages in	11✔
124	let pages = [ block (Block.List (Block.Unordered, [ pages ])) ] in	11✔
125	let pages = [ title @@ p.name ^ "'s Pages" ] @ pages in	11✔
126	pages)
127	pages
128	in
129	let units =	11✔
130	let units =
131	List.map
132	(fun { units; name } ->
133	[	5✔
134	title name;	5✔
135	block (List (Block.Unordered, [ List.map render_entry units ]));	5✔
136	])
137	libraries
138	in
139	let units = block (Block.List (Block.Unordered, units)) in	11✔
140	[ title "Libraries"; units ]	11✔
141	in
142	pages @ units

ocaml / odoc / 2403

Source File Press 'n' to go to next uncovered line, 'b' for previous

Source File
Press 'n' to go to next uncovered line, 'b' for previous