Easy way to parse JSON from a file, without reading it all to string first. --- common/mltools/JSON_parser-c.c | 25 +++++++++++++++++++++++++ common/mltools/JSON_parser.ml | 1 + common/mltools/JSON_parser.mli | 3 +++ common/mltools/JSON_parser_tests.ml | 23 +++++++++++++++++++++++ 4 files changed, 52 insertions(+) diff --git a/common/mltools/JSON_parser-c.c b/common/mltools/JSON_parser-c.c index e10a2b69d..be1f011d1 100644 --- a/common/mltools/JSON_parser-c.c +++ b/common/mltools/JSON_parser-c.c @@ -37,6 +37,7 @@ #define JSON_DICT_TAG 5 value virt_builder_json_parser_tree_parse (value stringv); +value virt_builder_json_parser_tree_parse_file (value stringv); static value convert_json_t (json_t *val, int level) @@ -142,3 +143,27 @@ virt_builder_json_parser_tree_parse (value stringv) CAMLreturn (rv); } + +value +virt_builder_json_parser_tree_parse_file (value filev) +{ + CAMLparam1 (filev); + CAMLlocal1 (rv); + json_t *tree; + json_error_t err; + + tree = json_load_file (String_val (filev), JSON_DECODE_ANY, &err); + if (tree == NULL) { + char buf[1024 + JSON_ERROR_TEXT_LENGTH]; + if (strlen (err.text) > 0) + snprintf (buf, sizeof buf, "%s: JSON parse error: %s", String_val (filev), err.text); + else + snprintf (buf, sizeof buf, "%s: unknown JSON parse error", String_val (filev)); + caml_invalid_argument (buf); + } + + rv = convert_json_t (tree, 1); + json_decref (tree); + + CAMLreturn (rv); +} diff --git a/common/mltools/JSON_parser.ml b/common/mltools/JSON_parser.ml index 642e24d65..7c01ddf04 100644 --- a/common/mltools/JSON_parser.ml +++ b/common/mltools/JSON_parser.ml @@ -21,6 +21,7 @@ open Tools_utils open Common_gettext.Gettext external json_parser_tree_parse : string -> JSON.json_t = "virt_builder_json_parser_tree_parse" +external json_parser_tree_parse_file : string -> JSON.json_t = "virt_builder_json_parser_tree_parse_file" let object_find_optional key = function | JSON.Dict fields -> diff --git a/common/mltools/JSON_parser.mli b/common/mltools/JSON_parser.mli index 5ad0ef017..a62d387cd 100644 --- a/common/mltools/JSON_parser.mli +++ b/common/mltools/JSON_parser.mli @@ -19,6 +19,9 @@ val json_parser_tree_parse : string -> JSON.json_t (** Parse the JSON string. *) +val json_parser_tree_parse_file : string -> JSON.json_t +(** Parse the JSON in the specified file. *) + val object_get_string : string -> JSON.json_t -> string (** [object_get_string key yv] gets the value of the [key] field as a string in the [yv] structure *) diff --git a/common/mltools/JSON_parser_tests.ml b/common/mltools/JSON_parser_tests.ml index 024817711..286724616 100644 --- a/common/mltools/JSON_parser_tests.ml +++ b/common/mltools/JSON_parser_tests.ml @@ -122,6 +122,28 @@ let test_tree_parse_inspect ctx = assert_is_number 10_L (List.nth a 2); assert_is_number 2_L (List.assoc "second" l) +let test_tree_parse_file_basic ctx = + begin + let tmpfile, chan = bracket_tmpfile ctx in + output_string chan "{}\n"; + flush chan; + close_out chan; + let value = json_parser_tree_parse_file tmpfile in + assert_is_object value + end; + begin + let tmpfile, chan = bracket_tmpfile ctx in + output_string chan "{\"foo\":5}\n"; + flush chan; + close_out chan; + let value = json_parser_tree_parse_file tmpfile in + let l = get_dict value in + assert_equal_int 1 (List.length l); + assert_equal_string "foo" (fst (List.hd l)); + assert_is_number 5_L (snd (List.hd l)); + end; + () + (* Suites declaration. *) let suite = "mltools JSON_parser" >::: @@ -129,6 +151,7 @@ let suite = "tree_parse.invalid" >:: test_tree_parse_invalid; "tree_parse.basic" >:: test_tree_parse_basic; "tree_parse.inspect" >:: test_tree_parse_inspect; + "tree_parse_file.basic" >:: test_tree_parse_file_basic; ] let () = -- 2.17.1