Merge pull request #15 from jestabro/identity

T5089: support for unit test of config_diff

9 files changed, 109 insertions, 46 deletions

diff --git a/src/config_diff.ml b/src/config_diff.ml
index 2c0a91f..9bbd2fd 100644
--- a/src/config_diff.ml
+++ b/src/config_diff.ml
@@ -12,8 +12,7 @@ type diff_trees = {
 
 exception Incommensurable
 exception Empty_comparison
-
-module ValueS = Set.Make(struct type t = string let compare = compare end)
+exception Nonexistent_child
 
 let make_diff_trees l r = { left = l; right = r;
                            add = ref (Config_tree.make "");
@@ -26,6 +25,20 @@ let data_of n = Vytree.data_of_node n
 let children_of n = Vytree.children_of_node n
 let make data name children = Vytree.make_full data name children
 
+module ValueOrd = struct
+    type t = string
+    let compare a b =
+        Util.lexical_numeric_compare a b
+end
+module ValueS = Set.Make(ValueOrd)
+
+module TreeOrd = struct
+    type t = Config_tree.t
+    let compare a b =
+        Util.lexical_numeric_compare (name_of a) (name_of b)
+end
+module ChildrenS = Set.Make(TreeOrd)
+
 let (^~) (node : Config_tree.t) (node' : Config_tree.t) =
   name_of node = name_of node' &&
   (data_of node).values <> (data_of node').values
@@ -111,13 +124,13 @@ let rec clone_path ?(recurse=true) ?(set_values=None) old_root new_root path_don
             | None -> data_of old_node
         in
         if recurse then
-            Vytree.insert ~children:(children_of old_node) new_root path_total data
+            Vytree.insert ~position:Lexical ~children:(children_of old_node) new_root path_total data
         else
-            Vytree.insert new_root path_total data
+            Vytree.insert ~position:Lexical new_root path_total data
     | name :: names ->
         let path_done = path_done @ [name] in
         let old_node = Vytree.get old_root path_done in
-        let new_root = Vytree.insert new_root path_done (data_of old_node) in
+        let new_root = Vytree.insert ~position:Lexical new_root path_done (data_of old_node) in
         clone_path ~recurse:recurse ~set_values:set_values old_root new_root path_done names
 
 let clone ?(recurse=true) ?(set_values=None) old_root new_root path =
@@ -128,16 +141,6 @@ let clone ?(recurse=true) ?(set_values=None) old_root new_root path =
             let path_remaining = Vylist.complement path path_existing in
             clone_path ~recurse:recurse ~set_values:set_values old_root new_root path_existing path_remaining
 
-let rec graft_children children stock path =
-    match children with
-    | [] -> stock
-    | x::xs ->
-            let stock = Vytree.insert ~children:(children_of x) stock (path @ [name_of x]) (data_of x)
-            in graft_children xs stock path
-
-let graft_tree stem stock path =
-    graft_children (children_of stem) stock path
-
 let is_empty l = (l = [])
 
 (* define the diff_func; in this instance, we imperatively build the difference trees *)
@@ -231,13 +234,10 @@ let compare path left right =
 (* wrapper to return diff trees *)
 let diff_tree path left right =
     let trees = compare path left right in
-    let add_node = Config_tree.make "add" in
-    let sub_node = Config_tree.make "sub" in
-    let int_node = Config_tree.make "inter" in
+    let add_node = make Config_tree.default_data "add" (children_of !(trees.add)) in
+    let sub_node = make Config_tree.default_data "sub" (children_of !(trees.sub)) in
+    let int_node = make Config_tree.default_data "inter" (children_of !(trees.inter)) in
     let ret = make Config_tree.default_data "" [add_node; sub_node; int_node] in
-    let ret = graft_tree !(trees.add) ret ["add"] in
-    let ret = graft_tree !(trees.sub) ret ["sub"] in
-    let ret = graft_tree !(trees.inter) ret ["inter"] in
     ret
 
 (* wrapper to return trimmed tree for 'delete' commands *)
@@ -352,3 +352,35 @@ let show_diff ?(cmds=false) path left right =
         diff [] (unified_diff ~cmds:cmds udiff trees) [(Option.some left, Option.some right)];
         if cmds then order_commands udiff;
         !udiff
+
+let union_of_values (n : Config_tree.t) (m : Config_tree.t) =
+    let set_n = ValueS.of_list (data_of n).values in
+    let set_m = ValueS.of_list (data_of m).values in
+    ValueS.elements (ValueS.union set_n set_m)
+
+let union_of_children n m =
+    let set_n = ChildrenS.of_list (children_of n) in
+    let set_m = ChildrenS.of_list (children_of m) in
+    ChildrenS.elements (ChildrenS.union set_n set_m)
+
+(* tree_union is currently used only for unit tests, so only values of data
+   are considered. Should there be a reason to expose it in the future,
+   consistency check and union of remaining data will need to be added.
+ *)
+let rec tree_union s t =
+    let child_of_union s t c =
+        let s_c = Vytree.find s (name_of c) in
+        let t_c = Vytree.find t (name_of c) in
+        match s_c, t_c with
+        | Some child, None -> clone s t [(name_of child)]
+        | None, Some _ -> t
+        | Some u, Some v ->
+                if u ^~ v then
+                    let values = union_of_values u v in
+                    let data = {(data_of v) with Config_tree.values = values} in
+                    Vytree.replace t (Vytree.make data (name_of v))
+                else
+                    Vytree.replace t (tree_union u v)
+        | None, None -> raise Nonexistent_child
+    in
+    List.fold_left (fun x c -> child_of_union s x c) t (union_of_children s t)
diff --git a/src/config_diff.mli b/src/config_diff.mli
index 4a9a1d3..0f4ebf0 100644
--- a/src/config_diff.mli
+++ b/src/config_diff.mli
@@ -12,6 +12,7 @@ type diff_trees = {
 
 exception Incommensurable
 exception Empty_comparison
+exception Nonexistent_child
 
 val make_diff_trees : Config_tree.t -> Config_tree.t -> diff_trees
 val clone : ?recurse:bool -> ?set_values:(string list) option -> Config_tree.t -> Config_tree.t -> string list -> Config_tree.t
@@ -21,3 +22,4 @@ val compare : string list -> Config_tree.t -> Config_tree.t -> diff_trees
 val diff_tree : string list -> Config_tree.t -> Config_tree.t -> Config_tree.t
 val trim_tree : Config_tree.t -> Config_tree.t -> Config_tree.t
 val show_diff : ?cmds:bool -> string list -> Config_tree.t -> Config_tree.t -> string
+val tree_union : Config_tree.t -> Config_tree.t -> Config_tree.t
diff --git a/src/config_tree.ml b/src/config_tree.ml
index 8c95b1f..a5698dc 100644
--- a/src/config_tree.ml
+++ b/src/config_tree.ml
@@ -159,11 +159,16 @@ struct
   (* Rendering config as a VyOS/EdgeOS config file *)
   let make_indent indent level = String.make (level * indent) ' '
 
-  let render_values indent_str name values =
+  let render_values ?(ord_val=false) indent_str name values =
     match values with
     | [] -> Printf.sprintf "%s%s { }\n" indent_str name
     | [v] -> Printf.sprintf "%s%s \"%s\"\n" indent_str name (Util.escape_string v)
     | _  -> 
+      let values =
+          if ord_val then
+              List.sort Util.lexical_numeric_compare values
+          else values
+      in
       let rendered = List.map (fun s -> Printf.sprintf "%s%s \"%s\"" indent_str name (Util.escape_string s)) values in
       let rendered = String.concat "\n" rendered in
       Printf.sprintf "%s\n" rendered
@@ -173,34 +178,34 @@ struct
     | None -> ""
     | Some c ->  Printf.sprintf "%s/* %s */\n" indent c
 
-  let rec render_node indent level node =
+  let rec render_node ?(ord_val=false) indent level node =
     let indent_str = make_indent indent level in
     let name = Vytree.name_of_node node in
     let data = Vytree.data_of_node node in
     let is_tag = data.tag in 
     let comment = render_comment indent_str data.comment in
-    let values = render_values indent_str name data.values in
+    let values = render_values ~ord_val:ord_val indent_str name data.values in
     let children = Vytree.children_of_node node in
     match children with
     | [] -> Printf.sprintf "%s%s" comment values
     | _ :: _ ->
       if is_tag then 
         begin
-          let inner = List.map (render_tag_node_child indent level name) children in
+          let inner = List.map (render_tag_node_child ~ord_val:ord_val indent level name) children in
           String.concat "" inner
         end
       else
         begin
-          let inner = List.map (render_node indent (level + 1)) children in
+          let inner = List.map (render_node ~ord_val:ord_val indent (level + 1)) children in
           let inner = String.concat "" inner in
           Printf.sprintf "%s%s%s {\n%s%s}\n" comment indent_str name inner indent_str
         end
-  and render_tag_node_child indent level parent node =
+  and render_tag_node_child ?(ord_val=false) indent level parent node =
     let indent_str = make_indent indent level in
     let name = Vytree.name_of_node node in
     let data = Vytree.data_of_node node in
     let comment = render_comment indent_str data.comment in
-    let values = render_values indent_str name data.values in
+    let values = render_values ~ord_val:ord_val indent_str name data.values in
     let children = Vytree.children_of_node node in
     match children with
     (* This produces too much whitespace due to indent_str from values,
@@ -209,13 +214,13 @@ struct
     | _ ->
         (* Exploiting the fact that immediate children of tag nodes are
            never themselves tag nodes *)
-        let inner = List.map (render_node indent (level + 1)) children in
+        let inner = List.map (render_node ~ord_val:ord_val indent (level + 1)) children in
         let inner = String.concat "" inner in
         Printf.sprintf "%s%s%s %s {\n%s%s}\n" comment indent_str parent name inner indent_str
 
-  let render_config node =
+  let render_config ?(ord_val=false) node =
     let children = Vytree.children_of_node node in
-    let child_configs = List.map (render_node 4 0) children in
+    let child_configs = List.map (render_node ~ord_val:ord_val 4 0) children in
     String.concat "" child_configs
 
 end (* Renderer *)
@@ -268,7 +273,7 @@ let render_commands ?(op=Set) node path =
     let commands = List.map (Renderer.render_commands ~op:op path) children in
     String.concat "\n" commands
 
-let render_config = Renderer.render_config
+let render_config ?(ord_val=false) = Renderer.render_config ~ord_val:ord_val
 
 let render_json = JSONRenderer.render_json
 
diff --git a/src/config_tree.mli b/src/config_tree.mli
index 5375c23..990bb49 100644
--- a/src/config_tree.mli
+++ b/src/config_tree.mli
@@ -38,7 +38,7 @@ val get_subtree : ?with_node:bool -> t -> string list -> t
 
 val render_commands : ?op:command -> t -> string list -> string
 
-val render_config : t -> string
+val render_config : ?ord_val:bool -> t -> string
 
 val render_json : t -> string
 
diff --git a/src/vylist.ml b/src/vylist.ml
index cd4a32e..c64dd89 100644
--- a/src/vylist.ml
+++ b/src/vylist.ml
@@ -28,6 +28,12 @@ let rec insert_after p x xs =
     | y :: ys -> if (p y) then y :: x :: ys
                  else y :: (insert_after p x ys)
 
+let rec insert_compare p x xs =
+    match xs with
+    | [] -> [x]
+    | y :: ys -> if (p x y <= 0) then x :: y :: ys
+                 else y :: (insert_compare p x ys)
+
 let complement xs ys =
     let rec aux xs ys =
         match xs, ys with
diff --git a/src/vylist.mli b/src/vylist.mli
index 9135bf6..b74a537 100644
--- a/src/vylist.mli
+++ b/src/vylist.mli
@@ -3,5 +3,6 @@ val remove : ('a -> bool) -> 'a list -> 'a list
 val replace : ('a -> bool) -> 'a -> 'a list -> 'a list
 val insert_before : ('a -> bool) -> 'a -> 'a list -> 'a list
 val insert_after : ('a -> bool) -> 'a -> 'a list -> 'a	list
+val insert_compare : ('a -> 'a -> int) -> 'a -> 'a list -> 'a list
 val complement : 'a list -> 'a list -> 'a list
 val in_list : 'a list -> 'a -> bool
diff --git a/src/vyos1x_parser.mly b/src/vyos1x_parser.mly
index ba1c5a7..8b2d7d8 100644
--- a/src/vyos1x_parser.mly
+++ b/src/vyos1x_parser.mly
@@ -20,6 +20,7 @@
     (* When merging nodes with values, append values of subsequent nodes to the
        first one *)
     let merge_data l r = {l with values=(List.append l.values r.values)}
+    let order = Util.lexical_numeric_compare
 %}
 
 %token <string> IDENTIFIER
@@ -66,7 +67,8 @@ node:
     {
         let node =
             Vytree.make_full {default_data with comment=comment} name [] in
-        let node = List.fold_left Vytree.adopt node (List.rev children) |> Vytree.merge_children merge_data in
+        let node = List.fold_left Vytree.adopt node (List.rev children) |> Vytree.merge_children merge_data order in
+        let node = Vytree.sort_children order node in
         try
             List.iter find_duplicate_children (Vytree.children_of_node node);
             node
@@ -87,8 +89,10 @@ tag_node:
       let outer_node = Vytree.make_full {default_data with tag=true} name [] in
       let inner_node =
           Vytree.make_full {default_data with comment=comment} tag [] in
-      let inner_node = List.fold_left Vytree.adopt inner_node (List.rev children) |> Vytree.merge_children merge_data in
+      let inner_node = List.fold_left Vytree.adopt inner_node (List.rev children) |> Vytree.merge_children merge_data order in
+      let inner_node = Vytree.sort_children order inner_node in
       let node = Vytree.adopt outer_node inner_node in
+      let node = Vytree.sort_children order node in
       try
           List.iter find_duplicate_children (Vytree.children_of_node inner_node);
           node
@@ -104,7 +108,8 @@ node_content: n = node { n } | n = leaf_node { n } | n = tag_node { n };
  | ns = list(node_content); EOF
  {
     let root = make "" in
-    let root = List.fold_left Vytree.adopt root (List.rev ns) |> Vytree.merge_children merge_data in
+    let root = List.fold_left Vytree.adopt root (List.rev ns) |> Vytree.merge_children merge_data order in
+    let root = Vytree.sort_children order root in
         try
             List.iter find_duplicate_children (Vytree.children_of_node root);
             root
diff --git a/src/vytree.ml b/src/vytree.ml
index cda12f0..bd73776 100644
--- a/src/vytree.ml
+++ b/src/vytree.ml
@@ -4,7 +4,7 @@ type 'a	t = {
     children: 'a t list
 } [@@deriving yojson]
 
-type position = Before of string | After of string | End | Default
+type position = Before of string | After of string | Lexical | End | Default
 
 exception Empty_path
 exception Duplicate_child
@@ -27,6 +27,8 @@ let insert_immediate ?(position=Default) node name data children =
         | End -> node.children @ [new_node]
         | Before s -> Vylist.insert_before (fun x -> x.name = s) new_node node.children
         | After s -> Vylist.insert_after (fun x -> x.name = s) new_node node.children
+        | Lexical ->
+            Vylist.insert_compare (fun x y -> Util.lexical_numeric_compare x.name y.name) new_node node.children
     in { node with children = children' }
 
 let delete_immediate node name =
@@ -86,6 +88,14 @@ let rec insert ?(position=Default) ?(children=[]) node path data =
             let s = Printf.sprintf "Non-existent intermediary node: \'%s\'" name in
             raise (Insert_error s)
 
+let sorted_children_of_node cmp node =
+    let names = list_children node in
+    let names = List.sort cmp names in
+    List.map (find_or_fail node) names
+
+let sort_children cmp node =
+    {node with children = (sorted_children_of_node cmp node)}
+
 (** Given a node N check if it has children with duplicate names,
     and merge subsequent children's children into the first child by
     that name.
@@ -97,9 +107,11 @@ let rec insert ?(position=Default) ?(children=[]) node path data =
     may be normal and even expected, such as "ethernet eth0" and "ethernet eth1"
     in the "curly" format.
  *)
-let merge_children merge_data node =
+let merge_children merge_data cmp node =
     (* Given a node N and a list of nodes NS, find all nodes in NS that
-       have the same name as N and merge their children into N *)
+       have the same name as N and merge their children into N, sorting
+       children by a comparison function cmp (string -> string -> int) on
+       node names *)
     let rec merge_into n ns =
         match ns with
         | [] -> n
@@ -108,6 +120,7 @@ let merge_children merge_data node =
                 let children = List.append n.children n'.children in
                 let data = merge_data n.data n'.data in
                 let n = {n with children=children; data=data} in
+                let n = sort_children cmp n in
                 merge_into n ns'
             else merge_into n ns'
     in
@@ -177,11 +190,6 @@ let children_of_path node path =
     let node' = get node path in
     list_children node'
 
-let sorted_children_of_node cmp node =
-    let names = list_children node in
-    let names = List.sort cmp names in
-    List.map (find_or_fail node) names
-
 let copy node old_path new_path =
     if exists node new_path then raise Duplicate_child else
     let child = get node old_path in
diff --git a/src/vytree.mli b/src/vytree.mli
index 451e130..377c9aa 100644
--- a/src/vytree.mli
+++ b/src/vytree.mli
@@ -5,7 +5,7 @@ exception Duplicate_child
 exception Nonexistent_path
 exception Insert_error of string
 
-type position = Before of string | After of string | End | Default
+type position = Before of string | After of string | Lexical | End | Default
 
 val make : 'a -> string -> 'a t
 val make_full : 'a -> string -> ('a t) list -> 'a t
@@ -19,11 +19,13 @@ val find_or_fail : 'a t -> string -> 'a t
 
 val adopt : 'a t -> 'a t -> 'a t
 
+val replace : 'a t -> 'a t -> 'a t
+
 val insert : ?position:position -> ?children:('a t list) -> 'a t -> string list -> 'a -> 'a t
 
 val insert_multi_level : 'a -> 'a t -> string list -> string list -> 'a -> 'a t
 
-val merge_children : ('a -> 'a -> 'a) -> 'a t -> 'a t
+val merge_children : ('a -> 'a -> 'a) -> (string -> string -> int) -> 'a t -> 'a t
 
 val delete : 'a t -> string list -> 'a t
 
@@ -45,6 +47,8 @@ val children_of_path : 'a t -> string list -> string list
 
 val sorted_children_of_node : (string -> string -> int) -> 'a t -> ('a t) list
 
+val sort_children : (string -> string -> int) -> 'a t -> 'a t
+
 val copy : 'a t -> string list -> string list -> 'a t
 
 val move : 'a t -> string list -> position -> 'a t