1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
|
type change = Unchanged | Added | Subtracted | Updated of string list
exception Incommensurable
exception Empty_comparison
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 (^~) (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]
module type Place = sig
type t
val diff_func : ?descent:bool -> string list -> t -> change -> t
end
module Diff (P: Place) = struct
let rec diff_calc (path : string list) (res: P.t) ((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 -> P.diff_func path res Subtracted
| None, Some _ -> P.diff_func path res Added
| Some left_node, Some right_node when left_node = right_node ->
P.diff_func ~descent:true path res Unchanged
| Some left_node, Some right_node when left_node ^~ right_node ->
let values = (data_of right_node).values in
P.diff_func path res (Updated values)
| Some left_node, Some right_node ->
let ret = P.diff_func ~descent:false path res Unchanged in
List.fold_left (diff_calc path) ret (opt_zip left_node right_node)
let diff (init: P.t) l r = diff_calc [] init (Option.some l, Option.some r)
end
|
