Something went wrong. Try again.
static-site-generator blogging hypertext ocaml
Something went wrong. Try again.
4.0 kB · 129 lines
OCaml
at main
123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130(* * SPDX-FileCopyrightText: 2024 The Forester Project Contributors * SPDX-FileCopyrightText: 2026 The Forester Project Contributors * * SPDX-License-Identifier: GPL-3.0-or-later *)
open Bwd
(* Based on cmap_utf_8 from https://erratique.ch/software/uucp/doc/Uucp/Case/index.html#caseexamples *)let title_case_word s = let did_uppercase = ref false in let rec loop buf s i max = if i > max then Buffer.contents buf else let dec = String.get_utf_8_uchar s i in let u = Uchar.utf_decode_uchar dec in let should_ignore = Uucp.Case.is_case_ignorable u || not (Uucp.Case.is_cased u) in let () = match should_ignore || !did_uppercase with | true -> Buffer.add_utf_8_uchar buf u | false -> ( did_uppercase := true; match Uucp.Case.Map.to_upper u with | `Self -> Buffer.add_utf_8_uchar buf u | `Uchars us -> List.iter (Buffer.add_utf_8_uchar buf) us) in loop buf s (i + Uchar.utf_decode_length dec) max in let buf = Buffer.create @@ (String.length s * 2) in loop buf s 0 @@ (String.length s - 1)
let sentence_case str = let words = String.split_on_char ' ' str in String.concat " " @@ List.mapi (fun i word -> if i = 0 then title_case_word word else word) words
let trim_newlines str = let rec process_lines lines = match lines with | [] -> [] | "" :: lines -> process_lines lines | _ -> lines in let lines = String.split_on_char '\n' str in String.concat "\n" @@ List.rev @@ process_lines @@ List.rev @@ process_lines lines
let trim_trailing_whitespace str = let rec process_chars rstr = match rstr with | '\n' :: rstr -> process_chars rstr | ' ' :: rstr -> process_chars rstr | '\t' :: rstr -> process_chars rstr | _ -> List.rev rstr in let n = String.length str in let chars = List.rev @@ List.init n (String.get str) in String.of_seq @@ List.to_seq @@ process_chars @@ chars
let explode str = List.init (String.length str) (String.get str)let implode chars = String.init (List.length chars) (List.nth chars)let implode_bwd chars = implode (Bwd.to_list chars)
(* Chars above 0xFFFF are surrogate pairs: https://en.wikipedia.org/wiki/UTF-16#Code_points_from_U+010000_to_U+10FFFF *)let utf16_length_of_uchar u = if Uchar.to_int u > 0xFFFF then 2 else 1
let utf16_length (s : string) : int = (* Can't use String.to_seq, since each "char" would just be a single byte*) let n = String.length s in let rec loop i acc = if i >= n then acc else let dec = String.get_utf_8_uchar s i in loop (i + Uchar.utf_decode_length dec) (acc + utf16_length_of_uchar (Uchar.utf_decode_uchar dec)) in loop 0 0
let byte_offset_of_utf16_offset (s : string) (units : int) : int = let n = String.length s in let rec loop i units = if units <= 0 || i >= n then i else let dec = String.get_utf_8_uchar s i in loop (i + Uchar.utf_decode_length dec) (units - utf16_length_of_uchar (Uchar.utf_decode_uchar dec)) in loop 0 units
let html_escape (s : string) : string = let buf = Buffer.create (String.length s) in String.iter (function | '&' -> Buffer.add_string buf "&" | '<' -> Buffer.add_string buf "<" | '>' -> Buffer.add_string buf ">" | '"' -> Buffer.add_string buf """ | c -> Buffer.add_char buf c) s; Buffer.contents buf
let is_ident_char = function | 'a' .. 'z' | 'A' .. 'Z' | '0' .. '9' | '-' | '_' | '/' -> true | _ -> false
let truncate_at_word ~max s = if String.length s <= max then s else let cut = match String.rindex_from_opt s max ' ' with | Some i when i > 0 -> i | _ -> max in String.sub s 0 cut ^ "…"
let collapse_whitespace s = String.split_on_char ' ' (String.map (function '\n' | '\t' | '\r' -> ' ' | c -> c) s) |> List.filter (( <> ) "") |> String.concat " "