From f0f8dfc17cc271ee63e946964ea4a2d17cc71a86 Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Tue, 8 Feb 2022 21:05:07 -0600
Subject: configtree: T4235: implementation of config tree diff

(cherry picked from commit ba3b34c901b74aa4aee0764e4f3eb84731519139)
---
 src/config_diff.ml  | 157 ++++++++++++++++++++++++++++++++++++++++++++++++++++
 src/config_diff.mli |  21 +++++++
 2 files changed, 178 insertions(+)
 create mode 100644 src/config_diff.ml
 create mode 100644 src/config_diff.mli

diff --git a/src/config_diff.ml b/src/config_diff.ml
new file mode 100644
index 0000000..75d12dd
--- /dev/null
+++ b/src/config_diff.ml
@@ -0,0 +1,157 @@
+type change = Unchanged | Added | Deleted | Updated of string list
+
+type diff_func = ?with_children:bool -> string list -> change -> unit
+
+type diff_trees = {
+    left: Config_tree.t;
+    right: Config_tree.t;
+    add: Config_tree.t ref;
+    del: Config_tree.t ref;
+    inter: Config_tree.t ref;
+}
+
+exception Incommensurable
+exception Empty_comparison
+
+module ValueS = Set.Make(struct type t = string let compare = compare end)
+
+let make_diff_tree l r = { left = l; right = r;
+                           add = ref (Config_tree.make "root");
+                           del = ref (Config_tree.make "root");
+                           inter = ref (Config_tree.make "root");
+}
+
+let name_of n = Vytree.name_of_node n
+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
+
+let (^~) (node : Config_tree.t) (node' : Config_tree.t) =
+  name_of node = name_of node' &&
+  (data_of node).values <> (data_of node').values
+
+let left_opt_pairs n m =
+    (children_of n) |> List.map (fun x ->
+        let maybe_node =
+            (children_of m) |> List.find_opt (fun y ->
+                name_of y = name_of x) in
+        (Some x, maybe_node))
+
+let right_opt_pairs n m =
+    (children_of m) |> List.map (fun y ->
+        let maybe_node =
+            (children_of n) |> List.find_opt (fun x ->
+                name_of x = name_of y) in
+        (maybe_node, Some y))
+
+let opt_zip n m =
+    left_opt_pairs n m @ right_opt_pairs n m |> List.sort_uniq compare
+
+let get_opt_name left_opt right_opt =
+    match left_opt, right_opt with
+    | Some left_node, None -> name_of left_node
+    | None, Some right_node -> name_of right_node
+    | Some left_node, Some _ -> name_of left_node
+    | None, None -> raise Empty_comparison
+
+let update_path path left_opt right_opt =
+    let name = get_opt_name left_opt right_opt in
+    if name = "root" then path
+    else path @ [name]
+
+(* tree diff algorithm: walk the tree pair, calling a function of type
+   diff_func at bifurcation points; f acts as a form of continuation.
+   The idea of matching on pairs of (node opt) is from
+   https://github.com/LukeBurgessYeo/tree-diff
+*)
+let rec diff (path : string list) (f : diff_func) (l : (Config_tree.t option * Config_tree.t option) list) =
+    match l with
+    | [] -> ()
+    | (left_node_opt, right_node_opt) :: ls ->
+        (let path = update_path path left_node_opt right_node_opt in
+        match left_node_opt, right_node_opt with
+        | Some _, None -> f path Deleted
+        | None, Some _ -> f path Added
+        | Some left_node, Some right_node when left_node = right_node ->
+                f path Unchanged
+        | Some left_node, Some right_node when left_node ^~ right_node ->
+                let values = (data_of right_node).values in
+                f path (Updated values)
+        | Some left_node, Some right_node ->
+                (f ~with_children:false path Unchanged;
+                diff path f (opt_zip left_node right_node))
+        | None, None -> raise Empty_comparison)
+        ; diff path f ls
+
+(* copy node paths between trees *)
+let rec clone_path ?(with_children=true) ?(set_values=[]) old_root new_root path_done path_remaining =
+    match path_remaining with
+    | [] | [_] ->
+        let path_total = path_done @ path_remaining in
+        let old_node = Vytree.get old_root path_total in
+        let data = if not (set_values = []) then
+            { (data_of old_node) with Config_tree.values = set_values } else (data_of old_node) in
+        if with_children then
+            Vytree.insert ~children:(children_of old_node) new_root path_total data
+        else
+            Vytree.insert 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
+        clone_path ~with_children:with_children ~set_values:set_values old_root new_root path_done names
+
+let clone ?(with_children=true) ?(set_values=[]) old_root new_root path =
+    match path with
+    | [] -> if with_children then old_root else new_root
+    | _ ->
+            let path_existing = Vytree.get_existent_path new_root path in
+            let path_remaining = Vylist.complement path path_existing in
+            clone_path ~with_children:with_children ~set_values:set_values old_root new_root path_existing path_remaining
+
+(* define the diff_func; in this instance, we imperatively build the difference trees *)
+let decorate_trees (trees : diff_trees) ?(with_children=true) (path : string list) (m : change) =
+    match m with
+    | Added -> trees.add := clone trees.right !(trees.add) path
+    | Deleted -> trees.del := clone ~with_children:false trees.left !(trees.del) path
+    | Unchanged -> trees.inter := clone ~with_children:with_children trees.left !(trees.inter) path
+    | Updated v ->
+            (* if in this case, node at path is guaranteed to exist *)
+            let ov = Config_tree.get_values trees.left path in
+            match ov, v with
+            | [_], [_] -> trees.del := clone trees.left !(trees.del) path;
+                          trees.add := clone trees.right !(trees.add) path
+            | _, _ -> let ovs = ValueS.of_list ov in
+                      let vs = ValueS.of_list v in
+                      let set_ov = ValueS.elements (ValueS.diff ovs vs) in
+                      let set_v = ValueS.elements (ValueS.diff vs ovs) in
+                      let set_inter = ValueS.elements (ValueS.inter ovs vs) in
+                      if not (set_ov = []) then
+                          trees.del := clone ~set_values:set_ov trees.left !(trees.del) path;
+                      if not (set_v = []) then
+                          trees.add := clone ~set_values:set_v trees.right !(trees.add) path;
+                      if not (set_inter = []) then
+                          trees.inter := clone ~set_values:set_inter trees.left !(trees.inter) path
+
+(* get sub trees for path-relative comparison *)
+let tree_at_path path node =
+    try
+        let node = Vytree.get node path in
+        make Config_tree.default_data "root" [node]
+    with Vytree.Nonexistent_path -> raise Empty_comparison
+
+(* call recursive diff on config_trees with decorate_trees as the diff_func *)
+let compare path left right =
+    if (name_of left) <> (name_of right) then
+        raise Incommensurable
+    else
+        let (left, right) = if not (path = []) then
+            (tree_at_path path left, tree_at_path path right) else (left, right) in
+        let trees = make_diff_tree left right in
+        diff [] (decorate_trees trees) [(Option.some left, Option.some right)];
+        trees
+
+(* wrapper to return diff trees *)
+let diffs path left right =
+    let trees = compare path left right in
+    (!(trees.add), !(trees.del), !(trees.inter))
diff --git a/src/config_diff.mli b/src/config_diff.mli
new file mode 100644
index 0000000..623c6ef
--- /dev/null
+++ b/src/config_diff.mli
@@ -0,0 +1,21 @@
+type change = Unchanged | Added | Deleted | Updated of string list
+
+type diff_func = ?with_children:bool -> string list -> change -> unit
+
+type diff_trees = {
+    left: Config_tree.t;
+    right: Config_tree.t;
+    add: Config_tree.t ref;
+    del: Config_tree.t ref;
+    inter: Config_tree.t ref;
+}
+
+exception Incommensurable
+exception Empty_comparison
+
+val make_diff_tree : Config_tree.t -> Config_tree.t -> diff_trees
+val clone : ?with_children:bool -> ?set_values:string list -> Config_tree.t -> Config_tree.t -> string list -> Config_tree.t
+val decorate_trees : diff_trees -> ?with_children:bool -> string list -> change -> unit
+val compare : string list -> Config_tree.t -> Config_tree.t -> diff_trees
+val diffs : string list -> Config_tree.t -> Config_tree.t -> Config_tree.t * Config_tree.t * Config_tree.t
+
-- 
cgit v1.2.3


From dd6d808bcbd96a80c63e43fe57a93776ba1ba86e Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Tue, 8 Feb 2022 21:06:58 -0600
Subject: configtree: T4235: render delete commands

(cherry picked from commit cfc2e186822de7f15c15ae5e15f5872714c7dcd7)
---
 src/config_tree.ml  | 30 ++++++++++++++++++++----------
 src/config_tree.mli |  3 ++-
 2 files changed, 22 insertions(+), 11 deletions(-)

diff --git a/src/config_tree.ml b/src/config_tree.ml
index c85b358..6ae7ad2 100644
--- a/src/config_tree.ml
+++ b/src/config_tree.ml
@@ -1,4 +1,5 @@
 type value_behaviour = AddValue | ReplaceValue
+type command = Set | Delete
 
 exception Duplicate_value
 exception Node_has_no_value
@@ -21,6 +22,11 @@ let default_data = {
 
 let make name = Vytree.make default_data name
 
+let op_to_string op =
+    match op with
+    | Set -> "set"
+    | Delete -> "delete"
+
 let replace_value node path value =
   let data = {default_data with values=[value]} in
   Vytree.update node path data
@@ -98,16 +104,20 @@ let is_tag node path =
 module Renderer =
 struct
     (* Rendering configs as set commands *)
-    let render_set_path path value =
+    let render_set_path ?(op=Set) path value =
         let v = Printf.sprintf "\'%s\'" value in
-        List.append path [v] |> String.concat " " |> Printf.sprintf "set %s"
+        List.append path [v] |> String.concat " " |> Printf.sprintf "%s %s" (op_to_string op)
 
-    let rec render_commands path ct =
+    let rec render_commands ?(op=Set) path ct =
         let new_path = List.append path [Vytree.name_of_node ct] in
         let new_path_str = String.concat " " new_path in
         let data = Vytree.data_of_node ct in
         (* Get the node comment, if any *)
-        let comment = Util.default "" data.comment in 
+        let comment =
+            match op with
+            | Set -> Util.default "" data.comment
+            | Delete -> ""
+        in
         let comment_cmd = (if comment = "" then "" else Printf.sprintf "comment %s \'%s\'" new_path_str comment) in
         let child_names = Vytree.list_children ct in
         (* Now handle the different cases for nodes with and without children *)
@@ -120,20 +130,20 @@ struct
                  match values with
                  | [] ->
                       (* Valueless leaf node *)
-                      String.concat " " new_path |> Printf.sprintf "set %s"
+                      String.concat " " new_path |> Printf.sprintf "%s %s" (op_to_string op)
                  | [v] ->
                       (* Single value, just one command *)
-                      render_set_path new_path v
+                      render_set_path ~op:op new_path v
                  | vs ->
                       (* A leaf node with multiple values *)
-                      List.map (render_set_path new_path) vs |> String.concat "\n"
+                      List.map (render_set_path ~op:op new_path) vs |> String.concat "\n"
                   end
               in
               if comment_cmd = "" then cmds else Printf.sprintf "%s\n%s" cmds comment_cmd
         | _ :: _ ->
             (* A node with children *)
             let children = List.map (fun n -> Vytree.get ct [n]) child_names in
-            let rendered_children = List.map (render_commands new_path) children in
+            let rendered_children = List.map (render_commands ~op:op new_path) children in
             let cmds = String.concat "\n" rendered_children in
             if comment_cmd = "" then cmds else Printf.sprintf "%s\n%s" cmds comment_cmd
 
@@ -239,14 +249,14 @@ module JSONRenderer = struct
         Printf.sprintf "{%s}" child_configs
 end (* JSONRenderer *)
 
-let render_commands node path =
+let render_commands ?(op=Set) node path =
     let node =
 	match path with
         | [] -> node
         | _ -> Vytree.get node path
     in
     let children = Vytree.children_of_node node in
-    let commands = List.map (Renderer.render_commands path) children in
+    let commands = List.map (Renderer.render_commands ~op:op path) children in
     String.concat "\n" commands
 
 let render_config = Renderer.render_config
diff --git a/src/config_tree.mli b/src/config_tree.mli
index 730b32f..cf94af7 100644
--- a/src/config_tree.mli
+++ b/src/config_tree.mli
@@ -1,4 +1,5 @@
 type value_behaviour = AddValue | ReplaceValue
+type command = Set | Delete
 
 exception Duplicate_value
 exception Node_has_no_value
@@ -33,7 +34,7 @@ val set_tag : t -> string list -> bool -> t
 
 val is_tag : t -> string list -> bool
 
-val render_commands : t -> string list -> string
+val render_commands : ?op:command -> t -> string list -> string
 
 val render_config : t -> string
 
-- 
cgit v1.2.3


From 572f5ca5e4d265e4f1e70bbad83972004aa000d7 Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Wed, 23 Feb 2022 14:04:42 -0600
Subject: T4235: function diff_tree now returns single tree containing diffs

(cherry picked from commit 4d5e3522c14aa22538942e2601be5b6963236452)
---
 src/config_diff.ml  | 25 +++++++++++++++++++++----
 src/config_diff.mli |  4 ++--
 2 files changed, 23 insertions(+), 6 deletions(-)

diff --git a/src/config_diff.ml b/src/config_diff.ml
index 75d12dd..565d64f 100644
--- a/src/config_diff.ml
+++ b/src/config_diff.ml
@@ -15,7 +15,7 @@ exception Empty_comparison
 
 module ValueS = Set.Make(struct type t = string let compare = compare end)
 
-let make_diff_tree l r = { left = l; right = r;
+let make_diff_trees l r = { left = l; right = r;
                            add = ref (Config_tree.make "root");
                            del = ref (Config_tree.make "root");
                            inter = ref (Config_tree.make "root");
@@ -109,6 +109,16 @@ let clone ?(with_children=true) ?(set_values=[]) old_root new_root path =
             let path_remaining = Vylist.complement path path_existing in
             clone_path ~with_children:with_children ~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
+
 (* define the diff_func; in this instance, we imperatively build the difference trees *)
 let decorate_trees (trees : diff_trees) ?(with_children=true) (path : string list) (m : change) =
     match m with
@@ -147,11 +157,18 @@ let compare path left right =
     else
         let (left, right) = if not (path = []) then
             (tree_at_path path left, tree_at_path path right) else (left, right) in
-        let trees = make_diff_tree left right in
+        let trees = make_diff_trees left right in
         diff [] (decorate_trees trees) [(Option.some left, Option.some right)];
         trees
 
 (* wrapper to return diff trees *)
-let diffs path left right =
+let diff_tree path left right =
     let trees = compare path left right in
-    (!(trees.add), !(trees.del), !(trees.inter))
+    let add_node = Config_tree.make "add" in
+    let del_node = Config_tree.make "delete" in
+    let int_node = Config_tree.make "inter" in
+    let ret = make Config_tree.default_data "root" [add_node; del_node; int_node] in
+    let ret = graft_tree !(trees.add) ret ["add"] in
+    let ret = graft_tree !(trees.del) ret ["delete"] in
+    let ret = graft_tree !(trees.inter) ret ["inter"] in
+    ret
diff --git a/src/config_diff.mli b/src/config_diff.mli
index 623c6ef..5f96209 100644
--- a/src/config_diff.mli
+++ b/src/config_diff.mli
@@ -13,9 +13,9 @@ type diff_trees = {
 exception Incommensurable
 exception Empty_comparison
 
-val make_diff_tree : Config_tree.t -> Config_tree.t -> diff_trees
+val make_diff_trees : Config_tree.t -> Config_tree.t -> diff_trees
 val clone : ?with_children:bool -> ?set_values:string list -> Config_tree.t -> Config_tree.t -> string list -> Config_tree.t
 val decorate_trees : diff_trees -> ?with_children:bool -> string list -> change -> unit
 val compare : string list -> Config_tree.t -> Config_tree.t -> diff_trees
-val diffs : string list -> Config_tree.t -> Config_tree.t -> Config_tree.t * Config_tree.t * Config_tree.t
+val diff_tree : string list -> Config_tree.t -> Config_tree.t -> Config_tree.t
 
-- 
cgit v1.2.3


From 2d37aa4240447b0ee052fec637fd9a7cd5ec915b Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Wed, 23 Feb 2022 14:32:02 -0600
Subject: T4235: add utility function get_subtree

(cherry picked from commit 23173c6b5d12e5b7990fafe2b43d40f5cbf1a2a5)
---
 src/config_tree.ml  | 9 +++++++++
 src/config_tree.mli | 2 ++
 2 files changed, 11 insertions(+)

diff --git a/src/config_tree.ml b/src/config_tree.ml
index 6ae7ad2..3e97e80 100644
--- a/src/config_tree.ml
+++ b/src/config_tree.ml
@@ -101,6 +101,15 @@ let is_tag node path =
     let data = Vytree.get_data node path in
     data.tag
 
+let get_subtree ?(with_node=false) node path =
+    try
+        let n = Vytree.get node path in
+        if with_node then
+            Vytree.make_full default_data "root" [n]
+        else
+            Vytree.make_full default_data "root" (Vytree.children_of_node n)
+    with Vytree.Nonexistent_path -> make "root"
+
 module Renderer =
 struct
     (* Rendering configs as set commands *)
diff --git a/src/config_tree.mli b/src/config_tree.mli
index cf94af7..5375c23 100644
--- a/src/config_tree.mli
+++ b/src/config_tree.mli
@@ -34,6 +34,8 @@ val set_tag : t -> string list -> bool -> t
 
 val is_tag : t -> string list -> bool
 
+val get_subtree : ?with_node:bool -> t -> string list -> t
+
 val render_commands : ?op:command -> t -> string list -> string
 
 val render_config : t -> string
-- 
cgit v1.2.3


From eb70fde4fbd8d6f5418ca87e9207eb394cf5741b Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Fri, 25 Feb 2022 10:43:13 -0600
Subject: T4235: keep full paths in subtract tree

In the intial implementation, the delete tree only kept the first node
of a path not present in the RHS of the comparison; this was done as a
convenience for generating 'trimmed' delete commands for the CLI.
However, this loses needed information, and breaks the symmetry of
results:
        LHS, RHS -> del, inter, add
        RHS, LHS -> add, inter, del
Keep full paths in delete tree and rename trees.del to trees.sub(-tract).

A separate function 'trim_tree' will be provided to produce a
CLI-appopriate delete tree and commands.

(cherry picked from commit 7e4d9ff86ca96a990f52e05310a0486cb668cfb8)
---
 src/config_diff.ml  | 16 ++++++++--------
 src/config_diff.mli |  2 +-
 2 files changed, 9 insertions(+), 9 deletions(-)

diff --git a/src/config_diff.ml b/src/config_diff.ml
index 565d64f..6d7c328 100644
--- a/src/config_diff.ml
+++ b/src/config_diff.ml
@@ -6,7 +6,7 @@ type diff_trees = {
     left: Config_tree.t;
     right: Config_tree.t;
     add: Config_tree.t ref;
-    del: Config_tree.t ref;
+    sub: Config_tree.t ref;
     inter: Config_tree.t ref;
 }
 
@@ -17,7 +17,7 @@ module ValueS = Set.Make(struct type t = string let compare = compare end)
 
 let make_diff_trees l r = { left = l; right = r;
                            add = ref (Config_tree.make "root");
-                           del = ref (Config_tree.make "root");
+                           sub = ref (Config_tree.make "root");
                            inter = ref (Config_tree.make "root");
 }
 
@@ -123,13 +123,13 @@ let graft_tree stem stock path =
 let decorate_trees (trees : diff_trees) ?(with_children=true) (path : string list) (m : change) =
     match m with
     | Added -> trees.add := clone trees.right !(trees.add) path
-    | Deleted -> trees.del := clone ~with_children:false trees.left !(trees.del) path
+    | Deleted -> trees.sub := clone trees.left !(trees.sub) path
     | Unchanged -> trees.inter := clone ~with_children:with_children trees.left !(trees.inter) path
     | Updated v ->
             (* if in this case, node at path is guaranteed to exist *)
             let ov = Config_tree.get_values trees.left path in
             match ov, v with
-            | [_], [_] -> trees.del := clone trees.left !(trees.del) path;
+            | [_], [_] -> trees.sub := clone trees.left !(trees.sub) path;
                           trees.add := clone trees.right !(trees.add) path
             | _, _ -> let ovs = ValueS.of_list ov in
                       let vs = ValueS.of_list v in
@@ -137,7 +137,7 @@ let decorate_trees (trees : diff_trees) ?(with_children=true) (path : string lis
                       let set_v = ValueS.elements (ValueS.diff vs ovs) in
                       let set_inter = ValueS.elements (ValueS.inter ovs vs) in
                       if not (set_ov = []) then
-                          trees.del := clone ~set_values:set_ov trees.left !(trees.del) path;
+                          trees.sub := clone ~set_values:set_ov trees.left !(trees.sub) path;
                       if not (set_v = []) then
                           trees.add := clone ~set_values:set_v trees.right !(trees.add) path;
                       if not (set_inter = []) then
@@ -165,10 +165,10 @@ let compare path left right =
 let diff_tree path left right =
     let trees = compare path left right in
     let add_node = Config_tree.make "add" in
-    let del_node = Config_tree.make "delete" in
+    let sub_node = Config_tree.make "sub" in
     let int_node = Config_tree.make "inter" in
-    let ret = make Config_tree.default_data "root" [add_node; del_node; int_node] in
+    let ret = make Config_tree.default_data "root" [add_node; sub_node; int_node] in
     let ret = graft_tree !(trees.add) ret ["add"] in
-    let ret = graft_tree !(trees.del) ret ["delete"] in
+    let ret = graft_tree !(trees.sub) ret ["sub"] in
     let ret = graft_tree !(trees.inter) ret ["inter"] in
     ret
diff --git a/src/config_diff.mli b/src/config_diff.mli
index 5f96209..5aa6d30 100644
--- a/src/config_diff.mli
+++ b/src/config_diff.mli
@@ -6,7 +6,7 @@ type diff_trees = {
     left: Config_tree.t;
     right: Config_tree.t;
     add: Config_tree.t ref;
-    del: Config_tree.t ref;
+    sub: Config_tree.t ref;
     inter: Config_tree.t ref;
 }
 
-- 
cgit v1.2.3


From 4417f99a8818ff18a63daf2d682d58624ac6ce64 Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Fri, 25 Feb 2022 11:57:22 -0600
Subject: T4235: change type/variable names for clarity; add is_empty for list

(cherry picked from commit 275c95be26f86a06cbec3123bc90ffbcd76f78af)
---
 src/config_diff.ml  | 50 ++++++++++++++++++++++++++------------------------
 src/config_diff.mli |  8 ++++----
 2 files changed, 30 insertions(+), 28 deletions(-)

diff --git a/src/config_diff.ml b/src/config_diff.ml
index 6d7c328..18f3fa5 100644
--- a/src/config_diff.ml
+++ b/src/config_diff.ml
@@ -1,6 +1,6 @@
-type change = Unchanged | Added | Deleted | Updated of string list
+type change = Unchanged | Added | Subtracted | Updated of string list
 
-type diff_func = ?with_children:bool -> string list -> change -> unit
+type diff_func = ?recurse:bool -> string list -> change -> unit
 
 type diff_trees = {
     left: Config_tree.t;
@@ -70,7 +70,7 @@ let rec diff (path : string list) (f : diff_func) (l : (Config_tree.t option * C
     | (left_node_opt, right_node_opt) :: ls ->
         (let path = update_path path left_node_opt right_node_opt in
         match left_node_opt, right_node_opt with
-        | Some _, None -> f path Deleted
+        | Some _, None -> f path Subtracted
         | None, Some _ -> f path Added
         | Some left_node, Some right_node when left_node = right_node ->
                 f path Unchanged
@@ -78,20 +78,20 @@ let rec diff (path : string list) (f : diff_func) (l : (Config_tree.t option * C
                 let values = (data_of right_node).values in
                 f path (Updated values)
         | Some left_node, Some right_node ->
-                (f ~with_children:false path Unchanged;
+                (f ~recurse:false path Unchanged;
                 diff path f (opt_zip left_node right_node))
         | None, None -> raise Empty_comparison)
         ; diff path f ls
 
 (* copy node paths between trees *)
-let rec clone_path ?(with_children=true) ?(set_values=[]) old_root new_root path_done path_remaining =
+let rec clone_path ?(recurse=true) ?(set_values=[]) old_root new_root path_done path_remaining =
     match path_remaining with
     | [] | [_] ->
         let path_total = path_done @ path_remaining in
         let old_node = Vytree.get old_root path_total in
         let data = if not (set_values = []) then
             { (data_of old_node) with Config_tree.values = set_values } else (data_of old_node) in
-        if with_children then
+        if recurse then
             Vytree.insert ~children:(children_of old_node) new_root path_total data
         else
             Vytree.insert new_root path_total data
@@ -99,15 +99,15 @@ let rec clone_path ?(with_children=true) ?(set_values=[]) old_root new_root path
         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
-        clone_path ~with_children:with_children ~set_values:set_values old_root new_root path_done names
+        clone_path ~recurse:recurse ~set_values:set_values old_root new_root path_done names
 
-let clone ?(with_children=true) ?(set_values=[]) old_root new_root path =
+let clone ?(recurse=true) ?(set_values=[]) old_root new_root path =
     match path with
-    | [] -> if with_children then old_root else new_root
+    | [] -> if recurse then old_root else new_root
     | _ ->
             let path_existing = Vytree.get_existent_path new_root path in
             let path_remaining = Vylist.complement path path_existing in
-            clone_path ~with_children:with_children ~set_values:set_values old_root new_root path_existing path_remaining
+            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
@@ -119,29 +119,31 @@ let rec graft_children children 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 *)
-let decorate_trees (trees : diff_trees) ?(with_children=true) (path : string list) (m : change) =
+let decorate_trees (trees : diff_trees) ?(recurse=true) (path : string list) (m : change) =
     match m with
     | Added -> trees.add := clone trees.right !(trees.add) path
-    | Deleted -> trees.sub := clone trees.left !(trees.sub) path
-    | Unchanged -> trees.inter := clone ~with_children:with_children trees.left !(trees.inter) path
+    | Subtracted -> trees.sub := clone trees.left !(trees.sub) path
+    | Unchanged -> trees.inter := clone ~recurse:recurse trees.left !(trees.inter) path
     | Updated v ->
             (* if in this case, node at path is guaranteed to exist *)
             let ov = Config_tree.get_values trees.left path in
             match ov, v with
             | [_], [_] -> trees.sub := clone trees.left !(trees.sub) path;
                           trees.add := clone trees.right !(trees.add) path
-            | _, _ -> let ovs = ValueS.of_list ov in
-                      let vs = ValueS.of_list v in
-                      let set_ov = ValueS.elements (ValueS.diff ovs vs) in
-                      let set_v = ValueS.elements (ValueS.diff vs ovs) in
-                      let set_inter = ValueS.elements (ValueS.inter ovs vs) in
-                      if not (set_ov = []) then
-                          trees.sub := clone ~set_values:set_ov trees.left !(trees.sub) path;
-                      if not (set_v = []) then
-                          trees.add := clone ~set_values:set_v trees.right !(trees.add) path;
-                      if not (set_inter = []) then
-                          trees.inter := clone ~set_values:set_inter trees.left !(trees.inter) path
+            | _, _ -> let ov_set = ValueS.of_list ov in
+                      let v_set = ValueS.of_list v in
+                      let sub_vals = ValueS.elements (ValueS.diff ov_set v_set) in
+                      let add_vals = ValueS.elements (ValueS.diff v_set ov_set) in
+                      let inter_vals = ValueS.elements (ValueS.inter ov_set v_set) in
+                      if not (is_empty sub_vals) then
+                          trees.sub := clone ~set_values:sub_vals trees.left !(trees.sub) path;
+                      if not (is_empty add_vals) then
+                          trees.add := clone ~set_values:add_vals trees.right !(trees.add) path;
+                      if not (is_empty inter_vals) then
+                          trees.inter := clone ~set_values:inter_vals trees.left !(trees.inter) path
 
 (* get sub trees for path-relative comparison *)
 let tree_at_path path node =
diff --git a/src/config_diff.mli b/src/config_diff.mli
index 5aa6d30..d68976b 100644
--- a/src/config_diff.mli
+++ b/src/config_diff.mli
@@ -1,6 +1,6 @@
-type change = Unchanged | Added | Deleted | Updated of string list
+type change = Unchanged | Added | Subtracted | Updated of string list
 
-type diff_func = ?with_children:bool -> string list -> change -> unit
+type diff_func = ?recurse:bool -> string list -> change -> unit
 
 type diff_trees = {
     left: Config_tree.t;
@@ -14,8 +14,8 @@ exception Incommensurable
 exception Empty_comparison
 
 val make_diff_trees : Config_tree.t -> Config_tree.t -> diff_trees
-val clone : ?with_children:bool -> ?set_values:string list -> Config_tree.t -> Config_tree.t -> string list -> Config_tree.t
-val decorate_trees : diff_trees -> ?with_children:bool -> string list -> change -> unit
+val clone : ?recurse:bool -> ?set_values:string list -> Config_tree.t -> Config_tree.t -> string list -> Config_tree.t
+val decorate_trees : diff_trees -> ?recurse:bool -> string list -> change -> unit
 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
 
-- 
cgit v1.2.3


From 7b83a796b3fd661d3ba05f34f89f70ce571244a1 Mon Sep 17 00:00:00 2001
From: John Estabrook <jestabro@vyos.io>
Date: Fri, 25 Feb 2022 13:51:06 -0600
Subject: T4235: add function 'trim_tree' to produce tree for delete commands

(cherry picked from commit a16d8f3305bd8e33763bc23bd1a49efd0699d506)
---
 src/config_diff.ml  | 45 ++++++++++++++++++++++++++++++++++++++-------
 src/config_diff.mli |  4 +++-
 2 files changed, 41 insertions(+), 8 deletions(-)

diff --git a/src/config_diff.ml b/src/config_diff.ml
index 18f3fa5..604668b 100644
--- a/src/config_diff.ml
+++ b/src/config_diff.ml
@@ -84,13 +84,16 @@ let rec diff (path : string list) (f : diff_func) (l : (Config_tree.t option * C
         ; diff path f ls
 
 (* copy node paths between trees *)
-let rec clone_path ?(recurse=true) ?(set_values=[]) old_root new_root path_done path_remaining =
+let rec clone_path ?(recurse=true) ?(set_values=None) old_root new_root path_done path_remaining =
     match path_remaining with
     | [] | [_] ->
         let path_total = path_done @ path_remaining in
         let old_node = Vytree.get old_root path_total in
-        let data = if not (set_values = []) then
-            { (data_of old_node) with Config_tree.values = set_values } else (data_of old_node) in
+        let data =
+            match set_values with
+            | Some v -> { (data_of old_node) with Config_tree.values = v }
+            | None -> data_of old_node
+        in
         if recurse then
             Vytree.insert ~children:(children_of old_node) new_root path_total data
         else
@@ -101,7 +104,7 @@ let rec clone_path ?(recurse=true) ?(set_values=[]) old_root new_root path_done
         let new_root = Vytree.insert 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=[]) old_root new_root path =
+let clone ?(recurse=true) ?(set_values=None) old_root new_root path =
     match path with
     | [] -> if recurse then old_root else new_root
     | _ ->
@@ -139,11 +142,34 @@ let decorate_trees (trees : diff_trees) ?(recurse=true) (path : string list) (m
                       let add_vals = ValueS.elements (ValueS.diff v_set ov_set) in
                       let inter_vals = ValueS.elements (ValueS.inter ov_set v_set) in
                       if not (is_empty sub_vals) then
-                          trees.sub := clone ~set_values:sub_vals trees.left !(trees.sub) path;
+                          trees.sub := clone ~set_values:(Some sub_vals) trees.left !(trees.sub) path;
                       if not (is_empty add_vals) then
-                          trees.add := clone ~set_values:add_vals trees.right !(trees.add) path;
+                          trees.add := clone ~set_values:(Some add_vals) trees.right !(trees.add) path;
                       if not (is_empty inter_vals) then
-                          trees.inter := clone ~set_values:inter_vals trees.left !(trees.inter) path
+                          trees.inter := clone ~set_values:(Some inter_vals) trees.left !(trees.inter) path
+
+let trim_trees (trees : diff_trees) ?(recurse=false) (path : string list) (m : change) =
+    match m with
+    | Added -> ()
+    | Subtracted -> trees.sub := clone ~recurse:recurse ~set_values:(Some []) trees.left !(trees.sub) path
+    | Unchanged -> ()
+    | Updated v ->
+            (* if in this case, node at path is guaranteed to exist *)
+            let ov = Config_tree.get_values trees.left path in
+            match ov, v with
+            | [_], [_] -> trees.sub := clone trees.left !(trees.sub) path;
+            | _, _ -> let ov_set = ValueS.of_list ov in
+                      let v_set = ValueS.of_list v in
+                      let sub_vals = ValueS.elements (ValueS.diff ov_set v_set) in
+                      let add_vals = ValueS.elements (ValueS.diff v_set ov_set) in
+                      (* in practice, the above sets will be disjoint *)
+                      let inter_vals = ValueS.elements (ValueS.inter ov_set v_set) in
+                      if not (is_empty sub_vals) then
+                          if (is_empty add_vals) && (is_empty inter_vals) then
+                              (* delete whole node, not just values *)
+                              trees.sub := clone ~set_values:(Some []) trees.left !(trees.sub) path
+                          else
+                              trees.sub := clone ~set_values:(Some sub_vals) trees.left !(trees.sub) path
 
 (* get sub trees for path-relative comparison *)
 let tree_at_path path node =
@@ -174,3 +200,8 @@ let diff_tree path left right =
     let ret = graft_tree !(trees.sub) ret ["sub"] in
     let ret = graft_tree !(trees.inter) ret ["inter"] in
     ret
+
+let trim_tree left right =
+    let trees = make_diff_trees left right in
+    diff [] (trim_trees trees) [(Option.some left, Option.some right)];
+    !(trees.sub)
diff --git a/src/config_diff.mli b/src/config_diff.mli
index d68976b..70fb2e0 100644
--- a/src/config_diff.mli
+++ b/src/config_diff.mli
@@ -14,8 +14,10 @@ exception Incommensurable
 exception Empty_comparison
 
 val make_diff_trees : Config_tree.t -> Config_tree.t -> diff_trees
-val clone : ?recurse:bool -> ?set_values:string list -> Config_tree.t -> Config_tree.t -> string list -> Config_tree.t
+val clone : ?recurse:bool -> ?set_values:(string list) option -> Config_tree.t -> Config_tree.t -> string list -> Config_tree.t
 val decorate_trees : diff_trees -> ?recurse:bool -> string list -> change -> unit
+val trim_trees : diff_trees -> ?recurse:bool -> string list -> change -> unit
 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
 
-- 
cgit v1.2.3