OCaml HTML5 parser/serialiser based on Python's JustHTML
anil.recoil.org
1(** Validation messages with typed error codes. *)
2
3type severity = Error | Warning | Info
4
5type location = {
6 line : int;
7 column : int;
8 end_line : int option;
9 end_column : int option;
10 system_id : string option;
11}
12
13type error_code =
14 | Parse_error of Html5rw.Parse_error_code.t
15 | Conformance_error of Error_code.t
16
17type t = {
18 severity : severity;
19 message : string;
20 error_code : error_code;
21 location : location option;
22 element : string option;
23 attribute : string option;
24 extract : string option;
25}
26
27let make_location ~line ~column ?end_line ?end_column ?system_id () =
28 { line; column; end_line; end_column; system_id }
29
30(** Create a message from a conformance error code *)
31let of_conformance_error ?location ?element ?attribute ?extract error_code =
32 let severity = match Error_code.severity error_code with
33 | Error_code.Error -> Error
34 | Error_code.Warning -> Warning
35 | Error_code.Info -> Info
36 in
37 {
38 severity;
39 message = Error_code.to_message error_code;
40 error_code = Conformance_error error_code;
41 location;
42 element;
43 attribute;
44 extract;
45 }
46
47(** Create a message from a parse error code *)
48let of_parse_error ?location ?element ?attribute ?extract ~message code =
49 {
50 severity = Error; (* Parse errors are always errors *)
51 message;
52 error_code = Parse_error code;
53 location;
54 element;
55 attribute;
56 extract;
57 }
58
59let error_code_to_string = function
60 | Parse_error code -> Html5rw.Parse_error_code.to_string code
61 | Conformance_error code -> Error_code.code_string code
62
63let severity_to_string = function
64 | Error -> "error"
65 | Warning -> "warning"
66 | Info -> "info"
67
68let pp_severity fmt severity =
69 Format.pp_print_string fmt (severity_to_string severity)
70
71let pp_location fmt loc =
72 (match loc.system_id with
73 | Some sid -> Format.fprintf fmt "%s:" sid
74 | None -> ());
75 Format.fprintf fmt "%d:%d" loc.line loc.column;
76 match (loc.end_line, loc.end_column) with
77 | Some el, Some ec when el = loc.line && ec > loc.column ->
78 Format.fprintf fmt "-%d" ec
79 | Some el, Some ec when el > loc.line ->
80 Format.fprintf fmt "-%d:%d" el ec
81 | _ -> ()
82
83let pp fmt msg =
84 (match msg.location with
85 | Some loc ->
86 pp_location fmt loc;
87 Format.fprintf fmt ": "
88 | None -> ());
89 pp_severity fmt msg.severity;
90 Format.fprintf fmt " [%s]" (error_code_to_string msg.error_code);
91 Format.fprintf fmt ": %s" msg.message;
92 (match msg.element with
93 | Some elem -> Format.fprintf fmt " (element: %s)" elem
94 | None -> ());
95 match msg.attribute with
96 | Some attr -> Format.fprintf fmt " (attribute: %s)" attr
97 | None -> ()
98
99let to_string msg =
100 let buf = Buffer.create 256 in
101 let fmt = Format.formatter_of_buffer buf in
102 pp fmt msg;
103 Format.pp_print_flush fmt ();
104 Buffer.contents buf