lib/khatus_msg_parser.mll

   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}