From b5d79efaa9f1463c6babab48f43667e39dd1bca4 Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Thu, 9 Apr 2026 15:16:48 -0500 Subject: T8488: add mask_exclusive This is the complement to mask_inclusive, for excluding subpaths of a tree, for example, a subtree first isolated by mask_inclusive. --- src/config_diff.ml | 36 ++++++++++++++++++++++++++++++++---- 1 file changed, 32 insertions(+), 4 deletions(-) (limited to 'src/config_diff.ml') diff --git a/src/config_diff.ml b/src/config_diff.ml index 5d71c34..88756b6 100644 --- a/src/config_diff.ml +++ b/src/config_diff.ml @@ -706,7 +706,7 @@ let diff_show rt path left right = diff_show_result.config_diff (* mask function; mask applied on right *) -let mask_func ?recurse:_ (path : string list) (Diff_tree res) (m : change) = +let mask_func_inclusive ?recurse:_ (path : string list) (Diff_tree res) (m : change) = (* alert exn Vytree.delete: [Vytree.Empty_path] not possible since Unchanged pattern is only empty path [Vytree.Nonexistent_path] not possible as called on existing config paths (res.left) @@ -716,18 +716,43 @@ let mask_func ?recurse:_ (path : string list) (Diff_tree res) (m : change) = match m with | Added -> Diff_tree (res) | Subtracted -> - (match path with + begin + match path with | [_] -> Diff_tree {res with left = (Vytree.delete[@alert "-exn"]) res.left path} | _ -> if not ((Vytree.is_terminal_path[@alert "-exn"]) res.right (list_but_last path)) then Diff_tree {res with left = (Vytree.delete[@alert "-exn"]) res.left path} - else Diff_tree (res)) + else Diff_tree (res) + end | Unchanged -> Diff_tree (res) | Updated _ -> Diff_tree (res) +(* mask function; mask applied on right *) +let mask_func_exclusive ?recurse:_ (path : string list) (Diff_tree res) (m : change) = + (* alert exn Vytree.delete: + [Vytree.Empty_path] not possible in pattern match case + [Vytree.Nonexistent_path] not possible as called on existing config paths (res.left) + alert exn Vytree.is_terminal_path: + [Vytree.Empty_path] not possible in pattern match case + *) + match m with + | Added -> Diff_tree (res) + | Subtracted -> Diff_tree (res) + | Unchanged | Updated _ -> + begin + match path with + | [] -> Diff_tree(res) + | _ -> + if ((Vytree.is_terminal_path[@alert "-exn"]) res.right path) then + let tmp = (Vytree.delete[@alert "-exn"]) res.left path in + let left' = (Config_tree.prune_delete[@alert "-exn"]) tmp path in + Diff_tree {res with left = left'} + else Diff_tree (res) + end + (* call recursive diff with mask_func; mask applied on right *) -let mask_tree left right = +let mask_tree ?(exclusive=false) left right = (* raises: [Empty_comparison] from diff [Incommensurable] @@ -736,6 +761,9 @@ let mask_tree left right = raise Incommensurable else let trees = make_diff_trees left right in + let mask_func = + if exclusive then mask_func_exclusive else mask_func_inclusive + in let d = diff [] mask_func trees (Option.some left, Option.some right) in let res = eval_diff_result d in -- cgit v1.2.3 From f6e50f41de5dde75a27426d3d164a8f69f62d34d Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Fri, 10 Apr 2026 22:02:50 -0500 Subject: T8488: add utility subtree_from_partial Return the subtree of a configtree indicated by a path that may only be partly defined, lacking some or all intervening tag node value. --- src/config_diff.ml | 70 +++++++++++++++++++++++++++++++++++++++++++++++++++++ src/config_diff.mli | 4 +++ 2 files changed, 74 insertions(+) (limited to 'src/config_diff.ml') diff --git a/src/config_diff.ml b/src/config_diff.ml index 88756b6..c00705d 100644 --- a/src/config_diff.ml +++ b/src/config_diff.ml @@ -769,6 +769,76 @@ let mask_tree ?(exclusive=false) left right = let res = eval_diff_result d in res.left +(* Convert from a path that may or may not include intervening tag_values, + returning a subtree of matches *) +exception Malformed_path of string + +let subtree_from_partial reftree ctree result path = + if Util.is_empty path then result + else + let check_reftree p = + match p with + | [] -> false + | _ -> + let rpath = + Reference_tree.refpath_from_partial reftree p + in + match rpath with + | [] -> false + | _ -> true + in + let check_ctree p = + match p with + | [] -> false + | _ -> (Vytree.exists[@alert "-exn"]) ctree p + in + let clone_node tree p = + if (Vytree.exists[@alert "-exn"]) tree p then + tree + else + if not ((Vytree.exists[@alert "-exn"]) ctree p) then + tree + else + clone ~recurse:false ctree tree p + in + let clone_children tree p = + let children = Vytree.list_children ((Vytree.get[@alert "-exn"]) ctree p) in + let paths = List.map (fun n -> p @ [n]) children in + List.fold_left clone_node tree paths + in + let rec aux acc path_done p = + if not (check_reftree (path_done @ p)) then + raise (Malformed_path (Util.string_of_list (path_done @ p))) + else + match path_done, p with + | [], h :: tl -> + if check_reftree [h] then aux (clone_node acc [h]) [h] tl + else + raise (Malformed_path (Util.string_of_list p)) + | _, h :: tl -> + let p' = path_done @ [h] in + if check_ctree p' then aux (clone_node acc p') p' tl + else + if (Config_tree.is_tag[@alert "-exn"]) ctree path_done then + let children = + Vytree.list_children ((Vytree.get[@alert "-exn"]) ctree path_done) + in + let func accum child = + let path = path_done @ [child] @ [h] in + if check_ctree path then + aux (clone_node accum path) path tl + else accum + in + List.fold_left func acc children + else + (* [h] is a tag_value not present in the config tree *) + raise (Malformed_path (Util.string_of_list p')) + | _, [] -> + if (Config_tree.is_tag[@alert "-exn"]) ctree path_done then clone_children acc path_done + else acc + in aux result [] path + + 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 diff --git a/src/config_diff.mli b/src/config_diff.mli index 483e7df..168b748 100644 --- a/src/config_diff.mli +++ b/src/config_diff.mli @@ -70,3 +70,7 @@ val mask_tree : ?exclusive:bool -> Config_tree.t -> Config_tree.t -> Config_tree [@@alert exn "Config_diff.Empty_comparison"] val get_tagged_delete_tree : Config_tree.t -> Config_tree.t + +exception Malformed_path of string +val subtree_from_partial : Reference_tree.t -> Config_tree.t -> Config_tree.t -> string list -> Config_tree.t +[@@alert exn "Config_diff.Malformed_path"] -- cgit v1.2.3