type flavour = Latex | Groff | Html | Xml | Ics | None_

let all = [ Latex; Groff; Html; Xml; Ics; None_ ]

let to_string = function
  | Latex -> "latex" | Groff -> "groff" | Html -> "html"
  | Xml -> "xml" | Ics -> "ics" | None_ -> "none"

let of_string = function
  | "latex" -> Some Latex | "groff" -> Some Groff | "html" -> Some Html
  | "xml" -> Some Xml | "ics" -> Some Ics | "none" -> Some None_
  | _ -> None

let of_extension = function
  | ".tex" -> Some Latex
  | ".ms" | ".mom" | ".me" -> Some Groff
  | ".html" | ".htm" -> Some Html
  | ".xml" -> Some Xml
  | ".ics" -> Some Ics
  | ".md" | ".adoc" | ".txt" -> Some None_
  | _ -> None

(* Replace each character with its expansion, in ONE pass. A sequence of
   String.concat replacements would double-escape: "&" -> "\\&" then the
   backslash rule would rewrite the backslash it just introduced. *)
let expand f s =
  let b = Buffer.create (String.length s + 16) in
  String.iter (fun c -> Buffer.add_string b (f c)) s;
  Buffer.contents b

let latex = function
  | '\\' -> "\\textbackslash{}"
  | '{' -> "\\{" | '}' -> "\\}"
  | '$' -> "\\$" | '&' -> "\\&" | '#' -> "\\#"
  | '_' -> "\\_" | '%' -> "\\%"
  | '^' -> "\\textasciicircum{}"
  | '~' -> "\\textasciitilde{}"
  | c -> String.make 1 c

let html = function
  | '&' -> "&amp;" | '<' -> "&lt;" | '>' -> "&gt;"
  | '"' -> "&quot;" | '\'' -> "&#39;"
  | c -> String.make 1 c

let ics = function
  | '\\' -> "\\\\" | ';' -> "\\;" | ',' -> "\\,"
  | '\n' -> "\\n" | '\r' -> ""
  | c -> String.make 1 c

(* groff: a backslash starts an escape, and a '.' or '\'' in COLUMN ONE starts a
   request. \& is the zero-width non-printing character that defuses it. *)
let groff s =
  let escaped = expand (function '\\' -> "\\e" | c -> String.make 1 c) s in
  if String.length escaped > 0 && (escaped.[0] = '.' || escaped.[0] = '\'') then "\\&" ^ escaped
  else escaped

let apply flavour s =
  match flavour with
  | Latex -> expand latex s
  | Groff -> groff s
  | Html | Xml -> expand html s
  | Ics -> expand ics s
  | None_ -> s

(* RFC 5545 section 3.1. A continuation byte is 0x80-0xBF; backing off to a
   non-continuation byte keeps every fold on a character boundary. *)
let fold_ics line =
  let n = String.length line in
  let b = Buffer.create (n + (n / 70) + 8) in
  let is_cont c = Char.code c land 0xC0 = 0x80 in
  let rec go pos first =
    let limit = if first then 75 else 74 (* the leading space costs one octet *) in
    if n - pos <= limit then (
      if not first then Buffer.add_char b ' ';
      Buffer.add_string b (String.sub line pos (n - pos));
      Buffer.add_string b "\r\n")
    else begin
      let cut = ref (pos + limit) in
      while !cut > pos && is_cont line.[!cut] do decr cut done;
      if not first then Buffer.add_char b ' ';
      Buffer.add_string b (String.sub line pos (!cut - pos));
      Buffer.add_string b "\r\n";
      go !cut false
    end
  in
  go 0 true;
  Buffer.contents b