open Diff module ValueS = Config_tree.ValueS 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 module Diff_show = struct type t = { left: Config_tree.t; right: Config_tree.t; rt: Reference_tree.t; base_path: string list; open_blocks: string list list; config_diff: string; } let make_init l r rt path = { left = l; right = r; rt = rt; base_path = path; open_blocks = []; config_diff = ""; } let diff_func ?(descent=true) (path : string list) 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 {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 {res with config_diff = rev_diff; open_blocks = rev_blocks;} | Unchanged -> begin match descent with | false -> let rendered = render_level_open indent res.left path in let rev_diff = diff_str ^ annotate_rendered m rendered in {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 {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 {res with config_diff = rev_diff; open_blocks = rev_blocks;} end | Updated v -> let refp = (Reference_tree.refpath[@alert "-exn"]) res.rt (res.base_path @ path) in let multi = (Reference_tree.is_multi[@alert "-exn"]) res.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 {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 {res with config_diff = rev_diff; open_blocks = rev_blocks;} end module D = Diff(Diff_show) (* 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 (Vytree.name_of_node left) <> (Vytree.name_of_node 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 init = Diff_show.make_init left right rt path in let ret = D.diff init left right in (* close final braces *) let res = Diff_show.diff_func ~descent:false [] ret Unchanged in res.config_diff