3034

Committed 21 Nov 2025 03:17PM UTC coverage: 72.946%. Remained the same

Build # 3034

Build Type

Pull #1392

github

Committed by

web-flow

Commit Message

Merge af7dabc34 into 40bae1e1f

Pull Request Pull Request #1392: Remove obsolete symlinks

Run Details

10389 of 14242 relevant lines covered (72.95%)

7134.88 hits per line

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

97.56

/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.
 *)

open Odoc_utils

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 sidebars ~global_toc ~local_toc =
  let local_toc =
    match local_toc with
    | [] -> []
    | _ :: _ ->
        [
          Html.nav
            ~a:[ Html.a_class [ "odoc-toc"; "odoc-local-toc" ] ]
            (html_of_toc local_toc);
        ]
  in
  let global_toc =
    match global_toc with
    | None -> []
    | Some c ->
        [ Html.nav ~a:[ Html.a_class [ "odoc-toc"; "odoc-global-toc" ] ] c ]
  in
  match local_toc @ global_toc with
  | [] -> []
  | tocs -> [ Html.div ~a:[ Html.a_class [ "odoc-tocs" ] ] tocs ]

let html_of_breadcrumbs (breadcrumbs : Types.breadcrumbs) =
  let make_navigation ~up_url rest =
    let up =
      match up_url with
      | None -> []
      | Some up_url ->
          [ Html.a ~a:[ Html.a_href up_url ] [ Html.txt "Up" ]; Html.txt " – " ]
    in
    [ Html.nav ~a:[ Html.a_class [ "odoc-nav" ] ] (up @ rest) ]
  in
  let space = Html.txt " " in
  let sep = [ space; Html.entity "#x00BB"; space ] in
  let html =
    (* Create breadcrumbs *)
    List.concat_map_sep ~sep
      ~f:(fun (breadcrumb : Types.breadcrumb) ->
        match breadcrumb.href with
        | Some href ->
            [
              [
                Html.a
                  ~a:[ Html.a_href href ]
                  (breadcrumb.name
                    :> Html_types.flow5_without_interactive Html.elt list);
              ];
            ]
        | None ->
            [ (breadcrumb.name :> Html_types.nav_content_fun Html.elt list) ])
      breadcrumbs.parents
    |> List.flatten
  in
  let current_name :> Html_types.nav_content_fun Html.elt list =
    breadcrumbs.current.name
  in
  let rest =
    if List.is_empty breadcrumbs.parents then current_name
    else html @ sep @ current_name
  in
  make_navigation ~up_url:breadcrumbs.up_url
    (rest :> [< Html_types.nav_content_fun > `A `PCDATA `Wbr ] Html.elt list)

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 ~global_toc header breadcrumbs
    local_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 ~sep:"." 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 ~sep:"," 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 macros = {};
            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, macros });
              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 ]
    @ sidebars ~global_toc ~local_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 ~config url in
  let content =
    page_creator ~config ~url ~uses_katex ~global_toc:sidebar header breadcrumbs
      toc content
  in
  { Odoc_document.Renderer.filename; content; children; path = url }

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 ~sep:"." path)
  | None -> ()

let src_page_creator ~breadcrumbs ~config ~url ~header ~sidebar 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 ]
    @ sidebars ~global_toc:sidebar ~local_toc:[]
    @ 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 ~sidebar title content =
  let filename = Link.Path.as_filename ~config url in
  let content =
    src_page_creator ~breadcrumbs ~config ~url ~header ~sidebar title content
  in
  { Odoc_document.Renderer.filename; content; children = []; path = url }

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	open Odoc_utils
18
19	module Url = Odoc_document.Url
20	module Html = Tyxml.Html
21
22	let html_of_toc toc =
23	let open Types in	109✔
24	let rec section (section : toc) =
25	let link = Html.a ~a:[ Html.a_href section.href ] section.title in	305✔
26	match section.children with [] -> [ link ] \| cs -> [ link; sections cs ]	39✔
27	and sections the_sections =
28	the_sections	148✔
29	\|> List.map (fun the_section -> Html.li (section the_section))	305✔
30	\|> Html.ul	148✔
31	in
32	match toc with [] -> [] \| _ -> [ sections toc ]	×
33
34	let html_of_search () =
35	let search_bar =	19✔
36	Html.(
37	input	19✔
38	~a:[ a_class [ "search-bar" ]; a_placeholder "🔎 Type '/' to search..." ]	19✔
39	())
40	in
41	let snake = Html.(div ~a:[ a_class [ "search-snake" ] ] []) in	19✔
42	let search_result = Html.div ~a:[ Html.a_class [ "search-result" ] ] [] in	19✔
43	Html.(	19✔
44	div ~a:[ a_class [ "search-inner" ] ] [ search_bar; snake; search_result ])	19✔
45
46	let sidebars ~global_toc ~local_toc =
47	let local_toc =	1,009✔
48	match local_toc with
49	\| [] -> []	900✔
50	\| _ :: _ ->	109✔
51	[
52	Html.nav	109✔
53	~a:[ Html.a_class [ "odoc-toc"; "odoc-local-toc" ] ]	109✔
54	(html_of_toc local_toc);	109✔
55	]
56	in
57	let global_toc =
58	match global_toc with
59	\| None -> []	977✔
60	\| Some c ->	32✔
61	[ Html.nav ~a:[ Html.a_class [ "odoc-toc"; "odoc-global-toc" ] ] c ]	32✔
62	in
63	match local_toc @ global_toc with
64	\| [] -> []	868✔
65	\| tocs -> [ Html.div ~a:[ Html.a_class [ "odoc-tocs" ] ] tocs ]	141✔
66
67	let html_of_breadcrumbs (breadcrumbs : Types.breadcrumbs) =
68	let make_navigation ~up_url rest =	1,009✔
69	let up =	1,009✔
70	match up_url with
71	\| None -> []	7✔
72	\| Some up_url ->	1,002✔
73	[ Html.a ~a:[ Html.a_href up_url ] [ Html.txt "Up" ]; Html.txt " – " ]	1,002✔
74	in
75	[ Html.nav ~a:[ Html.a_class [ "odoc-nav" ] ] (up @ rest) ]	1,009✔
76	in
77	let space = Html.txt " " in
78	let sep = [ space; Html.entity "#x00BB"; space ] in	1,009✔
79	let html =
80	(* Create breadcrumbs *)
81	List.concat_map_sep ~sep
82	~f:(fun (breadcrumb : Types.breadcrumb) ->
83	match breadcrumb.href with	2,496✔
84	\| Some href ->	2,488✔
85	[
86	[
87	Html.a	2,488✔
88	~a:[ Html.a_href href ]	2,488✔
89	(breadcrumb.name
90	:> Html_types.flow5_without_interactive Html.elt list);
91	];
92	]
93	\| None ->	8✔
94	[ (breadcrumb.name :> Html_types.nav_content_fun Html.elt list) ])
95	breadcrumbs.parents
96	\|> List.flatten	1,009✔
97	in
98	let current_name :> Html_types.nav_content_fun Html.elt list =	1,009✔
99	breadcrumbs.current.name
100	in
101	let rest =
102	if List.is_empty breadcrumbs.parents then current_name	6✔
103	else html @ sep @ current_name	1,003✔
104	in
105	make_navigation ~up_url:breadcrumbs.up_url
106	(rest :> [< Html_types.nav_content_fun > `A `PCDATA `Wbr ] Html.elt list)
107
108	let file_uri ~config ~url (base : Types.uri) file =
109	match base with	2,022✔
110	\| Types.Absolute uri -> uri ^ "/" ^ file	×
111	\| Relative uri ->	2,022✔
112	let page = Url.Path.{ kind = `File; parent = uri; name = file } in
113	Link.href ~config ~resolve:(Current url) (Url.from_path page)	2,022✔
114
115	let default_meta_elements ~config ~url =
116	let theme_uri = Config.theme_uri config in	1,009✔
117	let odoc_css_uri = file_uri ~config ~url theme_uri "odoc.css" in	1,009✔
118	[	1,009✔
119	Html.meta ~a:[ Html.a_charset "utf-8" ] ();	1,009✔
120	Html.link ~rel:[ `Stylesheet ] ~href:odoc_css_uri ();	1,009✔
121	Html.meta	1,009✔
122	~a:[ Html.a_name "generator"; Html.a_content "odoc %%VERSION%%" ]	1,009✔
123	();
124	Html.meta	1,009✔
125	~a:
126	[
127	Html.a_name "viewport";	1,009✔
128	Html.a_content "width=device-width,initial-scale=1.0";	1,009✔
129	]
130	();
131	]
132
133	let page_creator ~config ~url ~uses_katex ~global_toc header breadcrumbs
134	local_toc content =
135	let theme_uri = Config.theme_uri config in	986✔
136	let support_uri = Config.support_uri config in	986✔
137	let search_uris = Config.search_uris config in	986✔
138	let path = Link.Path.for_printing url in	986✔
139
140	let head : Html_types.head Html.elt =	986✔
141	let title_string =
142	Printf.sprintf "%s (%s)" url.name (String.concat ~sep:"." path)	986✔
143	in
144
145	let file_uri = file_uri ~config ~url in	986✔
146	let search_uri uri =
147	match uri with	33✔
148	\| Types.Absolute uri -> uri	2✔
149	\| Relative uri ->	31✔
150	Link.href ~config ~resolve:(Current url) (Url.from_path uri)	31✔
151	in
152	let search_scripts =
153	match search_uris with
154	\| [] -> []	967✔
155	\| _ ->	19✔
156	let search_urls = List.map search_uri search_uris in
157	let search_urls =	19✔
158	let search_url name = Printf.sprintf "'%s'" name in	33✔
159	let search_urls = List.map search_url search_urls in
160	"[" ^ String.concat ~sep:"," search_urls ^ "]"	19✔
161	in
162	(* The names of the search scripts are put into a js variable. Then
163	the code in [odoc_search.js] load them into a webworker. *)
164	[
165	Html.script ~a:[]	19✔
166	(Html.txt	19✔
167	(Format.asprintf	19✔
168	{\|let base_url = '%s';
169	let search_urls = %s;
170	\|}
171	(let page =
172	Url.Path.{ kind = `File; parent = None; name = "" }
173	in
174	Link.href ~config ~resolve:(Current url)	19✔
175	(Url.from_path page))	19✔
176	search_urls));
177	Html.script	19✔
178	~a:
179	[
180	Html.a_src (file_uri support_uri "odoc_search.js");	19✔
181	Html.a_defer ();	19✔
182	]
183	(Html.txt "");	19✔
184	]
185	in
186	let meta_elements =
187	let highlightjs_meta =
188	let highlight_js_uri = file_uri support_uri "highlight.pack.js" in
189	[	986✔
190	Html.script ~a:[ Html.a_src highlight_js_uri ] (Html.txt "");	986✔
191	Html.script (Html.txt "hljs.initHighlightingOnLoad();");	986✔
192	]
193	in
194	let katex_meta =
195	if uses_katex then
196	let katex_css_uri = file_uri theme_uri "katex.min.css" in	4✔
197	let katex_js_uri = file_uri support_uri "katex.min.js" in	4✔
198	[	4✔
199	Html.link ~rel:[ `Stylesheet ] ~href:katex_css_uri ();	4✔
200	Html.script ~a:[ Html.a_src katex_js_uri ] (Html.txt "");	4✔
201	Html.script	4✔
202	(Html.cdata_script	4✔
203	{\|
204	document.addEventListener("DOMContentLoaded", function () {
205	var macros = {};
206	var elements = Array.from(document.getElementsByClassName("odoc-katex-math"));
207	for (var i = 0; i < elements.length; i++) {
208	var el = elements[i];
209	var content = el.textContent;
210	var new_el = document.createElement("span");
211	new_el.setAttribute("class", "odoc-katex-math-rendered");
212	var display = el.classList.contains("display");
213	katex.render(content, new_el, { throwOnError: false, displayMode: display, macros });
214	el.replaceWith(new_el);
215	}
216	});
217	\|});
218	]
219	else []	982✔
220	in
221	default_meta_elements ~config ~url @ highlightjs_meta @ katex_meta
222	in
223	let meta_elements = meta_elements @ search_scripts in
224	Html.head (Html.title (Html.txt title_string)) meta_elements	986✔
225	in
226	let search_bar =
227	match search_uris with
228	\| [] -> []	967✔
229	\| _ ->	19✔
230	[ Html.div ~a:[ Html.a_class [ "odoc-search" ] ] [ html_of_search () ] ]	19✔
231	in
232
233	let body =
234	html_of_breadcrumbs breadcrumbs	986✔
235	@ search_bar
236	@ [ Html.header ~a:[ Html.a_class [ "odoc-preamble" ] ] header ]	986✔
237	@ sidebars ~global_toc ~local_toc
238	@ [ Html.div ~a:[ Html.a_class [ "odoc-content" ] ] content ]	986✔
239	in
240
241	let htmlpp = Html.pp ~indent:(Config.indent config) () in	986✔
242	let html = Html.html head (Html.body ~a:[ Html.a_class [ "odoc" ] ] body) in	986✔
243	let content ppf =	986✔
244	htmlpp ppf html;	604✔
245	(* Tyxml's pp doesn't output a newline a the end, so we force one *)
246	Format.pp_force_newline ppf ()	604✔
247	in
248	content
249
250	let make ~config ~url ~header ~breadcrumbs ~sidebar ~toc ~uses_katex content
251	children =
252	let filename = Link.Path.as_filename ~config url in	986✔
253	let content =	986✔
254	page_creator ~config ~url ~uses_katex ~global_toc:sidebar header breadcrumbs
255	toc content
256	in
257	{ Odoc_document.Renderer.filename; content; children; path = url }	986✔
258
259	let path_of_module_of_source ppf url =
260	match url.Url.Path.parent with	23✔
261	\| Some parent ->	23✔
262	let path = Link.Path.for_printing parent in
263	Format.fprintf ppf " (%s)" (String.concat ~sep:"." path)	23✔
264	\| None -> ()	×
265
266	let src_page_creator ~breadcrumbs ~config ~url ~header ~sidebar name content =
267	let head : Html_types.head Html.elt =	23✔
268	let title_string =
269	Format.asprintf "Source: %s%a" name path_of_module_of_source url
270	in
271	let meta_elements = default_meta_elements ~config ~url in	23✔
272	Html.head (Html.title (Html.txt title_string)) meta_elements	23✔
273	in
274	let body =
275	html_of_breadcrumbs breadcrumbs	23✔
276	@ [ Html.header ~a:[ Html.a_class [ "odoc-preamble" ] ] header ]	23✔
277	@ sidebars ~global_toc:sidebar ~local_toc:[]
278	@ content
279	in
280	(* We never indent as there is a bug in tyxml and it would break lines inside
281	a [pre] *)
282	let htmlpp = Html.pp ~indent:false () in
283	let html =	23✔
284	Html.html head (Html.body ~a:[ Html.a_class [ "odoc-src" ] ] body)	23✔
285	in
286	let content ppf =	23✔
287	htmlpp ppf html;	21✔
288	(* Tyxml's pp doesn't output a newline a the end, so we force one *)
289	Format.pp_force_newline ppf ()	21✔
290	in
291	content
292
293	let make_src ~config ~url ~breadcrumbs ~header ~sidebar title content =
294	let filename = Link.Path.as_filename ~config url in	23✔
295	let content =	23✔
296	src_page_creator ~breadcrumbs ~config ~url ~header ~sidebar title content
297	in
298	{ Odoc_document.Renderer.filename; content; children = []; path = url }	23✔

ocaml / odoc / 3034

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