Merge pull request #65 from jestabro/config-dict

T8232: Simplify and extend config_dict construction

8 files changed, 158 insertions, 8 deletions

diff --git a/src/config_dict.ml b/src/config_dict.ml
new file mode 100644
index 0000000..e07c9bc
--- /dev/null
+++ b/src/config_dict.ml
@@ -0,0 +1,84 @@
+(** The goal here is to produce a JSON rendering to load into a Python dict.
+    By abuse of language, the entry point is named config_dict, the Python
+    wrapper for which will perform the json.loads().
+
+    The idea here is simple, and abstracts the construction in vyos-1x using
+    the xml_ref module:
+        fold over the config tree 'a fold over the reference tree'
+    The required details to make this work:
+        (1) skip tag nodes in the config tree, so as to call the
+        corresponding reference tree below the tag node value in the
+        depth-first fold.
+        (2) use a modified fold_tree_with_path to store a boolean for each
+        level, in order to ignore non-sensical (non-existent tag node value)
+        or excluded (masked) reference paths below a given level.
+        (3) make appropriate use of local vs global paths in the respective
+        trees.
+ *)
+
+let tree_with_defaults ?(with_first_node=true) ref_tree config_tree mask path =
+    let ct_at_path =
+        Config_tree.get_subtree ~with_node:with_first_node config_tree path
+    in
+    let continue l =
+        match l with
+        | [] -> true
+        | x :: _ -> x
+    in
+    let add_defaults ct p' =
+        let ref_path =
+            match with_first_node with
+            | false -> Reference_tree.refpath ref_tree (path @ p')
+            | true -> Reference_tree.refpath ref_tree ((Util.drop_last path) @ p')
+        in
+        let relative_ref_tree = Reference_tree.get_subtree ref_tree ref_path in
+        let ref_tree_walk ((p, c), acc) node =
+            let cont = continue c in
+            if not cont then ((p, false::c), acc)
+            else
+            let rev_p = List.rev p in
+            let sub_path = p' @ rev_p in
+            if not (Util.is_empty rev_p) &&
+                (Vytree.is_terminal_path[@alert "-exn"]) mask (ref_path @ rev_p) &&
+                not ((Vytree.exists[@alert "-exn"]) ct sub_path)
+            then ((p, false::c), acc)
+            else
+            let data = Vytree.data_of_node node in
+            match data.Reference_tree.node_type with
+            | `Tag -> ((p, false::c), acc)
+            | `Leaf ->
+                if (Vytree.exists[@alert "-exn"]) acc sub_path then ((p, cont::c), acc)
+                else
+                begin
+                match data.default_value with
+                | None -> ((p, cont::c), acc)
+                | Some v ->
+                    let acc' =
+                        (* The behaviour variant ReplaceValue has no effect in this case
+                           as the path does not exist in branch. *)
+                        (Config_tree.set[@alert "-exn"]) acc sub_path (Some v) ReplaceValue
+                    in ((p, cont::c), acc')
+                end
+            | _ -> ((p, cont::c), acc)
+        in
+        Vytree.fold_tree_with_path_and_list ref_tree_walk (([], []), ct) relative_ref_tree
+    in
+    let config_tree_walk (p, acc) ct =
+        let (data: Config_tree.config_node_data) = Vytree.data_of_node ct in
+        if with_first_node && Util.is_empty p then (p, acc) else
+        if data.tag then (p, acc) else
+        let rev_p = List.rev p in
+        let ct' = add_defaults acc rev_p
+        in (p, ct')
+    in Vytree.fold_tree_with_path config_tree_walk ([], ct_at_path) ct_at_path
+
+
+(* Simple check of config dict result. Modifications 'multi_to_list' and
+   'key_mangling' should belong to an extended config tree JSONRenderer *)
+let config_dict ?(with_defaults=true) ?(with_first_node=true) rt ct mask path =
+    let ht =
+        match with_defaults with
+        | true -> tree_with_defaults ~with_first_node rt ct mask path
+        | false -> Config_tree.get_subtree ~with_node:with_first_node ct path
+    in
+    Config_tree.render_json ht
diff --git a/src/config_dict.mli b/src/config_dict.mli
new file mode 100644
index 0000000..6f0d8c9
--- /dev/null
+++ b/src/config_dict.mli
@@ -0,0 +1,2 @@
+
+val config_dict : ?with_defaults:bool -> ?with_first_node:bool -> Reference_tree.t -> Config_tree.t -> Config_tree.t -> string list -> string
diff --git a/src/config_diff.ml b/src/config_diff.ml
index 54f6474..5d71c34 100644
--- a/src/config_diff.ml
+++ b/src/config_diff.ml
@@ -330,7 +330,7 @@ let get_tagged_delete_tree dt =
         else
             (p, a)
     in
-    snd (Vytree.fold_tree_with_path f ([], del_tree) del_tree)
+    Vytree.fold_tree_with_path f ([], del_tree) del_tree
 
 
 (* the following builds a diff_func to return a unified diff string of
diff --git a/src/config_tree.ml b/src/config_tree.ml
index a2bde3a..6a25c31 100644
--- a/src/config_tree.ml
+++ b/src/config_tree.ml
@@ -247,9 +247,21 @@ let get_subtree ?(with_node=false) node path =
     try
         let n = (Vytree.get[@alert "-exn"]) node path in
         if with_node then
-            Vytree.make_full default_data "" [n]
+            let data =
+                (* preserve tag attribute *)
+                match (is_tag_value node path) with
+                | true -> {default_data with tag = true}
+                | false -> default_data
+            in
+            Vytree.make_full data "" [n]
         else
-            Vytree.make_full default_data "" (Vytree.children_of_node n)
+            let data =
+                (* preserve tag attribute *)
+                match (is_tag node path) with
+                | true -> {default_data with tag = true}
+                | false -> default_data
+            in
+            Vytree.make_full data "" (Vytree.children_of_node n)
     with Vytree.Nonexistent_path -> make ""
 
 let value_paths_of_tree node =
@@ -274,7 +286,7 @@ let value_paths_of_tree node =
                             q'::acc
                         in List.fold_left f a vs
                     in (p, a')
-    in List.rev (snd (Vytree.fold_tree_with_path (func node) ([], []) node))
+    in List.rev (Vytree.fold_tree_with_path (func node) ([], []) node)
 
 let prune_delete node path =
     (* raises:
diff --git a/src/reference_tree.ml b/src/reference_tree.ml
index 81e45cf..10cc833 100644
--- a/src/reference_tree.ml
+++ b/src/reference_tree.ml
@@ -94,6 +94,8 @@ let default_data = {
 
 let default = Vytree.make default_data ""
 
+let make name = Vytree.make default_data name
+
 (* Loading from XML *)
 
 let node_type_of_string s =
@@ -602,6 +604,22 @@ let get_default_value reftree path =
     let data = (Vytree.get_data[@alert "-exn"]) reftree path in
     data.default_value
 
+let get_subtree ?(with_node=false) node path =
+    (* alert exn Vytree.get:
+        [Vytree.Empty_path] checked
+        [Vytree.Nonexistent_path] caught
+     *)
+    match path with
+    | [] -> node
+    | _ ->
+    try
+        let n = (Vytree.get[@alert "-exn"]) node path in
+        if with_node then
+            Vytree.make_full default_data "" [n]
+        else
+            Vytree.make_full default_data "" (Vytree.children_of_node n)
+    with Vytree.Nonexistent_path -> make ""
+
 (* Convert from config path to reference tree path *)
 let refpath reftree path =
     let check_existence p =
@@ -933,7 +951,7 @@ let validate_tree_filter dir rt ct =
             List.fold_left try_validate (p, (ctree, out)) l'
     in
     let tree, out =
-        snd (Vytree.fold_tree_with_path validate_path_filter ([], (ct, "")) ct)
+        Vytree.fold_tree_with_path validate_path_filter ([], (ct, "")) ct
     in
     tree, out
 
diff --git a/src/reference_tree.mli b/src/reference_tree.mli
index 96cb24f..f915275 100644
--- a/src/reference_tree.mli
+++ b/src/reference_tree.mli
@@ -51,6 +51,8 @@ val default_data : ref_node_data
 
 val default : t
 
+val make : string -> t
+
 val load_from_xml : t -> string -> t
 [@@alert exn "Reference_tree.Bad_interface_definition"]
 
@@ -110,6 +112,8 @@ val get_default_value : t -> string list -> string option
 [@@alert exn "Vytree.Empty_path"]
 [@@alert exn "Vytree.Nonexistent_path"]
 
+val get_subtree : ?with_node:bool -> t -> string list -> t
+
 val refpath : t -> string list -> string list
 
 val set_tag_data : t -> Config_tree.t -> string list -> Config_tree.t
diff --git a/src/vytree.ml b/src/vytree.ml
index a65fe6f..6ecc867 100644
--- a/src/vytree.ml
+++ b/src/vytree.ml
@@ -292,7 +292,8 @@ let is_terminal_path node path =
         | _ -> false
     with Nonexistent_path -> false
 
-let rec fold_tree_with_path f (p', a) t =
+let fold_tree_with_path f (p', a) t =
+    let rec fold_func f (p', a) t =
     let p =
         match name_of_node t with
         | "" -> p'
@@ -302,5 +303,31 @@ let rec fold_tree_with_path f (p', a) t =
     match children with
     | [] -> (Util.drop_first p), snd (f (p, a) t)
     | c -> let res =
-        List.fold_left (fold_tree_with_path f) (f (p, a) t) c in
+        List.fold_left (fold_func f) (f (p, a) t) c in
         (Util.drop_first p), snd res
+    in snd (fold_func f (p', a) t)
+
+(** Allow function called in fold to maintain a list of values for each
+    depth level of tree. A simple example is for the the function to cons a
+    boolean value to the list v at each call of the depth-first traversal;
+    at the return to local root, the value for that level is restored.
+    Note that if the function returns the empty list, this function reduces
+    to fold_tree_with_path.
+ *)
+
+let fold_tree_with_path_and_list f ((p', v), a) t =
+    let rec fold_func f ((p', v), a) t =
+    let p =
+        match name_of_node t with
+        | "" -> p'
+        | name -> name :: p'
+    in
+    let children = children_of_node t in
+    match children with
+    | [] -> let res =
+        f ((p, v), a) t in
+        (Util.drop_first p, Util.drop_first (snd (fst res))), snd res
+    | c -> let res =
+        List.fold_left (fold_func f) (f ((p, v), a) t) c in
+        (Util.drop_first p, Util.drop_first (snd (fst res))), snd res
+    in snd (fold_func f ((p', v), a) t)
diff --git a/src/vytree.mli b/src/vytree.mli
index c23f1a7..448aa84 100644
--- a/src/vytree.mli
+++ b/src/vytree.mli
@@ -95,4 +95,7 @@ val move : 'a t -> string list -> position -> 'a t
 val is_terminal_path : 'a t -> string list -> bool
 [@@alert exn "Vytree.Empty_path"]
 
-val fold_tree_with_path: (string list * 'acc -> 'b t -> string list * 'acc) -> string list * 'acc -> 'b t -> string list * 'acc
+val fold_tree_with_path: (string list * 'acc -> 'b t -> string list * 'acc) -> string list * 'acc -> 'b t -> 'acc
+
+val fold_tree_with_path_and_list: ((string list * bool list) * 'acc -> 'b t ->
+    (string list * bool list) * 'acc) -> (string list * bool list) * 'acc -> 'b t -> 'acc