1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
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
type args = {
html_config : Odoc_html.Config.t;
source : source option;
assets : Fpath.t list;
}
let render { html_config; source = _; assets = _ } page =
Odoc_html.Generator.render ~config:html_config page
let source_documents source_info source ~syntax =
match (source_info, source) with
| Some { Lang.Source_info.id; infos }, Some src -> (
let file =
match src with
| Source.File f -> f
| Root f ->
let open Odoc_model.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 id
in
match Fs.File.read file with
| Error (`Msg msg) ->
Error.raise_warning
(Error.filename_only "Couldn't load source file: %s" msg
(Fs.File.to_string file));
[]
| Ok source_code ->
let syntax_info =
Syntax_highlighter.syntax_highlighting_locs source_code
in
[
Odoc_document.Renderer.document_of_source ~syntax id syntax_info
infos source_code;
])
| Some { id; _ }, None ->
let filename = Paths.Identifier.name id in
Error.raise_warning
(Error.filename_only
"The --source should be passed when generating documents from \
compilation units that were compiled with --source-parent and \
--source-name"
filename);
[]
| None, Some src ->
Error.raise_warning
(Error.filename_only
"--source argument is invalid on compilation unit that were not \
compiled with --source-parent and --source-name"
(Source.to_string src));
[]
| None, None -> []
let list_filter_map f lst =
List.rev
@@ List.fold_left
(fun acc x -> match f x with None -> acc | Some x -> x :: acc)
[] lst
let asset_documents parent_id children asset_paths =
let asset_names =
list_filter_map
(function Lang.Page.Asset_child name -> Some name | _ -> None)
children
in
let rec paths name =
match paths with
| [] -> (paths, (name, None))
| x :: xs when Fpath.basename x = name -> (xs, (name, Some x))
| x :: xs ->
let rest, elt = extract xs name in
(x :: rest, elt)
in
let unmatched, paired_or_missing =
let rec foldmap paths paired = function
| [] -> (paths, paired)
| name :: names ->
let paths, pair = extract paths name in
foldmap paths (pair :: paired) names
in
foldmap asset_paths [] asset_names
in
List.iter
(fun asset ->
Error.raise_warning
(Error.filename_only "this asset was not declared as a child of %s"
(Paths.Identifier.name parent_id)
(Fs.File.to_string asset)))
unmatched;
list_filter_map
(fun (name, path) ->
match path with
| None ->
Error.raise_warning (Error.filename_only "asset is missing." name);
None
| Some path ->
let asset_id = Paths.Identifier.Mk.asset_file (parent_id, name) in
let url = Odoc_document.Url.Path.from_identifier asset_id in
Some (Odoc_document.Types.Document.Asset { url; src = path }))
paired_or_missing
let args input ~syntax =
match input with
| Odoc_document.Renderer.CU unit ->
source_documents unit.Lang.Compilation_unit.source_info args.source
~syntax
| Page page -> asset_documents page.Lang.Page.name page.children args.assets
let renderer = { Odoc_document.Renderer.name = "html"; render; extra_documents }