forked from alokmenghrajani/opalang
-
Notifications
You must be signed in to change notification settings - Fork 0
/
jsonPrint.ml
84 lines (72 loc) · 2.17 KB
/
jsonPrint.ml
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