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

80.9

/src/odoc/indexing.ml

open Odoc_utils
open Astring
open Odoc_json_index
open Or_error
open Odoc_model

module H = Odoc_model.Paths.Identifier.Hashtbl.Any

let handle_file file ~unit ~page ~occ =
  match Fpath.basename file with
  | s when String.is_prefix ~affix:"index-" s ->
      Odoc_file.load_index file >>= fun { index; _ } -> Ok (occ index)
  | _ -> (
      Odoc_file.load file >>= fun unit' ->
      match unit' with
      | { Odoc_file.content = Unit_content unit'; _ } when unit'.hidden ->
          Error (`Msg "Hidden units are ignored when generating an index")
      | { Odoc_file.content = Unit_content unit'; _ }
      (* when not unit'.hidden *) ->
          Ok (unit unit')
      | { Odoc_file.content = Page_content page'; _ } -> Ok (page page')
      | _ ->
          Error
            (`Msg
              "Only pages and unit are allowed as input when generating an \
               index"))

let parse_input_file input =
  let is_sep = function '\n' | '\r' -> true | _ -> false in
  Fs.File.read input >>= fun content ->
  let files =
    String.fields ~empty:false ~is_sep content |> List.rev_map Fs.File.of_string
  in
  Ok files

let parse_input_files input =
  List.fold_left
    (fun acc file ->
      acc >>= fun acc ->
      parse_input_file file >>= fun files -> Ok (files :: acc))
    (Ok []) input
  >>= fun files -> Ok (List.concat files)

let compile_to_json ~output ~occurrences files =
  let output_channel =
    Fs.Directory.mkdir_p (Fs.File.dirname output);
    open_out_bin (Fs.File.to_string output)
  in
  let output = Format.formatter_of_out_channel output_channel in
  let print f first up =
    if not first then Format.fprintf output ",";
    f output up;
    false
  in
  Format.fprintf output "[";
  let _ : bool =
    List.fold_left
      (fun acc file ->
        match
          handle_file
            ~unit:(print (Json_search.unit ?occurrences) acc)
            ~page:(print Json_search.page acc)
            ~occ:(print Json_search.index acc)
            file
        with
        | Ok acc -> acc
        | Error (`Msg m) ->
            Error.raise_warning ~non_fatal:true
              (Error.filename_only "%s" m (Fs.File.to_string file));
            acc)
      true files
  in
  Format.fprintf output "]";
  Ok ()

let compile_to_marshall ~output sidebar files =
  let final_index = H.create 10 in
  let unit u =
    Odoc_model.Fold.unit
      ~f:(fun () item ->
        let entries = Odoc_search.Entry.entries_of_item item in
        List.iter
          (fun entry -> H.add final_index entry.Odoc_search.Entry.id entry)
          entries)
      () u
  in
  let page p =
    Odoc_model.Fold.page
      ~f:(fun () item ->
        let entries = Odoc_search.Entry.entries_of_item item in
        List.iter
          (fun entry -> H.add final_index entry.Odoc_search.Entry.id entry)
          entries)
      () p
  in
  let index i = H.iter (H.add final_index) i in
  let () =
    List.fold_left
      (fun acc file ->
        match handle_file ~unit ~page ~occ:index file with
        | Ok acc -> acc
        | Error (`Msg m) ->
            Error.raise_warning ~non_fatal:true
              (Error.filename_only "%s" m (Fs.File.to_string file));
            acc)
      () files
  in
  Ok (Odoc_file.save_index output { index = final_index; sidebar })

let read_occurrences file =
  let ic = open_in_bin file in
  let htbl : Odoc_occurrences.Table.t = Marshal.from_channel ic in
  htbl

open Odoc_model.Sidebar

let compile out_format ~output ~warnings_options ~occurrences ~lib_roots
    ~page_roots ~inputs_in_file ~odocls =
  let handle_warnings f =
    let res = Error.catch_warnings f in
    Error.handle_warnings ~warnings_options res |> Result.join
  in
  handle_warnings @@ fun () ->
  let current_dir = Fs.File.dirname output in
  parse_input_files inputs_in_file >>= fun files ->
  let files = List.rev_append odocls files in
  let occurrences =
    match occurrences with
    | None -> None
    | Some occurrences -> Some (read_occurrences (Fpath.to_string occurrences))
  in
  let resolver =
    Resolver.create ~important_digests:false ~directories:[]
      ~roots:
        (Some
           {
             page_roots;
             lib_roots;
             current_lib = None;
             current_package = None;
             current_dir;
           })
      ~open_modules:[]
  in
  (* if files = [] && then Error (`Msg "No .odocl files were included") *)
  (* else *)
  let pages =
    List.map
      (fun (page_root, _) ->
        let pages = Resolver.all_pages ~root:page_root resolver in
        let pages =
          let pages =
            pages
            |> List.filter_map
                 Paths.Identifier.(
                   function
                   | ({ iv = #LeafPage.t_pv; _ } as id), pl, fm ->
                       Some (id, pl, fm)
                   | _ -> None)
            |> List.map (fun (id, title, fm) ->
                   let title =
                     match title with
                     | None ->
                         [
                           Location_.at (Location_.span [])
                             (`Word (Paths.Identifier.name id));
                         ]
                     | Some x -> x
                   in
                   let children_order = fm.Frontmatter.children_order in
                   (id, title, children_order))
          in
          PageToc.of_list pages
        in
        { hierarchy_name = page_root; pages })
      page_roots
  in
  let libraries =
    List.map
      (fun (library, _) ->
        { name = library; units = Resolver.all_units ~library resolver })
      lib_roots
  in
  let includes_rec =
    List.rev_append (List.map snd page_roots) (List.map snd lib_roots)
  in
  let files =
    List.rev_append files
      (includes_rec
      |> List.map (fun include_rec ->
             Fs.Directory.fold_files_rec ~ext:"odocl"
               (fun files file -> file :: files)
               [] include_rec)
      |> List.concat)
  in
  let content = { pages; libraries } in
  match out_format with
  | `JSON -> compile_to_json ~output ~occurrences files
  | `Marshall -> compile_to_marshall ~output content files

1	open Odoc_utils
2	open Astring
3	open Odoc_json_index
4	open Or_error
5	open Odoc_model
6
7	module H = Odoc_model.Paths.Identifier.Hashtbl.Any
8
9	let handle_file file ~unit ~page ~occ =
10	match Fpath.basename file with	25✔
11	\| s when String.is_prefix ~affix:"index-" s ->	25✔
NEW 12	Odoc_file.load_index file >>= fun { index; _ } -> Ok (occ index)	×
13	\| _ -> (	25✔
14	Odoc_file.load file >>= fun unit' ->	25✔
15	match unit' with	24✔
16	\| { Odoc_file.content = Unit_content unit'; _ } when unit'.hidden ->	11✔
17	Error (`Msg "Hidden units are ignored when generating an index")	×
18	\| { Odoc_file.content = Unit_content unit'; _ }	11✔
19	(* when not unit'.hidden *) ->
20	Ok (unit unit')	11✔
21	\| { Odoc_file.content = Page_content page'; _ } -> Ok (page page')	13✔
22	\| _ ->	×
23	Error
24	(`Msg
25	"Only pages and unit are allowed as input when generating an \
26	index"))
27
28	let parse_input_file input =
29	let is_sep = function '\n' \| '\r' -> true \| _ -> false in	×
30	Fs.File.read input >>= fun content ->	×
31	let files =	×
32	String.fields ~empty:false ~is_sep content \|> List.rev_map Fs.File.of_string	×
33	in
34	Ok files	×
35
36	let parse_input_files input =
37	List.fold_left	12✔
38	(fun acc file ->
39	acc >>= fun acc ->	×
40	parse_input_file file >>= fun files -> Ok (files :: acc))	×
41	(Ok []) input
42	>>= fun files -> Ok (List.concat files)	12✔
43
44	let compile_to_json ~output ~occurrences files =
45	let output_channel =	5✔
46	Fs.Directory.mkdir_p (Fs.File.dirname output);	5✔
47	open_out_bin (Fs.File.to_string output)	5✔
48	in
49	let output = Format.formatter_of_out_channel output_channel in
50	let print f first up =	5✔
51	if not first then Format.fprintf output ",";	2✔
52	f output up;	7✔
53	false	7✔
54	in
55	Format.fprintf output "[";
56	let _ : bool =	5✔
57	List.fold_left
58	(fun acc file ->
59	match	7✔
60	handle_file
61	~unit:(print (Json_search.unit ?occurrences) acc)	7✔
62	~page:(print Json_search.page acc)	7✔
63	~occ:(print Json_search.index acc)	7✔
64	file
65	with
66	\| Ok acc -> acc	7✔
67	\| Error (`Msg m) ->	×
68	Error.raise_warning ~non_fatal:true
69	(Error.filename_only "%s" m (Fs.File.to_string file));	×
70	acc)	×
71	true files
72	in
73	Format.fprintf output "]";	5✔
74	Ok ()	5✔
75
76	let compile_to_marshall ~output sidebar files =
77	let final_index = H.create 10 in	7✔
78	let unit u =	7✔
79	Odoc_model.Fold.unit	5✔
80	~f:(fun () item ->
81	let entries = Odoc_search.Entry.entries_of_item item in	52✔
82	List.iter	52✔
83	(fun entry -> H.add final_index entry.Odoc_search.Entry.id entry)	74✔
84	entries)
85	() u
86	in
87	let page p =
88	Odoc_model.Fold.page	12✔
89	~f:(fun () item ->
90	let entries = Odoc_search.Entry.entries_of_item item in	12✔
91	List.iter	12✔
92	(fun entry -> H.add final_index entry.Odoc_search.Entry.id entry)	26✔
93	entries)
94	() p
95	in
96	let index i = H.iter (H.add final_index) i in	×
97	let () =
98	List.fold_left
99	(fun acc file ->
100	match handle_file ~unit ~page ~occ:index file with	18✔
101	\| Ok acc -> acc	17✔
102	\| Error (`Msg m) ->	1✔
103	Error.raise_warning ~non_fatal:true
104	(Error.filename_only "%s" m (Fs.File.to_string file));	1✔
105	acc)	1✔
106	() files
107	in
108	Ok (Odoc_file.save_index output { index = final_index; sidebar })	7✔
109
110	let read_occurrences file =
111	let ic = open_in_bin file in	1✔
112	let htbl : Odoc_occurrences.Table.t = Marshal.from_channel ic in	1✔
113	htbl
114
115	open Odoc_model.Sidebar
116
117	let compile out_format ~output ~warnings_options ~occurrences ~lib_roots
118	~page_roots ~inputs_in_file ~odocls =
119	let handle_warnings f =	12✔
120	let res = Error.catch_warnings f in	12✔
121	Error.handle_warnings ~warnings_options res \|> Result.join	12✔
122	in
123	handle_warnings @@ fun () ->
124	let current_dir = Fs.File.dirname output in	12✔
125	parse_input_files inputs_in_file >>= fun files ->	12✔
126	let files = List.rev_append odocls files in	12✔
127	let occurrences =	12✔
128	match occurrences with
129	\| None -> None	11✔
130	\| Some occurrences -> Some (read_occurrences (Fpath.to_string occurrences))	1✔
131	in
132	let resolver =
133	Resolver.create ~important_digests:false ~directories:[]
134	~roots:
135	(Some
136	{
137	page_roots;
138	lib_roots;
139	current_lib = None;
140	current_package = None;
141	current_dir;
142	})
143	~open_modules:[]
144	in
145	(* if files = [] && then Error (`Msg "No .odocl files were included") *)
146	(* else *)
147	let pages =
148	List.map
149	(fun (page_root, _) ->
150	let pages = Resolver.all_pages ~root:page_root resolver in	9✔
151	let pages =	9✔
152	let pages =
153	pages
154	\|> List.filter_map
155	Paths.Identifier.(
156	function
157	\| ({ iv = #LeafPage.t_pv; _ } as id), pl, fm ->	10✔
158	Some (id, pl, fm)
159	\| _ -> None)	3✔
160	\|> List.map (fun (id, title, fm) ->	9✔
161	let title =	10✔
162	match title with
NEW 163	\| None ->	×
164	[
NEW 165	Location_.at (Location_.span [])	×
NEW 166	(`Word (Paths.Identifier.name id));	×
167	]
168	\| Some x -> x	10✔
169	in
170	let children_order = fm.Frontmatter.children_order in
171	(id, title, children_order))
172	in
173	PageToc.of_list pages	9✔
174	in
175	{ hierarchy_name = page_root; pages })
176	page_roots
177	in
178	let libraries =	12✔
179	List.map
180	(fun (library, _) ->
181	{ name = library; units = Resolver.all_units ~library resolver })	1✔
182	lib_roots
183	in
184	let includes_rec =	12✔
185	List.rev_append (List.map snd page_roots) (List.map snd lib_roots)	12✔
186	in
187	let files =	12✔
188	List.rev_append files
189	(includes_rec
190	\|> List.map (fun include_rec ->
191	Fs.Directory.fold_files_rec ~ext:"odocl"	10✔
192	(fun files file -> file :: files)	23✔
193	[] include_rec)
194	\|> List.concat)	12✔
195	in
196	let content = { pages; libraries } in	12✔
197	match out_format with
198	\| `JSON -> compile_to_json ~output ~occurrences files	5✔
199	\| `Marshall -> compile_to_marshall ~output content files	7✔

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