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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
|
(* 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 ?(descent=true) 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 spurious_value p =
Reference_tree.refpath_from_partial reftree p =
Reference_tree.refpath_from_partial reftree (Util.drop_last p)
in
let clone_node ?(descent=false) tree p =
if (Vytree.exists[@alert "-exn"]) tree p then
tree
else
if not ((Vytree.exists[@alert "-exn"]) ctree p) then
tree
else
(Config_tree.clone[@alert "-exn"]) ~descent:descent 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 ~descent:true) tree paths
in
let (complete, res) =
let rec aux (tail, 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_ctree [h] then aux (tail, (clone_node acc [h])) [h] tl
else (false, result)
| _, h :: tl ->
let p' = path_done @ [h] in
(* case: path_done @ [h] exists in config tree *)
if check_ctree p' then aux (tail, (clone_node acc p')) p' tl
else
(* case: path_done @ [h] is not a tag value, but is not set in config tree *)
if not ((Config_tree.is_tag[@alert "-exn"]) ctree path_done)
then (tail, acc)
else
(* case: path_done is tag node, [h] is not a false tag value *)
if not (spurious_value p')
then
let children =
Vytree.list_children ((Vytree.get[@alert "-exn"]) ctree path_done)
in
let func (tail', accum) child =
let path = path_done @ [child] @ [h] in
if check_ctree path then
aux (tail', (clone_node accum path)) path tl
else (tail', accum)
in
List.fold_left func (tail, acc) children
else
(* case: [h] is a tag_value not present in the config tree *)
raise (Malformed_path (Util.string_of_list p'))
| _, [] ->
if descent then
(true, clone_children acc path_done)
else
(true, acc)
in aux (false, result) [] path
in match complete, res with
| true, tree -> tree
| false, __ -> result
let subtree_values_of_path rt ct path =
(* raises:
[Malformed_path] from subtree_from_partial
*)
let subtree = subtree_from_partial ~descent:false rt ct Config_tree.default path
in
if Util.is_empty path || subtree = Config_tree.default then
[([], [])]
else
let func (p, (acc, ct')) ft =
let path = List.rev p in
if Vytree.is_terminal_node ft then
let node = (Vytree.get[@alert "-exn"]) (ct': Config_tree.t) path in
let data = Vytree.data_of_node node in
let acc' =
if data.tag then ((Vytree.list_children node, path) :: acc)
else
if data.leaf then ((data.values, path) :: acc)
else acc
in (p, (acc', ct'))
else (p, (acc, ct'))
in fst (Vytree.fold_tree_with_path func ([], ([], ct)) subtree)
let subtree_values_of_path_yojson rt ct path =
let ret = subtree_values_of_path rt ct path in
[%to_yojson: (string list * string list) list] ret |> Yojson.Safe.to_string
|
