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 _______________________________________________ Libguestfs mailing list Libguestfs@redhat.com https://www.redhat.com/mailman/listinfo/libguestfs