diff options
-rw-r--r-- | src/config_tree.ml | 40 | ||||
-rw-r--r-- | src/config_tree.mli | 2 |
2 files changed, 42 insertions, 0 deletions
diff --git a/src/config_tree.ml b/src/config_tree.ml index 463eb4b..a9dd61e 100644 --- a/src/config_tree.ml +++ b/src/config_tree.ml @@ -201,6 +201,44 @@ struct end (* Renderer *) +module JSONRenderer = struct + let render_values values = + match values with + | [] -> Printf.sprintf "{}" + | [v] -> Printf.sprintf "\"%s\"" (String.escaped v) + | _ -> + let rendered = List.map (fun s -> Printf.sprintf "\"%s\"" (String.escaped s)) values in + let rendered = String.concat "," rendered in + Printf.sprintf "[%s]" rendered + + let rec render_node node = + let name = Vytree.name_of_node node in + let children = Vytree.children_of_node node in + let data = Vytree.data_of_node node in + match children, data.values with + | [], [] -> + (* Empty node. + In JSON, we don't differentiate between leaf and non-leaf nodes in this case. *) + Printf.sprintf "\"%s\": {}" name + | _, [] -> + (* Non-empty, non-leaf node. *) + let children_strs = List.map render_node children in + let children_str = String.concat "," children_strs in + Printf.sprintf "\"%s\": {%s}" name children_str + | [], _ -> + (* Leaf node with children. *) + Printf.sprintf "\"%s\": %s" name (render_values data.values) + | _, _ -> + (* Shouldn't happen *) + failwith "Internal error: non-leaf node with values" + + let render_json node = + let children = Vytree.children_of_node node in + let child_configs = List.map render_node children in + let child_configs = String.concat "," child_configs in + Printf.sprintf "{%s}" child_configs +end (* JSONRenderer *) + let render_commands node path = let node = match path with @@ -212,3 +250,5 @@ let render_commands node path = String.concat "\n" commands let render_config = Renderer.render_config + +let render_json = JSONRenderer.render_json diff --git a/src/config_tree.mli b/src/config_tree.mli index c01e299..a0607e3 100644 --- a/src/config_tree.mli +++ b/src/config_tree.mli @@ -36,3 +36,5 @@ val is_tag : t -> string list -> bool val render_commands : t -> string list -> string val render_config : t -> string + +val render_json : t -> string |