2072

Committed 10 Jun 2024 10:09AM UTC coverage: 71.986% (+0.2%) from 71.774%

Build # 2072

Build Type

Pull #1145

github

Committed by

web-flow

Commit Message

Merge 1b7b0910b into 1ced6f23f

Pull Request Pull Request #1145: "Global" Sidebar

Run Details

195 of 220 new or added lines in 12 files covered. (88.64%)

630 existing lines in 13 files now uncovered.

9834 of 13661 relevant lines covered (71.99%)

3561.61 hits per line

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

97.64

/src/html/html_page.ml

(*
 * Copyright (c) 2016 Thomas Refis <trefis@janestreet.com>
 *
 * Permission to use, copy, modify, and distribute this software for any
 * purpose with or without fee is hereby granted, provided that the above
 * copyright notice and this permission notice appear in all copies.
 *
 * THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
 * WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
 * MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
 * ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
 * WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
 * ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
 * OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
 *)

module Url = Odoc_document.Url
module Html = Tyxml.Html

let html_of_toc toc =
  let open Types in
  let rec section (section : toc) =
    let link = Html.a ~a:[ Html.a_href section.href ] section.title in
    match section.children with [] -> [ link ] | cs -> [ link; sections cs ]
  and sections the_sections =
    the_sections
    |> List.map (fun the_section -> Html.li (section the_section))
    |> Html.ul
  in
  match toc with [] -> [] | _ -> [ sections toc ]

let html_of_search () =
  let search_bar =
    Html.(
      input
        ~a:[ a_class [ "search-bar" ]; a_placeholder "🔎 Type '/' to search..." ]
        ())
  in
  let snake = Html.(div ~a:[ a_class [ "search-snake" ] ] []) in
  let search_result = Html.div ~a:[ Html.a_class [ "search-result" ] ] [] in
  Html.(
    div ~a:[ a_class [ "search-inner" ] ] [ search_bar; snake; search_result ])

let sidebar ~sb toc =
  match sb with
  | None -> (
      match toc with
      | [] -> []
      | _ ->
          [
            Html.nav
              ~a:[ Html.a_class [ "odoc-toc"; "odoc-local-toc" ] ]
              (html_of_toc toc);
          ])
  | Some c ->
      [
        Html.nav
          ~a:[ Html.a_class [ "odoc-toc"; "odoc-local-toc" ] ]
          (html_of_toc toc);
        Html.nav ~a:[ Html.a_class [ "odoc-toc"; "odoc-global-toc" ] ] c;
      ]

let html_of_breadcrumbs (breadcrumbs : Types.breadcrumb list) =
  let make_navigation ~up_url rest =
    [
      Html.nav
        ~a:[ Html.a_class [ "odoc-nav" ] ]
        ([ Html.a ~a:[ Html.a_href up_url ] [ Html.txt "Up" ]; Html.txt " – " ]
        @ rest);
    ]
  in
  match List.rev breadcrumbs with
  | [] -> [] (* Can't happen - there's always the current page's breadcrumb. *)
  | [ _ ] -> [] (* No parents *)
  | [ { name = "index"; _ }; x ] ->
      (* Special case leaf pages called 'index' with one parent. This is for files called
          index.mld that would otherwise clash with their parent. In particular,
          dune and odig both cause this situation right now. *)
      let up_url = "../index.html" in
      let parent_name = x.name in
      make_navigation ~up_url [ Html.txt parent_name ]
  | current :: up :: bs ->
      let space = Html.txt " " in
      let sep = [ space; Html.entity "#x00BB"; space ] in
      let html =
        (* Create breadcrumbs *)
        Utils.list_concat_map ?sep:(Some sep)
          ~f:(fun (breadcrumb : Types.breadcrumb) ->
            [
              [
                Html.a
                  ~a:[ Html.a_href breadcrumb.href ]
                  [ Html.txt breadcrumb.name ];
              ];
            ])
          (up :: bs)
        |> List.flatten
      in
      make_navigation ~up_url:up.href
        (List.rev html @ sep @ [ Html.txt current.name ])

let file_uri ~config ~url (base : Types.uri) file =
  match base with
  | Types.Absolute uri -> uri ^ "/" ^ file
  | Relative uri ->
      let page = Url.Path.{ kind = `File; parent = uri; name = file } in
      Link.href ~config ~resolve:(Current url) (Url.from_path page)

let default_meta_elements ~config ~url =
  let theme_uri = Config.theme_uri config in
  let odoc_css_uri = file_uri ~config ~url theme_uri "odoc.css" in
  [
    Html.meta ~a:[ Html.a_charset "utf-8" ] ();
    Html.link ~rel:[ `Stylesheet ] ~href:odoc_css_uri ();
    Html.meta
      ~a:[ Html.a_name "generator"; Html.a_content "odoc %%VERSION%%" ]
      ();
    Html.meta
      ~a:
        [
          Html.a_name "viewport";
          Html.a_content "width=device-width,initial-scale=1.0";
        ]
      ();
  ]

let page_creator ~config ~url ~uses_katex ~sb header breadcrumbs toc content =
  let theme_uri = Config.theme_uri config in
  let support_uri = Config.support_uri config in
  let search_uris = Config.search_uris config in
  let path = Link.Path.for_printing url in

  let head : Html_types.head Html.elt =
    let title_string =
      Printf.sprintf "%s (%s)" url.name (String.concat "." path)
    in

    let file_uri = file_uri ~config ~url in
    let search_uri uri =
      match uri with
      | Types.Absolute uri -> uri
      | Relative uri ->
          Link.href ~config ~resolve:(Current url) (Url.from_path uri)
    in
    let search_scripts =
      match search_uris with
      | [] -> []
      | _ ->
          let search_urls = List.map search_uri search_uris in
          let search_urls =
            let search_url name = Printf.sprintf "'%s'" name in
            let search_urls = List.map search_url search_urls in
            "[" ^ String.concat "," search_urls ^ "]"
          in
          (* The names of the search scripts are put into a js variable. Then
             the code in [odoc_search.js] load them into a webworker. *)
          [
            Html.script ~a:[]
              (Html.txt
                 (Format.asprintf
                    {|let base_url = '%s';
let search_urls = %s;
|}
                    (let page =
                       Url.Path.{ kind = `File; parent = None; name = "" }
                     in
                     Link.href ~config ~resolve:(Current url)
                       (Url.from_path page))
                    search_urls));
            Html.script
              ~a:
                [
                  Html.a_src (file_uri support_uri "odoc_search.js");
                  Html.a_defer ();
                ]
              (Html.txt "");
          ]
    in
    let meta_elements =
      let highlightjs_meta =
        let highlight_js_uri = file_uri support_uri "highlight.pack.js" in
        [
          Html.script ~a:[ Html.a_src highlight_js_uri ] (Html.txt "");
          Html.script (Html.txt "hljs.initHighlightingOnLoad();");
        ]
      in
      let katex_meta =
        if uses_katex then
          let katex_css_uri = file_uri theme_uri "katex.min.css" in
          let katex_js_uri = file_uri support_uri "katex.min.js" in
          [
            Html.link ~rel:[ `Stylesheet ] ~href:katex_css_uri ();
            Html.script ~a:[ Html.a_src katex_js_uri ] (Html.txt "");
            Html.script
              (Html.cdata_script
                 {|
          document.addEventListener("DOMContentLoaded", function () {
            var elements = Array.from(document.getElementsByClassName("odoc-katex-math"));
            for (var i = 0; i < elements.length; i++) {
              var el = elements[i];
              var content = el.textContent;
              var new_el = document.createElement("span");
              new_el.setAttribute("class", "odoc-katex-math-rendered");
              var display = el.classList.contains("display");
              katex.render(content, new_el, { throwOnError: false, displayMode: display });
              el.replaceWith(new_el);
            }
          });
        |});
          ]
        else []
      in
      default_meta_elements ~config ~url @ highlightjs_meta @ katex_meta
    in
    let meta_elements = meta_elements @ search_scripts in
    Html.head (Html.title (Html.txt title_string)) meta_elements
  in
  let search_bar =
    match search_uris with
    | [] -> []
    | _ ->
        [ Html.div ~a:[ Html.a_class [ "odoc-search" ] ] [ html_of_search () ] ]
  in

  let body =
    html_of_breadcrumbs breadcrumbs
    @ search_bar
    @ [ Html.header ~a:[ Html.a_class [ "odoc-preamble" ] ] header ]
    @ sidebar ~sb toc
    @ [ Html.div ~a:[ Html.a_class [ "odoc-content" ] ] content ]
  in

  let htmlpp = Html.pp ~indent:(Config.indent config) () in
  let html = Html.html head (Html.body ~a:[ Html.a_class [ "odoc" ] ] body) in
  let content ppf =
    htmlpp ppf html;
    (* Tyxml's pp doesn't output a newline a the end, so we force one *)
    Format.pp_force_newline ppf ()
  in
  content

let make ~config ~url ~header ~breadcrumbs ~sidebar ~toc ~uses_katex content
    children =
  let filename = Link.Path.as_filename ~is_flat:(Config.flat config) url in
  let content =
    page_creator ~config ~url ~uses_katex ~sb:sidebar header breadcrumbs toc
      content
  in
  { Odoc_document.Renderer.filename; content; children }

let path_of_module_of_source ppf url =
  match url.Url.Path.parent with
  | Some parent ->
      let path = Link.Path.for_printing parent in
      Format.fprintf ppf " (%s)" (String.concat "." path)
  | None -> ()

let src_page_creator ~breadcrumbs ~config ~url ~header name content =
  let head : Html_types.head Html.elt =
    let title_string =
      Format.asprintf "Source: %s%a" name path_of_module_of_source url
    in
    let meta_elements = default_meta_elements ~config ~url in
    Html.head (Html.title (Html.txt title_string)) meta_elements
  in
  let body =
    html_of_breadcrumbs breadcrumbs
    @ [ Html.header ~a:[ Html.a_class [ "odoc-preamble" ] ] header ]
    @ content
  in
  (* We never indent as there is a bug in tyxml and it would break lines inside
     a [pre] *)
  let htmlpp = Html.pp ~indent:false () in
  let html =
    Html.html head (Html.body ~a:[ Html.a_class [ "odoc-src" ] ] body)
  in
  let content ppf =
    htmlpp ppf html;
    (* Tyxml's pp doesn't output a newline a the end, so we force one *)
    Format.pp_force_newline ppf ()
  in
  content

let make_src ~config ~url ~breadcrumbs ~header title content =
  let filename = Link.Path.as_filename ~is_flat:(Config.flat config) url in
  let content =
    src_page_creator ~breadcrumbs ~config ~url ~header title content
  in
  { Odoc_document.Renderer.filename; content; children = [] }

1	(*
2	* Copyright (c) 2016 Thomas Refis <trefis@janestreet.com>
3	*
4	* Permission to use, copy, modify, and distribute this software for any
5	* purpose with or without fee is hereby granted, provided that the above
6	* copyright notice and this permission notice appear in all copies.
7	*
8	* THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
9	* WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
10	* MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
11	* ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
12	* WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
13	* ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
14	* OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
15	*)
16
17	module Url = Odoc_document.Url
18	module Html = Tyxml.Html
19
20	let html_of_toc toc =
21	let open Types in	114✔
22	let rec section (section : toc) =
23	let link = Html.a ~a:[ Html.a_href section.href ] section.title in	300✔
24	match section.children with [] -> [ link ] \| cs -> [ link; sections cs ]	36✔
25	and sections the_sections =
26	the_sections	145✔
27	\|> List.map (fun the_section -> Html.li (section the_section))	300✔
28	\|> Html.ul	145✔
29	in
30	match toc with [] -> [] \| _ -> [ sections toc ]	5✔
31
32	let html_of_search () =
33	let search_bar =	11✔
34	Html.(
35	input	11✔
36	~a:[ a_class [ "search-bar" ]; a_placeholder "🔎 Type '/' to search..." ]	11✔
37	())
38	in
39	let snake = Html.(div ~a:[ a_class [ "search-snake" ] ] []) in	11✔
40	let search_result = Html.div ~a:[ Html.a_class [ "search-result" ] ] [] in	11✔
41	Html.(	11✔
42	div ~a:[ a_class [ "search-inner" ] ] [ search_bar; snake; search_result ])	11✔
43
44	let sidebar ~sb toc =
45	match sb with	964✔
46	\| None -> (	959✔
47	match toc with
48	\| [] -> []	850✔
49	\| _ ->	109✔
50	[
51	Html.nav	109✔
52	~a:[ Html.a_class [ "odoc-toc"; "odoc-local-toc" ] ]	109✔
53	(html_of_toc toc);	109✔
54	])
55	\| Some c ->	5✔
56	[
57	Html.nav	5✔
58	~a:[ Html.a_class [ "odoc-toc"; "odoc-local-toc" ] ]	5✔
59	(html_of_toc toc);	5✔
60	Html.nav ~a:[ Html.a_class [ "odoc-toc"; "odoc-global-toc" ] ] c;	5✔
61	]
62
63	let html_of_breadcrumbs (breadcrumbs : Types.breadcrumb list) =
64	let make_navigation ~up_url rest =	986✔
65	[	868✔
66	Html.nav	868✔
67	~a:[ Html.a_class [ "odoc-nav" ] ]	868✔
68	([ Html.a ~a:[ Html.a_href up_url ] [ Html.txt "Up" ]; Html.txt " – " ]	868✔
69	@ rest);
70	]
71	in
72	match List.rev breadcrumbs with
UNCOV 73	\| [] -> [] (* Can't happen - there's always the current page's breadcrumb. *)	×
74	\| [ _ ] -> [] (* No parents *)	118✔
75	\| [ { name = "index"; _ }; x ] ->	2✔
76	(* Special case leaf pages called 'index' with one parent. This is for files called
77	index.mld that would otherwise clash with their parent. In particular,
78	dune and odig both cause this situation right now. *)
79	let up_url = "../index.html" in
80	let parent_name = x.name in
81	make_navigation ~up_url [ Html.txt parent_name ]	2✔
82	\| current :: up :: bs ->	866✔
83	let space = Html.txt " " in
84	let sep = [ space; Html.entity "#x00BB"; space ] in	866✔
85	let html =
86	(* Create breadcrumbs *)
87	Utils.list_concat_map ?sep:(Some sep)
88	~f:(fun (breadcrumb : Types.breadcrumb) ->
89	[	1,486✔
90	[
91	Html.a	1,486✔
92	~a:[ Html.a_href breadcrumb.href ]	1,486✔
93	[ Html.txt breadcrumb.name ];	1,486✔
94	];
95	])
96	(up :: bs)
97	\|> List.flatten	866✔
98	in
99	make_navigation ~up_url:up.href	866✔
100	(List.rev html @ sep @ [ Html.txt current.name ])	866✔
101
102	let file_uri ~config ~url (base : Types.uri) file =
103	match base with	1,969✔
UNCOV 104	\| Types.Absolute uri -> uri ^ "/" ^ file	×
105	\| Relative uri ->	1,969✔
106	let page = Url.Path.{ kind = `File; parent = uri; name = file } in
107	Link.href ~config ~resolve:(Current url) (Url.from_path page)	1,969✔
108
109	let default_meta_elements ~config ~url =
110	let theme_uri = Config.theme_uri config in	986✔
111	let odoc_css_uri = file_uri ~config ~url theme_uri "odoc.css" in	986✔
112	[	986✔
113	Html.meta ~a:[ Html.a_charset "utf-8" ] ();	986✔
114	Html.link ~rel:[ `Stylesheet ] ~href:odoc_css_uri ();	986✔
115	Html.meta	986✔
116	~a:[ Html.a_name "generator"; Html.a_content "odoc %%VERSION%%" ]	986✔
117	();
118	Html.meta	986✔
119	~a:
120	[
121	Html.a_name "viewport";	986✔
122	Html.a_content "width=device-width,initial-scale=1.0";	986✔
123	]
124	();
125	]
126
127	let page_creator ~config ~url ~uses_katex ~sb header breadcrumbs toc content =
128	let theme_uri = Config.theme_uri config in	964✔
129	let support_uri = Config.support_uri config in	964✔
130	let search_uris = Config.search_uris config in	964✔
131	let path = Link.Path.for_printing url in	964✔
132
133	let head : Html_types.head Html.elt =	964✔
134	let title_string =
135	Printf.sprintf "%s (%s)" url.name (String.concat "." path)	964✔
136	in
137
138	let file_uri = file_uri ~config ~url in	964✔
139	let search_uri uri =
140	match uri with	17✔
141	\| Types.Absolute uri -> uri	2✔
142	\| Relative uri ->	15✔
143	Link.href ~config ~resolve:(Current url) (Url.from_path uri)	15✔
144	in
145	let search_scripts =
146	match search_uris with
147	\| [] -> []	953✔
148	\| _ ->	11✔
149	let search_urls = List.map search_uri search_uris in
150	let search_urls =	11✔
151	let search_url name = Printf.sprintf "'%s'" name in	17✔
152	let search_urls = List.map search_url search_urls in
153	"[" ^ String.concat "," search_urls ^ "]"	11✔
154	in
155	(* The names of the search scripts are put into a js variable. Then
156	the code in [odoc_search.js] load them into a webworker. *)
157	[
158	Html.script ~a:[]	11✔
159	(Html.txt	11✔
160	(Format.asprintf	11✔
161	{\|let base_url = '%s';
162	let search_urls = %s;
163	\|}
164	(let page =
165	Url.Path.{ kind = `File; parent = None; name = "" }
166	in
167	Link.href ~config ~resolve:(Current url)	11✔
168	(Url.from_path page))	11✔
169	search_urls));
170	Html.script	11✔
171	~a:
172	[
173	Html.a_src (file_uri support_uri "odoc_search.js");	11✔
174	Html.a_defer ();	11✔
175	]
176	(Html.txt "");	11✔
177	]
178	in
179	let meta_elements =
180	let highlightjs_meta =
181	let highlight_js_uri = file_uri support_uri "highlight.pack.js" in
182	[	964✔
183	Html.script ~a:[ Html.a_src highlight_js_uri ] (Html.txt "");	964✔
184	Html.script (Html.txt "hljs.initHighlightingOnLoad();");	964✔
185	]
186	in
187	let katex_meta =
188	if uses_katex then
189	let katex_css_uri = file_uri theme_uri "katex.min.css" in	4✔
190	let katex_js_uri = file_uri support_uri "katex.min.js" in	4✔
191	[	4✔
192	Html.link ~rel:[ `Stylesheet ] ~href:katex_css_uri ();	4✔
193	Html.script ~a:[ Html.a_src katex_js_uri ] (Html.txt "");	4✔
194	Html.script	4✔
195	(Html.cdata_script	4✔
196	{\|
197	document.addEventListener("DOMContentLoaded", function () {
198	var elements = Array.from(document.getElementsByClassName("odoc-katex-math"));
199	for (var i = 0; i < elements.length; i++) {
200	var el = elements[i];
201	var content = el.textContent;
202	var new_el = document.createElement("span");
203	new_el.setAttribute("class", "odoc-katex-math-rendered");
204	var display = el.classList.contains("display");
205	katex.render(content, new_el, { throwOnError: false, displayMode: display });
206	el.replaceWith(new_el);
207	}
208	});
209	\|});
210	]
211	else []	960✔
212	in
213	default_meta_elements ~config ~url @ highlightjs_meta @ katex_meta
214	in
215	let meta_elements = meta_elements @ search_scripts in
216	Html.head (Html.title (Html.txt title_string)) meta_elements	964✔
217	in
218	let search_bar =
219	match search_uris with
220	\| [] -> []	953✔
221	\| _ ->	11✔
222	[ Html.div ~a:[ Html.a_class [ "odoc-search" ] ] [ html_of_search () ] ]	11✔
223	in
224
225	let body =
226	html_of_breadcrumbs breadcrumbs	964✔
227	@ search_bar
228	@ [ Html.header ~a:[ Html.a_class [ "odoc-preamble" ] ] header ]	964✔
229	@ sidebar ~sb toc	964✔
230	@ [ Html.div ~a:[ Html.a_class [ "odoc-content" ] ] content ]	964✔
231	in
232
233	let htmlpp = Html.pp ~indent:(Config.indent config) () in	964✔
234	let html = Html.html head (Html.body ~a:[ Html.a_class [ "odoc" ] ] body) in	964✔
235	let content ppf =	964✔
236	htmlpp ppf html;	571✔
237	(* Tyxml's pp doesn't output a newline a the end, so we force one *)
238	Format.pp_force_newline ppf ()	571✔
239	in
240	content
241
242	let make ~config ~url ~header ~breadcrumbs ~sidebar ~toc ~uses_katex content
243	children =
244	let filename = Link.Path.as_filename ~is_flat:(Config.flat config) url in	964✔
245	let content =	964✔
246	page_creator ~config ~url ~uses_katex ~sb:sidebar header breadcrumbs toc
247	content
248	in
249	{ Odoc_document.Renderer.filename; content; children }	964✔
250
251	let path_of_module_of_source ppf url =
252	match url.Url.Path.parent with	22✔
253	\| Some parent ->	22✔
254	let path = Link.Path.for_printing parent in
255	Format.fprintf ppf " (%s)" (String.concat "." path)	22✔
UNCOV 256	\| None -> ()	×
257
258	let src_page_creator ~breadcrumbs ~config ~url ~header name content =
259	let head : Html_types.head Html.elt =	22✔
260	let title_string =
261	Format.asprintf "Source: %s%a" name path_of_module_of_source url
262	in
263	let meta_elements = default_meta_elements ~config ~url in	22✔
264	Html.head (Html.title (Html.txt title_string)) meta_elements	22✔
265	in
266	let body =
267	html_of_breadcrumbs breadcrumbs	22✔
268	@ [ Html.header ~a:[ Html.a_class [ "odoc-preamble" ] ] header ]	22✔
269	@ content
270	in
271	(* We never indent as there is a bug in tyxml and it would break lines inside
272	a [pre] *)
273	let htmlpp = Html.pp ~indent:false () in
274	let html =	22✔
275	Html.html head (Html.body ~a:[ Html.a_class [ "odoc-src" ] ] body)	22✔
276	in
277	let content ppf =	22✔
278	htmlpp ppf html;	20✔
279	(* Tyxml's pp doesn't output a newline a the end, so we force one *)
280	Format.pp_force_newline ppf ()	20✔
281	in
282	content
283
284	let make_src ~config ~url ~breadcrumbs ~header title content =
285	let filename = Link.Path.as_filename ~is_flat:(Config.flat config) url in	22✔
286	let content =	22✔
287	src_page_creator ~breadcrumbs ~config ~url ~header title content
288	in
289	{ Odoc_document.Renderer.filename; content; children = [] }	22✔

ocaml / odoc / 2072

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