(** Org mode documentation format.

    Parses Org headings, #+BEGIN_SRC blocks, metadata directives, unordered,
    ordered, and definition lists, and paragraphs. Inline markup handles
    =verbatim=, ~code~, and [[link][desc]] syntax. *)

(* {1 Inline markup} *)

let org_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 && text.[i + 1] = '[' ->
          flush ();
          parse_link (i + 2)
      | ('=' | '~') as marker -> (
          let close = find_close marker (i + 1) in
          match close with
          | Some end_pos ->
              flush ();
              let content = String.sub text (i + 1) (end_pos - i - 1) in
              let node =
                match marker with
                | '~' -> Ui.code_inline ~class_:"readme-code" content
                | _ -> Ui.inline ~class_:"readme-verbatim" [ Ui.text content ]
              in
              nodes := node :: !nodes;
              loop (end_pos + 1)
          | None ->
              Buffer.add_char buf text.[i];
              loop (i + 1))
      | c ->
          Buffer.add_char buf c;
          loop (i + 1)
  and find_close marker start =
    let rec search j =
      if j >= len then None
      else if text.[j] = marker then Some j
      else if text.[j] = '\n' then None
      else search (j + 1)
    in
    if start >= len then None else search start
  and parse_link start =
    let rec find_end j _depth =
      if j >= len then None
      else if j + 1 < len && text.[j] = ']' && text.[j + 1] = ']' then Some j
      else find_end (j + 1) 0
    in
    match find_end start 0 with
    | None ->
        Buffer.add_string buf "[[";
        loop start
    | Some close_pos ->
        let inner = String.sub text start (close_pos - start) in
        let href, desc =
          match String.index_opt inner ']' with
          | Some bracket_pos
            when bracket_pos + 1 < String.length inner
                 && inner.[bracket_pos + 1] = '[' ->
              let href = String.sub inner 0 bracket_pos in
              let desc =
                String.sub inner (bracket_pos + 2)
                  (String.length inner - bracket_pos - 2)
              in
              (href, desc)
          | _ -> (inner, inner)
        in
        let node = Ui.link ~class_:"readme-link" ~href [ Ui.text desc ] in
        nodes := node :: !nodes;
        loop (close_pos + 2)
  in
  loop 0;
  List.rev !nodes

(* {1 Line classifiers} *)

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

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

let definition_item line =
  let trimmed = String.trim line in
  let tlen = String.length trimmed in
  if tlen < 2 || trimmed.[0] <> '-' || trimmed.[1] <> ' ' then None
  else
    let rest = String.sub trimmed 2 (tlen - 2) in
    let rec find_sep i =
      if i + 3 >= String.length rest then None
      else if
        rest.[i] = ' '
        && rest.[i + 1] = ':'
        && rest.[i + 2] = ':'
        && rest.[i + 3] = ' '
      then
        let term = String.sub rest 0 i |> String.trim in
        let desc =
          String.sub rest (i + 4) (String.length rest - i - 4) |> String.trim
        in
        Some (term, desc)
      else find_sep (i + 1)
    in
    find_sep 0

let src_begin line =
  let prefix = "#+begin_src" in
  let lower = String.lowercase_ascii (String.trim line) in
  if not (String.starts_with ~prefix lower) then None
  else
    let language =
      String.sub lower (String.length prefix)
        (String.length lower - String.length prefix)
      |> String.trim |> Format.first_word
    in
    Some language

let is_src_end line =
  String.trim line |> String.lowercase_ascii
  |> String.starts_with ~prefix:"#+end_src"

let is_example_begin line =
  String.trim line |> String.lowercase_ascii
  |> String.starts_with ~prefix:"#+begin_example"

let is_example_end line =
  String.trim line |> String.lowercase_ascii
  |> String.starts_with ~prefix:"#+end_example"

(* {1 Block parsing} *)

let is_boundary_common line =
  Format.is_boundary_common line || Option.is_some (definition_item line)

let parse_blocks lines =
  let is_boundary line =
    is_boundary_common line
    || Option.is_some (heading line)
    || Option.is_some (src_begin line)
    || is_example_begin 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 rec take_definitions collected = function
    | line :: rest -> (
        match definition_item line with
        | Some (term, first_desc) ->
            let continuations, rest = Format.take_continuations rest in
            let desc = String.concat " " (first_desc :: continuations) in
            take_definitions ((term, desc) :: 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 src_begin line with
            | Some language ->
                let lines, rest = Format.take_until is_src_end [] rest in
                loop
                  (Code_block (language, String.concat "\n" lines) :: blocks)
                  rest
            | None when is_example_begin line ->
                let lines, rest = Format.take_until is_example_end [] rest in
                loop
                  (Code_block (None, String.concat "\n" lines) :: blocks)
                  rest
            | None -> (
                match definition_item line with
                | Some _ ->
                    let items, rest = take_definitions [] (line :: rest) in
                    loop (Definition_list items :: 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 Org metadata} *)

let metadata_line line =
  let prefix = "#+" in
  let line = String.trim line in
  if not (String.starts_with ~prefix line) then None
  else
    match String.index_opt line ':' with
    | None -> None
    | Some colon ->
        let key = String.sub line 2 (colon - 2) |> String.lowercase_ascii in
        let value =
          String.sub line (colon + 1) (String.length line - colon - 1)
          |> String.trim
        in
        if List.mem key [ "title"; "author"; "date"; "email"; "language" ] then
          Some (key, value)
        else None

let split_metadata lines =
  List.fold_left
    (fun (metadata, body) line ->
      match metadata_line line with
      | None -> (metadata, line :: body)
      | Some entry -> (entry :: metadata, body))
    ([], []) lines
  |> fun (metadata, body) -> (List.rev metadata, List.rev body)

(* {1 Format definition} *)

let format : Format.format =
  {
    name = "org";
    css_class = "readme-document readme-org";
    parse =
      (fun content ->
        let lines = String.split_on_char '\n' content in
        let metadata, lines = split_metadata lines in
        let title =
          List.find_opt (fun (key, _) -> key = "title") metadata
          |> Option.map snd
        in
        let metadata_entries =
          List.filter (fun (key, _) -> key <> "title") metadata
        in
        {
          Format.title;
          metadata = metadata_entries;
          blocks = parse_blocks lines;
        });
    inline = org_inline;
  }