From 411c132a6158e62064b23ef4bbcc0c939cdcdaba Mon Sep 17 00:00:00 2001 From: John Estabrook Date: Mon, 10 Nov 2025 13:34:51 -0600 Subject: T7988: add diff function for show config --- src/config_diff.ml | 243 ++++++++++++++++++++++++++++++++++++++++++++++++++++ src/config_diff.mli | 14 +++ 2 files changed, 257 insertions(+) (limited to 'src') diff --git a/src/config_diff.ml b/src/config_diff.ml index c97fd40..b69440d 100644 --- a/src/config_diff.ml +++ b/src/config_diff.ml @@ -23,13 +23,24 @@ module Diff_compare = struct } end +module Diff_show = struct + type t = { left: Config_tree.t; + right: Config_tree.t; + base_path: string list; + open_blocks: string list list; + config_diff: string; + } +end + type _ diff_result = | Diff_tree : Diff_tree.t -> Diff_tree.t diff_result | Diff_compare : Diff_compare.t -> Diff_compare.t diff_result + | Diff_show : Diff_show.t -> Diff_show.t diff_result let eval_diff_result : type a. a diff_result -> a = function | Diff_tree x -> x | Diff_compare x -> x + | Diff_show x -> x type 'a diff_func = ?recurse:bool -> string list -> 'a diff_result -> change -> 'a diff_result @@ -46,6 +57,12 @@ let make_diff_compare l r = Diff_compare { left = l; right = r; udiff = ""; } +let make_diff_show l r path = Diff_show { left = l; right = r; + base_path = path; + open_blocks = []; + config_diff = ""; + } + 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 @@ -319,6 +336,7 @@ let get_tagged_delete_tree dt = (* the following builds a diff_func to return a unified diff string of configs or config commands for use in the config-mode 'compare' command *) + let list_but_last l = let len = List.length l in List.filteri (fun i _ -> i < len - 1) l @@ -466,6 +484,231 @@ let diff_compare ?(cmds=false) path left right = in strs +(* the following builds a diff_func for 'show config' *) + +let annotate_rendered change rendered = + let mark = + match change with + | Unchanged -> " " + | Added -> "+" + | Subtracted -> "-" + | Updated _ -> ">" + in + let lst = String.split_on_char '\n' rendered in + let marked = List.map (fun x -> match x with "" -> x | _ -> mark ^ x) lst in + String.concat "\n" marked + +let get_level_at_path node path = + (* alert exn Config_tree.is_tag_value: + [Vytree.Empty_path] called in pattern path non-empty + [Vytree.Nonexistent_path] function diff never calls diff_func on nonexistent path + *) + let f level p = + if (Config_tree.is_tag_value[@alert "-exn"]) node p then level + else level + 1 + in + match path with + | [] -> 0 + | _ -> + List.fold_left f 0 (Util.flag path) - 1 + +let render_level_open indent node path = + (* alert exn Config_tree.is_tag, Config_tree.is_tag_value: + [Vytree.Empty_path] called in branch path non-empty + [Vytree.Nonexistent_path] function diff never calls diff_func on nonexistent path + *) + if Util.is_empty path || (Config_tree.is_tag[@alert "-exn"]) node path then + "" + else + let level = get_level_at_path node path in + let indent_str = Config_tree.make_indent indent level in + if (Config_tree.is_tag_value[@alert "-exn"]) node path then + let tag_node = + match Util.get_last_n path 1 with + | None -> (* not possible as path non-empty *) "none" + | Some n -> n + in + let tag_value = + match Util.get_last path with + | None -> (* not possible as path non-empty *) "none" + | Some v -> v + in + Printf.sprintf "%s%s %s {\n" indent_str tag_node tag_value + else + let name = + match Util.get_last path with + | None -> (* not possible as path non-empty *) "none" + | Some v -> v + in + Printf.sprintf "%s%s {\n" indent_str name + +let render_level_close indent node path = + (* alert exn Config_tree.is_tag: + [Vytree.Empty_path] called in branch path non-empty + [Vytree.Nonexistent_path] function diff never calls diff_func on nonexistent path + *) + if Util.is_empty path || (Config_tree.is_tag[@alert "-exn"]) node path then + "" + else + let level = get_level_at_path node path in + let indent_str = Config_tree.make_indent indent level in + Printf.sprintf "%s}\n" indent_str + +let config_diff (rt : Reference_tree.t) ?(recurse=true) (path : string list) (Diff_show res) (m : change) = + (* alert exn Vytree.get, Reference_tree.refpath, Config_tree.get_values, + Reference_tree.is_multi, Config_tree.is_tag_value: + [Vytree.Empty_path] checked at only point possible (Unchanged) + [Vytree.Nonexistent_path] function diff never calls diff_func on nonexistent path + *) + + let indent = 4 in + (* the only subtlety in all this is the bookkeeping of closing open + braces at correct level: + (1) a rendered line with open brace will occur before the next + depth-first step + (2) at each return to (local) root, the path is checked for the + matching closing brace + explicitly: the record field open_blocks is a list of open paths + ordered by reverse inclusion, which are closed when the path being + passed to config_diff no longer contains that element + *) + let rec close_blocks s l = + match l with + | [] -> s, [] + | h :: tl -> + if Util.is_sublist h path then + s, l + else + let rendered = render_level_close indent res.left h in + let s' = s ^ annotate_rendered Unchanged rendered + in close_blocks s' tl + in + let diff_str, rev_blocks = close_blocks res.config_diff res.open_blocks + in + match m with + | Added -> + let node = + if (Config_tree.is_tag_value[@alert "-exn"]) res.right path then + (Vytree.get[@alert "-exn"]) res.right (Util.drop_last path) + else + (Vytree.get[@alert "-exn"]) res.right path + in + let level = get_level_at_path res.right path in + let rendered = + Config_tree.render_node indent level node + in + let rev_diff = diff_str ^ annotate_rendered m rendered in + Diff_show {res with config_diff = rev_diff; open_blocks = rev_blocks;} + | Subtracted -> + let node = + if (Config_tree.is_tag_value[@alert "-exn"]) res.left path then + (Vytree.get[@alert "-exn"]) res.left (Util.drop_last path) + else + (Vytree.get[@alert "-exn"]) res.left path + in + let level = get_level_at_path res.left path in + let rendered = + Config_tree.render_node indent level node + in + let rev_diff = diff_str ^ annotate_rendered m rendered in + Diff_show {res with config_diff = rev_diff; open_blocks = rev_blocks;} + | Unchanged -> + begin + match recurse with + | false -> + let rendered = render_level_open indent res.left path in + let rev_diff = diff_str ^ annotate_rendered m rendered in + Diff_show {res with config_diff = rev_diff; open_blocks = path::rev_blocks} + | true -> + match path with + | [] -> (* case left = right *) + let rendered = + Config_tree.render_config res.left + in + let rev_diff = diff_str ^ annotate_rendered m rendered in + Diff_show {res with config_diff = rev_diff; open_blocks = rev_blocks;} + | _ -> + let level = get_level_at_path res.left path in + let node = (Vytree.get[@alert "-exn"]) res.left path in + let rendered = + Config_tree.render_node indent level node + in + let rev_diff = diff_str ^ annotate_rendered m rendered in + Diff_show {res with config_diff = rev_diff; open_blocks = rev_blocks;} + end + | Updated v -> + let refp = + (Reference_tree.refpath[@alert "-exn"]) rt (res.base_path @ path) in + let multi = (Reference_tree.is_multi[@alert "-exn"]) rt refp in + let level = get_level_at_path res.left path in + let indent_str = + Config_tree.make_indent indent level + in + let name = + match Util.get_last path with + | None -> (* not possible *) "none" + | Some n -> n + in + match multi with + | false -> + let rendered = + Config_tree.render_values indent_str name v + in + let rev_diff = diff_str ^ annotate_rendered m rendered in + Diff_show {res with config_diff = rev_diff; open_blocks = rev_blocks;} + | true -> + let ov = (Config_tree.get_values[@alert "-exn"]) res.left path in + 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 + let sub_rendered = + match sub_vals with + | [] -> "" + | _ -> + Config_tree.render_values indent_str name sub_vals + in + let sub_diff = annotate_rendered Subtracted sub_rendered in + let add_rendered = + match add_vals with + | [] -> "" + | _ -> + Config_tree.render_values indent_str name add_vals + in + let add_diff = annotate_rendered Added add_rendered in + let inter_rendered = + match inter_vals with + | [] -> "" + | _ -> + Config_tree.render_values indent_str name inter_vals + in + let inter_diff = annotate_rendered Unchanged inter_rendered in + let value_diff = sub_diff ^ inter_diff ^ add_diff in + let rev_diff = diff_str ^ value_diff in + Diff_show {res with config_diff = rev_diff; open_blocks = rev_blocks;} + +(* call recursive diff on config_trees with config_diff as the diff_func *) +let diff_show rt path left right = + (* raises: + [Incommensurable] + [Empty_comparison] + *) + if (name_of left) <> (name_of right) then + raise Incommensurable + else + let (left, right) = + if not (Util.is_empty path) then + (Config_tree.get_subtree left path, Config_tree.get_subtree right path) + else (left, right) + in + let config_show = make_diff_show left right path in + let ret = diff [] (config_diff rt) config_show (Option.some left, Option.some right) in + (* close final braces *) + let d = config_diff rt ~recurse:false [] ret Unchanged in + let diff_show_result = eval_diff_result d in + diff_show_result.config_diff + (* mask function; mask applied on right *) let mask_func ?recurse:_ (path : string list) (Diff_tree res) (m : change) = (* alert exn Vytree.delete: diff --git a/src/config_diff.mli b/src/config_diff.mli index 8f6860d..7579e32 100644 --- a/src/config_diff.mli +++ b/src/config_diff.mli @@ -19,9 +19,19 @@ module Diff_compare : sig } end +module Diff_show : sig + type t = { left: Config_tree.t; + right: Config_tree.t; + base_path: string list; + open_blocks: string list list; + config_diff: string; + } +end + type _ diff_result = | Diff_tree : Diff_tree.t -> Diff_tree.t diff_result | Diff_compare : Diff_compare.t -> Diff_compare.t diff_result + | Diff_show : Diff_show.t -> Diff_show.t diff_result val eval_diff_result : 'a diff_result -> 'a @@ -43,6 +53,10 @@ val diff_compare : ?cmds:bool -> string list -> Config_tree.t -> Config_tree.t - [@@alert exn "Config_diff.Incommensurable"] [@@alert exn "Config_diff.Empty_comparison"] +val diff_show : Reference_tree.t -> string list -> Config_tree.t -> Config_tree.t -> string +[@@alert exn "Config_diff.Incommensurable"] +[@@alert exn "Config_diff.Empty_comparison"] + val tree_union : Config_tree.t -> Config_tree.t -> Config_tree.t [@@alert exn "Tree_alg.Incompatible_union"] [@@alert exn "Tree_alg.Nonexistent_child"] -- cgit v1.2.3