diff options
| -rw-r--r-- | src/config_diff.ml | 54 | ||||
| -rw-r--r-- | src/config_diff.mli | 2 | ||||
| -rw-r--r-- | src/vytree.mli | 2 |
3 files changed, 51 insertions, 7 deletions
diff --git a/src/config_diff.ml b/src/config_diff.ml index d19b297..9bbd2fd 100644 --- a/src/config_diff.ml +++ b/src/config_diff.ml @@ -12,13 +12,7 @@ type diff_trees = { exception Incommensurable exception Empty_comparison - -module ValueOrd = struct - type t = string - let compare a b = - Util.lexical_numeric_compare a b -end -module ValueS = Set.Make(ValueOrd) +exception Nonexistent_child let make_diff_trees l r = { left = l; right = r; add = ref (Config_tree.make ""); @@ -31,6 +25,20 @@ 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 +module ValueOrd = struct + type t = string + let compare a b = + Util.lexical_numeric_compare a b +end +module ValueS = Set.Make(ValueOrd) + +module TreeOrd = struct + type t = Config_tree.t + let compare a b = + Util.lexical_numeric_compare (name_of a) (name_of b) +end +module ChildrenS = Set.Make(TreeOrd) + let (^~) (node : Config_tree.t) (node' : Config_tree.t) = name_of node = name_of node' && (data_of node).values <> (data_of node').values @@ -344,3 +352,35 @@ let show_diff ?(cmds=false) path left right = diff [] (unified_diff ~cmds:cmds udiff trees) [(Option.some left, Option.some right)]; if cmds then order_commands udiff; !udiff + +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 + ValueS.elements (ValueS.union set_n set_m) + +let union_of_children n m = + let set_n = ChildrenS.of_list (children_of n) in + let set_m = ChildrenS.of_list (children_of m) in + ChildrenS.elements (ChildrenS.union set_n set_m) + +(* tree_union is currently used only for unit tests, so only values of data + are considered. Should there be a reason to expose it in the future, + consistency check and union of remaining data will need to be added. + *) +let rec tree_union s t = + let child_of_union s t c = + let s_c = Vytree.find s (name_of c) in + let t_c = Vytree.find t (name_of c) in + match s_c, t_c with + | Some child, None -> clone s t [(name_of child)] + | None, Some _ -> t + | Some u, Some v -> + if u ^~ v then + let values = union_of_values u v in + let data = {(data_of v) with Config_tree.values = values} in + Vytree.replace t (Vytree.make data (name_of v)) + else + Vytree.replace t (tree_union u v) + | None, None -> raise Nonexistent_child + in + List.fold_left (fun x c -> child_of_union s x c) t (union_of_children s t) diff --git a/src/config_diff.mli b/src/config_diff.mli index 4a9a1d3..0f4ebf0 100644 --- a/src/config_diff.mli +++ b/src/config_diff.mli @@ -12,6 +12,7 @@ type diff_trees = { 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 @@ -21,3 +22,4 @@ 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 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 diff --git a/src/vytree.mli b/src/vytree.mli index a3a6154..c30ff3f 100644 --- a/src/vytree.mli +++ b/src/vytree.mli @@ -19,6 +19,8 @@ val find_or_fail : 'a t -> string -> 'a t val adopt : 'a t -> 'a t -> 'a t +val replace : 'a t -> 'a t -> 'a t + val insert : ?position:position -> ?children:('a t list) -> 'a t -> string list -> 'a -> 'a t val insert_multi_level : 'a -> 'a t -> string list -> string list -> 'a -> 'a t |