{ module Msg = Khatus_msg module Time = Khatus_time type error = [ `Bad_format_of_msg_head | `Bad_format_of_msg_content ] let sep_2 = ':' } let alphnumdash = ['a'-'z' 'A'-'Z' '0'-'9' '_' '-']+ let snake = ['a'-'z' '_']+ let sep_1 = '|' let node = alphnumdash let modul = snake let key = ['a'-'z' 'A'-'Z' '0'-'9' '_' '-' ':']+ let level = ("info" | "error") let priority = ("low" | "med" | "hi") let subject = alphnumdash rule parse_msg = parse | (node as node) sep_1 (modul as modul) sep_1 { match parse_content lexbuf with | Ok content -> Ok Msg.({node; modul; content : content}) | (Error _) as e -> e } | _ { parse_msg lexbuf } | eof { Error (`Bad_format_of_msg_head) } and parse_content = parse | "status_bar" sep_1 { Ok (Msg.Status_bar (tl lexbuf)) } | "cache" sep_1 (['0'-'9']+ as mtime) sep_1 (node as node) sep_1 (modul as modul) sep_1 (key as key) sep_1 { let key = String.split_on_char sep_2 key in let mtime = Time.of_string mtime in Ok (Msg.Cache {mtime; node; modul; key; value = tl lexbuf}) } | "data" sep_1 (key as key) sep_1 { Ok (Msg.Data {key = String.split_on_char sep_2 key; value = tl lexbuf}) } | "error" sep_1 { Ok (Msg.Error (tl lexbuf)) } | "alert" sep_1 (priority as priority) (subject as subject) sep_1 { let priority = match priority with | "low" -> `low | "med" -> `med | "hi" -> `hi | _ -> assert false in Ok (Msg.Alert {priority; subject; body = tl lexbuf}) } | "log" sep_1 (snake as location) (level as level) sep_1 { let level = match level with | "info" -> `info | "error" -> `error | _ -> assert false in Ok (Msg.Log {location; level; msg = tl lexbuf}) } | _ { parse_content lexbuf } | eof { Error (`Bad_format_of_msg_content) } and tl = parse | (_* as tail) eof {tail}