summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJohn Estabrook <jestabro@vyos.io>2023-07-21 10:08:07 -0500
committerJohn Estabrook <jestabro@vyos.io>2023-07-27 14:36:26 -0500
commit9477a518bbc228046898274f865981c5d2b37967 (patch)
treebb70180f2f238f55d59a77b8318cbbca88ca8d45
parent9ceb7a3ffb0e86af35c01aee38420007a1e3fa83 (diff)
downloadvyos1x-config-9477a518bbc228046898274f865981c5d2b37967.tar.gz
vyos1x-config-9477a518bbc228046898274f865981c5d2b37967.zip
T5317: remove mutable references
Redesign and implement version without mutable refs.
-rw-r--r--src/config_diff.ml276
-rw-r--r--src/config_diff.mli43
2 files changed, 206 insertions, 113 deletions
diff --git a/src/config_diff.ml b/src/config_diff.ml
index cd9104b..35a5b55 100644
--- a/src/config_diff.ml
+++ b/src/config_diff.ml
@@ -1,27 +1,61 @@
type change = Unchanged | Added | Subtracted | Updated of string list
-type diff_func = ?recurse:bool -> string list -> change -> unit
-
-type diff_trees = {
- left: Config_tree.t;
- right: Config_tree.t;
- add: Config_tree.t ref;
- sub: Config_tree.t ref;
- del: Config_tree.t ref;
- inter: Config_tree.t ref;
-}
-
exception Incommensurable
exception Empty_comparison
exception Nonexistent_child
-let make_diff_trees l r = { left = l; right = r;
- add = ref (Config_tree.make "");
- sub = ref (Config_tree.make "");
- del = ref (Config_tree.make "");
- inter = ref (Config_tree.make "");
+module Diff_tree = struct
+ type t = { left: Config_tree.t;
+ right: Config_tree.t;
+ add: Config_tree.t;
+ sub: Config_tree.t;
+ del: Config_tree.t;
+ inter: Config_tree.t;
+ }
+end
+
+module Diff_string = struct
+ type t = { left: Config_tree.t;
+ right: Config_tree.t;
+ skel: Config_tree.t;
+ ppath: string list;
+ udiff: string;
+ }
+end
+
+module Diff_cstore = struct
+ type t = { left: Config_tree.t;
+ right: Config_tree.t;
+ handle: int;
+ }
+end
+
+type _ result =
+ | Diff_tree : Diff_tree.t -> Diff_tree.t result
+ | Diff_string : Diff_string.t -> Diff_string.t result
+ | Diff_cstore : Diff_cstore.t -> Diff_cstore.t result
+
+let eval_result : type a. a result -> a = function
+ | Diff_tree x -> x
+ | Diff_string x -> x
+ | Diff_cstore x -> x
+
+type 'a diff_func = ?recurse:bool -> string list -> 'a result -> change -> 'a result
+
+let make_diff_trees l r = Diff_tree { left = l; right = r;
+ add = (Config_tree.make "");
+ sub = (Config_tree.make "");
+ del = (Config_tree.make "");
+ inter = (Config_tree.make "");
}
+let make_diff_string l r = Diff_string {
+ left = l; right = r;
+ skel = (Config_tree.make "");
+ ppath = [];
+ udiff = "";
+ }
+
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
@@ -64,7 +98,7 @@ let right_opt_pairs n m =
*)
let opt_cmp o0 o1 =
match o0, o1 with
- | Some v0, Some v1 -> compare v0 v1
+ | Some v0, Some v1 -> compare (name_of v0) (name_of v1)
| None, None -> 0
| None, Some _ -> 1
| Some _, None -> -1
@@ -95,24 +129,20 @@ let update_path path left_opt right_opt =
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 Subtracted
- | 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 ~recurse:false path Unchanged;
- diff path f (opt_zip left_node right_node))
- | None, None -> raise Empty_comparison)
- ; diff path f ls
+let rec diff (path : string list) (f : 'a diff_func) (res: 'a result) ((left_node_opt, right_node_opt) : Config_tree.t option * Config_tree.t option) =
+ let path = update_path path left_node_opt right_node_opt in
+ match left_node_opt, right_node_opt with
+ | None, None -> raise Empty_comparison
+ | Some _, None -> f path res Subtracted
+ | None, Some _ -> f path res Added
+ | Some left_node, Some right_node when left_node = right_node ->
+ f ~recurse:true path res Unchanged
+ | Some left_node, Some right_node when left_node ^~ right_node ->
+ let values = (data_of right_node).values in
+ f path res (Updated values)
+ | Some left_node, Some right_node ->
+ let ret = f ~recurse:false path res Unchanged in
+ List.fold_left (diff path f) ret (opt_zip left_node right_node)
(* copy node paths between trees *)
let rec clone_path ?(recurse=true) ?(set_values=None) old_root new_root path_done path_remaining =
@@ -145,37 +175,58 @@ let clone ?(recurse=true) ?(set_values=None) old_root new_root 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) ?(recurse=true) (path : string list) (m : change) =
+(* define the diff_func *)
+let decorate_trees ?(recurse=true) (path : string list) (Diff_tree res) (m : change) =
match m with
- | Added -> trees.add := clone trees.right !(trees.add) path
- | Subtracted -> trees.sub := clone trees.left !(trees.sub) path;
- trees.del := clone ~recurse:false ~set_values:(Some []) trees.left !(trees.del) path
- | Unchanged -> trees.inter := clone ~recurse:recurse trees.left !(trees.inter) path
+ | Added -> Diff_tree {res with add = clone res.right res.add path; }
+ | Subtracted ->
+ Diff_tree {res with sub = clone res.left res.sub path;
+ del = clone ~recurse:false ~set_values:(Some []) res.left res.del path; }
+ | Unchanged ->
+ Diff_tree {res with inter = clone ~recurse:recurse res.left res.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
+ let ov = Config_tree.get_values res.left path in
match ov, v with
- | [_], [_] -> trees.sub := clone trees.left !(trees.sub) path;
- trees.del := clone trees.left !(trees.del) path;
- trees.add := clone trees.right !(trees.add) path
+ | [_], [_] -> Diff_tree {res with sub = clone res.left res.sub path;
+ del = clone res.left res.del path;
+ add = clone res.right res.add 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:(Some sub_vals) trees.left !(trees.sub) path;
- if not (is_empty sub_vals) then
- if (is_empty add_vals) && (is_empty inter_vals) then
- (* delete whole node, not just values *)
- trees.del := clone ~set_values:(Some []) trees.left !(trees.del) path
+ let sub_tree =
+ if not (is_empty sub_vals) then
+ clone ~set_values:(Some sub_vals) res.left res.sub path
+ else
+ res.sub
+ in
+ let del_tree =
+ if not (is_empty sub_vals) then
+ if (is_empty add_vals) && (is_empty inter_vals) then
+ (* delete whole node, not just values *)
+ clone ~set_values:(Some []) res.left res.del path
+ else
+ clone ~set_values:(Some sub_vals) res.left res.del path
else
- trees.del := clone ~set_values:(Some sub_vals) trees.left !(trees.del) path;
- if not (is_empty add_vals) then
- 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:(Some inter_vals) trees.left !(trees.inter) path
+ res.del
+ in
+ let add_tree =
+ if not (is_empty add_vals) then
+ clone ~set_values:(Some add_vals) res.right res.add path
+ else
+ res.add
+ in
+ let inter_tree =
+ if not (is_empty inter_vals) then
+ clone ~set_values:(Some inter_vals) res.left res.inter path
+ else
+ res.inter
+ in Diff_tree { res with add = add_tree;
+ sub = sub_tree;
+ del = del_tree;
+ inter = inter_tree; }
(* get sub trees for path-relative comparison *)
let tree_at_path path node =
@@ -192,16 +243,16 @@ let compare path left right =
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_trees left right in
- diff [] (decorate_trees trees) [(Option.some left, Option.some right)];
- trees
+ let d = diff [] decorate_trees trees (Option.some left, Option.some right)
+ in eval_result d
(* wrapper to return diff trees *)
let diff_tree path left right =
let trees = compare path left right 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 del_node = make Config_tree.default_data "del" (children_of !(trees.del)) in
- let int_node = make Config_tree.default_data "inter" (children_of !(trees.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 del_node = make Config_tree.default_data "del" (children_of (trees.del)) 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; del_node; int_node] in
ret
@@ -212,10 +263,8 @@ let list_but_last l =
let len = List.length l in
List.filteri (fun i _ -> i < len - 1) l
-let ppath_to_string_if_new (c: string list ref) (path: string list) =
- let p = list_but_last path in
- if (!c <> p) then
- (c := p; Printf.sprintf "[%s]\n" (String.concat " " !c)) else ""
+let path_to_string (path: string list) =
+ Printf.sprintf "[%s]\n" (String.concat " " path)
let marked_render mark node =
let lines = Config_tree.render_config node in
@@ -227,51 +276,76 @@ let marked_render mark node =
let added_lines ?(cmds=false) node path =
if not cmds then marked_render "+ " (tree_at_path path node)
else
- let skel = Config_tree.make "" in
- let snode = clone node skel path in
- (Config_tree.render_commands ~op:Set snode []) ^ "\n"
+ (Config_tree.render_commands ~op:Set node []) ^ "\n"
let removed_lines ?(cmds=false) node path =
if not cmds then marked_render "- " (tree_at_path path node)
else
- let skel = Config_tree.make "" in
- let snode = clone node skel path in
- (Config_tree.render_commands ~op:Delete snode []) ^ "\n"
+ (Config_tree.render_commands ~op:Delete node []) ^ "\n"
-let order_commands (strl: string ref) =
- let l = String.split_on_char '\n' !strl in
+let order_commands (strl: string) =
+ let l = String.split_on_char '\n' strl in
let del = List.filter (fun s -> (s <> "") && (s.[0] = 'd')) l in
let set = List.filter (fun s -> (s <> "") && (s.[0] = 's')) l in
- strl := (String.concat "\n" del) ^ "\n" ^ (String.concat "\n" set) ^ "\n"
-
-let ppath = ref [""]
+ (String.concat "\n" del) ^ "\n" ^ (String.concat "\n" set) ^ "\n"
-let unified_diff ?(cmds=false) (str_diff: string ref) (trees : diff_trees) ?recurse:_ (path : string list) (m : change) =
+let unified_diff ?(cmds=false) ?recurse:_ (path : string list) (Diff_string res) (m : change) =
+ let ppath_l = list_but_last path
+ in
+ let ppath_s =
+ if (ppath_l <> res.ppath) then path_to_string ppath_l
+ else ""
+ in
+ let str_diff =
+ if not cmds then res.udiff ^ ppath_s
+ else res.udiff
+ in
match m with
| Added ->
- if not cmds then str_diff := !str_diff ^ (ppath_to_string_if_new ppath path);
- str_diff := !str_diff ^ (added_lines ~cmds:cmds trees.right path)
+ let str_diff =
+ let add_tree = clone res.right res.skel path in
+ str_diff ^ (added_lines ~cmds:cmds add_tree path)
+ in
+ Diff_string { res with ppath = ppath_l; udiff = str_diff; }
| Subtracted ->
- if not cmds then str_diff := !str_diff ^ (ppath_to_string_if_new ppath path);
- str_diff := !str_diff ^ (removed_lines ~cmds:cmds trees.left path)
- | Unchanged -> ()
+ let str_diff =
+ let sub_tree = clone res.left res.skel path in
+ str_diff ^ (removed_lines ~cmds:cmds sub_tree path)
+ in
+ Diff_string { res with ppath = ppath_l; udiff = str_diff; }
+ | Unchanged -> Diff_string (res)
| Updated v ->
- if not cmds then str_diff := !str_diff ^ (ppath_to_string_if_new ppath path);
- let ov = Config_tree.get_values trees.left path in
+ let ov = Config_tree.get_values res.left path in
match ov, v with
| [_], [_] ->
- str_diff := !str_diff ^ (removed_lines ~cmds:cmds trees.left path);
- str_diff := !str_diff ^ (added_lines ~cmds:cmds trees.right path)
+ let str_diff =
+ let sub_tree = clone res.left res.skel path in
+ str_diff ^ (removed_lines ~cmds:cmds sub_tree path)
+ in
+ let str_diff =
+ let add_tree = clone res.right res.skel path in
+ str_diff ^ (added_lines ~cmds:cmds add_tree path)
+ in
+ Diff_string { res with ppath = ppath_l; udiff = str_diff; }
| _, _ -> 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
- if not (is_empty sub_vals) then
- (trees.sub := clone ~set_values:(Some sub_vals) trees.left !(trees.sub) path;
- str_diff := !str_diff ^ (removed_lines ~cmds:cmds !(trees.sub) path));
- if not (is_empty add_vals) then
- (trees.add := clone ~set_values:(Some add_vals) trees.right !(trees.add) path;
- str_diff := !str_diff ^ (added_lines ~cmds:cmds !(trees.add) path))
+ let str_diff =
+ if not (is_empty sub_vals) then
+ let sub_tree =
+ clone ~set_values:(Some sub_vals) res.left res.skel path
+ in str_diff ^ (removed_lines ~cmds:cmds sub_tree path)
+ else str_diff
+ in
+ let str_diff =
+ if not (is_empty add_vals) then
+ let add_tree =
+ clone ~set_values:(Some add_vals) res.right res.skel path
+ in str_diff ^ (added_lines ~cmds:cmds add_tree path)
+ else str_diff
+ in
+ Diff_string { res with ppath = ppath_l; udiff = str_diff; }
let add_empty_path src_node dest_node path =
clone ~recurse:false ~set_values:(Some []) src_node dest_node path
@@ -305,12 +379,16 @@ let show_diff ?(cmds=false) path left right =
if (path <> []) then
compare_at_path_maybe_empty left right path
else (left, right) in
- let trees = make_diff_trees left right in
- let udiff = ref "" in
- ppath := [""];
- diff [] (unified_diff ~cmds:cmds udiff trees) [(Option.some left, Option.some right)];
- if cmds then order_commands udiff;
- !udiff
+ let dstr = make_diff_string left right in
+ let dstr =
+ diff [] (unified_diff ~cmds:cmds) dstr (Option.some left, Option.some right)
+ in
+ let dstr = eval_result dstr in
+ let strs =
+ if cmds then order_commands dstr.udiff
+ else dstr.udiff
+ in
+ strs
let union_of_values (n : Config_tree.t) (m : Config_tree.t) =
let set_n = ValueS.of_list (data_of n).values in
diff --git a/src/config_diff.mli b/src/config_diff.mli
index b1c3c09..c995ba3 100644
--- a/src/config_diff.mli
+++ b/src/config_diff.mli
@@ -1,24 +1,39 @@
-type change = Unchanged | Added | Subtracted | Updated of string list
-type diff_func = ?recurse:bool -> string list -> change -> unit
+module Diff_tree : sig
+ type t = { left: Config_tree.t;
+ right: Config_tree.t;
+ add: Config_tree.t;
+ sub: Config_tree.t;
+ del: Config_tree.t;
+ inter: Config_tree.t;
+ }
+end
-type diff_trees = {
- left: Config_tree.t;
- right: Config_tree.t;
- add: Config_tree.t ref;
- sub: Config_tree.t ref;
- del: Config_tree.t ref;
- inter: Config_tree.t ref;
-}
+module Diff_string : sig
+ type t = { left: Config_tree.t;
+ right : Config_tree.t;
+ skel: Config_tree.t;
+ ppath: string list;
+ udiff: string;
+ }
+end
+
+module Diff_cstore : sig
+ type t = { left: Config_tree.t;
+ right: Config_tree.t;
+ handle: int;
+ }
+end
+
+type _ result =
+ | Diff_tree : Diff_tree.t -> Diff_tree.t result
+ | Diff_string : Diff_string.t -> Diff_string.t result
+ | Diff_cstore : Diff_cstore.t -> Diff_cstore.t result
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
-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
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