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
open Odoc_utils
open Odoc_document
open Or_error
open Odoc_model
let prepare ~ ~output_dir filename =
let filename =
match extra_suffix with
| Some s -> Fpath.add_ext s filename
| None -> filename
in
let filename = Fpath.normalize @@ Fs.File.append output_dir filename in
let directory = Fs.File.dirname filename in
Fs.Directory.mkdir_p directory;
filename
let document_of_odocl ~syntax input =
Odoc_file.load input >>= fun unit ->
match unit.content with
| Odoc_file.Page_content odoctree ->
Ok (Renderer.document_of_page ~syntax odoctree)
| Unit_content odoctree ->
Ok (Renderer.document_of_compilation_unit ~syntax odoctree)
| Impl_content _ ->
Error
(`Msg
"Wrong kind of unit: Expected a page or module unit, got an \
implementation. Use the dedicated command for implementation.")
| Asset_content _ ->
Error
(`Msg
"Wrong kind of unit: Expected a page or module unit, got an asset \
unit. Use the dedicated command for assets.")
let document_of_input ~resolver ~warnings_options ~syntax input =
let output = Fs.File.(set_ext ".odocl" input) in
Odoc_link.from_odoc ~resolver ~warnings_options ~warnings_tags:[] input output
>>= function
| `Page page -> Ok (Renderer.document_of_page ~syntax page)
| `Module m -> Ok (Renderer.document_of_compilation_unit ~syntax m)
| `Impl _ ->
Error
(`Msg
"Wrong kind of unit: Expected a page or module unit, got an \
implementation. Use the dedicated command for implementation.")
| `Asset _ ->
Error
(`Msg
"Wrong kind of unit: Expected a page or module unit, got an asset \
unit. Use the dedicated command for assets.")
let render_document renderer ~ ~output:root_dir ~ ~ doc
=
let pages = renderer.Renderer.render extra sidebar doc in
Renderer.traverse pages ~f:(fun filename content ->
let filename = prepare ~extra_suffix ~output_dir:root_dir filename in
Io_utils.with_formatter_out (Fs.File.to_string filename) @@ fun fmt ->
Format.fprintf fmt "%t@?" content)
let render_odoc ~resolver ~warnings_options ~syntax ~renderer ~output file
=
let = None in
document_of_input ~resolver ~warnings_options ~syntax file >>= fun doc ->
render_document renderer ~sidebar:None ~output ~extra_suffix ~extra doc;
Ok ()
let generate_odoc ~syntax ~warnings_options:_ ~renderer ~output ~
~ file =
(match sidebar with
| None -> Ok None
| Some x -> Odoc_file.load_sidebar x >>= fun -> Ok (Some sidebar))
>>= fun ->
document_of_odocl ~syntax file >>= fun doc ->
render_document renderer ~output ~sidebar ~extra_suffix ~extra doc;
Ok ()
let documents_of_implementation ~warnings_options:_ ~syntax impl source_file =
match impl.Lang.Implementation.id with
| Some _ -> (
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.")
let generate_source_odoc ~syntax ~warnings_options ~renderer ~output
~source_file ~ ~ file =
Odoc_file.load file >>= fun unit ->
(match sidebar with
| None -> Ok None
| Some x -> Odoc_file.load_sidebar x >>= fun -> Ok (Some sidebar))
>>= fun ->
match unit.content with
| Odoc_file.Impl_content impl ->
documents_of_implementation ~warnings_options ~syntax impl source_file
>>= fun docs ->
List.iter
(render_document renderer ~output ~sidebar ~extra_suffix ~extra)
docs;
Ok ()
| Page_content _ | Unit_content _ | Asset_content _ ->
Error (`Msg "Expected an implementation unit")
let generate_asset_odoc ~warnings_options:_ ~renderer ~output ~asset_file
~ file =
Odoc_file.load file >>= fun unit ->
match unit.content with
| Odoc_file.Asset_content unit ->
let url = Odoc_document.Url.Path.from_identifier unit.name in
let filename = renderer.Renderer.filepath extra url in
let dst = prepare ~extra_suffix ~output_dir:output filename in
Fs.File.copy ~src:asset_file ~dst
| Page_content _ | Unit_content _ | Impl_content _ ->
Error (`Msg "Expected an asset unit")
let targets_odoc ~resolver ~warnings_options ~syntax ~renderer ~output:root_dir
~ odoctree =
let doc =
if Fpath.get_ext odoctree = ".odoc" then
document_of_input ~resolver ~warnings_options ~syntax odoctree
else document_of_odocl ~syntax odoctree
in
doc >>= fun doc ->
let pages = renderer.Renderer.render extra None 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);
Ok ()
let targets_source_odoc ~syntax ~warnings_options ~renderer ~output:root_dir
~ ~source_file odoctree =
Odoc_file.load odoctree >>= fun unit ->
match unit.content with
| Odoc_file.Impl_content impl ->
documents_of_implementation ~warnings_options ~syntax impl source_file
>>= fun docs ->
List.iter
(fun doc ->
let pages = renderer.Renderer.render extra None 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 ()
| Page_content _ | Unit_content _ | Asset_content _ ->
Error (`Msg "Expected an implementation unit")