Move vytree to its own subdir.

2 files changed, 99 insertions, 0 deletions

diff --git a/src/vytree/vytree.ml b/src/vytree/vytree.ml
new file mode 100644
index 0000000..6a97211
--- /dev/null
+++ b/src/vytree/vytree.ml
@@ -0,0 +1,80 @@
+type 'a	vyconf_tree = {
+    name: string;
+    data: 'a;
+    children: 'a vyconf_tree list
+}
+
+type 'a t = 'a vyconf_tree
+
+exception Empty_path
+exception Duplicate_child
+exception Nonexistent_path
+
+let make name data = { name = name; data = data; children = [] }
+
+let make_full name data children = { name = name; data = data; children = children }
+
+let name_of_node node = node.name
+let data_of_node node = node.data
+let children_of_node node = node.children
+
+let insert_immediate_child node name data =
+    let new_node = make name data in
+    let children' = node.children @ [new_node] in
+    { node with children = children' }
+
+let delete_immediate_child node name =
+    let children' = Vylist.remove (fun x -> x.name = name) node.children in
+    { node with children = children' }
+
+let adopt_child node child =
+    { node with children = (node.children @ [child]) }
+
+let replace_child node child =
+    let children = node.children in
+    let name = child.name in
+    let children' = Vylist.replace (fun x -> x.name = name) child children in
+    { node with children = children' }
+
+let find_child node name =
+    Vylist.find (fun x -> x.name = name) node.children
+
+let rec extract_names children =
+    List.map (fun x -> x.name) children
+
+let list_children node =
+    extract_names node.children
+
+let rec insert_child default_data node path data =
+    match path with
+    | [] -> raise Empty_path
+    | [name] ->
+        begin
+            (* Check for duplicate item *)
+            let last_child = find_child node name in
+            match last_child with
+            | None -> insert_immediate_child node name data
+            | (Some _) -> raise Duplicate_child
+        end
+    | name :: names ->
+        let next_child = find_child node name in
+        match next_child with
+        | Some next_child' ->
+            let new_node = insert_child default_data next_child' names data in
+            replace_child node new_node
+        | None ->
+            let next_child' = make name default_data in
+            let new_node = insert_child default_data next_child' names data in
+            adopt_child node new_node
+
+let rec delete_child node path =
+    match path with
+    | [] -> raise Empty_path
+    | [name] -> delete_immediate_child node name
+    | name :: names ->
+        let next_child = find_child node name in
+        match next_child with
+        | None -> raise Nonexistent_path
+        | Some next_child' -> 
+            let new_node = delete_child next_child' names in
+            replace_child node new_node
diff --git a/src/vytree/vytree.mli b/src/vytree/vytree.mli
new file mode 100644
index 0000000..1b42de7
--- /dev/null
+++ b/src/vytree/vytree.mli
@@ -0,0 +1,19 @@
+type 'a t
+
+exception Empty_path
+exception Duplicate_child
+exception Nonexistent_path
+
+val make : string -> 'a -> 'a t
+val make_full : string -> 'a -> ('a t) list -> 'a t
+
+val name_of_node : 'a t -> string
+val data_of_node : 'a t -> 'a
+val children_of_node : 'a t -> 'a t list
+
+val insert_child :
+  'a -> 'a t -> string list -> 'a -> 'a t
+
+val delete_child : 'a t -> string list -> 'a t
+
+val list_children : 'a t -> string list