path: root/src/config_diff.ml

type change = Unchanged | Added | Subtracted | Updated of string list

exception Incommensurable
exception Empty_comparison
exception Nonexistent_child

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_compare = struct
    type t = { left: Config_tree.t;
               right: Config_tree.t;
               skel: Config_tree.t;
               ppath: string list;
               udiff: string;
             }
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

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_compare l r = Diff_compare { left = l; right = r;
                                skel = (Config_tree.make "");
                                ppath = [];
                                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
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)

(* unordered set of values *)
module ValueSet = Set.Make(String)

let (^~) (node : Config_tree.t) (node' : Config_tree.t) =
  name_of node = name_of node' &&
  (data_of node).values <> (data_of node').values

let left_opt_pairs n m =
    (children_of n) |> List.map (fun x ->
        let maybe_node =
            (children_of m) |> List.find_opt (fun y ->
                name_of y = name_of x) in
        (Some x, maybe_node))

let right_opt_pairs n m =
    (children_of m) |> List.map (fun y ->
        let maybe_node =
            (children_of n) |> List.find_opt (fun x ->
                name_of x = name_of y) in
        (maybe_node, Some y))

let opt_tuple_cmp t1 t2 =
    let opt_tuple_val t =
        match t with
        | None, None -> ""
        | Some x, None -> name_of x
        | None, Some y -> name_of y
        | Some x, Some _ -> name_of x
    in Util.lexical_numeric_compare (opt_tuple_val t1) (opt_tuple_val t2)

let opt_zip n m =
    left_opt_pairs n m @ right_opt_pairs n m |> List.sort_uniq opt_tuple_cmp

let get_opt_name left_opt right_opt =
    match left_opt, right_opt with
    | Some left_node, None -> name_of left_node
    | None, Some right_node -> name_of right_node
    | Some left_node, Some _ -> name_of left_node
    | None, None -> raise Empty_comparison

let update_path path left_opt right_opt =
    let name = get_opt_name left_opt right_opt in
    if name = "" then path
    else path @ [name]

(* tree diff algorithm: walk the tree pair, calling a function of type
   diff_func for each comparison.
   The idea of matching on pairs of (node opt) is from
   https://github.com/LukeBurgessYeo/tree-diff
 *)
let rec diff (path : string list) (f : 'a diff_func) (res: 'a diff_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 =
    (* raises:
        [Vytree.Nonexistent_path]
       alert exn Vytree.get:
        [Vytree.Empty_path] not possible as clone_path called by clone with non-empty path
        [Vytree.Nonexistent_path] allow raise
       alert exn Vytree.insert:
        [Vytree.Empty_path] not possible as clone_path called by clone with non-empty path
        [Not_found] not possible for postion=Lexical
        [Vytree.Duplicate_child] not possible as calls are on path complement
        [Vytree.Insert_error] not possible as calls are on path_existing @ [name]
     *)
    match path_remaining with
    | [] | [_] ->
        let path_total = path_done @ path_remaining in
        let old_node = (Vytree.get[@alert "-exn"]) old_root path_total 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[@alert "-exn"]) ~position:Lexical ~children:(children_of old_node) new_root path_total data
        else
            (Vytree.insert[@alert "-exn"]) ~position:Lexical new_root path_total data
    | name :: names ->
        let path_done = path_done @ [name] in
        let old_node = (Vytree.get[@alert "-exn"]) old_root path_done in
        let new_root = (Vytree.insert[@alert "-exn"]) ~position:Lexical 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=None) old_root new_root path =
    (* raises:
        [Vytree.Nonexistent_path] from clone_path
     *)
    match path with
    | [] -> 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 ~recurse:recurse ~set_values:set_values old_root new_root path_existing path_remaining

(* define the diff_func *)
let build_trees ?(recurse=true) (path : string list) (Diff_tree res) (m : change) =
    (* raises no exception:
        clone will always be called on extant path of left or right
       alert exn Vytree.get_values:
        [Vytree.Empty_path] not possible as pattern Updated implies non-empty path
        [Vytree.Nonexistent_path] not possible as pattern Updated implies path exists
     *)
    match m with
    | 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[@alert "-exn"]) res.left path in
            match ov, v with
            | [_], [_] -> 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
                      let sub_tree =
                          if not (Util.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 (Util.is_empty sub_vals) then
                              if (Util.is_empty add_vals) && (Util.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
                              res.del
                      in
                      let add_tree =
                          if not (Util.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 (Util.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 =
    (* raises:
        [Vytree.Empty_path]
        [Empty_comparison]
       alert exn Vytree.get:
        [Vytree.Empty_path] allow raise
        [Vytree.Nonexistent_path] catch and raise Empty_comparison
     *)
    try
        let node = (Vytree.get[@alert "-exn"]) node path in
        make Config_tree.default_data "" [node]
    with Vytree.Nonexistent_path -> raise Empty_comparison

(* call recursive diff on config_trees with build_trees as the diff_func *)
let diff_trees path left right =
    (* raises:
        [Empty_comparison] from tree_at_path
        [Incommensurable]
     *)
    if (name_of left) <> (name_of right) then
        raise Incommensurable
    else
        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
        let d = diff [] build_trees trees (Option.some left, Option.some right)
        in eval_diff_result d

(* wrapper to return single tree with diff trees as subtrees *)
let diff_tree path left right =
    (* raises:
        [Incommensurable],
        [Empty_comparison] from compare
     *)
    let trees = diff_trees 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 ret = make Config_tree.default_data "" [add_node; sub_node; del_node; int_node] in
    ret

(* convenience function needed for commit algorithm:
    we need a hybrid tree between the 'del' tree and the 'sub' tree, namely:
    in case the del tree has a terminal tag node (== all tag values have
    been removed) add tag node values for proper removal in commit execution
 *)

let get_tagged_delete_tree dt =
    (* alert exn Config_tree.is_tag:
        [Vytree.Empty_path] not possible in pattern non-empty path
        [Vytree.Nonexistent_path] not possible in fold_tree_with_path
       alert exn Vytree.is_terminal_path:
        [Vytree.Empty_path] not possible in pattern non-empty path
       alert exn Vytree.children_of_path:
        [Vytree.Empty_path] not possible in pattern non-empty path
        [Vytree.Nonexistent_path] not possible in super-tree of fold_tree_with_path arg
       alert exn Vytree.insert:
        [Vytree.Empty_path]: not possible since called on pattern path non-empty
        [Not_found]: not possible for postion=Lexical
        [Vytree.Duplicate_child]: not possible by condition is_terminal_path
        [Vytree.Insert_error]: not possible since constructed iteratively from existing path
     *)
    let del_tree = Config_tree.get_subtree dt ["del"] in
    let sub_tree = Config_tree.get_subtree dt ["sub"] in
    let f (p, a) _t =
        let q = List.rev p in
        match q with
        | [] -> (p, a)
        | _ ->
        if (Config_tree.is_tag[@alert "-exn"]) a q && (Vytree.is_terminal_path[@alert "-exn"]) a q then
            let children = (Vytree.children_of_path[@alert "-exn"]) sub_tree q in
            let insert_child path node name =
                (Vytree.insert[@alert "-exn"]) ~position:Lexical node (path @ [name]) Config_tree.default_data
            in
            let a' = List.fold_left (insert_child q) a children in
            (p, a')
        else
            (p, a)
    in
    Vytree.fold_tree_with_path f ([], del_tree) del_tree


(* 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

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
    let l = String.split_on_char '\n' lines in
    let m =
        List.map (fun s -> if (String.length s) > 0 then mark ^ s else s) l in
    String.concat "\n" m

let added_lines ?(cmds=false) node path =
    (* alert exn Config_tree.render_commands:
        [Vytree.Nonexistent_path] not possible on root path
     *)
    if not cmds then marked_render "+ " (tree_at_path path node)
    else
        ((Config_tree.render_commands[@alert "-exn"]) ~op:Set node []) ^ "\n"

let removed_lines ?(cmds=false) node path =
    (* alert exn Config_tree.render_commands:
        [Vytree.Nonexistent_path] not possible on root path
     *)
    if not cmds then marked_render "- " (tree_at_path path node)
    else
        ((Config_tree.render_commands[@alert "-exn"]) ~op:Delete node []) ^ "\n"

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
    (String.concat "\n" del) ^ "\n" ^ (String.concat "\n" set) ^ "\n"

let unified_diff ?(cmds=false) ?recurse:_ (path : string list) (Diff_compare res) (m : change) =
    (* raises no exception:
        clone will always be called on extant path of left or right
       alert exn Vytree.get_values:
        [Vytree.Empty_path] not possible as pattern Updated implies non-empty path
        [Vytree.Nonexistent_path] not possible as pattern Updated implies path exists
     *)
    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 ->
            let str_diff =
                let add_tree = clone res.right res.skel path in
                str_diff ^ (added_lines ~cmds:cmds add_tree path)
            in
            Diff_compare { res with ppath = ppath_l; udiff = str_diff; }
    | Subtracted ->
            let str_diff =
                let sub_tree = clone res.left res.skel path in
                str_diff ^ (removed_lines ~cmds:cmds sub_tree path)
            in
            Diff_compare { res with ppath = ppath_l; udiff = str_diff; }
    | Unchanged -> Diff_compare (res)
    | Updated v ->
            let ov = (Config_tree.get_values[@alert "-exn"]) res.left path in
            match ov, v with
            | [_], [_] ->
                    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_compare { 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
                      let str_diff =
                          if not (Util.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 (Util.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_compare { 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

let compare_at_path_maybe_empty left right path =
    let left =
        try
            tree_at_path path left
        with Empty_comparison ->
            try
                let left = add_empty_path right left path in
                tree_at_path path left
             with Vytree.Nonexistent_path ->
                 raise Empty_comparison
     and right =
        try
            tree_at_path path right
        with Empty_comparison ->
            try
                let right = add_empty_path left right path in
                tree_at_path path right
             with Vytree.Nonexistent_path ->
                 raise Empty_comparison
    in (left, right)

let diff_compare ?(cmds=false) path left right =
    (* raises:
        [Incommensurable],
        [Empty_comparison] from compare_at_path_maybe_empty
     *)
    if (name_of left) <> (name_of right) then
        raise Incommensurable
    else
        let (left, right) =
            if (path <> []) then
                compare_at_path_maybe_empty left right path
            else (left, right) in
        let dstr = make_diff_compare left right in
        let dstr =
            diff [] (unified_diff ~cmds:cmds) dstr (Option.some left, Option.some right)
        in
        let dstr = eval_diff_result dstr in
        let strs =
            if cmds then order_commands dstr.udiff
            else dstr.udiff
        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 = (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 = (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
            let with_node =
            match Reference_tree.get_path_type rt path with
            | `Leaf -> true
            | _ -> false
            in
            (Config_tree.get_subtree ~with_node left path,
            Config_tree.get_subtree ~with_node 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_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)
       alert exn Vytree.is_terminal_path:
        [Vytree.Empty_path] not possible since Unchanged pattern is only empty path
     *)
    match m with
    | Added -> Diff_tree (res)
    | Subtracted ->
        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)
        end
    | Unchanged -> Diff_tree (res)
    | Updated _ -> Diff_tree (res)

(* mask function; mask applied on right *)
let mask_func_exclusive ?(recurse=true) (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
            | [] ->
                if recurse then
                    (* in the diff function, recurse = true on an empty path means that the
                       trees are equal, hence exclude all: return default (empty) tree *)
                    Diff_tree {res with left = Config_tree.default}
                else Diff_tree(res)
            | _ ->
                if recurse || ((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 ?(exclusive=false) left right =
    (* raises:
        [Empty_comparison] from diff
        [Incommensurable]
     *)
    if (name_of left) <> (name_of right) then
        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
    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 ?(recurse=false) 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:recurse 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 ~recurse:true) 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'))
        | _, [] -> clone_children acc path_done
    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
    ValueS.elements (ValueS.union set_n set_m)

let tree_union s t =
    (* raises:
        [Tree_alg.Incompatible_union]
        [Tree_alg.Nonexistent_child] should not be reachable
       alert exn Tree_alg.ConfigAlg.tree_union:
        [Tree_alg.Incompatible_union] allow raise
        [Tree_alg.Nonexistent_child] allow raise; should not be reachable
     *)
    let f u v =
        let values = union_of_values u v in
        let data = {(data_of v) with Config_tree.values = values} in
        Vytree.make_full data (name_of v) (children_of v)
    in
    (Tree_alg.ConfigAlg.tree_union[@alert "-exn"]) s t f

let tree_merge ?(destructive=false) s t =
    (* raises:
        [Tree_alg.Incompatible_union]
        [Tree_alg.Nonexistent_child] should not be reachable
       alert exn Tree_alg.ConfigAlg.tree_union:
        [Tree_alg.Incompatible_union] allow raise
        [Tree_alg.Nonexistent_child] allow raise; should not be reachable
     *)
    let f u v =
        let data =
            match destructive with
            | false -> data_of u
            | true  -> data_of v
        in Vytree.make_full data (name_of v) (children_of v)
    in
    (Tree_alg.ConfigAlg.tree_union[@alert "-exn"]) s t f