OCaml HTML5 parser/serialiser based on Python's JustHTML
anil.recoil.org
1(** Get effective system_id, preferring location's system_id over the passed one *)
2let get_system_id ?system_id loc_system_id =
3 loc_system_id
4 |> Option.fold ~none:system_id ~some:Option.some
5 |> Option.value ~default:"input"
6
7let format_text ?system_id messages =
8 let buf = Buffer.create 1024 in
9 List.iter (fun msg ->
10 let loc_str = match msg.Message.location with
11 | Some loc ->
12 let sid = get_system_id ?system_id loc.Message.system_id in
13 let col_info = match loc.end_line, loc.end_column with
14 | Some el, Some ec when el = loc.line && ec > loc.column ->
15 Printf.sprintf "%d.%d-%d" loc.line loc.column ec
16 | Some el, Some ec when el > loc.line ->
17 Printf.sprintf "%d.%d-%d.%d" loc.line loc.column el ec
18 | _ ->
19 Printf.sprintf "%d.%d" loc.line loc.column
20 in
21 Printf.sprintf "%s:%s" sid col_info
22 | None ->
23 Option.value system_id ~default:"input"
24 in
25 let elem_str = Option.fold ~none:"" ~some:(Printf.sprintf " (element: %s)") msg.Message.element in
26 let attr_str = Option.fold ~none:"" ~some:(Printf.sprintf " (attribute: %s)") msg.Message.attribute in
27 Buffer.add_string buf (Printf.sprintf "%s: %s [%s]: %s%s%s\n"
28 loc_str
29 (Message.severity_to_string msg.Message.severity)
30 (Message.error_code_to_string msg.Message.error_code)
31 msg.Message.message
32 elem_str
33 attr_str)
34 ) messages;
35 Buffer.contents buf
36
37let format_gnu ?system_id messages =
38 let buf = Buffer.create 1024 in
39 List.iter (fun msg ->
40 let loc_str = match msg.Message.location with
41 | Some loc ->
42 Printf.sprintf "%s:%d:%d"
43 (get_system_id ?system_id loc.Message.system_id)
44 loc.line loc.column
45 | None ->
46 Option.value system_id ~default:"input" ^ ":0:0"
47 in
48 Buffer.add_string buf (Printf.sprintf "%s: %s [%s]: %s\n"
49 loc_str
50 (Message.severity_to_string msg.Message.severity)
51 (Message.error_code_to_string msg.Message.error_code)
52 msg.Message.message)
53 ) messages;
54 Buffer.contents buf
55
56let message_to_json ?system_id msg =
57 let open Jsont in
58 let str s = String (s, Meta.none) in
59 let num n = Number (float_of_int n, Meta.none) in
60 let field name value = ((name, Meta.none), value) in
61
62 let base = [
63 field "type" (str (Message.severity_to_string msg.Message.severity));
64 field "message" (str msg.Message.message);
65 field "subType" (str (Message.error_code_to_string msg.Message.error_code));
66 ] in
67
68 let with_location = match msg.Message.location with
69 | Some loc ->
70 let url = get_system_id ?system_id loc.Message.system_id in
71 let loc_fields = [
72 field "url" (str url);
73 field "firstLine" (num loc.line);
74 field "firstColumn" (num loc.column);
75 ] in
76 let loc_fields = Option.fold ~none:loc_fields
77 ~some:(fun el -> field "lastLine" (num el) :: loc_fields)
78 loc.Message.end_line in
79 let loc_fields = Option.fold ~none:loc_fields
80 ~some:(fun ec -> field "lastColumn" (num ec) :: loc_fields)
81 loc.Message.end_column in
82 loc_fields @ base
83 | None ->
84 field "url" (str (Option.value system_id ~default:"input")) :: base
85 in
86
87 let with_extract = Option.fold ~none:with_location
88 ~some:(fun e -> field "extract" (str e) :: with_location)
89 msg.Message.extract in
90
91 Object (with_extract, Meta.none)
92
93let messages_to_json ?system_id messages =
94 let open Jsont in
95 let msg_array = Array (List.map (message_to_json ?system_id) messages, Meta.none) in
96 Object ([ (("messages", Meta.none), msg_array) ], Meta.none)
97
98let format_json ?system_id messages =
99 let obj = messages_to_json ?system_id messages in
100 match Jsont_bytesrw.encode_string ~format:Minify Jsont.json obj with
101 | Ok s -> s
102 | Error e -> failwith ("JSON encoding error: " ^ e)