(** Typed error codes for HTML5 validation messages. *)

type severity = Error | Warning | Info

type attr_error = [
  | `Not_allowed of [`Attr of string] * [`Elem of string]
  | `Not_allowed_here of [`Attr of string]
  | `Not_allowed_when of [`Attr of string] * [`Elem of string] * [`Condition of string]
  | `Missing of [`Elem of string] * [`Attr of string]
  | `Missing_one_of of [`Elem of string] * [`Attrs of string list]
  | `Bad_value of [`Elem of string] * [`Attr of string] * [`Value of string] * [`Reason of string]
  | `Bad_value_generic of [`Message of string]
  | `Duplicate_id of [`Id of string]
  | `Data_invalid_name of [`Reason of string]
  | `Data_uppercase
]

type element_error = [
  | `Obsolete of [`Elem of string] * [`Suggestion of string]
  | `Obsolete_attr of [`Elem of string] * [`Attr of string] * [`Suggestion of string option]
  | `Obsolete_global_attr of [`Attr of string] * [`Suggestion of string]
  | `Not_allowed_as_child of [`Child of string] * [`Parent of string]
  | `Unknown of [`Elem of string]
  | `Must_not_descend of [`Elem of string] * [`Attr of string option] * [`Ancestor of string]
  | `Missing_child of [`Parent of string] * [`Child of string]
  | `Missing_child_one_of of [`Parent of string] * [`Children of string list]
  | `Missing_child_generic of [`Parent of string]
  | `Must_not_be_empty of [`Elem of string]
  | `Text_not_allowed of [`Parent of string]
]

type tag_error = [
  | `Stray_start of [`Tag of string]
  | `Stray_end of [`Tag of string]
  | `End_for_void of [`Tag of string]
  | `Self_closing_non_void
  | `Not_in_scope of [`Tag of string]
  | `End_implied_open of [`Tag of string]
  | `Start_in_table of [`Tag of string]
  | `Bad_start_in of [`Tag of string] * [`Context of string]
  | `Eof_with_open
]

type char_ref_error = [
  | `Forbidden_codepoint of [`Codepoint of int]
  | `Control_char of [`Codepoint of int]
  | `Non_char of [`Codepoint of int] * [`Astral of bool]
  | `Unassigned
  | `Zero
  | `Out_of_range
  | `Carriage_return
]

type aria_error = [
  | `Unnecessary_role of [`Role of string] * [`Elem of string] * [`Reason of string]
  | `Bad_role of [`Elem of string] * [`Role of string]
  | `Must_not_specify of [`Attr of string] * [`Elem of string] * [`Condition of string]
  | `Must_not_use of [`Attr of string] * [`Elem of string] * [`Condition of string]
  | `Should_not_use of [`Attr of string] * [`Role of string]
  | `Hidden_on_body
  | `Unrecognized_role of [`Token of string]
  | `Tab_without_tabpanel
  | `Multiple_main
  | `Accessible_name_prohibited of [`Attr of string] * [`Elem of string]
]

type li_role_error = [
  | `Div_in_dl_bad_role
  | `Li_bad_role_in_menu
  | `Li_bad_role_in_tablist
  | `Li_bad_role_in_list
]

type table_error = [
  | `Row_no_cells of [`Row of int]
  | `Cell_overlap
  | `Cell_spans_rowgroup
  | `Column_no_cells of [`Column of int] * [`Elem of string]
]

type i18n_error = [
  | `Missing_lang
  | `Wrong_lang of [`Detected of string] * [`Declared of string] * [`Suggested of string]
  | `Missing_dir_rtl of [`Language of string]
  | `Wrong_dir of [`Language of string] * [`Declared of string]
  | `Xml_lang_without_lang
  | `Xml_lang_mismatch
  | `Not_nfc of [`Replacement of string]
]

type importmap_error = [
  | `Invalid_json
  | `Invalid_root
  | `Imports_not_object
  | `Empty_key
  | `Non_string_value
  | `Key_trailing_slash
  | `Scopes_not_object
  | `Scopes_values_not_object
  | `Scopes_invalid_url
  | `Scopes_value_invalid_url
]

type img_error = [
  | `Missing_alt
  | `Missing_src_or_srcset
  | `Empty_alt_with_role
  | `Ismap_needs_href
]

type link_error = [
  | `Missing_href
  | `As_requires_preload
  | `Imagesrcset_requires_as_image
]

type label_error = [
  | `Too_many_labelable
  | `For_id_mismatch
  | `Role_on_ancestor
  | `Role_on_for
  | `Aria_label_on_ancestor
  | `Aria_label_on_for
]

type input_error = [
  | `Checkbox_needs_aria_pressed
  | `Value_constraint of [`Constraint of string]
  | `List_not_allowed
  | `List_requires_datalist
]

type srcset_error = [
  | `Sizes_without_srcset
  | `Imagesizes_without_imagesrcset
  | `W_without_sizes
  | `Source_missing_srcset
  | `Source_needs_media_or_type
  | `Picture_missing_img
]

type svg_error = [
  | `Deprecated_attr of [`Attr of string] * [`Elem of string]
  | `Missing_attr of [`Elem of string] * [`Attr of string]
]

type misc_error = [
  | `Option_empty_without_label
  | `Bdo_missing_dir
  | `Bdo_dir_auto
  | `Base_missing_href_or_target
  | `Base_after_link_script
  | `Map_id_name_mismatch
  | `Summary_missing_role
  | `Summary_missing_attrs
  | `Summary_role_not_allowed
  | `Autocomplete_webauthn_on_select
  | `Commandfor_invalid_target
  | `Style_type_invalid
  | `Headingoffset_invalid
  | `Media_empty
  | `Media_all
  | `Multiple_h1
  | `Multiple_autofocus
]

type t = [
  | `Attr of attr_error
  | `Element of element_error
  | `Tag of tag_error
  | `Char_ref of char_ref_error
  | `Aria of aria_error
  | `Li_role of li_role_error
  | `Table of table_error
  | `I18n of i18n_error
  | `Importmap of importmap_error
  | `Img of img_error
  | `Link of link_error
  | `Label of label_error
  | `Input of input_error
  | `Srcset of srcset_error
  | `Svg of svg_error
  | `Misc of misc_error
  | `Generic of string
]

(** Get the severity level for an error code *)
let severity : t -> severity = function
  (* Info level *)
  | `I18n `Missing_lang -> Info
  | `Misc `Multiple_h1 -> Info

  (* Warning level *)
  | `I18n (`Wrong_lang _) -> Warning
  | `I18n (`Missing_dir_rtl _) -> Warning
  | `I18n (`Wrong_dir _) -> Warning
  | `I18n (`Not_nfc _) -> Warning
  | `Aria (`Unnecessary_role _) -> Warning
  | `Aria (`Should_not_use _) -> Warning
  | `Element (`Unknown _) -> Warning

  (* Everything else is Error *)
  | _ -> Error

(** Get a short code string for categorization *)
let code_string : t -> string = function
  (* Attribute errors *)
  | `Attr (`Not_allowed _) -> "disallowed-attribute"
  | `Attr (`Not_allowed_here _) -> "disallowed-attribute"
  | `Attr (`Not_allowed_when _) -> "disallowed-attribute"
  | `Attr (`Missing _) -> "missing-required-attribute"
  | `Attr (`Missing_one_of _) -> "missing-required-attribute"
  | `Attr (`Bad_value _) -> "bad-attribute-value"
  | `Attr (`Bad_value_generic _) -> "bad-attribute-value"
  | `Attr (`Duplicate_id _) -> "duplicate-id"
  | `Attr (`Data_invalid_name _) -> "bad-attribute-name"
  | `Attr `Data_uppercase -> "bad-attribute-name"

  (* Element errors *)
  | `Element (`Obsolete _) -> "obsolete-element"
  | `Element (`Obsolete_attr _) -> "obsolete-attribute"
  | `Element (`Obsolete_global_attr _) -> "obsolete-attribute"
  | `Element (`Not_allowed_as_child _) -> "disallowed-child"
  | `Element (`Unknown _) -> "unknown-element"
  | `Element (`Must_not_descend _) -> "prohibited-ancestor"
  | `Element (`Missing_child _) -> "missing-required-child"
  | `Element (`Missing_child_one_of _) -> "missing-required-child"
  | `Element (`Missing_child_generic _) -> "missing-required-child"
  | `Element (`Must_not_be_empty _) -> "empty-element"
  | `Element (`Text_not_allowed _) -> "text-not-allowed"

  (* Tag errors *)
  | `Tag (`Stray_start _) -> "stray-tag"
  | `Tag (`Stray_end _) -> "stray-tag"
  | `Tag (`End_for_void _) -> "end-tag-void"
  | `Tag `Self_closing_non_void -> "self-closing-non-void"
  | `Tag (`Not_in_scope _) -> "no-element-in-scope"
  | `Tag (`End_implied_open _) -> "end-tag-implied"
  | `Tag (`Start_in_table _) -> "start-tag-in-table"
  | `Tag (`Bad_start_in _) -> "bad-start-tag"
  | `Tag `Eof_with_open -> "eof-open-elements"

  (* Character reference errors *)
  | `Char_ref (`Forbidden_codepoint _) -> "forbidden-codepoint"
  | `Char_ref (`Control_char _) -> "char-ref-control"
  | `Char_ref (`Non_char _) -> "char-ref-non-char"
  | `Char_ref `Unassigned -> "char-ref-unassigned"
  | `Char_ref `Zero -> "char-ref-zero"
  | `Char_ref `Out_of_range -> "char-ref-range"
  | `Char_ref `Carriage_return -> "numeric-char-ref"

  (* ARIA errors *)
  | `Aria (`Unnecessary_role _) -> "unnecessary-role"
  | `Aria (`Bad_role _) -> "bad-role"
  | `Aria (`Must_not_specify _) -> "aria-not-allowed"
  | `Aria (`Must_not_use _) -> "aria-not-allowed"
  | `Aria (`Should_not_use _) -> "aria-not-allowed"
  | `Aria `Hidden_on_body -> "aria-not-allowed"
  | `Aria (`Unrecognized_role _) -> "unrecognized-role"
  | `Aria `Tab_without_tabpanel -> "tab-without-tabpanel"
  | `Aria `Multiple_main -> "multiple-main"
  | `Aria (`Accessible_name_prohibited _) -> "aria-not-allowed"

  (* List item role errors *)
  | `Li_role `Div_in_dl_bad_role -> "invalid-role"
  | `Li_role `Li_bad_role_in_menu -> "invalid-role"
  | `Li_role `Li_bad_role_in_tablist -> "invalid-role"
  | `Li_role `Li_bad_role_in_list -> "invalid-role"

  (* Table errors *)
  | `Table (`Row_no_cells _) -> "table-row"
  | `Table `Cell_overlap -> "table-overlap"
  | `Table `Cell_spans_rowgroup -> "table-span"
  | `Table (`Column_no_cells _) -> "table-column"

  (* I18n errors *)
  | `I18n `Missing_lang -> "missing-lang"
  | `I18n (`Wrong_lang _) -> "wrong-lang"
  | `I18n (`Missing_dir_rtl _) -> "missing-dir"
  | `I18n (`Wrong_dir _) -> "wrong-dir"
  | `I18n `Xml_lang_without_lang -> "xml-lang"
  | `I18n `Xml_lang_mismatch -> "xml-lang-mismatch"
  | `I18n (`Not_nfc _) -> "unicode-normalization"

  (* Import map errors *)
  | `Importmap `Invalid_json -> "importmap"
  | `Importmap `Invalid_root -> "importmap"
  | `Importmap `Imports_not_object -> "importmap"
  | `Importmap `Empty_key -> "importmap"
  | `Importmap `Non_string_value -> "importmap"
  | `Importmap `Key_trailing_slash -> "importmap"
  | `Importmap `Scopes_not_object -> "importmap"
  | `Importmap `Scopes_values_not_object -> "importmap"
  | `Importmap `Scopes_invalid_url -> "importmap"
  | `Importmap `Scopes_value_invalid_url -> "importmap"

  (* Image errors *)
  | `Img `Missing_alt -> "missing-alt"
  | `Img `Missing_src_or_srcset -> "missing-src"
  | `Img `Empty_alt_with_role -> "img-alt-role"
  | `Img `Ismap_needs_href -> "ismap-needs-href"

  (* Link errors *)
  | `Link `Missing_href -> "missing-href"
  | `Link `As_requires_preload -> "link-as-preload"
  | `Link `Imagesrcset_requires_as_image -> "link-imagesrcset"

  (* Label errors *)
  | `Label `Too_many_labelable -> "label-multiple"
  | `Label `For_id_mismatch -> "label-for-mismatch"
  | `Label `Role_on_ancestor -> "role-on-label"
  | `Label `Role_on_for -> "role-on-label"
  | `Label `Aria_label_on_ancestor -> "aria-label-on-label"
  | `Label `Aria_label_on_for -> "aria-label-on-label"

  (* Input errors *)
  | `Input `Checkbox_needs_aria_pressed -> "missing-aria-pressed"
  | `Input (`Value_constraint _) -> "input-value"
  | `Input `List_not_allowed -> "list-not-allowed"
  | `Input `List_requires_datalist -> "list-datalist"

  (* Srcset errors *)
  | `Srcset `Sizes_without_srcset -> "sizes-without-srcset"
  | `Srcset `Imagesizes_without_imagesrcset -> "imagesizes-without-srcset"
  | `Srcset `W_without_sizes -> "srcset-needs-sizes"
  | `Srcset `Source_missing_srcset -> "missing-srcset"
  | `Srcset `Source_needs_media_or_type -> "source-needs-media"
  | `Srcset `Picture_missing_img -> "picture-missing-img"

  (* SVG errors *)
  | `Svg (`Deprecated_attr _) -> "svg-deprecated"
  | `Svg (`Missing_attr _) -> "missing-required-attribute"

  (* Misc errors *)
  | `Misc `Option_empty_without_label -> "empty-option"
  | `Misc `Bdo_missing_dir -> "missing-dir"
  | `Misc `Bdo_dir_auto -> "bdo-dir-auto"
  | `Misc `Base_missing_href_or_target -> "missing-required-attribute"
  | `Misc `Base_after_link_script -> "base-position"
  | `Misc `Map_id_name_mismatch -> "map-id-name"
  | `Misc `Summary_missing_role -> "summary-role"
  | `Misc `Summary_missing_attrs -> "summary-attrs"
  | `Misc `Summary_role_not_allowed -> "summary-role"
  | `Misc `Autocomplete_webauthn_on_select -> "autocomplete"
  | `Misc `Commandfor_invalid_target -> "commandfor"
  | `Misc `Style_type_invalid -> "style-type"
  | `Misc `Headingoffset_invalid -> "headingoffset"
  | `Misc `Media_empty -> "media-empty"
  | `Misc `Media_all -> "media-all"
  | `Misc `Multiple_h1 -> "multiple-h1"
  | `Misc `Multiple_autofocus -> "multiple-autofocus"

  (* Generic *)
  | `Generic _ -> "generic"

(** Format using curly quotes (Unicode) *)
let q s = "\xe2\x80\x9c" ^ s ^ "\xe2\x80\x9d"

(** Convert error code to exact Nu validator message string *)
let to_message : t -> string = function
  (* Attribute errors *)
  | `Attr (`Not_allowed (`Attr attr, `Elem element)) ->
      Printf.sprintf "Attribute %s not allowed on element %s at this point."
        (q attr) (q element)
  | `Attr (`Not_allowed_here (`Attr attr)) ->
      Printf.sprintf "Attribute %s not allowed here." (q attr)
  | `Attr (`Not_allowed_when (`Attr attr, `Elem _, `Condition condition)) ->
      Printf.sprintf "The %s attribute must not be used on any element which has %s." (q attr) condition
  | `Attr (`Missing (`Elem element, `Attr attr)) ->
      Printf.sprintf "Element %s is missing required attribute %s."
        (q element) (q attr)
  | `Attr (`Missing_one_of (`Elem element, `Attrs attrs)) ->
      let attrs_str = String.concat ", " attrs in
      Printf.sprintf "Element %s is missing one or more of the following attributes: [%s]."
        (q element) attrs_str
  | `Attr (`Bad_value (`Elem element, `Attr attr, `Value value, `Reason reason)) ->
      if reason = "" then
        Printf.sprintf "Bad value %s for attribute %s on element %s."
          (q value) (q attr) (q element)
      else
        Printf.sprintf "Bad value %s for attribute %s on element %s: %s"
          (q value) (q attr) (q element) reason
  | `Attr (`Bad_value_generic (`Message message)) -> message
  | `Attr (`Duplicate_id (`Id id)) ->
      Printf.sprintf "Duplicate ID %s." (q id)
  | `Attr (`Data_invalid_name (`Reason reason)) ->
      Printf.sprintf "%s attribute names %s." (q "data-*") reason
  | `Attr `Data_uppercase ->
      Printf.sprintf "%s attributes must not have characters from the range %s\xe2\x80\xa6%s in the name."
        (q "data-*") (q "A") (q "Z")

  (* Element errors *)
  | `Element (`Obsolete (`Elem element, `Suggestion suggestion)) ->
      if suggestion = "" then
        Printf.sprintf "The %s element is obsolete." (q element)
      else
        Printf.sprintf "The %s element is obsolete. %s" (q element) suggestion
  | `Element (`Obsolete_attr (`Elem element, `Attr attr, `Suggestion suggestion)) ->
      let base = Printf.sprintf "The %s attribute on the %s element is obsolete."
        (q attr) (q element) in
      (match suggestion with Some s -> base ^ " " ^ s | None -> base)
  | `Element (`Obsolete_global_attr (`Attr attr, `Suggestion suggestion)) ->
      Printf.sprintf "The %s attribute is obsolete. %s" (q attr) suggestion
  | `Element (`Not_allowed_as_child (`Child child, `Parent parent)) ->
      Printf.sprintf "Element %s not allowed as child of element %s in this context. (Suppressing further errors from this subtree.)"
        (q child) (q parent)
  | `Element (`Unknown (`Elem name)) ->
      Printf.sprintf "Unknown element %s." (q name)
  | `Element (`Must_not_descend (`Elem element, `Attr attr, `Ancestor ancestor)) ->
      (match attr with
       | Some a ->
           Printf.sprintf "The element %s with the attribute %s must not appear as a descendant of the %s element."
             (q element) (q a) (q ancestor)
       | None ->
           Printf.sprintf "The element %s must not appear as a descendant of the %s element."
             (q element) (q ancestor))
  | `Element (`Missing_child (`Parent parent, `Child child)) ->
      Printf.sprintf "Element %s is missing required child element %s."
        (q parent) (q child)
  | `Element (`Missing_child_one_of (`Parent parent, `Children children)) ->
      let children_str = String.concat ", " children in
      Printf.sprintf "Element %s is missing one or more of the following child elements: [%s]."
        (q parent) children_str
  | `Element (`Missing_child_generic (`Parent parent)) ->
      Printf.sprintf "Element %s is missing a required child element." (q parent)
  | `Element (`Must_not_be_empty (`Elem element)) ->
      Printf.sprintf "Element %s must not be empty." (q element)
  | `Element (`Text_not_allowed (`Parent parent)) ->
      Printf.sprintf "Text not allowed in element %s in this context." (q parent)

  (* Tag errors *)
  | `Tag (`Stray_start (`Tag tag)) ->
      Printf.sprintf "Stray start tag %s." (q tag)
  | `Tag (`Stray_end (`Tag tag)) ->
      Printf.sprintf "Stray end tag %s." (q tag)
  | `Tag (`End_for_void (`Tag tag)) ->
      Printf.sprintf "End tag %s." (q tag)
  | `Tag `Self_closing_non_void ->
      Printf.sprintf "Self-closing syntax (%s) used on a non-void HTML element. Ignoring the slash and treating as a start tag."
        (q "/>")
  | `Tag (`Not_in_scope (`Tag tag)) ->
      Printf.sprintf "No %s element in scope but a %s end tag seen."
        (q tag) (q tag)
  | `Tag (`End_implied_open (`Tag tag)) ->
      Printf.sprintf "End tag %s implied, but there were open elements."
        (q tag)
  | `Tag (`Start_in_table (`Tag tag)) ->
      Printf.sprintf "Start tag %s seen in %s." (q tag) (q "table")
  | `Tag (`Bad_start_in (`Tag tag, `Context _)) ->
      Printf.sprintf "Bad start tag in %s in %s in %s."
        (q tag) (q "noscript") (q "head")
  | `Tag `Eof_with_open ->
      "End of file seen and there were open elements."

  (* Character reference errors *)
  | `Char_ref (`Forbidden_codepoint (`Codepoint codepoint)) ->
      Printf.sprintf "Forbidden code point U+%04x." codepoint
  | `Char_ref (`Control_char (`Codepoint codepoint)) ->
      Printf.sprintf "Character reference expands to a control character (U+%04x)." codepoint
  | `Char_ref (`Non_char (`Codepoint codepoint, `Astral astral)) ->
      if astral then
        Printf.sprintf "Character reference expands to an astral non-character (U+%05x)." codepoint
      else
        Printf.sprintf "Character reference expands to a non-character (U+%04x)." codepoint
  | `Char_ref `Unassigned ->
      "Character reference expands to a permanently unassigned code point."
  | `Char_ref `Zero ->
      "Character reference expands to zero."
  | `Char_ref `Out_of_range ->
      "Character reference outside the permissible Unicode range."
  | `Char_ref `Carriage_return ->
      "A numeric character reference expanded to carriage return."

  (* ARIA errors *)
  | `Aria (`Unnecessary_role (`Role role, `Elem _, `Reason reason)) ->
      Printf.sprintf "The %s role is unnecessary %s."
        (q role) reason
  | `Aria (`Bad_role (`Elem element, `Role role)) ->
      Printf.sprintf "Bad value %s for attribute %s on element %s."
        (q role) (q "role") (q element)
  | `Aria (`Must_not_specify (`Attr attr, `Elem element, `Condition condition)) ->
      Printf.sprintf "The %s attribute must not be specified on any %s element unless %s."
        (q attr) (q element) condition
  | `Aria (`Must_not_use (`Attr attr, `Elem element, `Condition condition)) ->
      Printf.sprintf "The %s attribute must not be used on an %s element which has %s."
        (q attr) (q element) condition
  | `Aria (`Should_not_use (`Attr attr, `Role role)) ->
      Printf.sprintf "The %s attribute should not be used on any element which has %s."
        (q attr) (q ("role=" ^ role))
  | `Aria `Hidden_on_body ->
      Printf.sprintf "%s must not be used on the %s element."
        (q "aria-hidden=true") (q "body")
  | `Aria (`Unrecognized_role (`Token token)) ->
      Printf.sprintf "Discarding unrecognized token %s from value of attribute %s. Browsers ignore any token that is not a defined ARIA non-abstract role."
        (q token) (q "role")
  | `Aria `Tab_without_tabpanel ->
      Printf.sprintf "Every active %s element must have a corresponding %s element."
        (q "role=tab") (q "role=tabpanel")
  | `Aria `Multiple_main ->
      Printf.sprintf "A document should not include more than one visible element with %s."
        (q "role=main")
  | `Aria (`Accessible_name_prohibited (`Attr attr, `Elem element)) ->
      (* Roles that prohibit accessible names - defined by ARIA spec *)
      let prohibited_roles = [
        "caption"; "code"; "deletion"; "emphasis"; "generic"; "insertion";
        "paragraph"; "presentation"; "strong"; "subscript"; "superscript"
      ] in
      let roles_str = String.concat ", " (List.map q (List.rev (List.tl (List.rev prohibited_roles)))) ^
        ", or " ^ q (List.hd (List.rev prohibited_roles)) in
      Printf.sprintf "The %s attribute must not be specified on any %s element unless the element has a %s value other than %s."
        (q attr) (q element) (q "role") roles_str

  (* List item role errors *)
  | `Li_role `Div_in_dl_bad_role ->
      Printf.sprintf "A %s child of a %s element must not have any %s value other than %s or %s."
        (q "div") (q "dl") (q "role") (q "presentation") (q "none")
  | `Li_role `Li_bad_role_in_menu ->
      Printf.sprintf "An %s element that is a descendant of a %s element or %s element must not have any %s value other than %s, %s, %s, %s, or %s."
        (q "li") (q "role=menu") (q "role=menubar") (q "role")
        (q "group") (q "menuitem") (q "menuitemcheckbox") (q "menuitemradio") (q "separator")
  | `Li_role `Li_bad_role_in_tablist ->
      Printf.sprintf "An %s element that is a descendant of a %s element must not have any %s value other than %s."
        (q "li") (q "role=tablist") (q "role") (q "tab")
  | `Li_role `Li_bad_role_in_list ->
      Printf.sprintf "An %s element that is a descendant of a %s, %s, or %s element with no explicit %s value, or a descendant of a %s element, must not have any %s value other than %s."
        (q "li") (q "ul") (q "ol") (q "menu") (q "role") (q "role=list") (q "role") (q "listitem")

  (* Table errors *)
  | `Table (`Row_no_cells (`Row row)) ->
      Printf.sprintf "Row %d of an implicit row group has no cells beginning on it." row
  | `Table `Cell_overlap ->
      "Table cell is overlapped by later table cell."
  | `Table `Cell_spans_rowgroup ->
      Printf.sprintf "Table cell spans past the end of its row group established by a %s element; clipped to the end of the row group."
        (q "tbody")
  | `Table (`Column_no_cells (`Column column, `Elem element)) ->
      Printf.sprintf "Table column %d established by element %s has no cells beginning in it."
        column (q element)

  (* I18n errors *)
  | `I18n `Missing_lang ->
      Printf.sprintf "Consider adding a %s attribute to the %s start tag to declare the language of this document."
        (q "lang") (q "html")
  | `I18n (`Wrong_lang (`Detected detected, `Declared declared, `Suggested suggested)) ->
      Printf.sprintf "This document appears to be written in %s but the %s start tag has %s. Consider using %s (or variant) instead."
        detected (q "html") (q ("lang=\"" ^ declared ^ "\"")) (q ("lang=\"" ^ suggested ^ "\""))
  | `I18n (`Missing_dir_rtl (`Language language)) ->
      Printf.sprintf "This document appears to be written in %s. Consider adding %s to the %s start tag."
        language (q "dir=\"rtl\"") (q "html")
  | `I18n (`Wrong_dir (`Language language, `Declared declared)) ->
      Printf.sprintf "This document appears to be written in %s but the %s start tag has %s. Consider using %s instead."
        language (q "html") (q ("dir=\"" ^ declared ^ "\"")) (q "dir=\"rtl\"")
  | `I18n `Xml_lang_without_lang ->
      Printf.sprintf "When the attribute %s in no namespace is specified, the element must also have the attribute %s present with the same value."
        (q "xml:lang") (q "lang")
  | `I18n `Xml_lang_mismatch ->
      Printf.sprintf "The %s and %s attributes must have the same value."
        (q "xml:lang") (q "lang")
  | `I18n (`Not_nfc (`Replacement replacement)) ->
      Printf.sprintf "Text run is not in Unicode Normalization Form C. Should instead be %s. (Copy and paste that into your source document to replace the un-normalized text.)"
        (q replacement)

  (* Import map errors *)
  | `Importmap `Invalid_json ->
      Printf.sprintf "A script %s with a %s attribute whose value is %s must have valid JSON content."
        (q "script") (q "type") (q "importmap")
  | `Importmap `Invalid_root ->
      Printf.sprintf "A %s element with a %s attribute whose value is %s must contain a JSON object with no properties other than %s, %s, and %s."
        (q "script") (q "type") (q "importmap") (q "imports") (q "scopes") (q "integrity")
  | `Importmap `Imports_not_object ->
      Printf.sprintf "The value of the %s property within the content of a %s element with a %s attribute whose value is %s must be a JSON object."
        (q "imports") (q "script") (q "type") (q "importmap")
  | `Importmap `Empty_key ->
      Printf.sprintf "A specifier map defined in a %s property within the content of a %s element with a %s attribute whose value is %s must only contain non-empty keys."
        (q "imports") (q "script") (q "type") (q "importmap")
  | `Importmap `Non_string_value ->
      Printf.sprintf "A specifier map defined in a %s property within the content of a %s element with a %s attribute whose value is %s must only contain string values."
        (q "imports") (q "script") (q "type") (q "importmap")
  | `Importmap `Key_trailing_slash ->
      Printf.sprintf "A specifier map defined in a %s property within the content of a %s element with a %s attribute whose value is %s must have values that end with %s when its corresponding key ends with %s."
        (q "imports") (q "script") (q "type") (q "importmap") (q "/") (q "/")
  | `Importmap `Scopes_not_object ->
      Printf.sprintf "The value of the %s property within the content of a %s element with a %s attribute whose value is %s must be a JSON object whose keys are valid URL strings."
        (q "scopes") (q "script") (q "type") (q "importmap")
  | `Importmap `Scopes_values_not_object ->
      Printf.sprintf "The value of the %s property within the content of a %s element with a %s attribute whose value is %s must be a JSON object whose values are also JSON objects."
        (q "scopes") (q "script") (q "type") (q "importmap")
  | `Importmap `Scopes_invalid_url ->
      Printf.sprintf "The value of the %s property within the content of a %s element with a %s attribute whose value is %s must be a JSON object whose keys are valid URL strings."
        (q "scopes") (q "script") (q "type") (q "importmap")
  | `Importmap `Scopes_value_invalid_url ->
      Printf.sprintf "A specifier map defined in a %s property within the content of a %s element with a %s attribute whose value is %s must only contain valid URL values."
        (q "scopes") (q "script") (q "type") (q "importmap")

  (* Image errors *)
  | `Img `Missing_alt ->
      Printf.sprintf "An %s element must have an %s attribute, except under certain conditions. For details, consult guidance on providing text alternatives for images."
        (q "img") (q "alt")
  | `Img `Missing_src_or_srcset ->
      Printf.sprintf "Element %s is missing one or more of the following attributes: [src, srcset]."
        (q "img")
  | `Img `Empty_alt_with_role ->
      Printf.sprintf "An %s element which has an %s attribute whose value is the empty string must not have a %s attribute."
        (q "img") (q "alt") (q "role")
  | `Img `Ismap_needs_href ->
      Printf.sprintf "The %s element with the %s attribute set must have an %s ancestor with the %s attribute."
        (q "img") (q "ismap") (q "a") (q "href")

  (* Link errors *)
  | `Link `Missing_href ->
      Printf.sprintf "A %s element must have an %s or %s attribute, or both."
        (q "link") (q "href") (q "imagesrcset")
  | `Link `As_requires_preload ->
      Printf.sprintf "A %s element with an %s attribute must have a %s attribute that contains the value %s or the value %s."
        (q "link") (q "as") (q "rel") (q "preload") (q "modulepreload")
  | `Link `Imagesrcset_requires_as_image ->
      Printf.sprintf "A %s element with an %s attribute must have an %s attribute with value %s."
        (q "link") (q "imagesrcset") (q "as") (q "image")

  (* Label errors *)
  | `Label `Too_many_labelable ->
      Printf.sprintf "The %s element may contain at most one %s, %s, %s, %s, %s, %s, or %s descendant."
        (q "label") (q "button") (q "input") (q "meter") (q "output") (q "progress") (q "select") (q "textarea")
  | `Label `For_id_mismatch ->
      Printf.sprintf "Any %s descendant of a %s element with a %s attribute must have an ID value that matches that %s attribute."
        (q "input") (q "label") (q "for") (q "for")
  | `Label `Role_on_ancestor ->
      Printf.sprintf "The %s attribute must not be used on any %s element that is an ancestor of a labelable element."
        (q "role") (q "label")
  | `Label `Role_on_for ->
      Printf.sprintf "The %s attribute must not be used on any %s element that is associated with a labelable element."
        (q "role") (q "label")
  | `Label `Aria_label_on_ancestor ->
      Printf.sprintf "The %s attribute must not be used on any %s element that is an ancestor of a labelable element."
        (q "aria-label") (q "label")
  | `Label `Aria_label_on_for ->
      Printf.sprintf "The %s attribute must not be used on any %s element that is associated with a labelable element."
        (q "aria-label") (q "label")

  (* Input errors *)
  | `Input `Checkbox_needs_aria_pressed ->
      Printf.sprintf "An %s element with a %s attribute whose value is %s and with a %s attribute whose value is %s must have an %s attribute."
        (q "input") (q "type") (q "checkbox") (q "role") (q "button") (q "aria-pressed")
  | `Input (`Value_constraint (`Constraint constraint_type)) -> constraint_type
  | `Input `List_not_allowed ->
      Printf.sprintf "Attribute %s is only allowed when the input type is %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, %s, or %s."
        (q "list") (q "color") (q "date") (q "datetime-local") (q "email") (q "month")
        (q "number") (q "range") (q "search") (q "tel") (q "text") (q "time") (q "url") (q "week")
  | `Input `List_requires_datalist ->
      Printf.sprintf "The %s attribute of the %s element must refer to a %s element."
        (q "list") (q "input") (q "datalist")

  (* Srcset errors *)
  | `Srcset `Sizes_without_srcset ->
      Printf.sprintf "The %s attribute must only be specified if the %s attribute is also specified."
        (q "sizes") (q "srcset")
  | `Srcset `Imagesizes_without_imagesrcset ->
      Printf.sprintf "The %s attribute must only be specified if the %s attribute is also specified."
        (q "imagesizes") (q "imagesrcset")
  | `Srcset `W_without_sizes ->
      Printf.sprintf "When the %s attribute has any image candidate string with a width descriptor, the %s attribute must also be specified."
        (q "srcset") (q "sizes")
  | `Srcset `Source_missing_srcset ->
      Printf.sprintf "Element %s is missing required attribute %s."
        (q "source") (q "srcset")
  | `Srcset `Source_needs_media_or_type ->
      Printf.sprintf "A %s element that has a following sibling %s element or %s element with a %s attribute must have a %s attribute and/or %s attribute."
        (q "source") (q "source") (q "img") (q "srcset") (q "media") (q "type")
  | `Srcset `Picture_missing_img ->
      Printf.sprintf "Element %s is missing required child element %s."
        (q "picture") (q "img")

  (* SVG errors *)
  | `Svg (`Deprecated_attr (`Attr attr, `Elem element)) ->
      Printf.sprintf "Attribute %s not allowed on element %s at this point."
        (q attr) (q element)
  | `Svg (`Missing_attr (`Elem element, `Attr attr)) ->
      Printf.sprintf "Element %s is missing required attribute %s."
        (q element) (q attr)

  (* Misc errors *)
  | `Misc `Option_empty_without_label ->
      Printf.sprintf "Element %s without attribute %s must not be empty."
        (q "option") (q "label")
  | `Misc `Bdo_missing_dir ->
      Printf.sprintf "Element %s must have attribute %s." (q "bdo") (q "dir")
  | `Misc `Bdo_dir_auto ->
      Printf.sprintf "The value of %s attribute for the %s element must not be %s."
        (q "dir") (q "bdo") (q "auto")
  | `Misc `Base_missing_href_or_target ->
      Printf.sprintf "Element %s is missing one or more of the following attributes: [href, target]."
        (q "base")
  | `Misc `Base_after_link_script ->
      Printf.sprintf "The %s element must come before any %s or %s elements in the document."
        (q "base") (q "link") (q "script")
  | `Misc `Map_id_name_mismatch ->
      Printf.sprintf "The %s attribute on a %s element must have an the same value as the %s attribute."
        (q "id") (q "map") (q "name")
  | `Misc `Summary_missing_role ->
      Printf.sprintf "Element %s is missing required attribute %s."
        (q "summary") (q "role")
  | `Misc `Summary_missing_attrs ->
      Printf.sprintf "Element %s is missing one or more of the following attributes: [aria-checked, aria-level, role]."
        (q "summary")
  | `Misc `Summary_role_not_allowed ->
      Printf.sprintf "The %s attribute must not be used on any %s element that is a summary for its parent %s element."
        (q "role") (q "summary") (q "details")
  | `Misc `Autocomplete_webauthn_on_select ->
      Printf.sprintf "The value of the %s attribute for the %s element must not contain %s."
        (q "autocomplete") (q "select") (q "webauthn")
  | `Misc `Commandfor_invalid_target ->
      Printf.sprintf "The value of the %s attribute of the %s element must be the ID of an element in the same tree as the %s with the %s attribute."
        (q "commandfor") (q "button") (q "button") (q "commandfor")
  | `Misc `Style_type_invalid ->
      Printf.sprintf "The only allowed value for the %s attribute for the %s element is %s (with no parameters). (But the attribute is not needed and should be omitted altogether.)"
        (q "type") (q "style") (q "text/css")
  | `Misc `Headingoffset_invalid ->
      Printf.sprintf "The value of the %s attribute must be a number between %s and %s."
        (q "headingoffset") (q "0") (q "8")
  | `Misc `Media_empty ->
      Printf.sprintf "Value of %s attribute here must not be empty." (q "media")
  | `Misc `Media_all ->
      Printf.sprintf "Value of %s attribute here must not be %s." (q "media") (q "all")
  | `Misc `Multiple_h1 ->
      Printf.sprintf "Consider using only one %s element per document (or, if using %s elements multiple times is required, consider using the %s attribute to indicate that these %s elements are not all top-level headings)."
        (q "h1") (q "h1") (q "headingoffset") (q "h1")
  | `Misc `Multiple_autofocus ->
      Printf.sprintf "There must not be two elements with the same %s that both have the %s attribute specified."
        (q "nearest ancestor autofocus scoping root element") (q "autofocus")

  (* Generic *)
  | `Generic message -> message

(** {2 Error Construction Helpers} *)

(** Create a bad attribute value error with element, attribute, value, and reason. *)
let bad_value ~element ~attr ~value ~reason : t =
  `Attr (`Bad_value (`Elem element, `Attr attr, `Value value, `Reason reason))

(** Create a bad attribute value error with just a message. *)
let bad_value_msg msg : t =
  `Attr (`Bad_value_generic (`Message msg))

(** Create a missing required attribute error. *)
let missing_attr ~element ~attr : t =
  `Attr (`Missing (`Elem element, `Attr attr))

(** Create an attribute not allowed error. *)
let attr_not_allowed ~element ~attr : t =
  `Attr (`Not_allowed (`Attr attr, `Elem element))

(** Create an element not allowed as child error. *)
let not_allowed_as_child ~child ~parent : t =
  `Element (`Not_allowed_as_child (`Child child, `Parent parent))

(** Create a must not be empty error. *)
let must_not_be_empty ~element : t =
  `Element (`Must_not_be_empty (`Elem element))