From 7e4d9ff86ca96a990f52e05310a0486cb668cfb8 Mon Sep 17 00:00:00 2001 From: John Estabrook 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. --- 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 275c95be26f86a06cbec3123bc90ffbcd76f78af Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Fri, 25 Feb 2022 11:57:22 -0600 Subject: T4235: change type/variable names for clarity; add is_empty for list --- 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 a16d8f3305bd8e33763bc23bd1a49efd0699d506 Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Fri, 25 Feb 2022 13:51:06 -0600 Subject: T4235: add function 'trim_tree' to produce tree for delete commands --- 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