| 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} |