(** Shared document AST and renderer for prose formats.

    Format-specific parsing is supplied by the {!format} type; the renderer, TOC
    generation, and anchor management are format-independent.

    Every text fragment is emitted through {!Ui}, ensuring safe escaping of
    repository content. *)

(* {1 Document AST} *)

type inline =
  | Text of string
  | Code of string
  | Verbatim of string
  | Link of { href : string; text : string }

type block =
  | Heading of int * string
  | Paragraph of string
  | Unordered_list of string list
  | Ordered_list of string list
  | Definition_list of (string * string) list
  | Code_block of string option * string

type document = {
  title : string option;
  metadata : (string * string) list;
  blocks : block list;
}

(* {1 Format interface} *)

type format = {
  name : string;
  css_class : string;
  parse : string -> document;
  inline : string -> Ui.node list;
}
(** A documentation format provides parsing and inline markup rendering. *)

(* {1 Shared utilities} *)

let first_word text =
  match
    String.split_on_char ' ' text |> List.filter (fun word -> word <> "")
  with
  | word :: _ -> Some word
  | [] -> None

(** A continuation line belongs to the current list item if it is indented
    (starts with whitespace) and is not blank. *)
let is_continuation line =
  String.length line > 0
  && (line.[0] = ' ' || line.[0] = '\t')
  && String.trim line <> ""

let take_continuations rest =
  let rec loop acc = function
    | line :: rest when is_continuation line ->
        loop (String.trim line :: acc) rest
    | remaining -> (List.rev acc, remaining)
  in
  loop [] rest

let rec take_until close collected = function
  | [] -> (List.rev collected, [])
  | line :: rest when close line -> (List.rev collected, rest)
  | line :: rest -> take_until close (line :: collected) rest

(* {1 Shared list-item classifiers} *)

(** Recognise an unordered list item ([-], [+], or indented [*]). *)
let unordered_item line =
  let length = String.length line in
  let trimmed = String.trim line in
  let tlen = String.length trimmed in
  if tlen >= 2 && List.mem trimmed.[0] [ '-'; '+' ] && trimmed.[1] = ' ' then
    Some (String.sub trimmed 2 (tlen - 2) |> String.trim)
  else if
    tlen >= 2
    && trimmed.[0] = '*'
    && trimmed.[1] = ' '
    && length > 0
    && (line.[0] = ' ' || line.[0] = '\t')
  then Some (String.sub trimmed 2 (tlen - 2) |> String.trim)
  else None

(** Recognise an ordered list item ([1.], [2)], etc.). *)
let ordered_item line =
  let trimmed = String.trim line in
  let tlen = String.length trimmed in
  let rec digits i =
    if i < tlen && trimmed.[i] >= '0' && trimmed.[i] <= '9' then digits (i + 1)
    else i
  in
  let d = digits 0 in
  if d = 0 || d >= tlen then None
  else if
    (trimmed.[d] = '.' || trimmed.[d] = ')')
    && d + 1 < tlen
    && trimmed.[d + 1] = ' '
  then Some (String.sub trimmed (d + 2) (tlen - d - 2) |> String.trim)
  else None

(** True when a line starts a new block (blank, or a list item). *)
let is_boundary_common line =
  String.trim line = ""
  || Option.is_some (unordered_item line)
  || Option.is_some (ordered_item line)

(* {1 Anchor generation} *)

let new_anchor () =
  let seen = Hashtbl.create 16 in
  fun text ->
    let base =
      let buffer = Buffer.create (String.length text) in
      let pending_separator = ref false in
      String.iter
        (fun character ->
          if
            (character >= 'a' && character <= 'z')
            || (character >= 'A' && character <= 'Z')
            || (character >= '0' && character <= '9')
          then (
            if !pending_separator && Buffer.length buffer > 0 then
              Buffer.add_char buffer '-';
            pending_separator := false;
            Buffer.add_char buffer (Char.lowercase_ascii character))
          else pending_separator := true)
        text;
      if Buffer.length buffer = 0 then "section" else Buffer.contents buffer
    in
    let count = Option.value (Hashtbl.find_opt seen base) ~default:0 + 1 in
    Hashtbl.replace seen base count;
    if count = 1 then base else Printf.sprintf "%s-%d" base count

(* {1 Rendering} *)

let render_heading anchor level text =
  let id = anchor text in
  Ui.heading ~id ~level ~class_:"readme-heading"
    [ Ui.text_link ~class_:"readme-heading-link" ~href:("#" ^ id) text ]

let render_code_block language source =
  let nodes =
    match language with
    | None | Some "" -> [ Ui.text source ]
    | Some language ->
        Highlight.Engine.highlight ~lang:(Some language) source |> List.concat
  in
  Ui.code_block ~class_:"readme-code-block" nodes

let render_block format anchor = function
  | Heading (level, text) -> render_heading anchor level text
  | Paragraph text ->
      Ui.paragraph ~class_:"readme-paragraph" (format.inline text)
  | Unordered_list items ->
      Ui.items ~class_:"readme-list"
        (List.map (fun item -> Ui.item (format.inline item)) items)
  | Ordered_list items ->
      Ui.ordered_items ~class_:"readme-list readme-ordered-list"
        (List.map (fun item -> Ui.item (format.inline item)) items)
  | Definition_list items ->
      Ui.definitions ~class_:"readme-definition-list"
        (List.map (fun (term, desc) -> (term, format.inline desc)) items)
  | Code_block (language, source) -> render_code_block language source

let render_toc ~title_text body_headings =
  let toc_anchor = new_anchor () in
  (match title_text with Some t -> ignore (toc_anchor t) | None -> ());
  (* Build a nested tree from a flat (level, text) list. Headings at a deeper
     level than the current base become children of the preceding entry. *)
  let rec build base_level headings =
    match headings with
    | [] -> ([], [])
    | (level, _) :: _ when level < base_level -> ([], headings)
    | (level, text) :: rest ->
        let id = toc_anchor text in
        let children, rest' = build (level + 1) rest in
        let entry = Ui.toc_entry ~children ~href:("#" ^ id) text in
        let siblings, rest'' = build base_level rest' in
        (entry :: siblings, rest'')
  in
  let min_level =
    List.fold_left (fun acc (l, _) -> min acc l) max_int body_headings
  in
  let entries, _ = build min_level body_headings in
  Ui.toc ~class_:"readme-toc" ~title:"Table of Contents" entries

(** Render a document using the given format. *)
let render format content =
  let doc = format.parse content in
  let body_headings =
    List.filter_map
      (function Heading (level, text) -> Some (level, text) | _ -> None)
      doc.blocks
  in
  let toc = render_toc ~title_text:doc.title body_headings in
  let anchor = new_anchor () in
  let title =
    match doc.title with
    | None -> None
    | Some t -> Some (render_heading anchor 1 t)
  in
  let metadata_node =
    match doc.metadata with
    | [] -> Ui.nothing
    | entries ->
        Ui.definitions ~class_:"readme-org-metadata"
          (List.map
             (fun (key, value) ->
               (String.capitalize_ascii key, [ Ui.text value ]))
             entries)
  in
  Ui.region ~class_:format.css_class
    (Option.to_list title @ [ metadata_node; toc ]
    @ List.map (render_block format anchor) doc.blocks)