[OCaml] Mobile-friendly clone of cgit.
refactor extract Doc_format module for generalized documentation rendering
Introduce lib/doc_format.ml with a shared document AST, format interface, and unified renderer. Readme now defines Markdown and Org as format values and delegates to Doc_format.render. Adding a new documentation format (e.g. mld) requires only defining a Doc_format.format value with its parser and inline handler.
Changed files
lib/doc_format.ml
@@ -0,0 +1,176 @@
1
Added:
(** Generalized documentation format rendering.
2
Added:
3
Added:
This module provides a shared document AST and renderer for prose
4
Added:
documentation formats (Markdown, Org, mld). Format-specific parsing is
5
Added:
supplied by the {!format} type; the renderer, TOC generation, and anchor
6
Added:
management are format-independent.
7
Added:
8
Added:
Every text fragment is emitted through {!Ui}, ensuring safe escaping of
9
Added:
repository content. *)
10
Added:
11
Added:
(* {1 Document AST} *)
12
Added:
13
Added:
type inline =
14
Added:
| Text of string
15
Added:
| Code of string
16
Added:
| Verbatim of string
17
Added:
| Link of { href : string; text : string }
18
Added:
19
Added:
type block =
20
Added:
| Heading of int * string
21
Added:
| Paragraph of string
22
Added:
| Unordered_list of string list
23
Added:
| Ordered_list of string list
24
Added:
| Definition_list of (string * string) list
25
Added:
| Code_block of string option * string
26
Added:
27
Added:
type document = {
28
Added:
title : string option;
29
Added:
metadata : (string * string) list;
30
Added:
blocks : block list;
31
Added:
}
32
Added:
33
Added:
(* {1 Format interface} *)
34
Added:
35
Added:
type format = {
36
Added:
name : string;
37
Added:
css_class : string;
38
Added:
parse : string -> document;
39
Added:
inline : string -> Ui.node list;
40
Added:
}
41
Added:
(** A documentation format provides parsing and inline markup rendering. *)
42
Added:
43
Added:
(* {1 Shared utilities} *)
44
Added:
45
Added:
let first_word text =
46
Added:
match
47
Added:
String.split_on_char ' ' text |> List.filter (fun word -> word <> "")
48
Added:
with
49
Added:
| word :: _ -> Some word
50
Added:
| [] -> None
51
Added:
52
Added:
(** A continuation line belongs to the current list item if it is indented
53
Added:
(starts with whitespace) and is not blank. *)
54
Added:
let is_continuation line =
55
Added:
String.length line > 0
56
Added:
&& (line.[0] = ' ' || line.[0] = '\t')
57
Added:
&& String.trim line <> ""
58
Added:
59
Added:
let take_continuations rest =
60
Added:
let rec loop acc = function
61
Added:
| line :: rest when is_continuation line ->
62
Added:
loop (String.trim line :: acc) rest
63
Added:
| remaining -> (List.rev acc, remaining)
64
Added:
in
65
Added:
loop [] rest
66
Added:
67
Added:
let rec take_until close collected = function
68
Added:
| [] -> (List.rev collected, [])
69
Added:
| line :: rest when close line -> (List.rev collected, rest)
70
Added:
| line :: rest -> take_until close (line :: collected) rest
71
Added:
72
Added:
(* {1 Anchor generation} *)
73
Added:
74
Added:
let new_anchor () =
75
Added:
let seen = Hashtbl.create 16 in
76
Added:
fun text ->
77
Added:
let base =
78
Added:
let buffer = Buffer.create (String.length text) in
79
Added:
let pending_separator = ref false in
80
Added:
String.iter
81
Added:
(fun character ->
82
Added:
if
83
Added:
(character >= 'a' && character <= 'z')
84
Added:
|| (character >= 'A' && character <= 'Z')
85
Added:
|| (character >= '0' && character <= '9')
86
Added:
then (
87
Added:
if !pending_separator && Buffer.length buffer > 0 then
88
Added:
Buffer.add_char buffer '-';
89
Added:
pending_separator := false;
90
Added:
Buffer.add_char buffer (Char.lowercase_ascii character))
91
Added:
else pending_separator := true)
92
Added:
text;
93
Added:
if Buffer.length buffer = 0 then "section" else Buffer.contents buffer
94
Added:
in
95
Added:
let count = Option.value (Hashtbl.find_opt seen base) ~default:0 + 1 in
96
Added:
Hashtbl.replace seen base count;
97
Added:
if count = 1 then base else Printf.sprintf "%s-%d" base count
98
Added:
99
Added:
(* {1 Rendering} *)
100
Added:
101
Added:
let render_heading anchor level text =
102
Added:
let id = anchor text in
103
Added:
Ui.heading ~id ~level ~class_:"readme-heading"
104
Added:
[ Ui.text_link ~class_:"readme-heading-link" ~href:("#" ^ id) text ]
105
Added:
106
Added:
let render_code_block language source =
107
Added:
let nodes =
108
Added:
match language with
109
Added:
| None | Some "" -> [ Ui.text source ]
110
Added:
| Some language ->
111
Added:
Highlight.highlight ~lang:(Some language) source |> List.concat
112
Added:
in
113
Added:
Ui.code_block ~class_:"readme-code-block" nodes
114
Added:
115
Added:
let render_block format anchor = function
116
Added:
| Heading (level, text) -> render_heading anchor level text
117
Added:
| Paragraph text ->
118
Added:
Ui.paragraph ~class_:"readme-paragraph" (format.inline text)
119
Added:
| Unordered_list items ->
120
Added:
Ui.items ~class_:"readme-list"
121
Added:
(List.map (fun item -> Ui.item (format.inline item)) items)
122
Added:
| Ordered_list items ->
123
Added:
Ui.ordered_items ~class_:"readme-list readme-ordered-list"
124
Added:
(List.map (fun item -> Ui.item (format.inline item)) items)
125
Added:
| Definition_list items ->
126
Added:
Ui.definitions ~class_:"readme-definition-list"
127
Added:
(List.map (fun (term, desc) -> (term, format.inline desc)) items)
128
Added:
| Code_block (language, source) -> render_code_block language source
129
Added:
130
Added:
let render_toc ~title_text body_headings =
131
Added:
match body_headings with
132
Added:
| [] -> Ui.nothing
133
Added:
| _ ->
134
Added:
let toc_anchor = new_anchor () in
135
Added:
(match title_text with Some t -> ignore (toc_anchor t) | None -> ());
136
Added:
let toc_entries =
137
Added:
List.map
138
Added:
(fun (level, text) ->
139
Added:
let id = toc_anchor text in
140
Added:
Ui.item
141
Added:
~class_:(Printf.sprintf "readme-toc-%d" level)
142
Added:
[ Ui.text_link ~href:("#" ^ id) text ])
143
Added:
body_headings
144
Added:
in
145
Added:
Ui.disclosure ~class_:"readme-toc" ~summary_class:"readme-toc-summary"
146
Added:
~summary:[ Ui.text "Table of Contents" ]
147
Added:
[ Ui.items ~class_:"readme-toc-list" toc_entries ]
148
Added:
149
Added:
(** Render a document using the given format. *)
150
Added:
let render format content =
151
Added:
let doc = format.parse content in
152
Added:
let body_headings =
153
Added:
List.filter_map
154
Added:
(function Heading (level, text) -> Some (level, text) | _ -> None)
155
Added:
doc.blocks
156
Added:
in
157
Added:
let toc = render_toc ~title_text:doc.title body_headings in
158
Added:
let anchor = new_anchor () in
159
Added:
let title =
160
Added:
match doc.title with
161
Added:
| None -> None
162
Added:
| Some t -> Some (render_heading anchor 1 t)
163
Added:
in
164
Added:
let metadata_node =
165
Added:
match doc.metadata with
166
Added:
| [] -> Ui.nothing
167
Added:
| entries ->
168
Added:
Ui.definitions ~class_:"readme-org-metadata"
169
Added:
(List.map
170
Added:
(fun (key, value) ->
171
Added:
(String.capitalize_ascii key, [ Ui.text value ]))
172
Added:
entries)
173
Added:
in
174
Added:
Ui.region ~class_:format.css_class
175
Added:
(Option.to_list title @ [ metadata_node; toc ]
176
Added:
@ List.map (render_block format anchor) doc.blocks)
lib/readme.ml
@@ -1,43 +1,15 @@
1
Removed:
(** Semantic rendering for README documents.
1
Added:
(** README file detection and rendering.
2
2
3
Removed:
README files are prose, not source listings: Markdown and Org are rendered
4
Removed:
as headings, paragraphs, lists, metadata, and unnumbered code blocks. The
5
Removed:
renderer deliberately keeps its supported surface compact and safe; every
6
Removed:
source fragment is emitted through {!Ui}, so repository content is escaped.
7
Removed:
*)
3
Added:
This module detects README filenames, selects the appropriate documentation
4
Added:
format (Markdown or Org), and delegates rendering to {!Doc_format}. *)
8
5
9
Removed:
type format = Markdown | Org
10
Removed:
11
Removed:
type block =
12
Removed:
| Heading of int * string
13
Removed:
| Paragraph of string
14
Removed:
| Unordered_list of string list
15
Removed:
| Ordered_list of string list
16
Removed:
| Definition_list of (string * string) list
17
Removed:
| Code of string option * string
18
Removed:
19
Removed:
(* {1 Utilities} *)
20
Removed:
21
Removed:
let first_word text =
22
Removed:
match
23
Removed:
String.split_on_char ' ' text |> List.filter (fun word -> word <> "")
24
Removed:
with
25
Removed:
| word :: _ -> Some word
26
Removed:
| [] -> None
27
Removed:
28
6
let is_readme_filename filename =
29
7
Filename.basename filename |> String.lowercase_ascii
30
8
|> String.starts_with ~prefix:"readme"
31
9
32
Removed:
let format_of_filename filename =
33
Removed:
match Filename.extension filename |> String.lowercase_ascii with
34
Removed:
| ".org" -> Org
35
Removed:
| _ -> Markdown
10
Added:
(* {1 Inline markup} *)
36
11
37
Removed:
(* {1 Inline markup (Org)} *)
38
Removed:
39
Removed:
(** Parse Org inline markup: =verbatim=, ~code~, and [[link][desc]] / [[link]].
40
Removed:
Returns a list of UI nodes with safe escaping. *)
12
Added:
(** Org inline markup: =verbatim=, ~code~, and [[link][desc]] / [[link]]. *)
41
13
let org_inline text =
42
14
let len = String.length text in
43
15
let buf = Buffer.create 64 in
@@ -55,7 +27,6 @@
55
27
flush ();
56
28
parse_link (i + 2)
57
29
| ('=' | '~') as marker -> (
58
Removed:
(* Look for closing marker — must not span across whitespace-only *)
59
30
let close = find_close marker (i + 1) in
60
31
match close with
61
32
| Some end_pos ->
@@ -83,11 +54,10 @@
83
54
in
84
55
if start >= len then None else search start
85
56
and parse_link start =
86
Removed:
(* Find matching ]] — possibly with ][desc] in between *)
87
Removed:
let rec find_end j depth =
57
Added:
let rec find_end j _depth =
88
58
if j >= len then None
89
59
else if j + 1 < len && text.[j] = ']' && text.[j + 1] = ']' then Some j
90
Removed:
else find_end (j + 1) depth
60
Added:
else find_end (j + 1) 0
91
61
in
92
62
match find_end start 0 with
93
63
| None ->
@@ -115,14 +85,10 @@
115
85
loop 0;
116
86
List.rev !nodes
117
87
118
Removed:
(** For Markdown, text is currently rendered as escaped prose without inline
119
Removed:
parsing. *)
120
88
let plain_inline text = [ Ui.text text ]
121
89
122
Removed:
let inline_of_format = function Org -> org_inline | Markdown -> plain_inline
90
Added:
(* {1 Line classifiers} *)
123
91
124
Removed:
(* {1 Line classification} *)
125
Removed:
126
92
let trim_end_hashes text =
127
93
let text = String.trim text in
128
94
let rec last_non_hash index =
@@ -157,10 +123,6 @@
157
123
( min 6 level,
158
124
String.sub line (level + 1) (length - level - 1) |> String.trim )
159
125
160
Removed:
let heading_of_line format =
161
Removed:
match format with Markdown -> markdown_heading | Org -> org_heading
162
Removed:
163
Removed:
(** Unordered list item: - / + / * followed by a space *)
164
126
let unordered_item line =
165
127
let length = String.length line in
166
128
let trimmed = String.trim line in
@@ -173,12 +135,9 @@
173
135
&& trimmed.[1] = ' '
174
136
&& length > 0
175
137
&& (line.[0] = ' ' || line.[0] = '\t')
176
Removed:
then
177
Removed:
(* Org: * at BOL is a heading; indented * is a list item *)
178
Removed:
Some (String.sub trimmed 2 (tlen - 2) |> String.trim)
138
Added:
then Some (String.sub trimmed 2 (tlen - 2) |> String.trim)
179
139
else None
180
140
181
Removed:
(** Ordered list item: 1. or 1) followed by a space *)
182
141
let ordered_item line =
183
142
let trimmed = String.trim line in
184
143
let tlen = String.length trimmed in
@@ -195,34 +154,28 @@
195
154
then Some (String.sub trimmed (d + 2) (tlen - d - 2) |> String.trim)
196
155
else None
197
156
198
Removed:
(** Org definition list item: - term :: description *)
199
157
let definition_item line =
200
158
let trimmed = String.trim line in
201
159
let tlen = String.length trimmed in
202
160
if tlen < 2 || trimmed.[0] <> '-' || trimmed.[1] <> ' ' then None
203
161
else
204
162
let rest = String.sub trimmed 2 (tlen - 2) in
205
Removed:
match String.split_on_char ':' rest with
206
Removed:
| [] -> None
207
Removed:
| _ ->
208
Removed:
(* Look for " :: " separator *)
209
Removed:
let rec find_sep i =
210
Removed:
if i + 3 >= String.length rest then None
211
Removed:
else if
212
Removed:
rest.[i] = ' '
213
Removed:
&& rest.[i + 1] = ':'
214
Removed:
&& rest.[i + 2] = ':'
215
Removed:
&& rest.[i + 3] = ' '
216
Removed:
then
217
Removed:
let term = String.sub rest 0 i |> String.trim in
218
Removed:
let desc =
219
Removed:
String.sub rest (i + 4) (String.length rest - i - 4)
220
Removed:
|> String.trim
221
Removed:
in
222
Removed:
Some (term, desc)
223
Removed:
else find_sep (i + 1)
163
Added:
let rec find_sep i =
164
Added:
if i + 3 >= String.length rest then None
165
Added:
else if
166
Added:
rest.[i] = ' '
167
Added:
&& rest.[i + 1] = ':'
168
Added:
&& rest.[i + 2] = ':'
169
Added:
&& rest.[i + 3] = ' '
170
Added:
then
171
Added:
let term = String.sub rest 0 i |> String.trim in
172
Added:
let desc =
173
Added:
String.sub rest (i + 4) (String.length rest - i - 4) |> String.trim
224
174
in
225
Removed:
find_sep 0
175
Added:
Some (term, desc)
176
Added:
else find_sep (i + 1)
177
Added:
in
178
Added:
find_sep 0
226
179
227
180
let markdown_fence line =
228
181
let line = String.trim line in
@@ -232,7 +185,8 @@
232
185
if marker <> "```" && marker <> "~~~" then None
233
186
else
234
187
let language =
235
Removed:
String.sub line 3 (String.length line - 3) |> String.trim |> first_word
188
Added:
String.sub line 3 (String.length line - 3)
189
Added:
|> String.trim |> Doc_format.first_word
236
190
in
237
191
Some (marker, language)
238
192
@@ -244,7 +198,7 @@
244
198
let language =
245
199
String.sub lower (String.length prefix)
246
200
(String.length lower - String.length prefix)
247
Removed:
|> String.trim |> first_word
201
Added:
|> String.trim |> Doc_format.first_word
248
202
in
249
203
Some language
250
204
@@ -252,47 +206,103 @@
252
206
String.trim line |> String.lowercase_ascii
253
207
|> String.starts_with ~prefix:"#+end_src"
254
208
255
Removed:
let rec take_until close collected = function
256
Removed:
| [] -> (List.rev collected, [])
257
Removed:
| line :: rest when close line -> (List.rev collected, rest)
258
Removed:
| line :: rest -> take_until close (line :: collected) rest
209
Added:
(* {1 Block parsing} *)
259
210
260
Removed:
let is_code_opener format line =
261
Removed:
match format with
262
Removed:
| Markdown -> Option.is_some (markdown_fence line)
263
Removed:
| Org -> Option.is_some (org_src_begin line)
211
Added:
let is_code_opener_markdown line = Option.is_some (markdown_fence line)
212
Added:
let is_code_opener_org line = Option.is_some (org_src_begin line)
264
213
265
Removed:
let is_boundary format line =
214
Added:
let is_boundary_common line =
266
215
String.trim line = ""
267
Removed:
|| Option.is_some (heading_of_line format line)
268
216
|| Option.is_some (unordered_item line)
269
217
|| Option.is_some (ordered_item line)
270
218
|| Option.is_some (definition_item line)
271
Removed:
|| is_code_opener format line
272
219
273
Removed:
(* {1 Block parsing} *)
220
Added:
let parse_markdown_blocks lines =
221
Added:
let is_boundary line =
222
Added:
is_boundary_common line
223
Added:
|| Option.is_some (markdown_heading line)
224
Added:
|| is_code_opener_markdown line
225
Added:
in
226
Added:
let rec take_paragraph collected = function
227
Added:
| line :: _ as rest when is_boundary line -> (List.rev collected, rest)
228
Added:
| line :: rest -> take_paragraph (String.trim line :: collected) rest
229
Added:
| [] -> (List.rev collected, [])
230
Added:
in
231
Added:
let rec take_unordered collected = function
232
Added:
| line :: rest -> (
233
Added:
match unordered_item line with
234
Added:
| Some first_line ->
235
Added:
let continuations, rest = Doc_format.take_continuations rest in
236
Added:
let item = String.concat " " (first_line :: continuations) in
237
Added:
take_unordered (item :: collected) rest
238
Added:
| None -> (List.rev collected, line :: rest))
239
Added:
| [] -> (List.rev collected, [])
240
Added:
in
241
Added:
let rec take_ordered collected = function
242
Added:
| line :: rest -> (
243
Added:
match ordered_item line with
244
Added:
| Some first_line ->
245
Added:
let continuations, rest = Doc_format.take_continuations rest in
246
Added:
let item = String.concat " " (first_line :: continuations) in
247
Added:
take_ordered (item :: collected) rest
248
Added:
| None -> (List.rev collected, line :: rest))
249
Added:
| [] -> (List.rev collected, [])
250
Added:
in
251
Added:
let open Doc_format in
252
Added:
let rec loop blocks = function
253
Added:
| [] -> List.rev blocks
254
Added:
| line :: rest when String.trim line = "" -> loop blocks rest
255
Added:
| line :: rest -> (
256
Added:
match markdown_heading line with
257
Added:
| Some (level, text) -> loop (Heading (level, text) :: blocks) rest
258
Added:
| None -> (
259
Added:
match markdown_fence line with
260
Added:
| Some (marker, language) ->
261
Added:
let lines, rest =
262
Added:
Doc_format.take_until
263
Added:
(fun candidate ->
264
Added:
String.starts_with ~prefix:marker (String.trim candidate))
265
Added:
[] rest
266
Added:
in
267
Added:
loop
268
Added:
(Code_block (language, String.concat "\n" lines) :: blocks)
269
Added:
rest
270
Added:
| None -> (
271
Added:
match unordered_item line with
272
Added:
| Some _ ->
273
Added:
let items, rest = take_unordered [] (line :: rest) in
274
Added:
loop (Unordered_list items :: blocks) rest
275
Added:
| None -> (
276
Added:
match ordered_item line with
277
Added:
| Some _ ->
278
Added:
let items, rest = take_ordered [] (line :: rest) in
279
Added:
loop (Ordered_list items :: blocks) rest
280
Added:
| None ->
281
Added:
let paragraph, rest =
282
Added:
take_paragraph [] (line :: rest)
283
Added:
in
284
Added:
loop
285
Added:
(Paragraph (String.concat " " paragraph) :: blocks)
286
Added:
rest))))
287
Added:
in
288
Added:
loop [] lines
274
289
275
Removed:
(** A continuation line belongs to the current list item if it is indented
276
Removed:
(starts with whitespace) and is not blank. *)
277
Removed:
let is_continuation line =
278
Removed:
String.length line > 0
279
Removed:
&& (line.[0] = ' ' || line.[0] = '\t')
280
Removed:
&& String.trim line <> ""
281
Removed:
282
Removed:
let parse_blocks format lines =
283
Removed:
let take_continuations rest =
284
Removed:
let rec loop acc = function
285
Removed:
| line :: rest when is_continuation line ->
286
Removed:
loop (String.trim line :: acc) rest
287
Removed:
| remaining -> (List.rev acc, remaining)
288
Removed:
in
289
Removed:
loop [] rest
290
Added:
let parse_org_blocks lines =
291
Added:
let is_boundary line =
292
Added:
is_boundary_common line
293
Added:
|| Option.is_some (org_heading line)
294
Added:
|| is_code_opener_org line
290
295
in
296
Added:
let rec take_paragraph collected = function
297
Added:
| line :: _ as rest when is_boundary line -> (List.rev collected, rest)
298
Added:
| line :: rest -> take_paragraph (String.trim line :: collected) rest
299
Added:
| [] -> (List.rev collected, [])
300
Added:
in
291
301
let rec take_unordered collected = function
292
302
| line :: rest -> (
293
303
match unordered_item line with
294
304
| Some first_line ->
295
Removed:
let continuations, rest = take_continuations rest in
305
Added:
let continuations, rest = Doc_format.take_continuations rest in
296
306
let item = String.concat " " (first_line :: continuations) in
297
307
take_unordered (item :: collected) rest
298
308
| None -> (List.rev collected, line :: rest))
@@ -302,7 +312,7 @@
302
312
| line :: rest -> (
303
313
match ordered_item line with
304
314
| Some first_line ->
305
Removed:
let continuations, rest = take_continuations rest in
315
Added:
let continuations, rest = Doc_format.take_continuations rest in
306
316
let item = String.concat " " (first_line :: continuations) in
307
317
take_ordered (item :: collected) rest
308
318
| None -> (List.rev collected, line :: rest))
@@ -312,39 +322,33 @@
312
322
| line :: rest -> (
313
323
match definition_item line with
314
324
| Some (term, first_desc) ->
315
Removed:
let continuations, rest = take_continuations rest in
325
Added:
let continuations, rest = Doc_format.take_continuations rest in
316
326
let desc = String.concat " " (first_desc :: continuations) in
317
327
take_definitions ((term, desc) :: collected) rest
318
328
| None -> (List.rev collected, line :: rest))
319
329
| [] -> (List.rev collected, [])
320
330
in
321
Removed:
let rec take_paragraph collected = function
322
Removed:
| line :: _ as rest when is_boundary format line ->
323
Removed:
(List.rev collected, rest)
324
Removed:
| line :: rest -> take_paragraph (String.trim line :: collected) rest
325
Removed:
| [] -> (List.rev collected, [])
326
Removed:
in
331
Added:
let open Doc_format in
327
332
let rec loop blocks = function
328
333
| [] -> List.rev blocks
329
334
| line :: rest when String.trim line = "" -> loop blocks rest
330
335
| line :: rest -> (
331
Removed:
match heading_of_line format line with
336
Added:
match org_heading line with
332
337
| Some (level, text) -> loop (Heading (level, text) :: blocks) rest
333
338
| None -> (
334
Removed:
match format with
335
Removed:
| Markdown -> (
336
Removed:
match markdown_fence line with
337
Removed:
| Some (marker, language) ->
338
Removed:
let lines, rest =
339
Removed:
take_until
340
Removed:
(fun candidate ->
341
Removed:
String.starts_with ~prefix:marker
342
Removed:
(String.trim candidate))
343
Removed:
[] rest
344
Removed:
in
345
Removed:
loop
346
Removed:
(Code (language, String.concat "\n" lines) :: blocks)
347
Removed:
rest
339
Added:
match org_src_begin line with
340
Added:
| Some language ->
341
Added:
let lines, rest =
342
Added:
Doc_format.take_until is_org_src_end [] rest
343
Added:
in
344
Added:
loop
345
Added:
(Code_block (language, String.concat "\n" lines) :: blocks)
346
Added:
rest
347
Added:
| None -> (
348
Added:
match definition_item line with
349
Added:
| Some _ ->
350
Added:
let items, rest = take_definitions [] (line :: rest) in
351
Added:
loop (Definition_list items :: blocks) rest
348
352
| None -> (
349
353
match unordered_item line with
350
354
| Some _ ->
@@ -361,41 +365,7 @@
361
365
in
362
366
loop
363
367
(Paragraph (String.concat " " paragraph) :: blocks)
364
Removed:
rest)))
365
Removed:
| Org -> (
366
Removed:
match org_src_begin line with
367
Removed:
| Some language ->
368
Removed:
let lines, rest = take_until is_org_src_end [] rest in
369
Removed:
loop
370
Removed:
(Code (language, String.concat "\n" lines) :: blocks)
371
Removed:
rest
372
Removed:
| None -> (
373
Removed:
match definition_item line with
374
Removed:
| Some _ ->
375
Removed:
let items, rest = take_definitions [] (line :: rest) in
376
Removed:
loop (Definition_list items :: blocks) rest
377
Removed:
| None -> (
378
Removed:
match unordered_item line with
379
Removed:
| Some _ ->
380
Removed:
let items, rest =
381
Removed:
take_unordered [] (line :: rest)
382
Removed:
in
383
Removed:
loop (Unordered_list items :: blocks) rest
384
Removed:
| None -> (
385
Removed:
match ordered_item line with
386
Removed:
| Some _ ->
387
Removed:
let items, rest =
388
Removed:
take_ordered [] (line :: rest)
389
Removed:
in
390
Removed:
loop (Ordered_list items :: blocks) rest
391
Removed:
| None ->
392
Removed:
let paragraph, rest =
393
Removed:
take_paragraph [] (line :: rest)
394
Removed:
in
395
Removed:
loop
396
Removed:
(Paragraph (String.concat " " paragraph)
397
Removed:
:: blocks)
398
Removed:
rest))))))
368
Added:
rest)))))
399
369
in
400
370
loop [] lines
401
371
@@ -427,129 +397,53 @@
427
397
([], []) lines
428
398
|> fun (metadata, body) -> (List.rev metadata, List.rev body)
429
399
430
Removed:
(* {1 Rendering} *)
400
Added:
(* {1 Format definitions} *)
431
401
432
Removed:
let new_anchor () =
433
Removed:
let seen = Hashtbl.create 16 in
434
Removed:
fun text ->
435
Removed:
let base =
436
Removed:
let buffer = Buffer.create (String.length text) in
437
Removed:
let pending_separator = ref false in
438
Removed:
String.iter
439
Removed:
(fun character ->
440
Removed:
if
441
Removed:
(character >= 'a' && character <= 'z')
442
Removed:
|| (character >= 'A' && character <= 'Z')
443
Removed:
|| (character >= '0' && character <= '9')
444
Removed:
then (
445
Removed:
if !pending_separator && Buffer.length buffer > 0 then
446
Removed:
Buffer.add_char buffer '-';
447
Removed:
pending_separator := false;
448
Removed:
Buffer.add_char buffer (Char.lowercase_ascii character))
449
Removed:
else pending_separator := true)
450
Removed:
text;
451
Removed:
if Buffer.length buffer = 0 then "section" else Buffer.contents buffer
452
Removed:
in
453
Removed:
let count = Option.value (Hashtbl.find_opt seen base) ~default:0 + 1 in
454
Removed:
Hashtbl.replace seen base count;
455
Removed:
if count = 1 then base else Printf.sprintf "%s-%d" base count
402
Added:
let markdown : Doc_format.format =
403
Added:
{
404
Added:
name = "markdown";
405
Added:
css_class = "readme-document readme-markdown";
406
Added:
parse =
407
Added:
(fun content ->
408
Added:
let lines = String.split_on_char '\n' content in
409
Added:
{
410
Added:
Doc_format.title = None;
411
Added:
metadata = [];
412
Added:
blocks = parse_markdown_blocks lines;
413
Added:
});
414
Added:
inline = plain_inline;
415
Added:
}
456
416
457
Removed:
let heading anchor level text =
458
Removed:
let id = anchor text in
459
Removed:
Ui.heading ~id ~level ~class_:"readme-heading"
460
Removed:
[ Ui.text_link ~class_:"readme-heading-link" ~href:("#" ^ id) text ]
417
Added:
let org : Doc_format.format =
418
Added:
{
419
Added:
name = "org";
420
Added:
css_class = "readme-document readme-org";
421
Added:
parse =
422
Added:
(fun content ->
423
Added:
let lines = String.split_on_char '\n' content in
424
Added:
let metadata, lines = split_org_metadata lines in
425
Added:
let title =
426
Added:
List.find_opt (fun (key, _) -> key = "title") metadata
427
Added:
|> Option.map snd
428
Added:
in
429
Added:
let metadata_entries =
430
Added:
List.filter (fun (key, _) -> key <> "title") metadata
431
Added:
in
432
Added:
{
433
Added:
Doc_format.title;
434
Added:
metadata = metadata_entries;
435
Added:
blocks = parse_org_blocks lines;
436
Added:
});
437
Added:
inline = org_inline;
438
Added:
}
461
439
462
Removed:
let code_block language source =
463
Removed:
let nodes =
464
Removed:
match language with
465
Removed:
| None | Some "" -> [ Ui.text source ]
466
Removed:
| Some language ->
467
Removed:
Highlight.highlight ~lang:(Some language) source |> List.concat
468
Removed:
in
469
Removed:
Ui.code_block ~class_:"readme-code-block" nodes
440
Added:
(* {1 Public API} *)
470
441
471
Removed:
let render_block format anchor = function
472
Removed:
| Heading (level, text) -> heading anchor level text
473
Removed:
| Paragraph text ->
474
Removed:
Ui.paragraph ~class_:"readme-paragraph" (inline_of_format format text)
475
Removed:
| Unordered_list items ->
476
Removed:
let inline = inline_of_format format in
477
Removed:
Ui.items ~class_:"readme-list"
478
Removed:
(List.map (fun item -> Ui.item (inline item)) items)
479
Removed:
| Ordered_list items ->
480
Removed:
let inline = inline_of_format format in
481
Removed:
Ui.ordered_items ~class_:"readme-list readme-ordered-list"
482
Removed:
(List.map (fun item -> Ui.item (inline item)) items)
483
Removed:
| Definition_list items ->
484
Removed:
let inline = inline_of_format format in
485
Removed:
Ui.definitions ~class_:"readme-definition-list"
486
Removed:
(List.map (fun (term, desc) -> (term, inline desc)) items)
487
Removed:
| Code (language, source) -> code_block language source
442
Added:
let format_of_filename filename =
443
Added:
match Filename.extension filename |> String.lowercase_ascii with
444
Added:
| ".org" -> org
445
Added:
| _ -> markdown
488
446
489
447
let render ~filename content =
490
448
let format = format_of_filename filename in
491
Removed:
let lines = String.split_on_char '\n' content in
492
Removed:
let metadata, lines =
493
Removed:
match format with
494
Removed:
| Markdown -> ([], lines)
495
Removed:
| Org -> split_org_metadata lines
496
Removed:
in
497
Removed:
let blocks = parse_blocks format lines in
498
Removed:
(* Extract the Org title if present. *)
499
Removed:
let title_text =
500
Removed:
List.find_opt (fun (key, _) -> key = "title") metadata |> Option.map snd
501
Removed:
in
502
Removed:
let metadata_entries =
503
Removed:
List.filter (fun (key, _) -> key <> "title") metadata
504
Removed:
in
505
Removed:
(* Collect body headings for the table of contents. *)
506
Removed:
let body_headings =
507
Removed:
List.filter_map
508
Removed:
(function Heading (level, text) -> Some (level, text) | _ -> None)
509
Removed:
blocks
510
Removed:
in
511
Removed:
(* Build the TOC: use a dedicated anchor instance so IDs match the render
512
Removed:
pass which sees the same heading sequence. *)
513
Removed:
let toc =
514
Removed:
match body_headings with
515
Removed:
| [] -> Ui.nothing
516
Removed:
| _ ->
517
Removed:
let toc_anchor = new_anchor () in
518
Removed:
(* Consume the title first to keep the anchor counter in sync. *)
519
Removed:
(match title_text with Some t -> ignore (toc_anchor t) | None -> ());
520
Removed:
let toc_entries =
521
Removed:
List.map
522
Removed:
(fun (level, text) ->
523
Removed:
let id = toc_anchor text in
524
Removed:
Ui.item
525
Removed:
~class_:(Printf.sprintf "readme-toc-%d" level)
526
Removed:
[ Ui.text_link ~href:("#" ^ id) text ])
527
Removed:
body_headings
528
Removed:
in
529
Removed:
Ui.disclosure ~class_:"readme-toc" ~summary_class:"readme-toc-summary"
530
Removed:
~summary:[ Ui.text "Table of Contents" ]
531
Removed:
[ Ui.items ~class_:"readme-toc-list" toc_entries ]
532
Removed:
in
533
Removed:
(* Render the document. *)
534
Removed:
let anchor = new_anchor () in
535
Removed:
let title =
536
Removed:
match title_text with None -> None | Some t -> Some (heading anchor 1 t)
537
Removed:
in
538
Removed:
let metadata_node =
539
Removed:
match metadata_entries with
540
Removed:
| [] -> Ui.nothing
541
Removed:
| entries ->
542
Removed:
Ui.definitions ~class_:"readme-org-metadata"
543
Removed:
(List.map
544
Removed:
(fun (key, value) ->
545
Removed:
(String.capitalize_ascii key, [ Ui.text value ]))
546
Removed:
entries)
547
Removed:
in
548
Removed:
let class_ =
549
Removed:
match format with
550
Removed:
| Markdown -> "readme-document readme-markdown"
551
Removed:
| Org -> "readme-document readme-org"
552
Removed:
in
553
Removed:
Ui.region ~class_
554
Removed:
(Option.to_list title @ [ metadata_node; toc ]
555
Removed:
@ List.map (render_block format anchor) blocks)
449
Added:
Doc_format.render format content