Skip to content
This repository
tag: v1119
Fetching contributors…

Cannot retrieve contributors at this time

file 84 lines (72 sloc) 2.224 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
(*
Copyright © 2011 MLstate

This file is part of OPA.

OPA is free software: you can redistribute it and/or modify it under the
terms of the GNU Affero General Public License, version 3, as published by
the Free Software Foundation.

OPA is distributed in the hope that it will be useful, but WITHOUT ANY
WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
FOR A PARTICULAR PURPOSE. See the GNU Affero General Public License for
more details.

You should have received a copy of the GNU Affero General Public License
along with OPA. If not, see <http://www.gnu.org/licenses/>.
*)
(* depends *)
module List = BaseList

(* shorthands *)
module J = JsonTypes

(* -- *)

module type Printer =
sig
  type t
  val json : t -> JsonTypes.json -> unit
end

let escape_non_utf8_special s =
  let reg_rep_list = [
    Str.regexp "\\", "\\\\\\\\";
    Str.regexp "\"", "\\\\\"";
    Str.regexp "\n" , "\\\\n";
    Str.regexp "\r" , "\\\\r";
    Str.regexp "\t" , "\\\\t";
  ] in
  List.fold_left
    (fun str (reg,rep) ->
       Str.global_replace reg rep str) s reg_rep_list

let print add arg formule =
  let add x = add arg x in
  let rec aux = function
    | J.Int n -> add (string_of_int n)
    | J.Float f -> add (Printf.sprintf "%f" f)
    | J.String s -> add ("\""^(escape_non_utf8_special s)^"\"")
    | J.Bool b -> add (string_of_bool b)
    | J.Void -> add "{}"
    | J.Array jlst ->
        add "[";
        let length = List.length jlst - 1 in
        List.iteri (fun x i -> aux x; if i < length then add ",") jlst;
        add "]";
    | J.Record sjlst ->
        add "{";
        let aux_field (n, x) =
          add "\""; add n; add "\":"; aux x in
        let rec aux = function
          | [x] -> aux_field x
          | t::q -> aux_field t; add ","; aux q
          | _ -> ()
        in aux sjlst; add "}"
  in
  aux formule

let to_string json =
  let fb = Buffer.create 50 in
  print Buffer.add_string fb json ;
  Buffer.contents fb

module Output =
struct
  type t = out_channel
  let json oc json = print Pervasives.output_string oc json
end

module Buffer =
struct
  type t = Buffer.t
  let json buf json = print Buffer.add_string buf json
end
Something went wrong with that request. Please try again.