[Libguestfs] [PATCH 1/2] mltools: JSON: add json_parser_tree_parse_file

[Pino Toscano]

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