summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--src/config_dict.ml2
-rw-r--r--src/config_tree.ml12
-rw-r--r--src/config_tree.mli2
-rw-r--r--src/derived.ml98
-rw-r--r--src/derived.mli8
-rw-r--r--src/diff.ml6
-rw-r--r--src/diff.mli2
-rw-r--r--src/diff_compare.ml4
-rw-r--r--src/diff_show.ml6
-rw-r--r--src/diff_tree.ml6
-rw-r--r--src/generate.ml9
-rw-r--r--src/mask.ml10
-rw-r--r--src/reference_tree.ml17
-rw-r--r--src/reference_tree.mli7
-rw-r--r--src/util_reference_tree.ml133
-rw-r--r--src/util_reference_tree.mli16
-rw-r--r--src/vytree.ml11
-rw-r--r--src/vytree.mli4
18 files changed, 294 insertions, 59 deletions
diff --git a/src/config_dict.ml b/src/config_dict.ml
index e07c9bc..84076e9 100644
--- a/src/config_dict.ml
+++ b/src/config_dict.ml
@@ -61,7 +61,7 @@ let tree_with_defaults ?(with_first_node=true) ref_tree config_tree mask path =
end
| _ -> ((p, cont::c), acc)
in
- Vytree.fold_tree_with_path_and_list ref_tree_walk (([], []), ct) relative_ref_tree
+ Vytree.fold_tree_with_path_and_stack ref_tree_walk (([], []), ct) relative_ref_tree
in
let config_tree_walk (p, acc) ct =
let (data: Config_tree.config_node_data) = Vytree.data_of_node ct in
diff --git a/src/config_tree.ml b/src/config_tree.ml
index b552be9..7550651 100644
--- a/src/config_tree.ml
+++ b/src/config_tree.ml
@@ -313,7 +313,7 @@ let prune_delete node path =
else node
(* copy node paths between trees *)
-let rec clone_path ?(recurse=true) ?(set_values=None) old_root new_root path_done path_remaining =
+let rec clone_path ?(descent=true) ?(set_values=None) old_root new_root path_done path_remaining =
(* raises:
[Vytree.Nonexistent_path]
alert exn Vytree.get:
@@ -334,7 +334,7 @@ let rec clone_path ?(recurse=true) ?(set_values=None) old_root new_root path_don
| Some v -> { (Vytree.data_of_node old_node) with values = v }
| None -> Vytree.data_of_node old_node
in
- if recurse then
+ if descent then
let children' = Vytree.children_of_node old_node in
(Vytree.insert[@alert "-exn"]) ~position:Lexical ~children:children' new_root path_total data
else
@@ -345,18 +345,18 @@ let rec clone_path ?(recurse=true) ?(set_values=None) old_root new_root path_don
let new_root =
(Vytree.insert[@alert "-exn"]) ~position:Lexical new_root path_done (Vytree.data_of_node old_node)
in
- clone_path ~recurse:recurse ~set_values:set_values old_root new_root path_done names
+ clone_path ~descent:descent ~set_values:set_values old_root new_root path_done names
-let clone ?(recurse=true) ?(set_values=None) old_root new_root path =
+let clone ?(descent=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
+ | [] -> if descent 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
+ clone_path ~descent:descent ~set_values:set_values old_root new_root path_existing path_remaining
module Renderer =
diff --git a/src/config_tree.mli b/src/config_tree.mli
index 2820a77..6f9c58e 100644
--- a/src/config_tree.mli
+++ b/src/config_tree.mli
@@ -89,7 +89,7 @@ val get_subtree : ?with_node:bool -> t -> string list -> t
val value_paths_of_tree : t -> string list list
-val clone : ?recurse:bool -> ?set_values:string list option -> t -> t -> string list -> t
+val clone : ?descent:bool -> ?set_values:string list option -> t -> t -> string list -> t
[@@alert exn "Vytree.Nonexistent_path"]
val render_commands : ?op:command -> t -> string list -> string
diff --git a/src/derived.ml b/src/derived.ml
index b82226c..74254a6 100644
--- a/src/derived.ml
+++ b/src/derived.ml
@@ -2,7 +2,7 @@
returning a subtree of matches *)
exception Malformed_path of string
-let subtree_from_partial reftree ctree result path =
+let subtree_from_partial ?(descent=true) reftree ctree result path =
if Util.is_empty path then result
else
let check_reftree p =
@@ -21,46 +21,92 @@ let subtree_from_partial reftree ctree result path =
| [] -> false
| _ -> (Vytree.exists[@alert "-exn"]) ctree p
in
- let clone_node ?(recurse=false) tree p =
+ 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"]) ~recurse:recurse ctree tree p
+ (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 ~recurse:true) tree paths
+ List.fold_left (clone_node ~descent: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 (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 accum child =
+ let func (tail', accum) child =
let path = path_done @ [child] @ [h] in
if check_ctree path then
- aux (clone_node accum path) path tl
- else accum
+ aux (tail', (clone_node accum path)) path tl
+ else (tail', accum)
in
- List.fold_left func acc children
+ 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
- (* [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
+ 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
diff --git a/src/derived.mli b/src/derived.mli
index 39f255a..9ae2d26 100644
--- a/src/derived.mli
+++ b/src/derived.mli
@@ -1,4 +1,10 @@
exception Malformed_path of string
-val subtree_from_partial : Reference_tree.t -> Config_tree.t -> Config_tree.t -> string list -> Config_tree.t
+val subtree_from_partial : ?descent:bool -> Reference_tree.t -> Config_tree.t -> Config_tree.t -> string list -> Config_tree.t
+[@@alert exn "Derived.Malformed_path"]
+
+val subtree_values_of_path : Reference_tree.t -> Config_tree.t -> string list -> (string list * string list) list
+[@@alert exn "Derived.Malformed_path"]
+
+val subtree_values_of_path_yojson : Reference_tree.t -> Config_tree.t -> string list -> string
[@@alert exn "Derived.Malformed_path"]
diff --git a/src/diff.ml b/src/diff.ml
index 6a87d93..80c3654 100644
--- a/src/diff.ml
+++ b/src/diff.ml
@@ -51,7 +51,7 @@ let update_path path left_opt right_opt =
module type Place = sig
type t
- val diff_func : ?recurse:bool -> string list -> t -> change -> t
+ val diff_func : ?descent:bool -> string list -> t -> change -> t
end
module Diff (P: Place) = struct
@@ -62,12 +62,12 @@ module Diff (P: Place) = struct
| 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 ~recurse:true path res Unchanged
+ 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 ~recurse:false path res Unchanged in
+ 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)
diff --git a/src/diff.mli b/src/diff.mli
index 41ae523..1b021bd 100644
--- a/src/diff.mli
+++ b/src/diff.mli
@@ -5,7 +5,7 @@ exception Empty_comparison
module type Place = sig
type t
- val diff_func : ?recurse:bool -> string list -> t -> change -> t
+ val diff_func : ?descent:bool -> string list -> t -> change -> t
end
module Diff : functor (P: Place) -> sig
diff --git a/src/diff_compare.ml b/src/diff_compare.ml
index 8a9f0e1..9e24c32 100644
--- a/src/diff_compare.ml
+++ b/src/diff_compare.ml
@@ -64,7 +64,7 @@ module Diff_compare = struct
cmds = cmds;
}
- let diff_func ?recurse:_ (path : string list) res (m : change) =
+ let diff_func ?descent:_ (path : string list) res (m : change) =
(* raises no exception:
clone will always be called on extant path of left or right
alert exn Vytree.get_values:
@@ -132,7 +132,7 @@ end
module D = Diff(Diff_compare)
let add_empty_path src_node dest_node path =
- (Config_tree.clone[@alert "-exn"]) ~recurse:false ~set_values:(Some []) src_node dest_node path
+ (Config_tree.clone[@alert "-exn"]) ~descent:false ~set_values:(Some []) src_node dest_node path
let compare_at_path_maybe_empty left right path =
let left =
diff --git a/src/diff_show.ml b/src/diff_show.ml
index f10fde4..fad9b34 100644
--- a/src/diff_show.ml
+++ b/src/diff_show.ml
@@ -88,7 +88,7 @@ module Diff_show = struct
}
- let diff_func ?(recurse=true) (path : string list) res (m : change) =
+ 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)
@@ -138,7 +138,7 @@ module Diff_show = struct
{res with config_diff = rev_diff; open_blocks = rev_blocks;}
| Unchanged ->
begin
- match recurse with
+ match descent with
| false ->
let rendered = render_level_open indent res.left path in
let rev_diff = diff_str ^ annotate_rendered m rendered in
@@ -238,5 +238,5 @@ let diff_show rt path left right =
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 ~recurse:false [] ret Unchanged in
+ let res = Diff_show.diff_func ~descent:false [] ret Unchanged in
res.config_diff
diff --git a/src/diff_tree.ml b/src/diff_tree.ml
index d592c90..3cd5303 100644
--- a/src/diff_tree.ml
+++ b/src/diff_tree.ml
@@ -19,7 +19,7 @@ module Diff_tree = struct
inter = Config_tree.default;
}
- let diff_func ?(recurse=true) (path : string list) res (m : change) =
+ let diff_func ?(descent=true) (path : string list) res (m : change) =
(* raises no exception:
clone will always be called on extant path of left or right
alert exn Vytree.get_values:
@@ -30,9 +30,9 @@ module Diff_tree = struct
| Added -> {res with add = (Config_tree.clone[@alert "-exn"]) res.right res.add path; }
| Subtracted ->
{res with sub = (Config_tree.clone[@alert "-exn"]) res.left res.sub path;
- del = (Config_tree.clone[@alert "-exn"]) ~recurse:false ~set_values:(Some []) res.left res.del path; }
+ del = (Config_tree.clone[@alert "-exn"]) ~descent:false ~set_values:(Some []) res.left res.del path; }
| Unchanged ->
- {res with inter = (Config_tree.clone[@alert "-exn"]) ~recurse:recurse res.left res.inter path; }
+ {res with inter = (Config_tree.clone[@alert "-exn"]) ~descent:descent 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
diff --git a/src/generate.ml b/src/generate.ml
index d4d3f0e..3a0347d 100644
--- a/src/generate.ml
+++ b/src/generate.ml
@@ -14,8 +14,15 @@ let load_interface_definitions dir =
let relative_paths =
List.filter (fun x -> Filename.extension x = ".xml") dir_paths
in
+ let compar x y =
+ (* reverse order so as not to List.rev for fold_left below *)
+ String.compare (FilePath.basename y) (FilePath.basename x)
+ in
+ let sort_paths =
+ List.sort compar relative_paths
+ in
let absolute_paths =
- try Ok (List.map Util.absolute_path relative_paths)
+ try Ok (List.map Util.absolute_path sort_paths)
with Sys_error no_dir_msg -> Error no_dir_msg
in
let load_aux tree file =
diff --git a/src/mask.ml b/src/mask.ml
index 9edad33..5179876 100644
--- a/src/mask.ml
+++ b/src/mask.ml
@@ -10,7 +10,7 @@ module Mask_inclusive = struct
}
(* mask function; mask applied on right *)
- let diff_func ?recurse:_ (path : string list) res (m : change) =
+ let diff_func ?descent:_ (path : string list) 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)
@@ -43,7 +43,7 @@ module Mask_exclusive = struct
}
(* mask function; mask applied on right *)
- let diff_func ?(recurse=true) (path : string list) res (m : change) =
+ let diff_func ?(descent=true) (path : string list) 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)
@@ -57,13 +57,13 @@ module Mask_exclusive = struct
begin
match path with
| [] ->
- if recurse then
- (* in the diff function, recurse = true on an empty path means that the
+ if descent then
+ (* in the diff function, descent = true on an empty path means that the
trees are equal, hence exclude all: return default (empty) tree *)
{res with left = Config_tree.default}
else res
| _ ->
- if recurse || ((Vytree.is_terminal_path[@alert "-exn"]) res.right path) then
+ if descent || ((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
{res with left = left'}
diff --git a/src/reference_tree.ml b/src/reference_tree.ml
index dead1be..3e22d83 100644
--- a/src/reference_tree.ml
+++ b/src/reference_tree.ml
@@ -45,6 +45,11 @@ type docs = {
hints: doc_hints list;
} [@@deriving yojson]
+type dependency_type = {
+ kind: string;
+ alert: string;
+} [@@deriving yojson]
+
type ref_node_data = {
node_type: node_type;
constraints: Value_checker.value_constraint list;
@@ -61,6 +66,8 @@ type ref_node_data = {
default_value: string option;
hidden: bool;
secret: bool;
+ kind: string list;
+ dependency: dependency_type option;
docs: docs;
} [@@deriving yojson]
@@ -86,6 +93,8 @@ let default_data = {
default_value = None;
hidden = false;
secret = false;
+ kind = [];
+ dependency = None;
docs = {
headline = "";
text = "";
@@ -219,6 +228,12 @@ let load_docs_from_xml d x =
| _ -> d (* Ignore unknown elements instead of raising an error *)
in Xml.fold aux d x
+let load_dependency_from_xml d x =
+ try
+ let k, a = Xml.attrib x "kind", Xml.attrib x "alert" in
+ {d with dependency=Some { kind=k; alert=a }}
+ with _ -> {d with dependency=None}
+
let data_from_xml d x =
let aux d x =
match x with
@@ -237,6 +252,8 @@ let data_from_xml d x =
{d with priority=Some i}
| Xml.Element ("hidden", _, _) -> {d with hidden=true}
| Xml.Element ("secret", _, _) -> {d with secret=true}
+ | Xml.Element ("kind", _, [Xml.PCData k]) -> {d with kind=k::d.kind}
+ | Xml.Element ("dependency", _, _) -> load_dependency_from_xml d x
| Xml.Element ("docs", _, _) -> load_docs_from_xml d x
| _ -> raise (Bad_interface_definition ("Malformed property tag: " ^ Xml.to_string x))
in Xml.fold aux d x
diff --git a/src/reference_tree.mli b/src/reference_tree.mli
index b1341da..f27aaf7 100644
--- a/src/reference_tree.mli
+++ b/src/reference_tree.mli
@@ -23,6 +23,11 @@ type docs = {
hints: doc_hints list;
} [@@deriving to_yojson]
+type dependency_type = {
+ kind: string;
+ alert: string;
+} [@@deriving yojson]
+
type ref_node_data = {
node_type: node_type;
constraints: Value_checker.value_constraint list;
@@ -39,6 +44,8 @@ type ref_node_data = {
default_value: string option;
hidden: bool;
secret: bool;
+ kind: string list;
+ dependency: dependency_type option;
docs: docs;
} [@@deriving yojson]
diff --git a/src/util_reference_tree.ml b/src/util_reference_tree.ml
new file mode 100644
index 0000000..018489e
--- /dev/null
+++ b/src/util_reference_tree.ml
@@ -0,0 +1,133 @@
+
+open Reference_tree
+
+
+let node_is_tag node =
+ let data = Vytree.data_of_node node in
+ match data.node_type with
+ | `Tag -> true
+ | _ -> false
+
+let node_is_multi node =
+ let data = Vytree.data_of_node node in
+ data.multi
+
+let get_nodes ?(tag_value_placeholder="") (condition: t -> bool) rt =
+ let stored l =
+ match l with
+ | [] -> []
+ | x :: _ -> x
+ in
+ let func ((p, l), acc) rt =
+ match p with
+ | [] -> ((p, l), acc)
+ | _ ->
+ let v = stored l in
+ let v = (Vytree.name_of_node rt) :: v in
+ let acc =
+ if condition rt then
+ List.rev v :: acc
+ else
+ acc
+ in
+ let v =
+ if node_is_tag rt then
+ match tag_value_placeholder with
+ | "" -> v
+ | _ as s -> s :: v
+ else
+ v
+ in ((p, v::l), acc)
+ in
+ let ret = Vytree.fold_tree_with_path_and_stack func (([], []), []) rt in
+ List.rev ret
+
+let get_multi_nodes ?(tag_value_placeholder="") rt =
+ get_nodes ~tag_value_placeholder node_is_multi rt
+
+let get_multi_nodes_yojson ?(tag_value_placeholder="") rt =
+ let ret = get_multi_nodes ~tag_value_placeholder rt in
+ [%to_yojson: string list list] ret |> Yojson.Safe.to_string
+
+let get_tag_nodes ?(tag_value_placeholder="") rt =
+ get_nodes ~tag_value_placeholder node_is_tag rt
+
+let get_tag_nodes_yojson ?(tag_value_placeholder="") rt =
+ let ret = get_tag_nodes ~tag_value_placeholder rt in
+ [%to_yojson: string list list] ret |> Yojson.Safe.to_string
+
+let node_is_of_kind k rt =
+ let data = Vytree.data_of_node rt in
+ List.mem k data.kind
+
+let get_nodes_of_kind ?(tag_value_placeholder="") rt k =
+ get_nodes ~tag_value_placeholder (node_is_of_kind k) rt
+
+let get_nodes_of_kind_yojson ?(tag_value_placeholder="") rt k =
+ let ret = get_nodes_of_kind ~tag_value_placeholder rt k in
+ [%to_yojson: string list list] ret |> Yojson.Safe.to_string
+
+let node_dependency_of_kind k rt =
+ let data = Vytree.data_of_node rt in
+ match data.dependency with
+ | Some c when c.kind = k -> true
+ | _ -> false
+
+let get_rdeps_of_kind ?(tag_value_placeholder="") rt k =
+ get_nodes ~tag_value_placeholder (node_dependency_of_kind k) rt
+
+let get_rdeps_of_kind_yojson ?(tag_value_placeholder="") rt k =
+ let ret = get_rdeps_of_kind ~tag_value_placeholder rt k in
+ [%to_yojson: string list list] ret |> Yojson.Safe.to_string
+
+
+let get_nodes_data ?(tag_value_placeholder="") (data_opt: t -> string option) rt =
+ let stored l =
+ match l with
+ | [] -> []
+ | x :: _ -> x
+ in
+ let func ((p, l), acc) rt =
+ match p with
+ | [] -> ((p, l), acc)
+ | _ ->
+ let v = stored l in
+ let v = (Vytree.name_of_node rt) :: v in
+ let acc =
+ match data_opt rt with
+ | Some o -> (List.rev v, o) :: acc
+ | _ -> acc
+ in
+ let v =
+ if node_is_tag rt then
+ match tag_value_placeholder with
+ | "" -> v
+ | _ as s -> s :: v
+ else
+ v
+ in ((p, v::l), acc)
+ in
+ let ret = Vytree.fold_tree_with_path_and_stack func (([], []), []) rt in
+ List.rev ret
+
+let node_dependency_of_kind_opt k rt =
+ let data = Vytree.data_of_node rt in
+ match data.dependency with
+ | Some c when c.kind = k -> Some c.alert
+ | _ -> None
+
+let get_rdeps_of_kind_data ?(tag_value_placeholder="") rt k =
+ get_nodes_data ~tag_value_placeholder (node_dependency_of_kind_opt k) rt
+
+let get_rdeps_of_kind_data_yojson ?(tag_value_placeholder="") rt k =
+ let ret = get_rdeps_of_kind_data ~tag_value_placeholder rt k in
+ [%to_yojson: (string list * string) list] ret |> Yojson.Safe.to_string
+
+let get_path_owner reftree path =
+ if Util.is_empty path then None
+ else
+ if not ((Vytree.exists[@alert "-exn"]) reftree path) then None
+ else
+ let func data = data.owner in
+ (get_ceil_data[@alert "-exn"]) func reftree path
+
diff --git a/src/util_reference_tree.mli b/src/util_reference_tree.mli
new file mode 100644
index 0000000..605a58a
--- /dev/null
+++ b/src/util_reference_tree.mli
@@ -0,0 +1,16 @@
+
+open Reference_tree
+
+val get_multi_nodes : ?tag_value_placeholder:string -> t -> string list list
+val get_tag_nodes : ?tag_value_placeholder:string -> t -> string list list
+val get_nodes_of_kind : ?tag_value_placeholder:string -> t -> string -> string list list
+val get_rdeps_of_kind : ?tag_value_placeholder:string -> t -> string -> string list list
+val get_rdeps_of_kind_data : ?tag_value_placeholder:string -> t -> string -> (string list * string) list
+
+val get_multi_nodes_yojson : ?tag_value_placeholder:string -> t -> string
+val get_tag_nodes_yojson: ?tag_value_placeholder:string -> t -> string
+val get_nodes_of_kind_yojson : ?tag_value_placeholder:string -> t -> string -> string
+val get_rdeps_of_kind_yojson : ?tag_value_placeholder:string -> t -> string -> string
+val get_rdeps_of_kind_data_yojson : ?tag_value_placeholder:string -> t -> string -> string
+
+val get_path_owner : t -> string list -> string option
diff --git a/src/vytree.ml b/src/vytree.ml
index 6ecc867..3623dcb 100644
--- a/src/vytree.ml
+++ b/src/vytree.ml
@@ -281,15 +281,18 @@ let move node path position =
let node = delete node path in
insert ~position:position ~children:child.children node path child.data
+let is_terminal_node node =
+ match (children_of_node node) with
+ | [] -> true
+ | _ -> false
+
let is_terminal_path node path =
(* raises
[Empty_path] from get
*)
try
let n = get node path in
- match (children_of_node n) with
- | [] -> true
- | _ -> false
+ is_terminal_node n
with Nonexistent_path -> false
let fold_tree_with_path f (p', a) t =
@@ -315,7 +318,7 @@ let fold_tree_with_path f (p', a) t =
to fold_tree_with_path.
*)
-let fold_tree_with_path_and_list f ((p', v), a) t =
+let fold_tree_with_path_and_stack f ((p', v), a) t =
let rec fold_func f ((p', v), a) t =
let p =
match name_of_node t with
diff --git a/src/vytree.mli b/src/vytree.mli
index 448aa84..187b80f 100644
--- a/src/vytree.mli
+++ b/src/vytree.mli
@@ -92,10 +92,10 @@ val move : 'a t -> string list -> position -> 'a t
[@@alert exn "Not_found possible if position Before/After"]
[@@alert exn "Vytree.Insert_error"]
+val is_terminal_node : 'a t -> bool
val is_terminal_path : 'a t -> string list -> bool
[@@alert exn "Vytree.Empty_path"]
val fold_tree_with_path: (string list * 'acc -> 'b t -> string list * 'acc) -> string list * 'acc -> 'b t -> 'acc
-val fold_tree_with_path_and_list: ((string list * bool list) * 'acc -> 'b t ->
- (string list * bool list) * 'acc) -> (string list * bool list) * 'acc -> 'b t -> 'acc
+val fold_tree_with_path_and_stack: ((string list * 'a list) * 'acc -> 'b t -> (string list * 'a list) * 'acc) -> (string list * 'a list) * 'acc -> 'b t -> 'acc
generated by cgit v1.2.3 (git 2.39.1) at 2026-09-22 22:53:55 +0000