(** Markdown documentation format.

    Parses ATX headings, fenced code blocks, unordered and ordered lists, and
    paragraphs. Inline markup is passed through as plain text. *)

(* {1 Line classifiers} *)

let trim_end_hashes text =
  let text = String.trim text in
  let rec last_non_hash index =
    if index < 0 || text.[index] <> '#' then index else last_non_hash (index - 1)
  in
  let last = last_non_hash (String.length text - 1) in
  String.sub text 0 (last + 1) |> String.trim

let heading line =
  let length = String.length line in
  let rec count_hashes index =
    if index < length && line.[index] = '#' then count_hashes (index + 1)
    else index
  in
  let level = count_hashes 0 in
  if level = 0 || level > 6 || level >= length || line.[level] <> ' ' then None
  else
    Some
      ( level,
        String.sub line (level + 1) (length - level - 1) |> trim_end_hashes )

let unordered_item = Format.unordered_item
let ordered_item = Format.ordered_item

let fence line =
  let line = String.trim line in
  if String.length line < 3 then None
  else
    let marker = String.sub line 0 3 in
    if marker <> "```" && marker <> "~~~" then None
    else
      let language =
        String.sub line 3 (String.length line - 3)
        |> String.trim |> Format.first_word
      in
      Some (marker, language)

(* {1 Block parsing} *)

let is_boundary_common = Format.is_boundary_common

let parse_blocks lines =
  let is_boundary line =
    is_boundary_common line
    || Option.is_some (heading line)
    || Option.is_some (fence 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 rec take_unordered collected = function
    | line :: rest -> (
        match unordered_item line with
        | Some first_line ->
            let continuations, rest = Format.take_continuations rest in
            let item = String.concat " " (first_line :: continuations) in
            take_unordered (item :: collected) rest
        | None -> (List.rev collected, line :: rest))
    | [] -> (List.rev collected, [])
  in
  let rec take_ordered collected = function
    | line :: rest -> (
        match ordered_item line with
        | Some first_line ->
            let continuations, rest = Format.take_continuations rest in
            let item = String.concat " " (first_line :: continuations) in
            take_ordered (item :: collected) rest
        | None -> (List.rev collected, line :: 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 fence line with
            | Some (marker, language) ->
                let lines, rest =
                  Format.take_until
                    (fun candidate ->
                      String.starts_with ~prefix:marker (String.trim candidate))
                    [] rest
                in
                loop
                  (Code_block (language, String.concat "\n" lines) :: blocks)
                  rest
            | None -> (
                match unordered_item line with
                | Some _ ->
                    let items, rest = take_unordered [] (line :: rest) in
                    loop (Unordered_list items :: blocks) rest
                | None -> (
                    match ordered_item line with
                    | Some _ ->
                        let items, rest = take_ordered [] (line :: rest) in
                        loop (Ordered_list items :: blocks) rest
                    | None ->
                        let paragraph, rest =
                          take_paragraph [] (line :: rest)
                        in
                        loop
                          (Paragraph (String.concat " " paragraph) :: blocks)
                          rest))))
  in
  loop [] lines

(* {1 Format definition} *)

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