2108

Committed 03 Jul 2024 07:23AM UTC coverage: 71.946% (+0.2%) from 71.774%

Build # 2108

Build Type

Pull #1145

github

Committed by

web-flow

Commit Message

Merge 0b753d1e4 into 7e1e6ac92

Pull Request Pull Request #1145: "Global" Sidebar

Run Details

197 of 230 new or added lines in 12 files covered. (85.65%)

627 existing lines in 13 files now uncovered.

9835 of 13670 relevant lines covered (71.95%)

3555.77 hits per line

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

73.08

/src/odoc/rendering.ml

open Odoc_document
open Or_error
open Odoc_model

module Source = struct
  type t = File of Fpath.t | Root of Fpath.t

  let pp fmt = function
    | File f -> Format.fprintf fmt "File: %a" Fpath.pp f
    | Root f -> Format.fprintf fmt "File: %a" Fpath.pp f

  let to_string f = Format.asprintf "%a" pp f
end

type source = Source.t

let check_empty_source_arg source filename =
  if source <> None then
    Error.raise_warning
    @@ Error.filename_only
         "--source and --source-root only have an effect when generating from \
          an implementation"
         filename

let documents_of_unit ~warnings_options ~syntax ~source ~renderer ~extra
    ~filename ?sidebar unit =
  Error.catch_warnings (fun () ->
      check_empty_source_arg source filename;
      renderer.Renderer.extra_documents extra (CU unit))
  |> Error.handle_warnings ~warnings_options
  >>= fun extra_docs ->
  Ok (Renderer.document_of_compilation_unit ?sidebar ~syntax unit :: extra_docs)

let documents_of_page ~warnings_options ~syntax ~source ~renderer ~extra
    ~filename ?sidebar page =
  Error.catch_warnings (fun () ->
      check_empty_source_arg source filename;
      renderer.Renderer.extra_documents extra (Page page))
  |> Error.handle_warnings ~warnings_options
  >>= fun extra_docs ->
  Ok (Renderer.document_of_page ~syntax ?sidebar page :: extra_docs)

let documents_of_implementation ~warnings_options:_ ~syntax impl source =
  match (source, impl.Lang.Implementation.id) with
  | Some source, Some source_id -> (
      let source_file =
        match source with
        | Source.File f -> f
        | Root f ->
            let open Paths.Identifier in
            let rec get_path_dir : SourceDir.t -> Fpath.t = function
              | { iv = `SourceDir (d, f); _ } -> Fpath.(get_path_dir d / f)
              | { iv = `Page _; _ } -> f
            in
            let get_path : SourcePage.t -> Fpath.t = function
              | { iv = `SourcePage (d, f); _ } -> Fpath.(get_path_dir d / f)
            in
            get_path source_id
      in
      match Fs.File.read source_file with
      | Error (`Msg msg) ->
          Error (`Msg (Format.sprintf "Couldn't load source file: %s" msg))
      | Ok source_code ->
          let syntax_info =
            Syntax_highlighter.syntax_highlighting_locs source_code
          in
          let rendered =
            Odoc_document.Renderer.documents_of_implementation ~syntax impl
              syntax_info source_code
          in
          Ok rendered)
  | _, None ->
      Error (`Msg "The implementation unit was not compiled with --source-id.")
  | None, _ ->
      Error
        (`Msg
          "--source or --source-root should be passed when generating \
           documents for an implementation.")

let documents_of_source_tree ~warnings_options ~syntax ~source ~filename srctree
    =
  Error.catch_warnings (fun () -> check_empty_source_arg source filename)
  |> Error.handle_warnings ~warnings_options
  >>= fun () -> Ok (Renderer.documents_of_source_tree ~syntax srctree)

let documents_of_odocl ~warnings_options ~renderer ~extra ~source ~syntax
    ?sidebar input =
  Odoc_file.load input >>= fun unit ->
  let filename = Fpath.to_string input in
  match unit.content with
  | Odoc_file.Page_content odoctree ->
      documents_of_page ~warnings_options ~syntax ~source ~renderer ~extra
        ~filename ?sidebar odoctree
  | Source_tree_content srctree ->
      documents_of_source_tree ~warnings_options ~syntax ~source ~filename
        srctree
  | Impl_content impl ->
      documents_of_implementation ~warnings_options ~syntax (* ?sidebar *) impl
        source
  | Unit_content odoctree ->
      documents_of_unit ~warnings_options ~source ~syntax ~renderer ~extra
        ~filename ?sidebar odoctree

let documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax
    input =
  let output = Fs.File.(set_ext ".odocl" input) in
  Odoc_link.from_odoc ~resolver ~warnings_options input output >>= function
  | `Source_tree st -> Ok (Renderer.documents_of_source_tree ~syntax st)
  | `Page page -> Ok [ Renderer.document_of_page ~syntax page ]
  | `Impl impl -> Ok (Renderer.documents_of_implementation ~syntax impl [] "")
  | `Module m ->
      documents_of_unit ~warnings_options ~source:None ~filename:"" ~syntax
        ~renderer ~extra m

let render_document renderer ~output:root_dir ~extra_suffix ~extra doc =
  let pages = renderer.Renderer.render extra doc in
  Renderer.traverse pages ~f:(fun filename content ->
      let filename =
        match extra_suffix with
        | Some s -> Fpath.add_ext s filename
        | None -> filename
      in
      let filename = Fpath.normalize @@ Fs.File.append root_dir filename in
      let directory = Fs.File.dirname filename in
      Fs.Directory.mkdir_p directory;
      let oc = open_out (Fs.File.to_string filename) in
      let fmt = Format.formatter_of_out_channel oc in
      Format.fprintf fmt "%t@?" content;
      close_out oc)

let render_odoc ~resolver ~warnings_options ~syntax ~renderer ~output extra file
    =
  let extra_suffix = None in
  documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax file
  >>= fun docs ->
  List.iter (render_document renderer ~output ~extra_suffix ~extra) docs;
  Ok ()

let generate_odoc ~syntax ~warnings_options ~renderer ~output ~extra_suffix
    ~source ~sidebar extra file =
  let sidebar =
    match sidebar with None -> None | Some x -> Some (Sidebar.read x)
  in
  documents_of_odocl ~warnings_options ~renderer ~source ~extra ~syntax ?sidebar
    file
  >>= fun docs ->
  List.iter (render_document renderer ~output ~extra_suffix ~extra) docs;
  Ok ()

let targets_odoc ~resolver ~warnings_options ~syntax ~renderer ~output:root_dir
    ~extra ~source odoctree =
  let docs =
    if Fpath.get_ext odoctree = ".odoc" then
      documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax
        odoctree
    else
      documents_of_odocl ~warnings_options ~renderer ~extra ~syntax ~source
        odoctree
  in
  docs >>= fun docs ->
  List.iter
    (fun doc ->
      let pages = renderer.Renderer.render extra doc in
      Renderer.traverse pages ~f:(fun filename _content ->
          let filename = Fpath.normalize @@ Fs.File.append root_dir filename in
          Format.printf "%a\n" Fpath.pp filename))
    docs;
  Ok ()

1	open Odoc_document
2	open Or_error
3	open Odoc_model
4
5	module Source = struct
6	type t = File of Fpath.t \| Root of Fpath.t
7
8	let pp fmt = function
9	\| File f -> Format.fprintf fmt "File: %a" Fpath.pp f	×
10	\| Root f -> Format.fprintf fmt "File: %a" Fpath.pp f	×
11
12	let to_string f = Format.asprintf "%a" pp f	×
13	end
14
15	type source = Source.t
16
17	let check_empty_source_arg source filename =
18	if source <> None then	324✔
19	Error.raise_warning	×
20	@@ Error.filename_only	×
21	"--source and --source-root only have an effect when generating from \
22	an implementation"
23	filename
24
25	let documents_of_unit ~warnings_options ~syntax ~source ~renderer ~extra
26	~filename ?sidebar unit =
27	Error.catch_warnings (fun () ->	278✔
28	check_empty_source_arg source filename;	278✔
29	renderer.Renderer.extra_documents extra (CU unit))	278✔
30	\|> Error.handle_warnings ~warnings_options	278✔
31	>>= fun extra_docs ->
32	Ok (Renderer.document_of_compilation_unit ?sidebar ~syntax unit :: extra_docs)	278✔
33
34	let documents_of_page ~warnings_options ~syntax ~source ~renderer ~extra
35	~filename ?sidebar page =
36	Error.catch_warnings (fun () ->	46✔
37	check_empty_source_arg source filename;	46✔
38	renderer.Renderer.extra_documents extra (Page page))	46✔
39	\|> Error.handle_warnings ~warnings_options	46✔
40	>>= fun extra_docs ->
41	Ok (Renderer.document_of_page ~syntax ?sidebar page :: extra_docs)	46✔
42
43	let documents_of_implementation ~warnings_options:_ ~syntax impl source =
44	match (source, impl.Lang.Implementation.id) with	27✔
45	\| Some source, Some source_id -> (	26✔
46	let source_file =
47	match source with
48	\| Source.File f -> f	26✔
UNCOV 49	\| Root f ->	×
50	let open Paths.Identifier in
51	let rec get_path_dir : SourceDir.t -> Fpath.t = function
52	\| { iv = `SourceDir (d, f); _ } -> Fpath.(get_path_dir d / f)	×
UNCOV 53	\| { iv = `Page _; _ } -> f	×
54	in
55	let get_path : SourcePage.t -> Fpath.t = function
UNCOV 56	\| { iv = `SourcePage (d, f); _ } -> Fpath.(get_path_dir d / f)	×
57	in
UNCOV 58	get_path source_id	×
59	in
60	match Fs.File.read source_file with
61	\| Error (`Msg msg) ->	×
UNCOV 62	Error (`Msg (Format.sprintf "Couldn't load source file: %s" msg))	×
63	\| Ok source_code ->	26✔
64	let syntax_info =
65	Syntax_highlighter.syntax_highlighting_locs source_code
66	in
67	let rendered =	26✔
68	Odoc_document.Renderer.documents_of_implementation ~syntax impl
69	syntax_info source_code
70	in
71	Ok rendered)	26✔
72	\| _, None ->	1✔
73	Error (`Msg "The implementation unit was not compiled with --source-id.")
UNCOV 74	\| None, _ ->	×
75	Error
76	(`Msg
77	"--source or --source-root should be passed when generating \
78	documents for an implementation.")
79
80	let documents_of_source_tree ~warnings_options ~syntax ~source ~filename srctree
81	=
82	Error.catch_warnings (fun () -> check_empty_source_arg source filename)	×
83	\|> Error.handle_warnings ~warnings_options	×
UNCOV 84	>>= fun () -> Ok (Renderer.documents_of_source_tree ~syntax srctree)	×
85
86	let documents_of_odocl ~warnings_options ~renderer ~extra ~source ~syntax
87	?sidebar input =
88	Odoc_file.load input >>= fun unit ->	349✔
89	let filename = Fpath.to_string input in	349✔
90	match unit.content with	349✔
91	\| Odoc_file.Page_content odoctree ->	46✔
92	documents_of_page ~warnings_options ~syntax ~source ~renderer ~extra
93	~filename ?sidebar odoctree
UNCOV 94	\| Source_tree_content srctree ->	×
95	documents_of_source_tree ~warnings_options ~syntax ~source ~filename
96	srctree
97	\| Impl_content impl ->	27✔
98	documents_of_implementation ~warnings_options ~syntax (* ?sidebar *) impl
99	source
100	\| Unit_content odoctree ->	276✔
101	documents_of_unit ~warnings_options ~source ~syntax ~renderer ~extra
102	~filename ?sidebar odoctree
103
104	let documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax
105	input =
106	let output = Fs.File.(set_ext ".odocl" input) in	2✔
107	Odoc_link.from_odoc ~resolver ~warnings_options input output >>= function	2✔
108	\| `Source_tree st -> Ok (Renderer.documents_of_source_tree ~syntax st)	×
UNCOV 109	\| `Page page -> Ok [ Renderer.document_of_page ~syntax page ]	×
UNCOV 110	\| `Impl impl -> Ok (Renderer.documents_of_implementation ~syntax impl [] "")	×
111	\| `Module m ->	2✔
112	documents_of_unit ~warnings_options ~source:None ~filename:"" ~syntax
113	~renderer ~extra m
114
115	let render_document renderer ~output:root_dir ~extra_suffix ~extra doc =
116	let pages = renderer.Renderer.render extra doc in	236✔
117	Renderer.traverse pages ~f:(fun filename content ->	236✔
118	let filename =	882✔
119	match extra_suffix with
120	\| Some s -> Fpath.add_ext s filename	635✔
121	\| None -> filename	247✔
122	in
123	let filename = Fpath.normalize @@ Fs.File.append root_dir filename in	882✔
124	let directory = Fs.File.dirname filename in	882✔
125	Fs.Directory.mkdir_p directory;	882✔
126	let oc = open_out (Fs.File.to_string filename) in	882✔
127	let fmt = Format.formatter_of_out_channel oc in	882✔
128	Format.fprintf fmt "%t@?" content;	882✔
129	close_out oc)	882✔
130
131	let render_odoc ~resolver ~warnings_options ~syntax ~renderer ~output extra file
132	=
133	let extra_suffix = None in	2✔
134	documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax file	2✔
135	>>= fun docs ->
136	List.iter (render_document renderer ~output ~extra_suffix ~extra) docs;	2✔
137	Ok ()	2✔
138
139	let generate_odoc ~syntax ~warnings_options ~renderer ~output ~extra_suffix
140	~source ~sidebar extra file =
141	let sidebar =	234✔
142	match sidebar with None -> None \| Some x -> Some (Sidebar.read x)	5✔
143	in
144	documents_of_odocl ~warnings_options ~renderer ~source ~extra ~syntax ?sidebar	234✔
145	file
146	>>= fun docs ->
147	List.iter (render_document renderer ~output ~extra_suffix ~extra) docs;	233✔
148	Ok ()	233✔
149
150	let targets_odoc ~resolver ~warnings_options ~syntax ~renderer ~output:root_dir
151	~extra ~source odoctree =
152	let docs =	115✔
153	if Fpath.get_ext odoctree = ".odoc" then	115✔
154	documents_of_input ~renderer ~extra ~resolver ~warnings_options ~syntax	×
155	odoctree
156	else
157	documents_of_odocl ~warnings_options ~renderer ~extra ~syntax ~source	115✔
158	odoctree
159	in
160	docs >>= fun docs ->
161	List.iter	115✔
162	(fun doc ->
163	let pages = renderer.Renderer.render extra doc in	116✔
164	Renderer.traverse pages ~f:(fun filename _content ->	116✔
165	let filename = Fpath.normalize @@ Fs.File.append root_dir filename in	661✔
166	Format.printf "%a\n" Fpath.pp filename))	661✔
167	docs;
168	Ok ()	115✔

ocaml / odoc / 2108

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