x3/src/lib/khatus_msg_parser.mll

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