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
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
open Odoc_document
open Or_error
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
Odoc_model.Error.raise_warning
@@ Odoc_model.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 ~
~filename unit =
Odoc_model.Error.catch_warnings (fun () ->
check_empty_source_arg source filename;
renderer.Renderer.extra_documents extra (CU unit))
|> Odoc_model.Error.handle_warnings ~warnings_options
>>= fun ->
Ok (Renderer.document_of_compilation_unit ~syntax unit :: extra_docs)
let documents_of_page ~warnings_options ~syntax ~source ~renderer ~
~filename page =
Odoc_model.Error.catch_warnings (fun () ->
check_empty_source_arg source filename;
renderer.Renderer.extra_documents extra (Page page))
|> Odoc_model.Error.handle_warnings ~warnings_options
>>= fun -> Ok (Renderer.document_of_page ~syntax page :: extra_docs)
let documents_of_implementation ~warnings_options:_ ~syntax impl source =
match source with
| Some source -> (
let source_file =
match source 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 impl.Odoc_model.Lang.Implementation.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
Ok
[
Odoc_document.Renderer.documents_of_implementation ~syntax impl
syntax_info source_code;
])
| 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
=
Odoc_model.Error.catch_warnings (fun () ->
check_empty_source_arg source filename)
|> Odoc_model.Error.handle_warnings ~warnings_options
>>= fun () -> Ok (Renderer.documents_of_source_tree ~syntax srctree)
let documents_of_odocl ~warnings_options ~renderer ~ ~source ~syntax 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 odoctree
| Source_tree_content srctree ->
documents_of_source_tree ~warnings_options ~syntax ~source ~filename
srctree
| Impl_content impl ->
documents_of_implementation ~warnings_options ~syntax impl source
| Unit_content odoctree ->
documents_of_unit ~warnings_options ~source ~syntax ~renderer ~extra
~filename odoctree
let documents_of_input ~renderer ~ ~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 ~ ~ 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 file
=
let = 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 ~
~source file =
documents_of_odocl ~warnings_options ~renderer ~source ~extra ~syntax 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
~ ~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 ()