(*--------------------------------------------------------------------------- Copyright (c) 2025 Anil Madhavapeddy . All rights reserved. SPDX-License-Identifier: MIT ---------------------------------------------------------------------------*) open Brr open Htmlrw_js_types let ensure_doctype html = let lower = String.lowercase_ascii html in if String.length lower >= 9 && String.sub lower 0 9 = "" ^ html let validate_string raw_html = let html = ensure_doctype raw_html in try let core_result = Htmlrw_check.check_string html in let messages = List.map (fun msg -> { message = msg; element_ref = None } ) (Htmlrw_check.messages core_result) in { messages; core_result; source_element = None } with exn -> (* Return empty result with error message on parse failure *) let error_msg = { Htmlrw_check.severity = Htmlrw_check.Error; text = Printf.sprintf "Parse error: %s" (Printexc.to_string exn); error_code = Htmlrw_check.Conformance (`Misc `Multiple_h1); location = None; element = None; attribute = None; extract = None; } in let core_result = Htmlrw_check.check_string "" in { messages = [{ message = error_msg; element_ref = None }]; core_result; source_element = None } let validate_element el = try let el_map, html = Htmlrw_js_dom.create el in let core_result = Htmlrw_check.check_string html in let messages = List.map (fun msg -> let element_ref = match Htmlrw_js_dom.find_for_message el_map msg with | Some browser_el -> Some { element = Some browser_el; selector = Htmlrw_js_dom.selector_path browser_el; } | None -> (* No direct mapping found - try to find by element name *) match msg.Htmlrw_check.element with | Some tag -> let matches = Htmlrw_js_dom.filter_elements (fun e -> String.lowercase_ascii (Jstr.to_string (El.tag_name e)) = String.lowercase_ascii tag ) el in (match matches with | browser_el :: _ -> Some { element = Some browser_el; selector = Htmlrw_js_dom.selector_path browser_el; } | [] -> None) | None -> None in { message = msg; element_ref } ) (Htmlrw_check.messages core_result) in { messages; core_result; source_element = Some el } with exn -> (* Return error result on parse failure *) let error_msg = { Htmlrw_check.severity = Htmlrw_check.Error; text = Printf.sprintf "Parse error: %s" (Printexc.to_string exn); error_code = Htmlrw_check.Conformance (`Misc `Multiple_h1); location = None; element = None; attribute = None; extract = None; } in let core_result = Htmlrw_check.check_string "" in { messages = [{ message = error_msg; element_ref = None }]; core_result; source_element = Some el } let validate_and_annotate ?(config = default_annotation_config) el = let result = validate_element el in (* Inject styles if not already present *) let doc = El.document el in let existing = El.find_first_by_selector (Jstr.v "[data-html5rw-styles]") ~root:(Document.head doc) in if Option.is_none existing then ignore (Htmlrw_js_annotate.inject_default_styles ~theme:`Auto); (* Annotate elements *) Htmlrw_js_annotate.annotate ~config ~root:el result.messages; result let validate_and_show_panel ?(annotation_config = default_annotation_config) ?(panel_config = default_panel_config) el = let result = validate_and_annotate ~config:annotation_config el in (* Inject panel styles if not already present *) let doc = El.document el in let existing = El.find_first_by_selector (Jstr.v "[data-html5rw-panel-styles]") ~root:(Document.head doc) in if Option.is_none existing then ignore (Htmlrw_js_ui.inject_default_styles ~theme:panel_config.theme); (* Create and show panel *) ignore (Htmlrw_js_ui.create ~config:panel_config result); result let errors result = List.filter (fun bm -> bm.message.Htmlrw_check.severity = Htmlrw_check.Error ) result.messages let warnings_only result = List.filter (fun bm -> bm.message.Htmlrw_check.severity = Htmlrw_check.Warning ) result.messages let infos result = List.filter (fun bm -> bm.message.Htmlrw_check.severity = Htmlrw_check.Info ) result.messages let has_errors result = Htmlrw_check.has_errors result.core_result let has_issues result = Htmlrw_check.has_errors result.core_result || Htmlrw_check.has_warnings result.core_result let message_count result = List.length result.messages let element_map result = match result.source_element with | Some el -> Some (fst (Htmlrw_js_dom.create el)) | None -> None (* JavaScript API registration *) let register_api_on obj = (* validateString(html) -> result *) Jv.set obj "validateString" (Jv.callback ~arity:1 (fun html -> let html_str = Jv.to_string html in let result = validate_string html_str in result_to_jv result )); (* validateElement(el) -> result *) Jv.set obj "validateElement" (Jv.callback ~arity:1 (fun el_jv -> let el = El.of_jv el_jv in let result = validate_element el in result_to_jv result )); (* validateAndAnnotate(el, config?) -> result *) Jv.set obj "validateAndAnnotate" (Jv.callback ~arity:2 (fun el_jv config_jv -> let el = El.of_jv el_jv in let config = if Jv.is_none config_jv then default_annotation_config else { add_data_attrs = Jv.to_bool (Jv.get config_jv "addDataAttrs"); add_classes = Jv.to_bool (Jv.get config_jv "addClasses"); show_tooltips = Jv.to_bool (Jv.get config_jv "showTooltips"); tooltip_position = `Auto; highlight_on_hover = Jv.to_bool (Jv.get config_jv "highlightOnHover"); } in let result = validate_and_annotate ~config el in result_to_jv result )); (* validateAndShowPanel(el, config?) -> result *) Jv.set obj "validateAndShowPanel" (Jv.callback ~arity:2 (fun el_jv config_jv -> let el = El.of_jv el_jv in let annotation_config, panel_config = if Jv.is_none config_jv then default_annotation_config, default_panel_config else let ann_jv = Jv.get config_jv "annotation" in let panel_jv = Jv.get config_jv "panel" in let ann_config = if Jv.is_none ann_jv then default_annotation_config else { add_data_attrs = (let v = Jv.get ann_jv "addDataAttrs" in if Jv.is_none v then true else Jv.to_bool v); add_classes = (let v = Jv.get ann_jv "addClasses" in if Jv.is_none v then true else Jv.to_bool v); show_tooltips = (let v = Jv.get ann_jv "showTooltips" in if Jv.is_none v then true else Jv.to_bool v); tooltip_position = `Auto; highlight_on_hover = (let v = Jv.get ann_jv "highlightOnHover" in if Jv.is_none v then true else Jv.to_bool v); } in let panel_config = if Jv.is_none panel_jv then default_panel_config else { initial_position = (let v = Jv.get panel_jv "initialPosition" in if Jv.is_none v then `TopRight else match Jv.to_string v with | "topRight" -> `TopRight | "topLeft" -> `TopLeft | "bottomRight" -> `BottomRight | "bottomLeft" -> `BottomLeft | _ -> `TopRight); draggable = (let v = Jv.get panel_jv "draggable" in if Jv.is_none v then true else Jv.to_bool v); resizable = (let v = Jv.get panel_jv "resizable" in if Jv.is_none v then true else Jv.to_bool v); collapsible = (let v = Jv.get panel_jv "collapsible" in if Jv.is_none v then true else Jv.to_bool v); start_collapsed = (let v = Jv.get panel_jv "startCollapsed" in if Jv.is_none v then false else Jv.to_bool v); max_height = (let v = Jv.get panel_jv "maxHeight" in if Jv.is_none v then Some 400 else Some (Jv.to_int v)); group_by_severity = (let v = Jv.get panel_jv "groupBySeverity" in if Jv.is_none v then true else Jv.to_bool v); click_to_highlight = (let v = Jv.get panel_jv "clickToHighlight" in if Jv.is_none v then true else Jv.to_bool v); show_selector_path = (let v = Jv.get panel_jv "showSelectorPath" in if Jv.is_none v then true else Jv.to_bool v); theme = (let v = Jv.get panel_jv "theme" in if Jv.is_none v then `Auto else match Jv.to_string v with | "light" -> `Light | "dark" -> `Dark | _ -> `Auto); } in ann_config, panel_config in let result = validate_and_show_panel ~annotation_config ~panel_config el in result_to_jv result )); (* clearAnnotations(el) *) Jv.set obj "clearAnnotations" (Jv.callback ~arity:1 (fun el_jv -> let el = El.of_jv el_jv in Htmlrw_js_annotate.clear el; Jv.undefined )); (* hidePanel() *) Jv.set obj "hidePanel" (Jv.callback ~arity:0 (fun () -> Htmlrw_js_ui.hide_current (); Jv.undefined )); (* showPanel(result, config?) *) Jv.set obj "showPanel" (Jv.callback ~arity:2 (fun result_jv config_jv -> (* This expects a previously returned result object *) (* For now, just create a panel with the warnings from the result *) let warnings_jv = Jv.get result_jv "warnings" in let warnings = Jv.to_list (fun w_jv -> let msg = { Htmlrw_check.severity = (match Jv.to_string (Jv.get w_jv "severity") with | "error" -> Htmlrw_check.Error | "warning" -> Htmlrw_check.Warning | _ -> Htmlrw_check.Info); text = Jv.to_string (Jv.get w_jv "message"); error_code = Htmlrw_check.Conformance (`Misc `Multiple_h1); location = None; element = None; attribute = None; extract = None; } in let element_ref = let sel_jv = Jv.get w_jv "selector" in let el_jv = Jv.get w_jv "element" in if Jv.is_none sel_jv then None else Some { selector = Jv.to_string sel_jv; element = if Jv.is_none el_jv then None else Some (El.of_jv el_jv); } in { message = msg; element_ref } ) warnings_jv in let result = { messages = warnings; core_result = Htmlrw_check.check_string ""; source_element = None; } in let config = if Jv.is_none config_jv then default_panel_config else default_panel_config (* TODO: parse config *) in ignore (Htmlrw_js_ui.create ~config result); Jv.undefined )) (* Async/Worker support *) let console_log msg = ignore (Jv.call (Jv.get Jv.global "console") "log" [| Jv.of_string msg |]) let console_log_result prefix result = let error_count = List.length (List.filter (fun bm -> bm.message.Htmlrw_check.severity = Htmlrw_check.Error ) result.messages) in let warning_count = List.length (List.filter (fun bm -> bm.message.Htmlrw_check.severity = Htmlrw_check.Warning ) result.messages) in let msg = Printf.sprintf "[html5rw] %s: %d errors, %d warnings, %d total issues" prefix error_count warning_count (List.length result.messages) in console_log msg let _worker : Jv.t option ref = ref None let _pending_callbacks : (int, Jv.t -> unit) Hashtbl.t = Hashtbl.create 16 let _next_id = ref 0 let init_worker worker_url = console_log (Printf.sprintf "[html5rw] Initializing web worker from %s" worker_url); let worker = Jv.new' (Jv.get Jv.global "Worker") [| Jv.of_string worker_url |] in (* Error handler for worker-level errors *) let error_handler = Jv.callback ~arity:1 (fun ev -> let msg = Jv.get ev "message" in let filename = Jv.get ev "filename" in let lineno = Jv.get ev "lineno" in console_log (Printf.sprintf "[html5rw] Worker error: %s at %s:%d" (if Jv.is_undefined msg then "unknown" else Jv.to_string msg) (if Jv.is_undefined filename then "unknown" else Jv.to_string filename) (if Jv.is_undefined lineno then 0 else Jv.to_int lineno)) ) in ignore (Jv.call worker "addEventListener" [| Jv.of_string "error"; error_handler |]); let handler = Jv.callback ~arity:1 (fun ev -> let data = Jv.get ev "data" in let id = Jv.get data "id" |> Jv.to_int in let error_count = Jv.get data "errorCount" |> Jv.to_int in let warning_count = Jv.get data "warningCount" |> Jv.to_int in let total = Jv.get data "warnings" |> Jv.to_list (fun _ -> ()) |> List.length in console_log (Printf.sprintf "[html5rw] Worker validation complete: %d errors, %d warnings, %d total issues" error_count warning_count total); match Hashtbl.find_opt _pending_callbacks id with | Some callback -> Hashtbl.remove _pending_callbacks id; callback data | None -> () ) in ignore (Jv.call worker "addEventListener" [| Jv.of_string "message"; handler |]); _worker := Some worker; console_log "[html5rw] Web worker ready"; worker let validate_string_async ~callback html = match !_worker with | None -> failwith "Worker not initialized. Call html5rw.initWorker(url) first." | Some worker -> console_log (Printf.sprintf "[html5rw] Sending %d bytes to worker for validation..." (String.length html)); let id = !_next_id in incr _next_id; Hashtbl.add _pending_callbacks id callback; let msg = Jv.obj [| "id", Jv.of_int id; "html", Jv.of_string html |] in ignore (Jv.call worker "postMessage" [| msg |]) let _validate_element_async ~callback el = let html = Htmlrw_js_dom.outer_html el in validate_string_async ~callback html let validate_after_load callback el = (* Use requestIdleCallback if available, otherwise setTimeout *) console_log "[html5rw] Waiting for page load..."; let run () = console_log "[html5rw] Starting validation..."; let result = validate_element el in console_log_result "Validation complete" result; callback result in let request_idle = Jv.get Jv.global "requestIdleCallback" in if not (Jv.is_undefined request_idle) then ignore (Jv.apply request_idle [| Jv.callback ~arity:1 (fun _ -> run ()) |]) else ignore (Jv.call Jv.global "setTimeout" [| Jv.callback ~arity:0 run; Jv.of_int 0 |]) let validate_on_idle ?(timeout=5000) callback el = (* Wait for page load, then use requestIdleCallback with timeout *) console_log "[html5rw] Scheduling validation for idle time..."; let run_when_ready () = let request_idle = Jv.get Jv.global "requestIdleCallback" in if not (Jv.is_undefined request_idle) then begin let opts = Jv.obj [| "timeout", Jv.of_int timeout |] in ignore (Jv.call Jv.global "requestIdleCallback" [| Jv.callback ~arity:1 (fun _ -> console_log "[html5rw] Browser idle, starting validation..."; let result = validate_element el in console_log_result "Validation complete" result; callback result ); opts |]) end else begin ignore (Jv.call Jv.global "setTimeout" [| Jv.callback ~arity:0 (fun () -> console_log "[html5rw] Starting validation..."; let result = validate_element el in console_log_result "Validation complete" result; callback result ); Jv.of_int 100 |]) end in let ready_state = Jv.get (Jv.get Jv.global "document") "readyState" |> Jv.to_string in if ready_state = "complete" then run_when_ready () else ignore (Jv.call Jv.global "addEventListener" [| Jv.of_string "load"; Jv.callback ~arity:1 (fun _ -> run_when_ready ()) |]) let register_global_api () = let api = Jv.obj [||] in register_api_on api; (* Add async functions *) (* initWorker(url) - initialize web worker *) Jv.set api "initWorker" (Jv.callback ~arity:1 (fun url_jv -> let url = Jv.to_string url_jv in init_worker url )); (* validateStringAsync(html, callback) - validate in worker *) Jv.set api "validateStringAsync" (Jv.callback ~arity:2 (fun html_jv callback_jv -> let html = Jv.to_string html_jv in let callback result = ignore (Jv.apply callback_jv [| result |]) in validate_string_async ~callback html; Jv.undefined )); (* validateElementAsync(el, callback) - validate element in worker *) Jv.set api "validateElementAsync" (Jv.callback ~arity:2 (fun el_jv callback_jv -> let el = El.of_jv el_jv in let html = Htmlrw_js_dom.outer_html el in let callback result = ignore (Jv.apply callback_jv [| result |]) in validate_string_async ~callback html; Jv.undefined )); (* validateAfterLoad(el, callback) - validate after page load *) Jv.set api "validateAfterLoad" (Jv.callback ~arity:2 (fun el_jv callback_jv -> let el = El.of_jv el_jv in let callback result = ignore (Jv.apply callback_jv [| result_to_jv result |]) in validate_after_load callback el; Jv.undefined )); (* validateOnIdle(el, callback, timeout?) - validate when browser is idle *) Jv.set api "validateOnIdle" (Jv.callback ~arity:3 (fun el_jv callback_jv timeout_jv -> let el = El.of_jv el_jv in let timeout = if Jv.is_undefined timeout_jv then 5000 else Jv.to_int timeout_jv in let callback result = ignore (Jv.apply callback_jv [| result_to_jv result |]) in validate_on_idle ~timeout callback el; Jv.undefined )); (* validateAndShowPanelAsync(el, config?) - non-blocking panel display *) Jv.set api "validateAndShowPanelAsync" (Jv.callback ~arity:2 (fun el_jv config_jv -> let el = El.of_jv el_jv in validate_on_idle ~timeout:3000 (fun result -> let annotation_config, panel_config = if Jv.is_none config_jv then default_annotation_config, default_panel_config else (* Parse config same as validateAndShowPanel *) default_annotation_config, default_panel_config in (* Inject styles if needed *) let doc = El.document el in let existing = El.find_first_by_selector (Jstr.v "[data-html5rw-styles]") ~root:(Document.head doc) in if Option.is_none existing then ignore (Htmlrw_js_annotate.inject_default_styles ~theme:`Auto); let existing_panel = El.find_first_by_selector (Jstr.v "[data-html5rw-panel-styles]") ~root:(Document.head doc) in if Option.is_none existing_panel then ignore (Htmlrw_js_ui.inject_default_styles ~theme:panel_config.theme); (* Annotate and show panel *) Htmlrw_js_annotate.annotate ~config:annotation_config ~root:el result.messages; ignore (Htmlrw_js_ui.create ~config:panel_config result) ) el; Jv.undefined )); (* showPanelFromWorkerResult(result) - show panel from worker validation result *) Jv.set api "showPanelFromWorkerResult" (Jv.callback ~arity:1 (fun result_jv -> console_log "[html5rw] Showing panel from worker result"; (* Convert worker result format to internal format *) let warnings_jv = Jv.get result_jv "warnings" in let messages = Jv.to_list (fun w_jv -> let severity_str = Jv.to_string (Jv.get w_jv "severity") in let msg = { Htmlrw_check.severity = (match severity_str with | "error" -> Htmlrw_check.Error | "warning" -> Htmlrw_check.Warning | _ -> Htmlrw_check.Info); text = Jv.to_string (Jv.get w_jv "message"); error_code = Htmlrw_check.Conformance (`Misc `Multiple_h1); location = ( let line_jv = Jv.get w_jv "line" in let col_jv = Jv.get w_jv "column" in if Jv.is_undefined line_jv then None else Some { Htmlrw_check.line = Jv.to_int line_jv; column = (if Jv.is_undefined col_jv then 1 else Jv.to_int col_jv); end_line = None; end_column = None; system_id = None; } ); element = ( let el_jv = Jv.get w_jv "elementName" in if Jv.is_undefined el_jv then None else Some (Jv.to_string el_jv) ); attribute = ( let attr_jv = Jv.get w_jv "attribute" in if Jv.is_undefined attr_jv then None else Some (Jv.to_string attr_jv) ); extract = None; } in { message = msg; element_ref = None } ) warnings_jv in let result = { messages; core_result = Htmlrw_check.check_string ""; source_element = None; } in (* Inject panel styles *) let doc = Document.of_jv (Jv.get Jv.global "document") in let existing_panel = El.find_first_by_selector (Jstr.v "[data-html5rw-panel-styles]") ~root:(Document.head doc) in if Option.is_none existing_panel then ignore (Htmlrw_js_ui.inject_default_styles ~theme:`Auto); (* Create and show panel *) console_log (Printf.sprintf "[html5rw] Creating panel with %d messages" (List.length messages)); ignore (Htmlrw_js_ui.create ~config:default_panel_config result); Jv.undefined )); Jv.set Jv.global "html5rw" api; (* Dispatch 'html5rwReady' event for async loaders (WASM) *) let document = Jv.get Jv.global "document" in let event_class = Jv.get Jv.global "CustomEvent" in let event = Jv.new' event_class [| Jv.of_string "html5rwReady" |] in ignore (Jv.call document "dispatchEvent" [| event |]); console_log "[html5rw] API ready"