(*---------------------------------------------------------------------------
  Copyright (c) 2025 Anil Madhavapeddy <anil@recoil.org>. All rights reserved.
  SPDX-License-Identifier: MIT
 ---------------------------------------------------------------------------*)

let of_parse_error ?system_id err =
  let code = Html5rw.error_code err in
  let line = Html5rw.error_line err in
  let column = Html5rw.error_column err in
  let location =
    Message.make_location ~line ~column ?system_id ()
  in
  let code_str = Html5rw.Parse_error_code.to_string code in
  let message = match code with
    | Html5rw.Parse_error_code.Non_void_html_element_start_tag_with_trailing_solidus ->
      "Self-closing syntax (\"/>\") used on a non-void HTML element. Ignoring the slash and treating as a start tag."
    | _ -> Printf.sprintf "Parse error: %s" code_str
  in
  Message.error
    ~message
    ~code:code_str
    ~location
    ()

let collect_parse_errors ?system_id result =
  let errors = Html5rw.errors result in
  let is_xhtml = match system_id with
    | Some s -> String.length s > 6 && String.sub s (String.length s - 6) 6 = ".xhtml"
    | None -> false
  in
  let filtered_errors =
    if is_xhtml then
      (* XHTML has different requirements than HTML:
         - No DOCTYPE required
         - Self-closing syntax is valid for all elements *)
      List.filter (fun err ->
        match Html5rw.error_code err with
        | Html5rw.Parse_error_code.Tree_construction_error "expected-doctype-but-got-other" -> false
        | Html5rw.Parse_error_code.Non_void_html_element_start_tag_with_trailing_solidus -> false
        | _ -> true
      ) errors
    else errors
  in
  List.map (of_parse_error ?system_id) filtered_errors