gross

json_parser_generator.ml

  type _ cgrammar =
    | Lit    : elem -> elem cgrammar
    | Seq    : 'a cgrammar * 'b cgrammar -> ('a * 'b) cgrammar
    | Left   : 'a cgrammar * 'b cgrammar -> 'a cgrammar
    | Right  : 'a cgrammar * 'b cgrammar -> 'b cgrammar
    | Either : 'a cgrammar list  -> 'a cgrammar
    | Rep    : 'a cgrammar -> ('a list) cgrammar
    | Repsep : 'a cgrammar * 'b cgrammar -> ('a list) cgrammar
    | TakeWhile : ('a -> bool) -> ('a list) cgrammar
    | Trans : ('a -> 'b) * 'a cgrammar -> 'b cgrammar

  type json = Obj of obj | Arr of arr | StringLit of string
  and  obj = member list
  and  member = string * json
  and  arr = json list

  let rec json_parser = Either ([
      Trans ((fun o -> Obj o), obj_parser);
      Trans ((fun a -> Arr a), arr_parser);
      Trans ((fun s -> StringLit s), str_parser)])
  and obj_parser =
    Left ((Right ((Lit '{'), (Repsep (member_parser, (Lit ','))))), (Lit '}'))
  and str_parser =
    Trans (
      (fun cl -> List.map (fun c -> String.make 1 c) cl |> String.concat ""),
      Left ((Right ((lit '"'), (TakeWhile (fun c -> c <> '"')))), (Lit '"')))
  and arr_parser =
    Left ((Right ((Lit '['), (Repsep (json_parser, (Lit ','))))), (Lit ']'))
  and member_parser =
    Seq (str_parser, Right ((Lit ':'), json_parser))