refactor split readme.ml into lib/prose/ directory

Extract the monolithic readme.ml (633 lines) into focused modules: - prose_format.ml — shared document AST, renderer, TOC, anchors - prose_markdown.ml — Markdown block parser - prose_org.ml — Org parser, metadata, inline markup - prose_mld.ml — mld (ocamldoc) parser + inline - prose_plaintext.ml — plain text paragraph parser - prose.ml — public façade (is_doc_filename, format_of_filename, render) The old doc_format.ml and readme.ml are removed. All callers now use Prose.* instead of Readme.*. The (include_subdirs unqualified) dune directive picks up the new directory without a separate dune file.

Commit
9bf862e130261227ad96cf82b871ec8d5c1c4820
Author
Claude Sonnet 4 <claude@anthropic.invalid>
Author date
Committer
Marius Peter <dev@marius-peter.com>
Committer date
Changed files
lib/doc_format.ml
index e4654409..00000000 100644..000000
@@ -1,176 +0,0 @@
1 Removed: (** Generalized documentation format rendering.
2 Removed:
3 Removed: This module provides a shared document AST and renderer for prose
4 Removed: documentation formats (Markdown, Org, mld). Format-specific parsing is
5 Removed: supplied by the {!format} type; the renderer, TOC generation, and anchor
6 Removed: management are format-independent.
7 Removed:
8 Removed: Every text fragment is emitted through {!Ui}, ensuring safe escaping of
9 Removed: repository content. *)
10 Removed:
11 Removed: (* {1 Document AST} *)
12 Removed:
13 Removed: type inline =
14 Removed: | Text of string
15 Removed: | Code of string
16 Removed: | Verbatim of string
17 Removed: | Link of { href : string; text : string }
18 Removed:
19 Removed: type block =
20 Removed: | Heading of int * string
21 Removed: | Paragraph of string
22 Removed: | Unordered_list of string list
23 Removed: | Ordered_list of string list
24 Removed: | Definition_list of (string * string) list
25 Removed: | Code_block of string option * string
26 Removed:
27 Removed: type document = {
28 Removed: title : string option;
29 Removed: metadata : (string * string) list;
30 Removed: blocks : block list;
31 Removed: }
32 Removed:
33 Removed: (* {1 Format interface} *)
34 Removed:
35 Removed: type format = {
36 Removed: name : string;
37 Removed: css_class : string;
38 Removed: parse : string -> document;
39 Removed: inline : string -> Ui.node list;
40 Removed: }
41 Removed: (** A documentation format provides parsing and inline markup rendering. *)
42 Removed:
43 Removed: (* {1 Shared utilities} *)
44 Removed:
45 Removed: let first_word text =
46 Removed: match
47 Removed: String.split_on_char ' ' text |> List.filter (fun word -> word <> "")
48 Removed: with
49 Removed: | word :: _ -> Some word
50 Removed: | [] -> None
51 Removed:
52 Removed: (** A continuation line belongs to the current list item if it is indented
53 Removed: (starts with whitespace) and is not blank. *)
54 Removed: let is_continuation line =
55 Removed: String.length line > 0
56 Removed: && (line.[0] = ' ' || line.[0] = '\t')
57 Removed: && String.trim line <> ""
58 Removed:
59 Removed: let take_continuations rest =
60 Removed: let rec loop acc = function
61 Removed: | line :: rest when is_continuation line ->
62 Removed: loop (String.trim line :: acc) rest
63 Removed: | remaining -> (List.rev acc, remaining)
64 Removed: in
65 Removed: loop [] rest
66 Removed:
67 Removed: let rec take_until close collected = function
68 Removed: | [] -> (List.rev collected, [])
69 Removed: | line :: rest when close line -> (List.rev collected, rest)
70 Removed: | line :: rest -> take_until close (line :: collected) rest
71 Removed:
72 Removed: (* {1 Anchor generation} *)
73 Removed:
74 Removed: let new_anchor () =
75 Removed: let seen = Hashtbl.create 16 in
76 Removed: fun text ->
77 Removed: let base =
78 Removed: let buffer = Buffer.create (String.length text) in
79 Removed: let pending_separator = ref false in
80 Removed: String.iter
81 Removed: (fun character ->
82 Removed: if
83 Removed: (character >= 'a' && character <= 'z')
84 Removed: || (character >= 'A' && character <= 'Z')
85 Removed: || (character >= '0' && character <= '9')
86 Removed: then (
87 Removed: if !pending_separator && Buffer.length buffer > 0 then
88 Removed: Buffer.add_char buffer '-';
89 Removed: pending_separator := false;
90 Removed: Buffer.add_char buffer (Char.lowercase_ascii character))
91 Removed: else pending_separator := true)
92 Removed: text;
93 Removed: if Buffer.length buffer = 0 then "section" else Buffer.contents buffer
94 Removed: in
95 Removed: let count = Option.value (Hashtbl.find_opt seen base) ~default:0 + 1 in
96 Removed: Hashtbl.replace seen base count;
97 Removed: if count = 1 then base else Printf.sprintf "%s-%d" base count
98 Removed:
99 Removed: (* {1 Rendering} *)
100 Removed:
101 Removed: let render_heading anchor level text =
102 Removed: let id = anchor text in
103 Removed: Ui.heading ~id ~level ~class_:"readme-heading"
104 Removed: [ Ui.text_link ~class_:"readme-heading-link" ~href:("#" ^ id) text ]
105 Removed:
106 Removed: let render_code_block language source =
107 Removed: let nodes =
108 Removed: match language with
109 Removed: | None | Some "" -> [ Ui.text source ]
110 Removed: | Some language ->
111 Removed: Highlight.highlight ~lang:(Some language) source |> List.concat
112 Removed: in
113 Removed: Ui.code_block ~class_:"readme-code-block" nodes
114 Removed:
115 Removed: let render_block format anchor = function
116 Removed: | Heading (level, text) -> render_heading anchor level text
117 Removed: | Paragraph text ->
118 Removed: Ui.paragraph ~class_:"readme-paragraph" (format.inline text)
119 Removed: | Unordered_list items ->
120 Removed: Ui.items ~class_:"readme-list"
121 Removed: (List.map (fun item -> Ui.item (format.inline item)) items)
122 Removed: | Ordered_list items ->
123 Removed: Ui.ordered_items ~class_:"readme-list readme-ordered-list"
124 Removed: (List.map (fun item -> Ui.item (format.inline item)) items)
125 Removed: | Definition_list items ->
126 Removed: Ui.definitions ~class_:"readme-definition-list"
127 Removed: (List.map (fun (term, desc) -> (term, format.inline desc)) items)
128 Removed: | Code_block (language, source) -> render_code_block language source
129 Removed:
130 Removed: let render_toc ~title_text body_headings =
131 Removed: match body_headings with
132 Removed: | [] | [ _ ] -> Ui.nothing
133 Removed: | _ ->
134 Removed: let toc_anchor = new_anchor () in
135 Removed: (match title_text with Some t -> ignore (toc_anchor t) | None -> ());
136 Removed: let toc_entries =
137 Removed: List.map
138 Removed: (fun (level, text) ->
139 Removed: let id = toc_anchor text in
140 Removed: Ui.item
141 Removed: ~class_:(Printf.sprintf "readme-toc-%d" level)
142 Removed: [ Ui.text_link ~href:("#" ^ id) text ])
143 Removed: body_headings
144 Removed: in
145 Removed: Ui.disclosure ~class_:"readme-toc" ~summary_class:"readme-toc-summary"
146 Removed: ~summary:[ Ui.text "Table of Contents" ]
147 Removed: [ Ui.items ~class_:"readme-toc-list" toc_entries ]
148 Removed:
149 Removed: (** Render a document using the given format. *)
150 Removed: let render format content =
151 Removed: let doc = format.parse content in
152 Removed: let body_headings =
153 Removed: List.filter_map
154 Removed: (function Heading (level, text) -> Some (level, text) | _ -> None)
155 Removed: doc.blocks
156 Removed: in
157 Removed: let toc = render_toc ~title_text:doc.title body_headings in
158 Removed: let anchor = new_anchor () in
159 Removed: let title =
160 Removed: match doc.title with
161 Removed: | None -> None
162 Removed: | Some t -> Some (render_heading anchor 1 t)
163 Removed: in
164 Removed: let metadata_node =
165 Removed: match doc.metadata with
166 Removed: | [] -> Ui.nothing
167 Removed: | entries ->
168 Removed: Ui.definitions ~class_:"readme-org-metadata"
169 Removed: (List.map
170 Removed: (fun (key, value) ->
171 Removed: (String.capitalize_ascii key, [ Ui.text value ]))
172 Removed: entries)
173 Removed: in
174 Removed: Ui.region ~class_:format.css_class
175 Removed: (Option.to_list title @ [ metadata_node; toc ]
176 Removed: @ List.map (render_block format anchor) doc.blocks)
lib/prose/prose.ml
index 00000000..367715a0 000000..100644
@@ -0,0 +1,25 @@
1 Added: (** Prose rendering façade.
2 Added:
3 Added: Detects documentation formats by filename extension and renders content as
4 Added: styled HTML. This module is the single entry point for prose rendering
5 Added: throughout ogit. *)
6 Added:
7 Added: let is_readme_filename filename =
8 Added: Filename.basename filename |> String.lowercase_ascii
9 Added: |> String.starts_with ~prefix:"readme"
10 Added:
11 Added: let is_doc_filename filename =
12 Added: match Filename.extension filename |> String.lowercase_ascii with
13 Added: | ".md" | ".markdown" | ".org" | ".mld" | ".txt" -> true
14 Added: | _ -> false
15 Added:
16 Added: let format_of_filename filename =
17 Added: match Filename.extension filename |> String.lowercase_ascii with
18 Added: | ".org" -> Prose_org.format
19 Added: | ".mld" -> Prose_mld.format
20 Added: | ".txt" -> Prose_plaintext.format
21 Added: | _ -> Prose_markdown.format
22 Added:
23 Added: let render ~filename content =
24 Added: let format = format_of_filename filename in
25 Added: Prose_format.render format content
lib/prose/prose_format.ml
index 00000000..eda76a7f 000000..100644
@@ -0,0 +1,174 @@
1 Added: (** Shared document AST and renderer for prose formats.
2 Added:
3 Added: Format-specific parsing is supplied by the {!format} type; the renderer, TOC
4 Added: generation, and anchor management are format-independent.
5 Added:
6 Added: Every text fragment is emitted through {!Ui}, ensuring safe escaping of
7 Added: repository content. *)
8 Added:
9 Added: (* {1 Document AST} *)
10 Added:
11 Added: type inline =
12 Added: | Text of string
13 Added: | Code of string
14 Added: | Verbatim of string
15 Added: | Link of { href : string; text : string }
16 Added:
17 Added: type block =
18 Added: | Heading of int * string
19 Added: | Paragraph of string
20 Added: | Unordered_list of string list
21 Added: | Ordered_list of string list
22 Added: | Definition_list of (string * string) list
23 Added: | Code_block of string option * string
24 Added:
25 Added: type document = {
26 Added: title : string option;
27 Added: metadata : (string * string) list;
28 Added: blocks : block list;
29 Added: }
30 Added:
31 Added: (* {1 Format interface} *)
32 Added:
33 Added: type format = {
34 Added: name : string;
35 Added: css_class : string;
36 Added: parse : string -> document;
37 Added: inline : string -> Ui.node list;
38 Added: }
39 Added: (** A documentation format provides parsing and inline markup rendering. *)
40 Added:
41 Added: (* {1 Shared utilities} *)
42 Added:
43 Added: let first_word text =
44 Added: match
45 Added: String.split_on_char ' ' text |> List.filter (fun word -> word <> "")
46 Added: with
47 Added: | word :: _ -> Some word
48 Added: | [] -> None
49 Added:
50 Added: (** A continuation line belongs to the current list item if it is indented
51 Added: (starts with whitespace) and is not blank. *)
52 Added: let is_continuation line =
53 Added: String.length line > 0
54 Added: && (line.[0] = ' ' || line.[0] = '\t')
55 Added: && String.trim line <> ""
56 Added:
57 Added: let take_continuations rest =
58 Added: let rec loop acc = function
59 Added: | line :: rest when is_continuation line ->
60 Added: loop (String.trim line :: acc) rest
61 Added: | remaining -> (List.rev acc, remaining)
62 Added: in
63 Added: loop [] rest
64 Added:
65 Added: let rec take_until close collected = function
66 Added: | [] -> (List.rev collected, [])
67 Added: | line :: rest when close line -> (List.rev collected, rest)
68 Added: | line :: rest -> take_until close (line :: collected) rest
69 Added:
70 Added: (* {1 Anchor generation} *)
71 Added:
72 Added: let new_anchor () =
73 Added: let seen = Hashtbl.create 16 in
74 Added: fun text ->
75 Added: let base =
76 Added: let buffer = Buffer.create (String.length text) in
77 Added: let pending_separator = ref false in
78 Added: String.iter
79 Added: (fun character ->
80 Added: if
81 Added: (character >= 'a' && character <= 'z')
82 Added: || (character >= 'A' && character <= 'Z')
83 Added: || (character >= '0' && character <= '9')
84 Added: then (
85 Added: if !pending_separator && Buffer.length buffer > 0 then
86 Added: Buffer.add_char buffer '-';
87 Added: pending_separator := false;
88 Added: Buffer.add_char buffer (Char.lowercase_ascii character))
89 Added: else pending_separator := true)
90 Added: text;
91 Added: if Buffer.length buffer = 0 then "section" else Buffer.contents buffer
92 Added: in
93 Added: let count = Option.value (Hashtbl.find_opt seen base) ~default:0 + 1 in
94 Added: Hashtbl.replace seen base count;
95 Added: if count = 1 then base else Printf.sprintf "%s-%d" base count
96 Added:
97 Added: (* {1 Rendering} *)
98 Added:
99 Added: let render_heading anchor level text =
100 Added: let id = anchor text in
101 Added: Ui.heading ~id ~level ~class_:"readme-heading"
102 Added: [ Ui.text_link ~class_:"readme-heading-link" ~href:("#" ^ id) text ]
103 Added:
104 Added: let render_code_block language source =
105 Added: let nodes =
106 Added: match language with
107 Added: | None | Some "" -> [ Ui.text source ]
108 Added: | Some language ->
109 Added: Highlight.highlight ~lang:(Some language) source |> List.concat
110 Added: in
111 Added: Ui.code_block ~class_:"readme-code-block" nodes
112 Added:
113 Added: let render_block format anchor = function
114 Added: | Heading (level, text) -> render_heading anchor level text
115 Added: | Paragraph text ->
116 Added: Ui.paragraph ~class_:"readme-paragraph" (format.inline text)
117 Added: | Unordered_list items ->
118 Added: Ui.items ~class_:"readme-list"
119 Added: (List.map (fun item -> Ui.item (format.inline item)) items)
120 Added: | Ordered_list items ->
121 Added: Ui.ordered_items ~class_:"readme-list readme-ordered-list"
122 Added: (List.map (fun item -> Ui.item (format.inline item)) items)
123 Added: | Definition_list items ->
124 Added: Ui.definitions ~class_:"readme-definition-list"
125 Added: (List.map (fun (term, desc) -> (term, format.inline desc)) items)
126 Added: | Code_block (language, source) -> render_code_block language source
127 Added:
128 Added: let render_toc ~title_text body_headings =
129 Added: match body_headings with
130 Added: | [] | [ _ ] -> Ui.nothing
131 Added: | _ ->
132 Added: let toc_anchor = new_anchor () in
133 Added: (match title_text with Some t -> ignore (toc_anchor t) | None -> ());
134 Added: let toc_entries =
135 Added: List.map
136 Added: (fun (level, text) ->
137 Added: let id = toc_anchor text in
138 Added: Ui.item
139 Added: ~class_:(Printf.sprintf "readme-toc-%d" level)
140 Added: [ Ui.text_link ~href:("#" ^ id) text ])
141 Added: body_headings
142 Added: in
143 Added: Ui.disclosure ~class_:"readme-toc" ~summary_class:"readme-toc-summary"
144 Added: ~summary:[ Ui.text "Table of Contents" ]
145 Added: [ Ui.items ~class_:"readme-toc-list" toc_entries ]
146 Added:
147 Added: (** Render a document using the given format. *)
148 Added: let render format content =
149 Added: let doc = format.parse content in
150 Added: let body_headings =
151 Added: List.filter_map
152 Added: (function Heading (level, text) -> Some (level, text) | _ -> None)
153 Added: doc.blocks
154 Added: in
155 Added: let toc = render_toc ~title_text:doc.title body_headings in
156 Added: let anchor = new_anchor () in
157 Added: let title =
158 Added: match doc.title with
159 Added: | None -> None
160 Added: | Some t -> Some (render_heading anchor 1 t)
161 Added: in
162 Added: let metadata_node =
163 Added: match doc.metadata with
164 Added: | [] -> Ui.nothing
165 Added: | entries ->
166 Added: Ui.definitions ~class_:"readme-org-metadata"
167 Added: (List.map
168 Added: (fun (key, value) ->
169 Added: (String.capitalize_ascii key, [ Ui.text value ]))
170 Added: entries)
171 Added: in
172 Added: Ui.region ~class_:format.css_class
173 Added: (Option.to_list title @ [ metadata_node; toc ]
174 Added: @ List.map (render_block format anchor) doc.blocks)
lib/prose/prose_markdown.ml
index 00000000..44b04bd1 000000..100644
@@ -0,0 +1,165 @@
1 Added: (** Markdown documentation format.
2 Added:
3 Added: Parses ATX headings, fenced code blocks, unordered and ordered lists, and
4 Added: paragraphs. Inline markup is passed through as plain text. *)
5 Added:
6 Added: (* {1 Line classifiers} *)
7 Added:
8 Added: let trim_end_hashes text =
9 Added: let text = String.trim text in
10 Added: let rec last_non_hash index =
11 Added: if index < 0 || text.[index] <> '#' then index else last_non_hash (index - 1)
12 Added: in
13 Added: let last = last_non_hash (String.length text - 1) in
14 Added: String.sub text 0 (last + 1) |> String.trim
15 Added:
16 Added: let heading line =
17 Added: let length = String.length line in
18 Added: let rec count_hashes index =
19 Added: if index < length && line.[index] = '#' then count_hashes (index + 1)
20 Added: else index
21 Added: in
22 Added: let level = count_hashes 0 in
23 Added: if level = 0 || level > 6 || level >= length || line.[level] <> ' ' then None
24 Added: else
25 Added: Some
26 Added: ( level,
27 Added: String.sub line (level + 1) (length - level - 1) |> trim_end_hashes )
28 Added:
29 Added: let unordered_item line =
30 Added: let length = String.length line in
31 Added: let trimmed = String.trim line in
32 Added: let tlen = String.length trimmed in
33 Added: if tlen >= 2 && List.mem trimmed.[0] [ '-'; '+' ] && trimmed.[1] = ' ' then
34 Added: Some (String.sub trimmed 2 (tlen - 2) |> String.trim)
35 Added: else if
36 Added: tlen >= 2
37 Added: && trimmed.[0] = '*'
38 Added: && trimmed.[1] = ' '
39 Added: && length > 0
40 Added: && (line.[0] = ' ' || line.[0] = '\t')
41 Added: then Some (String.sub trimmed 2 (tlen - 2) |> String.trim)
42 Added: else None
43 Added:
44 Added: let ordered_item line =
45 Added: let trimmed = String.trim line in
46 Added: let tlen = String.length trimmed in
47 Added: let rec digits i =
48 Added: if i < tlen && trimmed.[i] >= '0' && trimmed.[i] <= '9' then digits (i + 1)
49 Added: else i
50 Added: in
51 Added: let d = digits 0 in
52 Added: if d = 0 || d >= tlen then None
53 Added: else if
54 Added: (trimmed.[d] = '.' || trimmed.[d] = ')')
55 Added: && d + 1 < tlen
56 Added: && trimmed.[d + 1] = ' '
57 Added: then Some (String.sub trimmed (d + 2) (tlen - d - 2) |> String.trim)
58 Added: else None
59 Added:
60 Added: let fence line =
61 Added: let line = String.trim line in
62 Added: if String.length line < 3 then None
63 Added: else
64 Added: let marker = String.sub line 0 3 in
65 Added: if marker <> "```" && marker <> "~~~" then None
66 Added: else
67 Added: let language =
68 Added: String.sub line 3 (String.length line - 3)
69 Added: |> String.trim |> Prose_format.first_word
70 Added: in
71 Added: Some (marker, language)
72 Added:
73 Added: (* {1 Block parsing} *)
74 Added:
75 Added: let is_boundary_common line =
76 Added: String.trim line = ""
77 Added: || Option.is_some (unordered_item line)
78 Added: || Option.is_some (ordered_item line)
79 Added:
80 Added: let parse_blocks lines =
81 Added: let is_boundary line =
82 Added: is_boundary_common line
83 Added: || Option.is_some (heading line)
84 Added: || Option.is_some (fence line)
85 Added: in
86 Added: let rec take_paragraph collected = function
87 Added: | line :: _ as rest when is_boundary line -> (List.rev collected, rest)
88 Added: | line :: rest -> take_paragraph (String.trim line :: collected) rest
89 Added: | [] -> (List.rev collected, [])
90 Added: in
91 Added: let rec take_unordered collected = function
92 Added: | line :: rest -> (
93 Added: match unordered_item line with
94 Added: | Some first_line ->
95 Added: let continuations, rest = Prose_format.take_continuations rest in
96 Added: let item = String.concat " " (first_line :: continuations) in
97 Added: take_unordered (item :: collected) rest
98 Added: | None -> (List.rev collected, line :: rest))
99 Added: | [] -> (List.rev collected, [])
100 Added: in
101 Added: let rec take_ordered collected = function
102 Added: | line :: rest -> (
103 Added: match ordered_item line with
104 Added: | Some first_line ->
105 Added: let continuations, rest = Prose_format.take_continuations rest in
106 Added: let item = String.concat " " (first_line :: continuations) in
107 Added: take_ordered (item :: collected) rest
108 Added: | None -> (List.rev collected, line :: rest))
109 Added: | [] -> (List.rev collected, [])
110 Added: in
111 Added: let open Prose_format in
112 Added: let rec loop blocks = function
113 Added: | [] -> List.rev blocks
114 Added: | line :: rest when String.trim line = "" -> loop blocks rest
115 Added: | line :: rest -> (
116 Added: match heading line with
117 Added: | Some (level, text) -> loop (Heading (level, text) :: blocks) rest
118 Added: | None -> (
119 Added: match fence line with
120 Added: | Some (marker, language) ->
121 Added: let lines, rest =
122 Added: Prose_format.take_until
123 Added: (fun candidate ->
124 Added: String.starts_with ~prefix:marker (String.trim candidate))
125 Added: [] rest
126 Added: in
127 Added: loop
128 Added: (Code_block (language, String.concat "\n" lines) :: blocks)
129 Added: rest
130 Added: | None -> (
131 Added: match unordered_item line with
132 Added: | Some _ ->
133 Added: let items, rest = take_unordered [] (line :: rest) in
134 Added: loop (Unordered_list items :: blocks) rest
135 Added: | None -> (
136 Added: match ordered_item line with
137 Added: | Some _ ->
138 Added: let items, rest = take_ordered [] (line :: rest) in
139 Added: loop (Ordered_list items :: blocks) rest
140 Added: | None ->
141 Added: let paragraph, rest =
142 Added: take_paragraph [] (line :: rest)
143 Added: in
144 Added: loop
145 Added: (Paragraph (String.concat " " paragraph) :: blocks)
146 Added: rest))))
147 Added: in
148 Added: loop [] lines
149 Added:
150 Added: (* {1 Format definition} *)
151 Added:
152 Added: let format : Prose_format.format =
153 Added: {
154 Added: name = "markdown";
155 Added: css_class = "readme-document readme-markdown";
156 Added: parse =
157 Added: (fun content ->
158 Added: let lines = String.split_on_char '\n' content in
159 Added: {
160 Added: Prose_format.title = None;
161 Added: metadata = [];
162 Added: blocks = parse_blocks lines;
163 Added: });
164 Added: inline = (fun text -> [ Ui.text text ]);
165 Added: }
lib/prose/prose_mld.ml
index 00000000..8d8ad49a 000000..100644
@@ -0,0 +1,166 @@
1 Added: (** Mld (ocamldoc) documentation format.
2 Added:
3 Added: Parses section headings, code blocks, and paragraphs. Inline markup handles
4 Added: bold, italic, emphasis, and code spans. *)
5 Added:
6 Added: (* {1 Line classifiers} *)
7 Added:
8 Added: let heading line =
9 Added: let trimmed = String.trim line in
10 Added: let len = String.length trimmed in
11 Added: if len < 4 || trimmed.[0] <> '{' then None
12 Added: else
13 Added: match trimmed.[1] with
14 Added: | '0' .. '6' when len > 3 && trimmed.[2] = ' ' ->
15 Added: let level = Char.code trimmed.[1] - Char.code '0' in
16 Added: let text_start = 3 in
17 Added: let text_end = if trimmed.[len - 1] = '}' then len - 1 else len in
18 Added: let text =
19 Added: String.sub trimmed text_start (text_end - text_start) |> String.trim
20 Added: in
21 Added: Some (max 1 level, text)
22 Added: | _ -> None
23 Added:
24 Added: let code_block_open line =
25 Added: let trimmed = String.trim line in
26 Added: if String.starts_with ~prefix:"{[" trimmed then
27 Added: let rest = String.sub trimmed 2 (String.length trimmed - 2) in
28 Added: if
29 Added: String.length rest > 0
30 Added: && rest.[String.length rest - 1] = ']'
31 Added: && String.length rest > 1
32 Added: && rest.[String.length rest - 2] = '}'
33 Added: then
34 Added: (* Single-line code block: {[code]} on one line *)
35 Added: None
36 Added: else Some rest
37 Added: else None
38 Added:
39 Added: let code_block_single line =
40 Added: let trimmed = String.trim line in
41 Added: let len = String.length trimmed in
42 Added: if
43 Added: len >= 4
44 Added: && String.starts_with ~prefix:"{[" trimmed
45 Added: && trimmed.[len - 2] = ']'
46 Added: && trimmed.[len - 1] = '}'
47 Added: then Some (String.sub trimmed 2 (len - 4))
48 Added: else None
49 Added:
50 Added: let is_code_block_close line =
51 Added: let trimmed = String.trim line in
52 Added: String.length trimmed >= 2
53 Added: && trimmed.[String.length trimmed - 2] = ']'
54 Added: && trimmed.[String.length trimmed - 1] = '}'
55 Added:
56 Added: (* {1 Block parsing} *)
57 Added:
58 Added: let parse_blocks lines =
59 Added: let is_boundary line =
60 Added: String.trim line = ""
61 Added: || Option.is_some (heading line)
62 Added: || Option.is_some (code_block_open line)
63 Added: || Option.is_some (code_block_single line)
64 Added: in
65 Added: let rec take_paragraph collected = function
66 Added: | line :: _ as rest when is_boundary line -> (List.rev collected, rest)
67 Added: | line :: rest -> take_paragraph (String.trim line :: collected) rest
68 Added: | [] -> (List.rev collected, [])
69 Added: in
70 Added: let open Prose_format in
71 Added: let rec loop blocks = function
72 Added: | [] -> List.rev blocks
73 Added: | line :: rest when String.trim line = "" -> loop blocks rest
74 Added: | line :: rest -> (
75 Added: match heading line with
76 Added: | Some (level, text) -> loop (Heading (level, text) :: blocks) rest
77 Added: | None -> (
78 Added: match code_block_single line with
79 Added: | Some code -> loop (Code_block (None, code) :: blocks) rest
80 Added: | None -> (
81 Added: match code_block_open line with
82 Added: | Some first_line ->
83 Added: let code_lines, rest =
84 Added: Prose_format.take_until is_code_block_close [] rest
85 Added: in
86 Added: let all_lines =
87 Added: if first_line = "" then code_lines
88 Added: else first_line :: code_lines
89 Added: in
90 Added: let code = String.concat "\n" all_lines in
91 Added: loop (Code_block (None, code) :: blocks) rest
92 Added: | None ->
93 Added: let paragraph, rest = take_paragraph [] (line :: rest) in
94 Added: loop
95 Added: (Paragraph (String.concat " " paragraph) :: blocks)
96 Added: rest)))
97 Added: in
98 Added: loop [] lines
99 Added:
100 Added: (* {1 Inline markup} *)
101 Added:
102 Added: let inline text =
103 Added: let len = String.length text in
104 Added: let buf = Buffer.create 64 in
105 Added: let nodes = ref [] in
106 Added: let flush () =
107 Added: if Buffer.length buf > 0 then (
108 Added: nodes := Ui.text (Buffer.contents buf) :: !nodes;
109 Added: Buffer.clear buf)
110 Added: in
111 Added: let rec loop i =
112 Added: if i >= len then flush ()
113 Added: else
114 Added: match text.[i] with
115 Added: | '{' when i + 1 < len -> (
116 Added: match text.[i + 1] with
117 Added: | ('b' | 'i' | 'e') when i + 2 < len && text.[i + 2] = ' ' ->
118 Added: flush ();
119 Added: let close = find_brace_close (i + 3) 1 in
120 Added: let content = String.sub text (i + 3) (close - i - 3) in
121 Added: nodes :=
122 Added: Ui.inline ~class_:"readme-emphasis" [ Ui.text content ]
123 Added: :: !nodes;
124 Added: loop (close + 1)
125 Added: | '[' ->
126 Added: flush ();
127 Added: let close = find_code_close (i + 2) in
128 Added: let content = String.sub text (i + 2) (close - i - 2) in
129 Added: nodes := Ui.code_inline ~class_:"readme-code" content :: !nodes;
130 Added: loop (close + 2)
131 Added: | _ ->
132 Added: Buffer.add_char buf '{';
133 Added: loop (i + 1))
134 Added: | c ->
135 Added: Buffer.add_char buf c;
136 Added: loop (i + 1)
137 Added: and find_brace_close start depth =
138 Added: if start >= len then len
139 Added: else if text.[start] = '}' then
140 Added: if depth <= 1 then start else find_brace_close (start + 1) (depth - 1)
141 Added: else if text.[start] = '{' then find_brace_close (start + 1) (depth + 1)
142 Added: else find_brace_close (start + 1) depth
143 Added: and find_code_close start =
144 Added: if start + 1 >= len then len
145 Added: else if text.[start] = ']' && text.[start + 1] = '}' then start
146 Added: else find_code_close (start + 1)
147 Added: in
148 Added: loop 0;
149 Added: List.rev !nodes
150 Added:
151 Added: (* {1 Format definition} *)
152 Added:
153 Added: let format : Prose_format.format =
154 Added: {
155 Added: name = "mld";
156 Added: css_class = "readme-document readme-mld";
157 Added: parse =
158 Added: (fun content ->
159 Added: let lines = String.split_on_char '\n' content in
160 Added: {
161 Added: Prose_format.title = None;
162 Added: metadata = [];
163 Added: blocks = parse_blocks lines;
164 Added: });
165 Added: inline;
166 Added: }
lib/prose/prose_org.ml
index 00000000..837f9438 000000..100644
@@ -0,0 +1,308 @@
1 Added: (** Org mode documentation format.
2 Added:
3 Added: Parses Org headings, #+BEGIN_SRC blocks, metadata directives, unordered,
4 Added: ordered, and definition lists, and paragraphs. Inline markup handles
5 Added: =verbatim=, ~code~, and [[link][desc]] syntax. *)
6 Added:
7 Added: (* {1 Inline markup} *)
8 Added:
9 Added: let org_inline text =
10 Added: let len = String.length text in
11 Added: let buf = Buffer.create 64 in
12 Added: let nodes = ref [] in
13 Added: let flush () =
14 Added: if Buffer.length buf > 0 then (
15 Added: nodes := Ui.text (Buffer.contents buf) :: !nodes;
16 Added: Buffer.clear buf)
17 Added: in
18 Added: let rec loop i =
19 Added: if i >= len then flush ()
20 Added: else
21 Added: match text.[i] with
22 Added: | '[' when i + 1 < len && text.[i + 1] = '[' ->
23 Added: flush ();
24 Added: parse_link (i + 2)
25 Added: | ('=' | '~') as marker -> (
26 Added: let close = find_close marker (i + 1) in
27 Added: match close with
28 Added: | Some end_pos ->
29 Added: flush ();
30 Added: let content = String.sub text (i + 1) (end_pos - i - 1) in
31 Added: let node =
32 Added: match marker with
33 Added: | '~' -> Ui.code_inline ~class_:"readme-code" content
34 Added: | _ -> Ui.inline ~class_:"readme-verbatim" [ Ui.text content ]
35 Added: in
36 Added: nodes := node :: !nodes;
37 Added: loop (end_pos + 1)
38 Added: | None ->
39 Added: Buffer.add_char buf text.[i];
40 Added: loop (i + 1))
41 Added: | c ->
42 Added: Buffer.add_char buf c;
43 Added: loop (i + 1)
44 Added: and find_close marker start =
45 Added: let rec search j =
46 Added: if j >= len then None
47 Added: else if text.[j] = marker then Some j
48 Added: else if text.[j] = '\n' then None
49 Added: else search (j + 1)
50 Added: in
51 Added: if start >= len then None else search start
52 Added: and parse_link start =
53 Added: let rec find_end j _depth =
54 Added: if j >= len then None
55 Added: else if j + 1 < len && text.[j] = ']' && text.[j + 1] = ']' then Some j
56 Added: else find_end (j + 1) 0
57 Added: in
58 Added: match find_end start 0 with
59 Added: | None ->
60 Added: Buffer.add_string buf "[[";
61 Added: loop start
62 Added: | Some close_pos ->
63 Added: let inner = String.sub text start (close_pos - start) in
64 Added: let href, desc =
65 Added: match String.index_opt inner ']' with
66 Added: | Some bracket_pos
67 Added: when bracket_pos + 1 < String.length inner
68 Added: && inner.[bracket_pos + 1] = '[' ->
69 Added: let href = String.sub inner 0 bracket_pos in
70 Added: let desc =
71 Added: String.sub inner (bracket_pos + 2)
72 Added: (String.length inner - bracket_pos - 2)
73 Added: in
74 Added: (href, desc)
75 Added: | _ -> (inner, inner)
76 Added: in
77 Added: let node = Ui.link ~class_:"readme-link" ~href [ Ui.text desc ] in
78 Added: nodes := node :: !nodes;
79 Added: loop (close_pos + 2)
80 Added: in
81 Added: loop 0;
82 Added: List.rev !nodes
83 Added:
84 Added: (* {1 Line classifiers} *)
85 Added:
86 Added: let heading line =
87 Added: let length = String.length line in
88 Added: let rec count_stars index =
89 Added: if index < length && line.[index] = '*' then count_stars (index + 1)
90 Added: else index
91 Added: in
92 Added: let level = count_stars 0 in
93 Added: if level = 0 || level >= length || line.[level] <> ' ' then None
94 Added: else
95 Added: Some
96 Added: ( min 6 level,
97 Added: String.sub line (level + 1) (length - level - 1) |> String.trim )
98 Added:
99 Added: let unordered_item line =
100 Added: let length = String.length line in
101 Added: let trimmed = String.trim line in
102 Added: let tlen = String.length trimmed in
103 Added: if tlen >= 2 && List.mem trimmed.[0] [ '-'; '+' ] && trimmed.[1] = ' ' then
104 Added: Some (String.sub trimmed 2 (tlen - 2) |> String.trim)
105 Added: else if
106 Added: tlen >= 2
107 Added: && trimmed.[0] = '*'
108 Added: && trimmed.[1] = ' '
109 Added: && length > 0
110 Added: && (line.[0] = ' ' || line.[0] = '\t')
111 Added: then Some (String.sub trimmed 2 (tlen - 2) |> String.trim)
112 Added: else None
113 Added:
114 Added: let ordered_item line =
115 Added: let trimmed = String.trim line in
116 Added: let tlen = String.length trimmed in
117 Added: let rec digits i =
118 Added: if i < tlen && trimmed.[i] >= '0' && trimmed.[i] <= '9' then digits (i + 1)
119 Added: else i
120 Added: in
121 Added: let d = digits 0 in
122 Added: if d = 0 || d >= tlen then None
123 Added: else if
124 Added: (trimmed.[d] = '.' || trimmed.[d] = ')')
125 Added: && d + 1 < tlen
126 Added: && trimmed.[d + 1] = ' '
127 Added: then Some (String.sub trimmed (d + 2) (tlen - d - 2) |> String.trim)
128 Added: else None
129 Added:
130 Added: let definition_item line =
131 Added: let trimmed = String.trim line in
132 Added: let tlen = String.length trimmed in
133 Added: if tlen < 2 || trimmed.[0] <> '-' || trimmed.[1] <> ' ' then None
134 Added: else
135 Added: let rest = String.sub trimmed 2 (tlen - 2) in
136 Added: let rec find_sep i =
137 Added: if i + 3 >= String.length rest then None
138 Added: else if
139 Added: rest.[i] = ' '
140 Added: && rest.[i + 1] = ':'
141 Added: && rest.[i + 2] = ':'
142 Added: && rest.[i + 3] = ' '
143 Added: then
144 Added: let term = String.sub rest 0 i |> String.trim in
145 Added: let desc =
146 Added: String.sub rest (i + 4) (String.length rest - i - 4) |> String.trim
147 Added: in
148 Added: Some (term, desc)
149 Added: else find_sep (i + 1)
150 Added: in
151 Added: find_sep 0
152 Added:
153 Added: let src_begin line =
154 Added: let prefix = "#+begin_src" in
155 Added: let lower = String.lowercase_ascii (String.trim line) in
156 Added: if not (String.starts_with ~prefix lower) then None
157 Added: else
158 Added: let language =
159 Added: String.sub lower (String.length prefix)
160 Added: (String.length lower - String.length prefix)
161 Added: |> String.trim |> Prose_format.first_word
162 Added: in
163 Added: Some language
164 Added:
165 Added: let is_src_end line =
166 Added: String.trim line |> String.lowercase_ascii
167 Added: |> String.starts_with ~prefix:"#+end_src"
168 Added:
169 Added: (* {1 Block parsing} *)
170 Added:
171 Added: let is_boundary_common line =
172 Added: String.trim line = ""
173 Added: || Option.is_some (unordered_item line)
174 Added: || Option.is_some (ordered_item line)
175 Added: || Option.is_some (definition_item line)
176 Added:
177 Added: let parse_blocks lines =
178 Added: let is_boundary line =
179 Added: is_boundary_common line
180 Added: || Option.is_some (heading line)
181 Added: || Option.is_some (src_begin line)
182 Added: in
183 Added: let rec take_paragraph collected = function
184 Added: | line :: _ as rest when is_boundary line -> (List.rev collected, rest)
185 Added: | line :: rest -> take_paragraph (String.trim line :: collected) rest
186 Added: | [] -> (List.rev collected, [])
187 Added: in
188 Added: let rec take_unordered collected = function
189 Added: | line :: rest -> (
190 Added: match unordered_item line with
191 Added: | Some first_line ->
192 Added: let continuations, rest = Prose_format.take_continuations rest in
193 Added: let item = String.concat " " (first_line :: continuations) in
194 Added: take_unordered (item :: collected) rest
195 Added: | None -> (List.rev collected, line :: rest))
196 Added: | [] -> (List.rev collected, [])
197 Added: in
198 Added: let rec take_ordered collected = function
199 Added: | line :: rest -> (
200 Added: match ordered_item line with
201 Added: | Some first_line ->
202 Added: let continuations, rest = Prose_format.take_continuations rest in
203 Added: let item = String.concat " " (first_line :: continuations) in
204 Added: take_ordered (item :: collected) rest
205 Added: | None -> (List.rev collected, line :: rest))
206 Added: | [] -> (List.rev collected, [])
207 Added: in
208 Added: let rec take_definitions collected = function
209 Added: | line :: rest -> (
210 Added: match definition_item line with
211 Added: | Some (term, first_desc) ->
212 Added: let continuations, rest = Prose_format.take_continuations rest in
213 Added: let desc = String.concat " " (first_desc :: continuations) in
214 Added: take_definitions ((term, desc) :: collected) rest
215 Added: | None -> (List.rev collected, line :: rest))
216 Added: | [] -> (List.rev collected, [])
217 Added: in
218 Added: let open Prose_format in
219 Added: let rec loop blocks = function
220 Added: | [] -> List.rev blocks
221 Added: | line :: rest when String.trim line = "" -> loop blocks rest
222 Added: | line :: rest -> (
223 Added: match heading line with
224 Added: | Some (level, text) -> loop (Heading (level, text) :: blocks) rest
225 Added: | None -> (
226 Added: match src_begin line with
227 Added: | Some language ->
228 Added: let lines, rest = Prose_format.take_until is_src_end [] rest in
229 Added: loop
230 Added: (Code_block (language, String.concat "\n" lines) :: blocks)
231 Added: rest
232 Added: | None -> (
233 Added: match definition_item line with
234 Added: | Some _ ->
235 Added: let items, rest = take_definitions [] (line :: rest) in
236 Added: loop (Definition_list items :: blocks) rest
237 Added: | None -> (
238 Added: match unordered_item line with
239 Added: | Some _ ->
240 Added: let items, rest = take_unordered [] (line :: rest) in
241 Added: loop (Unordered_list items :: blocks) rest
242 Added: | None -> (
243 Added: match ordered_item line with
244 Added: | Some _ ->
245 Added: let items, rest = take_ordered [] (line :: rest) in
246 Added: loop (Ordered_list items :: blocks) rest
247 Added: | None ->
248 Added: let paragraph, rest =
249 Added: take_paragraph [] (line :: rest)
250 Added: in
251 Added: loop
252 Added: (Paragraph (String.concat " " paragraph) :: blocks)
253 Added: rest)))))
254 Added: in
255 Added: loop [] lines
256 Added:
257 Added: (* {1 Org metadata} *)
258 Added:
259 Added: let metadata_line line =
260 Added: let prefix = "#+" in
261 Added: let line = String.trim line in
262 Added: if not (String.starts_with ~prefix line) then None
263 Added: else
264 Added: match String.index_opt line ':' with
265 Added: | None -> None
266 Added: | Some colon ->
267 Added: let key = String.sub line 2 (colon - 2) |> String.lowercase_ascii in
268 Added: let value =
269 Added: String.sub line (colon + 1) (String.length line - colon - 1)
270 Added: |> String.trim
271 Added: in
272 Added: if List.mem key [ "title"; "author"; "date"; "email"; "language" ] then
273 Added: Some (key, value)
274 Added: else None
275 Added:
276 Added: let split_metadata lines =
277 Added: List.fold_left
278 Added: (fun (metadata, body) line ->
279 Added: match metadata_line line with
280 Added: | None -> (metadata, line :: body)
281 Added: | Some entry -> (entry :: metadata, body))
282 Added: ([], []) lines
283 Added: |> fun (metadata, body) -> (List.rev metadata, List.rev body)
284 Added:
285 Added: (* {1 Format definition} *)
286 Added:
287 Added: let format : Prose_format.format =
288 Added: {
289 Added: name = "org";
290 Added: css_class = "readme-document readme-org";
291 Added: parse =
292 Added: (fun content ->
293 Added: let lines = String.split_on_char '\n' content in
294 Added: let metadata, lines = split_metadata lines in
295 Added: let title =
296 Added: List.find_opt (fun (key, _) -> key = "title") metadata
297 Added: |> Option.map snd
298 Added: in
299 Added: let metadata_entries =
300 Added: List.filter (fun (key, _) -> key <> "title") metadata
301 Added: in
302 Added: {
303 Added: Prose_format.title;
304 Added: metadata = metadata_entries;
305 Added: blocks = parse_blocks lines;
306 Added: });
307 Added: inline = org_inline;
308 Added: }
lib/prose/prose_plaintext.ml
index 00000000..ba8b7260 000000..100644
@@ -0,0 +1,22 @@
1 Added: (** Plain text documentation format.
2 Added:
3 Added: Each non-blank line becomes a paragraph. No inline markup is applied. *)
4 Added:
5 Added: let format : Prose_format.format =
6 Added: {
7 Added: name = "plaintext";
8 Added: css_class = "readme-document readme-plaintext";
9 Added: parse =
10 Added: (fun content ->
11 Added: let lines = String.split_on_char '\n' content in
12 Added: let blocks =
13 Added: List.filter_map
14 Added: (fun line ->
15 Added: let trimmed = String.trim line in
16 Added: if trimmed = "" then None
17 Added: else Some (Prose_format.Paragraph trimmed))
18 Added: lines
19 Added: in
20 Added: { Prose_format.title = None; metadata = []; blocks });
21 Added: inline = (fun text -> [ Ui.text text ]);
22 Added: }
lib/readme.ml
index 3ebb4a48..00000000 100644..000000
@@ -1,633 +0,0 @@
1 Removed: (** README file detection and rendering.
2 Removed:
3 Removed: This module detects README filenames, selects the appropriate documentation
4 Removed: format (Markdown or Org), and delegates rendering to {!Doc_format}. *)
5 Removed:
6 Removed: let is_readme_filename filename =
7 Removed: Filename.basename filename |> String.lowercase_ascii
8 Removed: |> String.starts_with ~prefix:"readme"
9 Removed:
10 Removed: (* {1 Inline markup} *)
11 Removed:
12 Removed: (** Org inline markup: =verbatim=, ~code~, and [[link][desc]] / [[link]]. *)
13 Removed: let org_inline text =
14 Removed: let len = String.length text in
15 Removed: let buf = Buffer.create 64 in
16 Removed: let nodes = ref [] in
17 Removed: let flush () =
18 Removed: if Buffer.length buf > 0 then (
19 Removed: nodes := Ui.text (Buffer.contents buf) :: !nodes;
20 Removed: Buffer.clear buf)
21 Removed: in
22 Removed: let rec loop i =
23 Removed: if i >= len then flush ()
24 Removed: else
25 Removed: match text.[i] with
26 Removed: | '[' when i + 1 < len && text.[i + 1] = '[' ->
27 Removed: flush ();
28 Removed: parse_link (i + 2)
29 Removed: | ('=' | '~') as marker -> (
30 Removed: let close = find_close marker (i + 1) in
31 Removed: match close with
32 Removed: | Some end_pos ->
33 Removed: flush ();
34 Removed: let content = String.sub text (i + 1) (end_pos - i - 1) in
35 Removed: let node =
36 Removed: match marker with
37 Removed: | '~' -> Ui.code_inline ~class_:"readme-code" content
38 Removed: | _ -> Ui.inline ~class_:"readme-verbatim" [ Ui.text content ]
39 Removed: in
40 Removed: nodes := node :: !nodes;
41 Removed: loop (end_pos + 1)
42 Removed: | None ->
43 Removed: Buffer.add_char buf text.[i];
44 Removed: loop (i + 1))
45 Removed: | c ->
46 Removed: Buffer.add_char buf c;
47 Removed: loop (i + 1)
48 Removed: and find_close marker start =
49 Removed: let rec search j =
50 Removed: if j >= len then None
51 Removed: else if text.[j] = marker then Some j
52 Removed: else if text.[j] = '\n' then None
53 Removed: else search (j + 1)
54 Removed: in
55 Removed: if start >= len then None else search start
56 Removed: and parse_link start =
57 Removed: let rec find_end j _depth =
58 Removed: if j >= len then None
59 Removed: else if j + 1 < len && text.[j] = ']' && text.[j + 1] = ']' then Some j
60 Removed: else find_end (j + 1) 0
61 Removed: in
62 Removed: match find_end start 0 with
63 Removed: | None ->
64 Removed: Buffer.add_string buf "[[";
65 Removed: loop start
66 Removed: | Some close_pos ->
67 Removed: let inner = String.sub text start (close_pos - start) in
68 Removed: let href, desc =
69 Removed: match String.index_opt inner ']' with
70 Removed: | Some bracket_pos
71 Removed: when bracket_pos + 1 < String.length inner
72 Removed: && inner.[bracket_pos + 1] = '[' ->
73 Removed: let href = String.sub inner 0 bracket_pos in
74 Removed: let desc =
75 Removed: String.sub inner (bracket_pos + 2)
76 Removed: (String.length inner - bracket_pos - 2)
77 Removed: in
78 Removed: (href, desc)
79 Removed: | _ -> (inner, inner)
80 Removed: in
81 Removed: let node = Ui.link ~class_:"readme-link" ~href [ Ui.text desc ] in
82 Removed: nodes := node :: !nodes;
83 Removed: loop (close_pos + 2)
84 Removed: in
85 Removed: loop 0;
86 Removed: List.rev !nodes
87 Removed:
88 Removed: let plain_inline text = [ Ui.text text ]
89 Removed:
90 Removed: (* {1 Line classifiers} *)
91 Removed:
92 Removed: let trim_end_hashes text =
93 Removed: let text = String.trim text in
94 Removed: let rec last_non_hash index =
95 Removed: if index < 0 || text.[index] <> '#' then index else last_non_hash (index - 1)
96 Removed: in
97 Removed: let last = last_non_hash (String.length text - 1) in
98 Removed: String.sub text 0 (last + 1) |> String.trim
99 Removed:
100 Removed: let markdown_heading line =
101 Removed: let length = String.length line in
102 Removed: let rec count_hashes index =
103 Removed: if index < length && line.[index] = '#' then count_hashes (index + 1)
104 Removed: else index
105 Removed: in
106 Removed: let level = count_hashes 0 in
107 Removed: if level = 0 || level > 6 || level >= length || line.[level] <> ' ' then None
108 Removed: else
109 Removed: Some
110 Removed: ( level,
111 Removed: String.sub line (level + 1) (length - level - 1) |> trim_end_hashes )
112 Removed:
113 Removed: let org_heading line =
114 Removed: let length = String.length line in
115 Removed: let rec count_stars index =
116 Removed: if index < length && line.[index] = '*' then count_stars (index + 1)
117 Removed: else index
118 Removed: in
119 Removed: let level = count_stars 0 in
120 Removed: if level = 0 || level >= length || line.[level] <> ' ' then None
121 Removed: else
122 Removed: Some
123 Removed: ( min 6 level,
124 Removed: String.sub line (level + 1) (length - level - 1) |> String.trim )
125 Removed:
126 Removed: let unordered_item line =
127 Removed: let length = String.length line in
128 Removed: let trimmed = String.trim line in
129 Removed: let tlen = String.length trimmed in
130 Removed: if tlen >= 2 && List.mem trimmed.[0] [ '-'; '+' ] && trimmed.[1] = ' ' then
131 Removed: Some (String.sub trimmed 2 (tlen - 2) |> String.trim)
132 Removed: else if
133 Removed: tlen >= 2
134 Removed: && trimmed.[0] = '*'
135 Removed: && trimmed.[1] = ' '
136 Removed: && length > 0
137 Removed: && (line.[0] = ' ' || line.[0] = '\t')
138 Removed: then Some (String.sub trimmed 2 (tlen - 2) |> String.trim)
139 Removed: else None
140 Removed:
141 Removed: let ordered_item line =
142 Removed: let trimmed = String.trim line in
143 Removed: let tlen = String.length trimmed in
144 Removed: let rec digits i =
145 Removed: if i < tlen && trimmed.[i] >= '0' && trimmed.[i] <= '9' then digits (i + 1)
146 Removed: else i
147 Removed: in
148 Removed: let d = digits 0 in
149 Removed: if d = 0 || d >= tlen then None
150 Removed: else if
151 Removed: (trimmed.[d] = '.' || trimmed.[d] = ')')
152 Removed: && d + 1 < tlen
153 Removed: && trimmed.[d + 1] = ' '
154 Removed: then Some (String.sub trimmed (d + 2) (tlen - d - 2) |> String.trim)
155 Removed: else None
156 Removed:
157 Removed: let definition_item line =
158 Removed: let trimmed = String.trim line in
159 Removed: let tlen = String.length trimmed in
160 Removed: if tlen < 2 || trimmed.[0] <> '-' || trimmed.[1] <> ' ' then None
161 Removed: else
162 Removed: let rest = String.sub trimmed 2 (tlen - 2) in
163 Removed: let rec find_sep i =
164 Removed: if i + 3 >= String.length rest then None
165 Removed: else if
166 Removed: rest.[i] = ' '
167 Removed: && rest.[i + 1] = ':'
168 Removed: && rest.[i + 2] = ':'
169 Removed: && rest.[i + 3] = ' '
170 Removed: then
171 Removed: let term = String.sub rest 0 i |> String.trim in
172 Removed: let desc =
173 Removed: String.sub rest (i + 4) (String.length rest - i - 4) |> String.trim
174 Removed: in
175 Removed: Some (term, desc)
176 Removed: else find_sep (i + 1)
177 Removed: in
178 Removed: find_sep 0
179 Removed:
180 Removed: let markdown_fence line =
181 Removed: let line = String.trim line in
182 Removed: if String.length line < 3 then None
183 Removed: else
184 Removed: let marker = String.sub line 0 3 in
185 Removed: if marker <> "```" && marker <> "~~~" then None
186 Removed: else
187 Removed: let language =
188 Removed: String.sub line 3 (String.length line - 3)
189 Removed: |> String.trim |> Doc_format.first_word
190 Removed: in
191 Removed: Some (marker, language)
192 Removed:
193 Removed: let org_src_begin line =
194 Removed: let prefix = "#+begin_src" in
195 Removed: let lower = String.lowercase_ascii (String.trim line) in
196 Removed: if not (String.starts_with ~prefix lower) then None
197 Removed: else
198 Removed: let language =
199 Removed: String.sub lower (String.length prefix)
200 Removed: (String.length lower - String.length prefix)
201 Removed: |> String.trim |> Doc_format.first_word
202 Removed: in
203 Removed: Some language
204 Removed:
205 Removed: let is_org_src_end line =
206 Removed: String.trim line |> String.lowercase_ascii
207 Removed: |> String.starts_with ~prefix:"#+end_src"
208 Removed:
209 Removed: (* {1 Block parsing} *)
210 Removed:
211 Removed: let is_code_opener_markdown line = Option.is_some (markdown_fence line)
212 Removed: let is_code_opener_org line = Option.is_some (org_src_begin line)
213 Removed:
214 Removed: let is_boundary_common line =
215 Removed: String.trim line = ""
216 Removed: || Option.is_some (unordered_item line)
217 Removed: || Option.is_some (ordered_item line)
218 Removed: || Option.is_some (definition_item line)
219 Removed:
220 Removed: let parse_markdown_blocks lines =
221 Removed: let is_boundary line =
222 Removed: is_boundary_common line
223 Removed: || Option.is_some (markdown_heading line)
224 Removed: || is_code_opener_markdown line
225 Removed: in
226 Removed: let rec take_paragraph collected = function
227 Removed: | line :: _ as rest when is_boundary line -> (List.rev collected, rest)
228 Removed: | line :: rest -> take_paragraph (String.trim line :: collected) rest
229 Removed: | [] -> (List.rev collected, [])
230 Removed: in
231 Removed: let rec take_unordered collected = function
232 Removed: | line :: rest -> (
233 Removed: match unordered_item line with
234 Removed: | Some first_line ->
235 Removed: let continuations, rest = Doc_format.take_continuations rest in
236 Removed: let item = String.concat " " (first_line :: continuations) in
237 Removed: take_unordered (item :: collected) rest
238 Removed: | None -> (List.rev collected, line :: rest))
239 Removed: | [] -> (List.rev collected, [])
240 Removed: in
241 Removed: let rec take_ordered collected = function
242 Removed: | line :: rest -> (
243 Removed: match ordered_item line with
244 Removed: | Some first_line ->
245 Removed: let continuations, rest = Doc_format.take_continuations rest in
246 Removed: let item = String.concat " " (first_line :: continuations) in
247 Removed: take_ordered (item :: collected) rest
248 Removed: | None -> (List.rev collected, line :: rest))
249 Removed: | [] -> (List.rev collected, [])
250 Removed: in
251 Removed: let open Doc_format in
252 Removed: let rec loop blocks = function
253 Removed: | [] -> List.rev blocks
254 Removed: | line :: rest when String.trim line = "" -> loop blocks rest
255 Removed: | line :: rest -> (
256 Removed: match markdown_heading line with
257 Removed: | Some (level, text) -> loop (Heading (level, text) :: blocks) rest
258 Removed: | None -> (
259 Removed: match markdown_fence line with
260 Removed: | Some (marker, language) ->
261 Removed: let lines, rest =
262 Removed: Doc_format.take_until
263 Removed: (fun candidate ->
264 Removed: String.starts_with ~prefix:marker (String.trim candidate))
265 Removed: [] rest
266 Removed: in
267 Removed: loop
268 Removed: (Code_block (language, String.concat "\n" lines) :: blocks)
269 Removed: rest
270 Removed: | None -> (
271 Removed: match unordered_item line with
272 Removed: | Some _ ->
273 Removed: let items, rest = take_unordered [] (line :: rest) in
274 Removed: loop (Unordered_list items :: blocks) rest
275 Removed: | None -> (
276 Removed: match ordered_item line with
277 Removed: | Some _ ->
278 Removed: let items, rest = take_ordered [] (line :: rest) in
279 Removed: loop (Ordered_list items :: blocks) rest
280 Removed: | None ->
281 Removed: let paragraph, rest =
282 Removed: take_paragraph [] (line :: rest)
283 Removed: in
284 Removed: loop
285 Removed: (Paragraph (String.concat " " paragraph) :: blocks)
286 Removed: rest))))
287 Removed: in
288 Removed: loop [] lines
289 Removed:
290 Removed: let parse_org_blocks lines =
291 Removed: let is_boundary line =
292 Removed: is_boundary_common line
293 Removed: || Option.is_some (org_heading line)
294 Removed: || is_code_opener_org line
295 Removed: in
296 Removed: let rec take_paragraph collected = function
297 Removed: | line :: _ as rest when is_boundary line -> (List.rev collected, rest)
298 Removed: | line :: rest -> take_paragraph (String.trim line :: collected) rest
299 Removed: | [] -> (List.rev collected, [])
300 Removed: in
301 Removed: let rec take_unordered collected = function
302 Removed: | line :: rest -> (
303 Removed: match unordered_item line with
304 Removed: | Some first_line ->
305 Removed: let continuations, rest = Doc_format.take_continuations rest in
306 Removed: let item = String.concat " " (first_line :: continuations) in
307 Removed: take_unordered (item :: collected) rest
308 Removed: | None -> (List.rev collected, line :: rest))
309 Removed: | [] -> (List.rev collected, [])
310 Removed: in
311 Removed: let rec take_ordered collected = function
312 Removed: | line :: rest -> (
313 Removed: match ordered_item line with
314 Removed: | Some first_line ->
315 Removed: let continuations, rest = Doc_format.take_continuations rest in
316 Removed: let item = String.concat " " (first_line :: continuations) in
317 Removed: take_ordered (item :: collected) rest
318 Removed: | None -> (List.rev collected, line :: rest))
319 Removed: | [] -> (List.rev collected, [])
320 Removed: in
321 Removed: let rec take_definitions collected = function
322 Removed: | line :: rest -> (
323 Removed: match definition_item line with
324 Removed: | Some (term, first_desc) ->
325 Removed: let continuations, rest = Doc_format.take_continuations rest in
326 Removed: let desc = String.concat " " (first_desc :: continuations) in
327 Removed: take_definitions ((term, desc) :: collected) rest
328 Removed: | None -> (List.rev collected, line :: rest))
329 Removed: | [] -> (List.rev collected, [])
330 Removed: in
331 Removed: let open Doc_format in
332 Removed: let rec loop blocks = function
333 Removed: | [] -> List.rev blocks
334 Removed: | line :: rest when String.trim line = "" -> loop blocks rest
335 Removed: | line :: rest -> (
336 Removed: match org_heading line with
337 Removed: | Some (level, text) -> loop (Heading (level, text) :: blocks) rest
338 Removed: | None -> (
339 Removed: match org_src_begin line with
340 Removed: | Some language ->
341 Removed: let lines, rest =
342 Removed: Doc_format.take_until is_org_src_end [] rest
343 Removed: in
344 Removed: loop
345 Removed: (Code_block (language, String.concat "\n" lines) :: blocks)
346 Removed: rest
347 Removed: | None -> (
348 Removed: match definition_item line with
349 Removed: | Some _ ->
350 Removed: let items, rest = take_definitions [] (line :: rest) in
351 Removed: loop (Definition_list items :: blocks) rest
352 Removed: | None -> (
353 Removed: match unordered_item line with
354 Removed: | Some _ ->
355 Removed: let items, rest = take_unordered [] (line :: rest) in
356 Removed: loop (Unordered_list items :: blocks) rest
357 Removed: | None -> (
358 Removed: match ordered_item line with
359 Removed: | Some _ ->
360 Removed: let items, rest = take_ordered [] (line :: rest) in
361 Removed: loop (Ordered_list items :: blocks) rest
362 Removed: | None ->
363 Removed: let paragraph, rest =
364 Removed: take_paragraph [] (line :: rest)
365 Removed: in
366 Removed: loop
367 Removed: (Paragraph (String.concat " " paragraph) :: blocks)
368 Removed: rest)))))
369 Removed: in
370 Removed: loop [] lines
371 Removed:
372 Removed: (* {1 Org metadata} *)
373 Removed:
374 Removed: let org_metadata_line line =
375 Removed: let prefix = "#+" in
376 Removed: let line = String.trim line in
377 Removed: if not (String.starts_with ~prefix line) then None
378 Removed: else
379 Removed: match String.index_opt line ':' with
380 Removed: | None -> None
381 Removed: | Some colon ->
382 Removed: let key = String.sub line 2 (colon - 2) |> String.lowercase_ascii in
383 Removed: let value =
384 Removed: String.sub line (colon + 1) (String.length line - colon - 1)
385 Removed: |> String.trim
386 Removed: in
387 Removed: if List.mem key [ "title"; "author"; "date"; "email"; "language" ] then
388 Removed: Some (key, value)
389 Removed: else None
390 Removed:
391 Removed: let split_org_metadata lines =
392 Removed: List.fold_left
393 Removed: (fun (metadata, body) line ->
394 Removed: match org_metadata_line line with
395 Removed: | None -> (metadata, line :: body)
396 Removed: | Some entry -> (entry :: metadata, body))
397 Removed: ([], []) lines
398 Removed: |> fun (metadata, body) -> (List.rev metadata, List.rev body)
399 Removed:
400 Removed: (* {1 Format definitions} *)
401 Removed:
402 Removed: let markdown : Doc_format.format =
403 Removed: {
404 Removed: name = "markdown";
405 Removed: css_class = "readme-document readme-markdown";
406 Removed: parse =
407 Removed: (fun content ->
408 Removed: let lines = String.split_on_char '\n' content in
409 Removed: {
410 Removed: Doc_format.title = None;
411 Removed: metadata = [];
412 Removed: blocks = parse_markdown_blocks lines;
413 Removed: });
414 Removed: inline = plain_inline;
415 Removed: }
416 Removed:
417 Removed: let org : Doc_format.format =
418 Removed: {
419 Removed: name = "org";
420 Removed: css_class = "readme-document readme-org";
421 Removed: parse =
422 Removed: (fun content ->
423 Removed: let lines = String.split_on_char '\n' content in
424 Removed: let metadata, lines = split_org_metadata lines in
425 Removed: let title =
426 Removed: List.find_opt (fun (key, _) -> key = "title") metadata
427 Removed: |> Option.map snd
428 Removed: in
429 Removed: let metadata_entries =
430 Removed: List.filter (fun (key, _) -> key <> "title") metadata
431 Removed: in
432 Removed: {
433 Removed: Doc_format.title;
434 Removed: metadata = metadata_entries;
435 Removed: blocks = parse_org_blocks lines;
436 Removed: });
437 Removed: inline = org_inline;
438 Removed: }
439 Removed:
440 Removed: (* {1 Mld (ocamldoc) parsing} *)
441 Removed:
442 Removed: let mld_heading line =
443 Removed: let trimmed = String.trim line in
444 Removed: let len = String.length trimmed in
445 Removed: if len < 4 || trimmed.[0] <> '{' then None
446 Removed: else
447 Removed: match trimmed.[1] with
448 Removed: | '0' .. '6' when len > 3 && trimmed.[2] = ' ' ->
449 Removed: let level = Char.code trimmed.[1] - Char.code '0' in
450 Removed: let text_start = 3 in
451 Removed: let text_end = if trimmed.[len - 1] = '}' then len - 1 else len in
452 Removed: let text =
453 Removed: String.sub trimmed text_start (text_end - text_start) |> String.trim
454 Removed: in
455 Removed: Some (max 1 level, text)
456 Removed: | _ -> None
457 Removed:
458 Removed: let mld_code_block_open line =
459 Removed: let trimmed = String.trim line in
460 Removed: if String.starts_with ~prefix:"{[" trimmed then
461 Removed: let rest = String.sub trimmed 2 (String.length trimmed - 2) in
462 Removed: if
463 Removed: String.length rest > 0
464 Removed: && rest.[String.length rest - 1] = ']'
465 Removed: && String.length rest > 1
466 Removed: && rest.[String.length rest - 2] = '}'
467 Removed: then
468 Removed: (* Single-line code block: {[code]} on one line *)
469 Removed: None
470 Removed: else Some rest
471 Removed: else None
472 Removed:
473 Removed: let mld_code_block_single line =
474 Removed: let trimmed = String.trim line in
475 Removed: let len = String.length trimmed in
476 Removed: if
477 Removed: len >= 4
478 Removed: && String.starts_with ~prefix:"{[" trimmed
479 Removed: && trimmed.[len - 2] = ']'
480 Removed: && trimmed.[len - 1] = '}'
481 Removed: then Some (String.sub trimmed 2 (len - 4))
482 Removed: else None
483 Removed:
484 Removed: let is_mld_code_block_close line =
485 Removed: let trimmed = String.trim line in
486 Removed: String.length trimmed >= 2
487 Removed: && trimmed.[String.length trimmed - 2] = ']'
488 Removed: && trimmed.[String.length trimmed - 1] = '}'
489 Removed:
490 Removed: let parse_mld_blocks lines =
491 Removed: let is_boundary line =
492 Removed: String.trim line = ""
493 Removed: || Option.is_some (mld_heading line)
494 Removed: || Option.is_some (mld_code_block_open line)
495 Removed: || Option.is_some (mld_code_block_single line)
496 Removed: in
497 Removed: let rec take_paragraph collected = function
498 Removed: | line :: _ as rest when is_boundary line -> (List.rev collected, rest)
499 Removed: | line :: rest -> take_paragraph (String.trim line :: collected) rest
500 Removed: | [] -> (List.rev collected, [])
501 Removed: in
502 Removed: let open Doc_format in
503 Removed: let rec loop blocks = function
504 Removed: | [] -> List.rev blocks
505 Removed: | line :: rest when String.trim line = "" -> loop blocks rest
506 Removed: | line :: rest -> (
507 Removed: match mld_heading line with
508 Removed: | Some (level, text) -> loop (Heading (level, text) :: blocks) rest
509 Removed: | None -> (
510 Removed: match mld_code_block_single line with
511 Removed: | Some code -> loop (Code_block (None, code) :: blocks) rest
512 Removed: | None -> (
513 Removed: match mld_code_block_open line with
514 Removed: | Some first_line ->
515 Removed: let code_lines, rest =
516 Removed: Doc_format.take_until is_mld_code_block_close [] rest
517 Removed: in
518 Removed: let all_lines =
519 Removed: if first_line = "" then code_lines
520 Removed: else first_line :: code_lines
521 Removed: in
522 Removed: let code = String.concat "\n" all_lines in
523 Removed: (* Strip trailing ]} if present in last consumed line *)
524 Removed: loop (Code_block (None, code) :: blocks) rest
525 Removed: | None ->
526 Removed: let paragraph, rest = take_paragraph [] (line :: rest) in
527 Removed: loop
528 Removed: (Paragraph (String.concat " " paragraph) :: blocks)
529 Removed: rest)))
530 Removed: in
531 Removed: loop [] lines
532 Removed:
533 Removed: let mld_inline text =
534 Removed: let len = String.length text in
535 Removed: let buf = Buffer.create 64 in
536 Removed: let nodes = ref [] in
537 Removed: let flush () =
538 Removed: if Buffer.length buf > 0 then (
539 Removed: nodes := Ui.text (Buffer.contents buf) :: !nodes;
540 Removed: Buffer.clear buf)
541 Removed: in
542 Removed: let rec loop i =
543 Removed: if i >= len then flush ()
544 Removed: else
545 Removed: match text.[i] with
546 Removed: | '{' when i + 1 < len -> (
547 Removed: match text.[i + 1] with
548 Removed: | ('b' | 'i' | 'e') when i + 2 < len && text.[i + 2] = ' ' ->
549 Removed: flush ();
550 Removed: let close = find_brace_close (i + 3) 1 in
551 Removed: let content = String.sub text (i + 3) (close - i - 3) in
552 Removed: nodes :=
553 Removed: Ui.inline ~class_:"readme-emphasis" [ Ui.text content ]
554 Removed: :: !nodes;
555 Removed: loop (close + 1)
556 Removed: | '[' ->
557 Removed: flush ();
558 Removed: let close = find_code_close (i + 2) in
559 Removed: let content = String.sub text (i + 2) (close - i - 2) in
560 Removed: nodes := Ui.code_inline ~class_:"readme-code" content :: !nodes;
561 Removed: loop (close + 2)
562 Removed: | _ ->
563 Removed: Buffer.add_char buf '{';
564 Removed: loop (i + 1))
565 Removed: | c ->
566 Removed: Buffer.add_char buf c;
567 Removed: loop (i + 1)
568 Removed: and find_brace_close start depth =
569 Removed: if start >= len then len
570 Removed: else if text.[start] = '}' then
571 Removed: if depth <= 1 then start else find_brace_close (start + 1) (depth - 1)
572 Removed: else if text.[start] = '{' then find_brace_close (start + 1) (depth + 1)
573 Removed: else find_brace_close (start + 1) depth
574 Removed: and find_code_close start =
575 Removed: if start + 1 >= len then len
576 Removed: else if text.[start] = ']' && text.[start + 1] = '}' then start
577 Removed: else find_code_close (start + 1)
578 Removed: in
579 Removed: loop 0;
580 Removed: List.rev !nodes
581 Removed:
582 Removed: let mld : Doc_format.format =
583 Removed: {
584 Removed: name = "mld";
585 Removed: css_class = "readme-document readme-mld";
586 Removed: parse =
587 Removed: (fun content ->
588 Removed: let lines = String.split_on_char '\n' content in
589 Removed: {
590 Removed: Doc_format.title = None;
591 Removed: metadata = [];
592 Removed: blocks = parse_mld_blocks lines;
593 Removed: });
594 Removed: inline = mld_inline;
595 Removed: }
596 Removed:
597 Removed: (* {1 Plain text} *)
598 Removed:
599 Removed: let plaintext : Doc_format.format =
600 Removed: {
601 Removed: name = "plaintext";
602 Removed: css_class = "readme-document readme-plaintext";
603 Removed: parse =
604 Removed: (fun content ->
605 Removed: let lines = String.split_on_char '\n' content in
606 Removed: let blocks =
607 Removed: List.filter_map
608 Removed: (fun line ->
609 Removed: let trimmed = String.trim line in
610 Removed: if trimmed = "" then None else Some (Doc_format.Paragraph trimmed))
611 Removed: lines
612 Removed: in
613 Removed: { Doc_format.title = None; metadata = []; blocks });
614 Removed: inline = plain_inline;
615 Removed: }
616 Removed:
617 Removed: (* {1 Public API} *)
618 Removed:
619 Removed: let format_of_filename filename =
620 Removed: match Filename.extension filename |> String.lowercase_ascii with
621 Removed: | ".org" -> org
622 Removed: | ".mld" -> mld
623 Removed: | ".txt" -> plaintext
624 Removed: | _ -> markdown
625 Removed:
626 Removed: let is_doc_filename filename =
627 Removed: match Filename.extension filename |> String.lowercase_ascii with
628 Removed: | ".md" | ".markdown" | ".org" | ".mld" | ".txt" -> true
629 Removed: | _ -> false
630 Removed:
631 Removed: let render ~filename content =
632 Removed: let format = format_of_filename filename in
633 Removed: Doc_format.render format content
lib/views/components.ml
index 06ca6ffe..50bc9323 100644..100644
@@ -165,4 +165,4 @@
165 165 Markdown and Org mode receive dedicated rendering; other README filenames
166 166 use the Markdown-compatible fallback until additional formats are added. *)
167 167 let inline_readme ?(filename = "README.md") content =
168 Removed: Readme.render ~filename content
168 Added: Prose.render ~filename content
lib/views/repo.ml
index e3d9f473..f0b9a73d 100644..100644
@@ -305,8 +305,8 @@
305 305 in
306 306 Ui.block ~class_:"image-preview"
307 307 [ Ui.image ~class_:"file-image" ~alt:filename ~src () ]
308 Removed: | Some filename when Readme.is_doc_filename filename ->
309 Removed: Readme.render ~filename blob.content
308 Added: | Some filename when Prose.is_doc_filename filename ->
309 Added: Prose.render ~filename blob.content
310 310 | _ ->
311 311 let language = Syntax.detect ~filename blob.content in
312 312 let lines = Highlight.highlight ~lang:language blob.content in
test/test_readme.ml
index ac98ab98..528023f1 100644..100644
@@ -11,7 +11,7 @@
11 11 fragment_length <= text_length && loop 0
12 12
13 13 let render ~filename content =
14 Removed: Ogit.Readme.render ~filename content |> Dream_html.to_string
14 Added: Ogit.Prose.render ~filename content |> Dream_html.to_string
15 15
16 16 let test_markdown_document () =
17 17 let html =
@@ -61,10 +61,10 @@
61 61 let test_readme_filename_detection () =
62 62 Alcotest.(check bool)
63 63 "case-insensitive README name" true
64 Removed: (Ogit.Readme.is_readme_filename "ReadMe.ORG");
64 Added: (Ogit.Prose.is_readme_filename "ReadMe.ORG");
65 65 Alcotest.(check bool)
66 66 "ordinary file is not a README" false
67 Removed: (Ogit.Readme.is_readme_filename "guide.md")
67 Added: (Ogit.Prose.is_readme_filename "guide.md")
68 68
69 69 let test_markdown_toc () =
70 70 let html =