···
+
(** Check if string contains any whitespace *)
+
let _ = Str.search_forward (Str.regexp "[ \t\n\r]") s 0 in
+
with Not_found -> false
(** Clean up excessive newlines and normalize spacing *)
···
(* Trim leading and trailing whitespace *)
+
(** 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
+
(* State: track if we need to insert a space before next text *)
+
let need_space = ref false in
+
(* Get last character in buffer, if any *)
+
let len = Buffer.length buffer in
+
else Some (Buffer.nth buffer (len - 1))
+
(* Add text with proper spacing *)
+
let trimmed = String.trim text in
+
if trimmed <> "" then begin
+
(* Add space if needed and last char isn't already whitespace *)
+
if !need_space then begin
+
match last_char () with
+
| Some (' ' | '\n') -> ()
+
| _ -> Buffer.add_char buffer ' '
+
Buffer.add_string buffer trimmed;
+
(* Mark that we need space before next text (for inline elements) *)
+
let mark_space_needed () =
+
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
+
(* Block elements - reset space tracking *)
Buffer.add_string buffer "\n# ";
Soup.children elem |> Soup.iter process_node;
+
Buffer.add_string buffer "\n\n";
Buffer.add_string buffer "\n## ";
Soup.children elem |> Soup.iter process_node;
+
Buffer.add_string buffer "\n\n";
Buffer.add_string buffer "\n### ";
Soup.children elem |> Soup.iter process_node;
+
Buffer.add_string buffer "\n\n";
Buffer.add_string buffer "\n#### ";
Soup.children elem |> Soup.iter process_node;
+
Buffer.add_string buffer "\n\n";
Buffer.add_string buffer "\n##### ";
Soup.children elem |> Soup.iter process_node;
+
Buffer.add_string buffer "\n\n";
Buffer.add_string buffer "\n###### ";
Soup.children elem |> Soup.iter process_node;
+
Buffer.add_string buffer "\n\n";
Soup.children elem |> Soup.iter process_node;
+
Buffer.add_string buffer "\n\n";
+
Buffer.add_string buffer "\n";
+
(* Inline elements - preserve space tracking *)
Buffer.add_string buffer "**";
Soup.children elem |> Soup.iter process_node;
+
Buffer.add_string buffer "**";
Buffer.add_string buffer "*";
Soup.children elem |> Soup.iter process_node;
+
Buffer.add_string buffer "*";
Buffer.add_string buffer "`";
Soup.children elem |> Soup.iter process_node;
+
Buffer.add_string buffer "`";
Buffer.add_string buffer "\n```\n";
Soup.children elem |> Soup.iter process_node;
+
Buffer.add_string buffer "\n```\n\n";
+
let text = Soup.texts elem |> String.concat " " |> String.trim in
+
let href = Soup.attribute "href" elem in
Buffer.add_string buffer (Printf.sprintf "<%s>" href)
+
Buffer.add_string buffer (Printf.sprintf "[%s](%s)" text href);
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" ->
Buffer.add_string buffer (Printf.sprintf "%d. " (i + 1))
···
Buffer.add_string buffer "\n"
+
Buffer.add_string buffer "\n";
Buffer.add_string buffer "\n> ";
Soup.children elem |> Soup.iter process_node;
+
Buffer.add_string buffer "\n\n";
let alt = Soup.attribute "alt" elem |> Option.value ~default:"" in
let src = Soup.attribute "src" elem |> Option.value ~default:"" in
+
Buffer.add_string buffer (Printf.sprintf "" alt src);
+
Buffer.add_string buffer "\n---\n\n";
(* Strip these tags but keep content *)
| "div" | "span" | "article" | "section" | "header" | "footer"
+
| "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)
+
(* Text node - handle whitespace properly *)
match Soup.leaf_text node with
+
(* If text is only whitespace, mark that we need space *)
+
let trimmed = String.trim text in
+
if trimmed = "" then begin
+
if has_whitespace text then
+
(* Text has content - check if it had leading/trailing whitespace *)
+
let had_leading_ws = has_whitespace text &&
+
(String.length text > 0 &&
+
(text.[0] = ' ' || text.[0] = '\t' || text.[0] = '\n' || text.[0] = '\r')) in
+
(* If had leading whitespace, mark we need space *)
+
if had_leading_ws then need_space := true;
+
(* Add the text content *)
+
(* If had trailing whitespace, mark we need space for next *)
+
let had_trailing_ws = has_whitespace text &&
+
(String.length text > 0 &&
+
let last = text.[String.length text - 1] in
+
last = ' ' || last = '\t' || last = '\n' || last = '\r') in
+
if had_trailing_ws then need_space := true
anil.recoil.org