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.36

/src/html/link.ml

module Url = Odoc_document.Url

type link = Relative of string list * string | Absolute of string

(* Translation from Url.Path *)
module Path = struct
  let for_printing url = List.map snd @@ Url.Path.to_list url

  let segment_to_string (kind, name) =
    Format.asprintf "%a%s" Url.Path.pp_disambiguating_prefix kind name

  let is_leaf_page url = url.Url.Path.kind = `LeafPage

  let remap config f =
    let l = String.concat "/" f in
    try
      let prefix, replacement =
        List.find
          (fun (prefix, _replacement) ->
            Astring.String.is_prefix ~affix:prefix l)
          (Config.remap config)
      in
      let len = String.length prefix in
      let l = String.sub l len (String.length l - len) in
      Some (replacement ^ l)
    with Not_found -> None

  let get_dir_and_file ~config url =
    let l = Url.Path.to_list url in
    let is_dir =
      if Config.flat config then function `Page -> `Always | _ -> `Never
      else function `LeafPage | `File | `SourcePage -> `Never | _ -> `Always
    in
    let dir, file = Url.Path.split ~is_dir l in
    let dir = List.map segment_to_string dir in
    let file =
      match file with
      | [] -> "index.html"
      | [ (`LeafPage, name) ] -> name ^ ".html"
      | [ (`File, name) ] -> name
      | [ (`SourcePage, name) ] -> name ^ ".html"
      | xs ->
          assert (Config.flat config);
          String.concat "-" (List.map segment_to_string xs) ^ ".html"
    in
    (dir, file)

  let for_linking ~config url =
    let dir, file = get_dir_and_file ~config url in
    match remap config dir with
    | None -> Relative (dir, file)
    | Some x -> Absolute (x ^ "/" ^ file)

  let as_filename ~config (url : Url.Path.t) =
    let dir, file = get_dir_and_file ~config url in
    Fpath.(v @@ String.concat Fpath.dir_sep (dir @ [ file ]))
end

type resolve = Current of Url.Path.t | Base of string

let rec drop_shared_prefix l1 l2 =
  match (l1, l2) with
  | l1 :: l1s, l2 :: l2s when l1 = l2 -> drop_shared_prefix l1s l2s
  | _, _ -> (l1, l2)

let href ~config ~resolve t =
  let { Url.Anchor.page; anchor; _ } = t in
  let add_anchor y = match anchor with "" -> y | anchor -> y ^ "#" ^ anchor in
  let target_loc = Path.for_linking ~config page in

  match target_loc with
  | Absolute y -> add_anchor y
  | Relative (dir, file) -> (
      let target_loc = dir @ [ file ] in
      (* If xref_base_uri is defined, do not perform relative URI resolution. *)
      match resolve with
      | Base xref_base_uri ->
          let page = xref_base_uri ^ String.concat "/" target_loc in
          add_anchor page
      | Current path -> (
          let current_loc =
            let dir, file = Path.get_dir_and_file ~config path in
            dir @ [ file ]
          in

          let current_from_common_ancestor, target_from_common_ancestor =
            drop_shared_prefix current_loc target_loc
          in

          let relative_target =
            match current_from_common_ancestor with
            | [] ->
                (* We're already on the right page *)
                (* If we're already on the right page, the target from our common
                    ancestor can't be anything other than the empty list *)
                assert (target_from_common_ancestor = []);
                []
            | [ _ ] ->
                (* We're already in the right dir *)
                target_from_common_ancestor
            | l ->
                (* We need to go up some dirs *)
                List.map (fun _ -> "..") (List.tl l)
                @ target_from_common_ancestor
          in
          let remove_index_html l =
            match List.rev l with
            | "index.html" :: rest -> List.rev ("" :: rest)
            | _ -> l
          in
          let relative_target =
            if Config.semantic_uris config then
              remove_index_html relative_target
            else relative_target
          in
          match (relative_target, anchor) with
          | [], "" -> "#"
          | page, _ -> add_anchor @@ String.concat "/" page))

1	module Url = Odoc_document.Url
2
3	type link = Relative of string list * string \| Absolute of string
4
5	(* Translation from Url.Path *)
6	module Path = struct
7	let for_printing url = List.map snd @@ Url.Path.to_list url	997✔
8
9	let segment_to_string (kind, name) =
10	Format.asprintf "%a%s" Url.Path.pp_disambiguating_prefix kind name	30,453✔
11
UNCOV 12	let is_leaf_page url = url.Url.Path.kind = `LeafPage	×
13
14	let remap config f =
15	let l = String.concat "/" f in	7,247✔
16	try	7,247✔
17	let prefix, replacement =
18	List.find
19	(fun (prefix, _replacement) ->
20	Astring.String.is_prefix ~affix:prefix l)	13✔
21	(Config.remap config)	7,247✔
22	in
23	let len = String.length prefix in	3✔
24	let l = String.sub l len (String.length l - len) in	3✔
25	Some (replacement ^ l)	3✔
26	with Not_found -> None	7,244✔
27
28	let get_dir_and_file ~config url =
29	let l = Url.Path.to_list url in	15,428✔
30	let is_dir =	15,428✔
UNCOV 31	if Config.flat config then function `Page -> `Always \| _ -> `Never	×
32	else function `LeafPage \| `File \| `SourcePage -> `Never \| _ -> `Always	522✔
33	in
34	let dir, file = Url.Path.split ~is_dir l in
35	let dir = List.map segment_to_string dir in	15,428✔
36	let file =	15,428✔
37	match file with
38	\| [] -> "index.html"	2,400✔
39	\| [ (`LeafPage, name) ] -> name ^ ".html"	287✔
40	\| [ (`File, name) ] -> name	2,021✔
41	\| [ (`SourcePage, name) ] -> name ^ ".html"	285✔
42	\| xs ->	10,435✔
43	assert (Config.flat config);	10,435✔
44	String.concat "-" (List.map segment_to_string xs) ^ ".html"	10,435✔
45	in
46	(dir, file)
47
48	let for_linking ~config url =
49	let dir, file = get_dir_and_file ~config url in	7,247✔
50	match remap config dir with	7,247✔
51	\| None -> Relative (dir, file)	7,244✔
52	\| Some x -> Absolute (x ^ "/" ^ file)	3✔
53
54	let as_filename ~config (url : Url.Path.t) =
55	let dir, file = get_dir_and_file ~config url in	1,018✔
56	Fpath.(v @@ String.concat Fpath.dir_sep (dir @ [ file ]))	1,018✔
57	end
58
59	type resolve = Current of Url.Path.t \| Base of string
60
61	let rec drop_shared_prefix l1 l2 =
62	match (l1, l2) with	10,431✔
63	\| l1 :: l1s, l2 :: l2s when l1 = l2 -> drop_shared_prefix l1s l2s	3,268✔
64	\| _, _ -> (l1, l2)	7,163✔
65
66	let href ~config ~resolve t =
67	let { Url.Anchor.page; anchor; _ } = t in	7,247✔
68	let add_anchor y = match anchor with "" -> y \| anchor -> y ^ "#" ^ anchor in	1,169✔
69	let target_loc = Path.for_linking ~config page in
70
71	match target_loc with	7,247✔
72	\| Absolute y -> add_anchor y	3✔
73	\| Relative (dir, file) -> (	7,244✔
74	let target_loc = dir @ [ file ] in
75	(* If xref_base_uri is defined, do not perform relative URI resolution. *)
76	match resolve with
77	\| Base xref_base_uri ->	81✔
78	let page = xref_base_uri ^ String.concat "/" target_loc in	81✔
79	add_anchor page
80	\| Current path -> (	7,163✔
81	let current_loc =
82	let dir, file = Path.get_dir_and_file ~config path in
83	dir @ [ file ]	7,163✔
84	in
85
86	let current_from_common_ancestor, target_from_common_ancestor =
87	drop_shared_prefix current_loc target_loc
88	in
89
90	let relative_target =	7,163✔
91	match current_from_common_ancestor with
92	\| [] ->	1,727✔
93	(* We're already on the right page *)
94	(* If we're already on the right page, the target from our common
95	ancestor can't be anything other than the empty list *)
96	assert (target_from_common_ancestor = []);	1,727✔
97	[]
98	\| [ _ ] ->	4,527✔
99	(* We're already in the right dir *)
100	target_from_common_ancestor
101	\| l ->	909✔
102	(* We need to go up some dirs *)
103	List.map (fun _ -> "..") (List.tl l)	909✔
104	@ target_from_common_ancestor
105	in
106	let remove_index_html l =
107	match List.rev l with	5✔
108	\| "index.html" :: rest -> List.rev ("" :: rest)	2✔
109	\| _ -> l	3✔
110	in
111	let relative_target =
112	if Config.semantic_uris config then
113	remove_index_html relative_target	5✔
114	else relative_target	7,158✔
115	in
116	match (relative_target, anchor) with
117	\| [], "" -> "#"	1,038✔
118	\| page, _ -> add_anchor @@ String.concat "/" page))	6,125✔

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