Commit | Line | Data |
---|---|---|
c6a7396e SK |
1 | { |
2 | module Msg = Khatus_msg | |
3 | module Time = Khatus_time | |
4 | let sep_2 = ':' | |
5 | } | |
6 | ||
7 | let alphnumdash = ['a'-'z' 'A'-'Z' '0'-'9' '_' '-']+ | |
8 | let snake = ['a'-'z' '_']+ | |
9 | ||
10 | let sep_1 = '|' | |
11 | let node = alphnumdash | |
12 | let modul = snake | |
13 | let key = ['a'-'z' 'A'-'Z' '0'-'9' '_' '-' ':']+ | |
14 | let level = ("info" | "error") | |
15 | let priority = ("low" | "med" | "hi") | |
16 | let subject = alphnumdash | |
17 | ||
18 | rule parse_msg = parse | |
19 | | (node as node) sep_1 (modul as modul) sep_1 { | |
20 | match parse_content lexbuf with | |
21 | | Ok content -> Ok Msg.({node; modul; content : content}) | |
22 | | (Error _) as e -> e | |
23 | } | |
24 | | _ { | |
25 | parse_msg lexbuf | |
26 | } | |
27 | | eof { | |
28 | Error (`Bad_format_of_msg_head) | |
29 | } | |
30 | ||
31 | and parse_content = parse | |
32 | | "status_bar" sep_1 { | |
33 | Ok (Msg.Status_bar (tl lexbuf)) | |
34 | } | |
35 | | "cache" | |
36 | sep_1 (['0'-'9']+ as mtime) | |
37 | sep_1 (node as node) | |
38 | sep_1 (modul as modul) | |
39 | sep_1 (key as key) | |
40 | sep_1 | |
41 | { | |
42 | let key = String.split_on_char sep_2 key in | |
43 | let mtime = Time.of_string mtime in | |
44 | Ok (Msg.Cache {mtime; node; modul; key; value = tl lexbuf}) | |
45 | } | |
46 | | "data" sep_1 (key as key) sep_1 { | |
47 | Ok (Msg.Data {key = String.split_on_char sep_2 key; value = tl lexbuf}) | |
48 | } | |
49 | | "error" sep_1 { | |
50 | Ok (Msg.Error (tl lexbuf)) | |
51 | } | |
52 | | "alert" sep_1 (priority as priority) (subject as subject) sep_1 { | |
53 | let priority = | |
54 | match priority with | |
55 | | "low" -> `low | |
56 | | "med" -> `med | |
57 | | "hi" -> `hi | |
58 | | _ -> assert false | |
59 | in | |
60 | Ok (Msg.Alert {priority; subject; body = tl lexbuf}) | |
61 | } | |
62 | | "log" sep_1 (snake as location) (level as level) sep_1 { | |
63 | let level = | |
64 | match level with | |
65 | | "info" -> `info | |
66 | | "error" -> `error | |
67 | | _ -> assert false | |
68 | in | |
69 | Ok (Msg.Log {location; level; msg = tl lexbuf}) | |
70 | } | |
71 | | _ { | |
72 | parse_content lexbuf | |
73 | } | |
74 | | eof { | |
75 | Error (`Bad_format_of_msg_content) | |
76 | } | |
77 | ||
78 | and tl = parse | |
79 | | (_* as tail) eof {tail} |