···
18
-
(** Normalize whitespace while preserving boundary spaces *)
19
-
let normalize_whitespace s =
20
-
let len = String.length s in
23
-
(* Check if original had leading/trailing whitespace *)
24
-
let has_leading = len > 0 && (s.[0] = ' ' || s.[0] = '\t' || s.[0] = '\n' || s.[0] = '\r') in
25
-
let has_trailing = len > 0 && (s.[len-1] = ' ' || s.[len-1] = '\t' || s.[len-1] = '\n' || s.[len-1] = '\r') in
27
-
(* Collapse multiple whitespace to single space *)
28
-
let normalized = Str.global_replace (Str.regexp "[ \t\n\r]+") " " s in
29
-
let trimmed = String.trim normalized in
31
-
(* If the trimmed result is empty but there was whitespace, return single space *)
32
-
if trimmed = "" && (has_leading || has_trailing) then " "
34
-
(* Add back boundary spaces if they existed *)
36
-
(if has_leading && trimmed <> "" then " " else "") ^
38
-
(if has_trailing && trimmed <> "" then " " else "")
18
+
(** Check if string contains any whitespace *)
19
+
let has_whitespace s =
21
+
let _ = Str.search_forward (Str.regexp "[ \t\n\r]") s 0 in
23
+
with Not_found -> false
(** Clean up excessive newlines and normalize spacing *)
···
(* Trim leading and trailing whitespace *)
71
-
(** Convert HTML to Markdown *)
54
+
(** Convert HTML to Markdown using state-based whitespace handling *)
let html_to_markdown html_str =
let soup = Soup.parse html_str in
let buffer = Buffer.create 256 in
60
+
(* State: track if we need to insert a space before next text *)
61
+
let need_space = ref false in
63
+
(* Get last character in buffer, if any *)
65
+
let len = Buffer.length buffer in
66
+
if len = 0 then None
67
+
else Some (Buffer.nth buffer (len - 1))
70
+
(* Add text with proper spacing *)
72
+
let trimmed = String.trim text in
73
+
if trimmed <> "" then begin
74
+
(* Add space if needed and last char isn't already whitespace *)
75
+
if !need_space then begin
76
+
match last_char () with
77
+
| Some (' ' | '\n') -> ()
78
+
| _ -> Buffer.add_char buffer ' '
80
+
Buffer.add_string buffer trimmed;
85
+
(* Mark that we need space before next text (for inline elements) *)
86
+
let mark_space_needed () =
87
+
need_space := has_whitespace (Buffer.contents buffer) || Buffer.length buffer > 0
let rec process_node node =
match Soup.element node with
let tag = Soup.name elem in
95
+
(* Block elements - reset space tracking *)
97
+
need_space := false;
Buffer.add_string buffer "\n# ";
Soup.children elem |> Soup.iter process_node;
85
-
Buffer.add_string buffer "\n\n"
100
+
Buffer.add_string buffer "\n\n";
101
+
need_space := false
103
+
need_space := false;
Buffer.add_string buffer "\n## ";
Soup.children elem |> Soup.iter process_node;
89
-
Buffer.add_string buffer "\n\n"
106
+
Buffer.add_string buffer "\n\n";
107
+
need_space := false
109
+
need_space := false;
Buffer.add_string buffer "\n### ";
Soup.children elem |> Soup.iter process_node;
93
-
Buffer.add_string buffer "\n\n"
112
+
Buffer.add_string buffer "\n\n";
113
+
need_space := false
115
+
need_space := false;
Buffer.add_string buffer "\n#### ";
Soup.children elem |> Soup.iter process_node;
97
-
Buffer.add_string buffer "\n\n"
118
+
Buffer.add_string buffer "\n\n";
119
+
need_space := false
121
+
need_space := false;
Buffer.add_string buffer "\n##### ";
Soup.children elem |> Soup.iter process_node;
101
-
Buffer.add_string buffer "\n\n"
124
+
Buffer.add_string buffer "\n\n";
125
+
need_space := false
127
+
need_space := false;
Buffer.add_string buffer "\n###### ";
Soup.children elem |> Soup.iter process_node;
105
-
Buffer.add_string buffer "\n\n"
130
+
Buffer.add_string buffer "\n\n";
131
+
need_space := false
133
+
need_space := false;
Soup.children elem |> Soup.iter process_node;
108
-
Buffer.add_string buffer "\n\n"
135
+
Buffer.add_string buffer "\n\n";
136
+
need_space := false
110
-
Buffer.add_string buffer "\n"
138
+
Buffer.add_string buffer "\n";
139
+
need_space := false
140
+
(* Inline elements - preserve space tracking *)
Buffer.add_string buffer "**";
143
+
need_space := false;
Soup.children elem |> Soup.iter process_node;
114
-
Buffer.add_string buffer "**"
145
+
Buffer.add_string buffer "**";
146
+
mark_space_needed ()
Buffer.add_string buffer "*";
149
+
need_space := false;
Soup.children elem |> Soup.iter process_node;
118
-
Buffer.add_string buffer "*"
151
+
Buffer.add_string buffer "*";
152
+
mark_space_needed ()
Buffer.add_string buffer "`";
155
+
need_space := false;
Soup.children elem |> Soup.iter process_node;
122
-
Buffer.add_string buffer "`"
157
+
Buffer.add_string buffer "`";
158
+
mark_space_needed ()
160
+
need_space := false;
Buffer.add_string buffer "\n```\n";
Soup.children elem |> Soup.iter process_node;
126
-
Buffer.add_string buffer "\n```\n\n"
163
+
Buffer.add_string buffer "\n```\n\n";
164
+
need_space := false
128
-
let text = Soup.texts elem |> String.concat "" |> String.trim in
129
-
(match Soup.attribute "href" elem with
166
+
let text = Soup.texts elem |> String.concat " " |> String.trim in
167
+
let href = Soup.attribute "href" elem in
Buffer.add_string buffer (Printf.sprintf "<%s>" href)
134
-
Buffer.add_string buffer (Printf.sprintf "[%s](%s)" text href)
135
-
| None -> Buffer.add_string buffer text)
173
+
Buffer.add_string buffer (Printf.sprintf "[%s](%s)" text href);
174
+
mark_space_needed ()
178
+
need_space := false;
Buffer.add_string buffer "\n";
let is_ordered = tag = "ol" in
let items = Soup.children elem |> Soup.to_list in
List.iteri (fun i item ->
match Soup.element item with
| Some li when Soup.name li = "li" ->
185
+
need_space := false;
Buffer.add_string buffer (Printf.sprintf "%d. " (i + 1))
···
Buffer.add_string buffer "\n"
151
-
Buffer.add_string buffer "\n"
194
+
Buffer.add_string buffer "\n";
195
+
need_space := false
197
+
need_space := false;
Buffer.add_string buffer "\n> ";
Soup.children elem |> Soup.iter process_node;
155
-
Buffer.add_string buffer "\n\n"
200
+
Buffer.add_string buffer "\n\n";
201
+
need_space := false
let alt = Soup.attribute "alt" elem |> Option.value ~default:"" in
let src = Soup.attribute "src" elem |> Option.value ~default:"" in
159
-
Buffer.add_string buffer (Printf.sprintf "" alt src)
205
+
Buffer.add_string buffer (Printf.sprintf "" alt src);
206
+
mark_space_needed ()
161
-
Buffer.add_string buffer "\n---\n\n"
208
+
need_space := false;
209
+
Buffer.add_string buffer "\n---\n\n";
210
+
need_space := false
(* Strip these tags but keep content *)
| "div" | "span" | "article" | "section" | "header" | "footer"
164
-
| "main" | "nav" | "aside" | "figure" | "figcaption" ->
213
+
| "main" | "nav" | "aside" | "figure" | "figcaption" | "details" | "summary" ->
Soup.children elem |> Soup.iter process_node
(* Ignore script, style, etc *)
| "script" | "style" | "noscript" -> ()
···
Soup.children elem |> Soup.iter process_node)
221
+
(* Text node - handle whitespace properly *)
match Soup.leaf_text node with
175
-
let normalized = normalize_whitespace text in
176
-
if normalized <> "" then
177
-
Buffer.add_string buffer normalized
224
+
(* If text is only whitespace, mark that we need space *)
225
+
let trimmed = String.trim text in
226
+
if trimmed = "" then begin
227
+
if has_whitespace text then
230
+
(* Text has content - check if it had leading/trailing whitespace *)
231
+
let had_leading_ws = has_whitespace text &&
232
+
(String.length text > 0 &&
233
+
(text.[0] = ' ' || text.[0] = '\t' || text.[0] = '\n' || text.[0] = '\r')) in
235
+
(* If had leading whitespace, mark we need space *)
236
+
if had_leading_ws then need_space := true;
238
+
(* Add the text content *)
241
+
(* If had trailing whitespace, mark we need space for next *)
242
+
let had_trailing_ws = has_whitespace text &&
243
+
(String.length text > 0 &&
244
+
let last = text.[String.length text - 1] in
245
+
last = ' ' || last = '\t' || last = '\n' || last = '\r') in
246
+
if had_trailing_ws then need_space := true
anil.recoil.org