Buffer.add_json function

buffer_add_json.ml

(* Simple Buffer.add_json function. *)

type json =
[ `Null | `Bool of bool | `Float of float | `String of string
| `Array of json list | `Object of (string * json) list ]

let rec buffer_add_json b = function
| `Null -> Buffer.add_string b "null"
| `Bool bool -> Buffer.add_string b (if bool then "true" else "false")
| `Float f -> Buffer.add_string b (Printf.sprintf "%.16g" f)
| `String s -> buffer_add_json_string b s
| `Array els ->
    begin match els with
    | [] -> Buffer.add_string b "[]";
    | el :: els ->
        let add_sep_el b e = Buffer.add_char b ','; buffer_add_json b e in
        Buffer.add_char b '[';
        buffer_add_json b el; List.iter (add_sep_el b) els;
        Buffer.add_char b ']';
    end
| `Object mems ->
    begin match mems with
    | [] -> Buffer.add_string b "{}"
    | mem :: mems ->
        let add_mem b (k,v) =
          buffer_add_json_string b k; Buffer.add_char b ':'; buffer_add_json b v
        in
        let add_sep_mem b mem = Buffer.add_char b ','; add_mem b mem in
        Buffer.add_char b '{';
        add_mem b mem; List.iter (add_sep_mem b) mems;
        Buffer.add_char b '}';
    end

and buffer_add_json_string b s =
  let is_control = function '\x00' .. '\x1F' | '\x7F' -> true | _ -> false in
  let len = String.length s in
  let max_idx = len - 1 in
  let flush b start i =
    if start < len then Buffer.add_substring b s start (i - start);
  in
  let rec loop start i = match i > max_idx with
  | true -> flush b start i
  | false ->
      let next = i + 1 in
      match String.get s i with
      | '"' -> flush b start i; Buffer.add_string b "\\\""; loop next next
      | '\\' -> flush b start i; Buffer.add_string b "\\\\"; loop next next
      | c when is_control c ->
          flush b start i;
          Buffer.add_string b (Printf.sprintf "\\u%04X" (Char.code c));
          loop next next
      | c -> loop start next
  in
  Buffer.add_char b '"'; loop 0 0; Buffer.add_char b '"'

let to_string json =
  let b = Buffer.create 1024 in
  buffer_add_json b json; Buffer.contents b