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 t = {
14 severity : severity;
15 message : string;
16 code : string;
17 error_code : Error_code.t option;
18 location : location option;
19 element : string option;
20 attribute : string option;
21 extract : string option;
22}
23
24let make_location ~line ~column ?end_line ?end_column ?system_id () =
25 { line; column; end_line; end_column; system_id }
26
27(** Create a message from a typed error code *)
28let of_error_code ?location ?element ?attribute ?extract error_code =
29 let severity = match Error_code.severity error_code with
30 | Error_code.Error -> Error
31 | Error_code.Warning -> Warning
32 | Error_code.Info -> Info
33 in
34 {
35 severity;
36 message = Error_code.to_message error_code;
37 code = Error_code.code_string error_code;
38 error_code = Some error_code;
39 location;
40 element;
41 attribute;
42 extract;
43 }
44
45(** Create a message with manual message text (for backwards compatibility during migration) *)
46let make ~severity ~message ?(code="generic") ?location ?element ?attribute ?extract () =
47 { severity; message; code; error_code = None; location; element; attribute; extract }
48
49let error ~message ?(code="generic") ?location ?element ?attribute ?extract () =
50 make ~severity:Error ~message ~code ?location ?element ?attribute ?extract ()
51
52let warning ~message ?(code="generic") ?location ?element ?attribute ?extract () =
53 make ~severity:Warning ~message ~code ?location ?element ?attribute ?extract ()
54
55let info ~message ?(code="generic") ?location ?element ?attribute ?extract () =
56 make ~severity:Info ~message ~code ?location ?element ?attribute ?extract ()
57
58let severity_to_string = function
59 | Error -> "error"
60 | Warning -> "warning"
61 | Info -> "info"
62
63let pp_severity fmt severity =
64 Format.pp_print_string fmt (severity_to_string severity)
65
66let pp_location fmt loc =
67 (match loc.system_id with
68 | Some sid -> Format.fprintf fmt "%s:" sid
69 | None -> ());
70 Format.fprintf fmt "%d:%d" loc.line loc.column;
71 match (loc.end_line, loc.end_column) with
72 | Some el, Some ec when el = loc.line && ec > loc.column ->
73 Format.fprintf fmt "-%d" ec
74 | Some el, Some ec when el > loc.line ->
75 Format.fprintf fmt "-%d:%d" el ec
76 | _ -> ()
77
78let pp fmt msg =
79 (match msg.location with
80 | Some loc ->
81 pp_location fmt loc;
82 Format.fprintf fmt ": "
83 | None -> ());
84 pp_severity fmt msg.severity;
85 Format.fprintf fmt " [%s]" msg.code;
86 Format.fprintf fmt ": %s" msg.message;
87 (match msg.element with
88 | Some elem -> Format.fprintf fmt " (element: %s)" elem
89 | None -> ());
90 match msg.attribute with
91 | Some attr -> Format.fprintf fmt " (attribute: %s)" attr
92 | None -> ()
93
94let to_string msg =
95 let buf = Buffer.create 256 in
96 let fmt = Format.formatter_of_buffer buf in
97 pp fmt msg;
98 Format.pp_print_flush fmt ();
99 Buffer.contents buf