10:10 a.m.
Improve the homebrew JSON writer:
- add more types (including also nested dictionaries and lists)
- format in a compact way (single line), or indented (multilines)
---
mllib/JSON.ml | 118 ++++++++++++++++++++++++++++++++++++++++++++-------------
mllib/JSON.mli | 16 ++++++--
2 files changed, 104 insertions(+), 30 deletions(-)
diff --git a/mllib/JSON.ml b/mllib/JSON.ml
index 5e3a879..316b3f2 100644
--- a/mllib/JSON.ml
+++ b/mllib/JSON.ml
@@ -16,38 +16,102 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
-(* Poor man's JSON generator. *)
-
-open Printf
-
-open Common_utils
+(* Simple JSON generator. *)
type field = string * json_t
-and json_t = String of string | Int of int
+and json_t =
+ | String of string
+ | Int of int
+ | Int64 of int64
+ | Bool of bool
+ | List of json_t list
+ | Dict of field list
and doc = field list
+type output_format =
+ | Compact
+ | Indented
+
+
+let spaces_for_indent level =
+ let len = level * 2 in
+ let s = String.create len in
+ String.fill s 0 len ' ';
+ s
+
+let print_dict_after_start ~fmt ~indent ~size =
+ match size, fmt with
+ | 0, Compact -> ""
+ | _, Compact -> " "
+ | _, Indented -> "\n"
+
+let print_dict_before_end ~fmt ~indent ~size =
+ match size, fmt with
+ | 0, _ -> ""
+ | _, Compact -> " "
+ | _, Indented -> "\n"
+
+let print_indent ~fmt ~indent =
+ match fmt with
+ | Compact -> ""
+ | Indented -> spaces_for_indent indent
+
(* JSON quoting. *)
-let json_quote str =
- let str = replace_str str "\\" "\\\\" in
- let str = replace_str str "\"" "\\\"" in
- let str = replace_str str "'" "\\'" in
- let str = replace_str str "\008" "\\b" in
- let str = replace_str str "\012" "\\f" in
- let str = replace_str str "\n" "\\n" in
- let str = replace_str str "\r" "\\r" in
- let str = replace_str str "\t" "\\t" in
- let str = replace_str str "\011" "\\v" in
- str
-
-let string_of_doc fields =
- "{ " ^
- String.concat ", " (
+let json_escape_string str =
+ let res = ref "" in
+ for i = 0 to String.length str - 1 do
+ res := !res ^ (match str.[i] with
+ | '"' -> "\\\""
+ | '\\' -> "\\\\"
+ | '\b' -> "\\b"
+ | '\n' -> "\\n"
+ | '\r' -> "\\r"
+ | '\t' -> "\\t"
+ | c -> String.make 1 c)
+ done;
+ !res
+
+let json_quote_string str =
+ "\"" ^ (json_escape_string str) ^ "\""
+
+let rec output_dict fields ~fmt ~indent =
+ let size = List.length fields in
+ let newlinesep =
+ match fmt with
+ | Compact -> ", "
+ | Indented -> ",\n" in
+ "{" ^ (print_dict_after_start ~fmt ~indent ~size) ^
+ String.concat newlinesep (
+ List.map (
+ fun (n, f) ->
+ (print_indent ~fmt ~indent:(indent + 1)) ^ (json_quote_string n)
+ ^ ": " ^ (output_field ~fmt ~indent f)
+ ) fields
+ )
+ ^ (print_dict_before_end ~fmt ~indent ~size) ^ (print_indent ~fmt ~indent) ^
"}"
+
+and output_list fields ~fmt ~indent =
+ let size = List.length fields in
+ let newlinesep =
+ match fmt with
+ | Compact -> ", "
+ | Indented -> ",\n" in
+ "[" ^ (print_dict_after_start ~fmt ~indent ~size) ^
+ String.concat newlinesep (
List.map (
- function
- | (n, String v) ->
- sprintf "\"%s\" : \"%s\"" n (json_quote v)
- | (n, Int v) ->
- sprintf "\"%s\" : %d" n v
+ fun f ->
+ (print_indent ~fmt ~indent:(indent + 1)) ^ (output_field ~fmt ~indent f)
) fields
)
- ^ " }"
+ ^ (print_dict_before_end ~fmt ~indent ~size) ^ (print_indent ~fmt ~indent) ^
"]"
+
+and output_field ~indent ~fmt = function
+ | String s -> json_quote_string s
+ | Int i -> string_of_int i
+ | Bool b -> if b then "true" else "false"
+ | Int64 i -> Int64.to_string i
+ | List l -> output_list ~indent:(indent + 1) ~fmt l
+ | Dict d -> output_dict ~indent:(indent + 1) ~fmt d
+
+let string_of_doc ?(fmt = Compact) fields =
+ output_dict fields ~fmt ~indent:0
diff --git a/mllib/JSON.mli b/mllib/JSON.mli
index 1e3a1b3..fbaffab 100644
--- a/mllib/JSON.mli
+++ b/mllib/JSON.mli
@@ -16,11 +16,21 @@
* 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
*)
-(** Poor man's JSON generator. *)
+(** Simple JSON generator. *)
type field = string * json_t
-and json_t = String of string | Int of int
+and json_t =
+ | String of string
+ | Int of int
+ | Int64 of int64
+ | Bool of bool
+ | List of json_t list
+ | Dict of field list
and doc = field list
-val string_of_doc : doc -> string
+type output_format =
+ | Compact
+ | Indented
+
+val string_of_doc : ?fmt:output_format -> doc -> string
(** Serialize {!doc} object as a string. *)
--
1.9.3