(** Mld (ocamldoc) documentation format.

    Parses section headings, code blocks, and paragraphs. Inline markup handles
    bold, italic, emphasis, and code spans. *)

(* {1 Line classifiers} *)

let heading line =
  let trimmed = String.trim line in
  let len = String.length trimmed in
  if len < 4 || trimmed.[0] <> '{' then None
  else
    match trimmed.[1] with
    | '0' .. '6' when len > 3 && trimmed.[2] = ' ' ->
        let level = Char.code trimmed.[1] - Char.code '0' in
        let text_start = 3 in
        let text_end = if trimmed.[len - 1] = '}' then len - 1 else len in
        let text =
          String.sub trimmed text_start (text_end - text_start) |> String.trim
        in
        Some (max 1 level, text)
    | _ -> None

let code_block_open line =
  let trimmed = String.trim line in
  if String.starts_with ~prefix:"{[" trimmed then
    let rest = String.sub trimmed 2 (String.length trimmed - 2) in
    if
      String.length rest > 0
      && rest.[String.length rest - 1] = ']'
      && String.length rest > 1
      && rest.[String.length rest - 2] = '}'
    then
      (* Single-line code block: {[code]} on one line *)
      None
    else Some rest
  else None

let code_block_single line =
  let trimmed = String.trim line in
  let len = String.length trimmed in
  if
    len >= 4
    && String.starts_with ~prefix:"{[" trimmed
    && trimmed.[len - 2] = ']'
    && trimmed.[len - 1] = '}'
  then Some (String.sub trimmed 2 (len - 4))
  else None

let is_code_block_close line =
  let trimmed = String.trim line in
  String.length trimmed >= 2
  && trimmed.[String.length trimmed - 2] = ']'
  && trimmed.[String.length trimmed - 1] = '}'

(* {1 Block parsing} *)

let parse_blocks lines =
  let is_boundary line =
    String.trim line = ""
    || Option.is_some (heading line)
    || Option.is_some (code_block_open line)
    || Option.is_some (code_block_single line)
  in
  let rec take_paragraph collected = function
    | line :: _ as rest when is_boundary line -> (List.rev collected, rest)
    | line :: rest -> take_paragraph (String.trim line :: collected) rest
    | [] -> (List.rev collected, [])
  in
  let open Format in
  let rec loop blocks = function
    | [] -> List.rev blocks
    | line :: rest when String.trim line = "" -> loop blocks rest
    | line :: rest -> (
        match heading line with
        | Some (level, text) -> loop (Heading (level, text) :: blocks) rest
        | None -> (
            match code_block_single line with
            | Some code -> loop (Code_block (None, code) :: blocks) rest
            | None -> (
                match code_block_open line with
                | Some first_line ->
                    let code_lines, rest =
                      Format.take_until is_code_block_close [] rest
                    in
                    let all_lines =
                      if first_line = "" then code_lines
                      else first_line :: code_lines
                    in
                    let code = String.concat "\n" all_lines in
                    loop (Code_block (None, code) :: blocks) rest
                | None ->
                    let paragraph, rest = take_paragraph [] (line :: rest) in
                    loop
                      (Paragraph (String.concat " " paragraph) :: blocks)
                      rest)))
  in
  loop [] lines

(* {1 Inline markup} *)

let inline text =
  let len = String.length text in
  let buf = Buffer.create 64 in
  let nodes = ref [] in
  let flush () =
    if Buffer.length buf > 0 then (
      nodes := Ui.text (Buffer.contents buf) :: !nodes;
      Buffer.clear buf)
  in
  let rec loop i =
    if i >= len then flush ()
    else
      match text.[i] with
      | '{' when i + 1 < len -> (
          match text.[i + 1] with
          | ('b' | 'i' | 'e') when i + 2 < len && text.[i + 2] = ' ' ->
              flush ();
              let close = find_brace_close (i + 3) 1 in
              let content = String.sub text (i + 3) (close - i - 3) in
              nodes :=
                Ui.inline ~class_:"readme-emphasis" [ Ui.text content ]
                :: !nodes;
              loop (close + 1)
          | '[' ->
              flush ();
              let close = find_code_close (i + 2) in
              let content = String.sub text (i + 2) (close - i - 2) in
              nodes := Ui.code_inline ~class_:"readme-code" content :: !nodes;
              loop (close + 2)
          | _ ->
              Buffer.add_char buf '{';
              loop (i + 1))
      | c ->
          Buffer.add_char buf c;
          loop (i + 1)
  and find_brace_close start depth =
    if start >= len then len
    else if text.[start] = '}' then
      if depth <= 1 then start else find_brace_close (start + 1) (depth - 1)
    else if text.[start] = '{' then find_brace_close (start + 1) (depth + 1)
    else find_brace_close (start + 1) depth
  and find_code_close start =
    if start + 1 >= len then len
    else if text.[start] = ']' && text.[start + 1] = '}' then start
    else find_code_close (start + 1)
  in
  loop 0;
  List.rev !nodes

(* {1 Format definition} *)

let format : Format.format =
  {
    name = "mld";
    css_class = "readme-document readme-mld";
    parse =
      (fun content ->
        let lines = String.split_on_char '\n' content in
        { Format.title = None; metadata = []; blocks = parse_blocks lines });
    inline;
  }