diff options
author | Daniil Baturin <daniil@baturin.org> | 2015-02-08 21:16:47 +0600 |
---|---|---|
committer | Daniil Baturin <daniil@baturin.org> | 2015-02-08 21:16:47 +0600 |
commit | 72569f0c5562d7ba7522b6456241567c0fcd32ac (patch) | |
tree | 352c9c1e54eb338a3cb6d87fdbaff7a06b64e4b7 | |
parent | 16ab9644dd7421a7012c75302439d4819a169569 (diff) | |
download | vyconf-72569f0c5562d7ba7522b6456241567c0fcd32ac.tar.gz vyconf-72569f0c5562d7ba7522b6456241567c0fcd32ac.zip |
Use record instead of tuple for easier updates.
Preserve original children order in insertions.
-rw-r--r-- | src/vyconf_tree.ml | 51 |
1 files changed, 25 insertions, 26 deletions
diff --git a/src/vyconf_tree.ml b/src/vyconf_tree.ml index f634d55..08bb652 100644 --- a/src/vyconf_tree.ml +++ b/src/vyconf_tree.ml @@ -1,53 +1,52 @@ -type 'a vyconf_tree = Node of string * 'a * ('a vyconf_tree list) +type 'a vyconf_tree = { + name: string; + data: 'a; + children: 'a vyconf_tree list +} exception Empty_path exception Duplicate_child exception Nonexistent_path -let name_of_node (Node (name, _, _)) = name - -let children_of_node (Node (_, _, children)) = children - -let data_of_node (Node (_, data, _)) = data - -let destructure_node node = - name_of_node node, - data_of_node node, - children_of_node node +let make name data = { name = name; data = data; children = [] } let rec find_child_in_list children name = match children with | [] -> None - | c :: cs -> if (name_of_node c) = name then (Some c) + | c :: cs -> if c.name = name then (Some c) else find_child_in_list cs name -let find_child node name = - find_child_in_list (children_of_node node) name - let rec remove_child_from_list children name = match children with | [] -> [] - | c :: cs -> if (name_of_node c) = name then cs + | c :: cs -> if c.name = name then cs else c :: (remove_child_from_list cs name) +let rec replace_child_in_list children child = + match children with + | [] -> [] + | c :: cs -> if c.name = child.name then child :: cs + else replace_child_in_list cs child + let extract_child children name = find_child_in_list children name, remove_child_from_list children name let insert_immediate_child node name data = - let new_node = Node (name, data, []) in - let (old_name, old_data, old_children) = destructure_node node in - Node (old_name, old_data, new_node :: old_children) + let new_node = make name data in + let children' = node.children @ [new_node] in + { node with children = children' } let adopt_child node child = - let (old_name, old_data, old_children) = destructure_node node in - Node (old_name, old_data, child :: old_children) + { node with children = (node.children @ [child]) } let replace_child node child = - let (old_name, old_data, old_children) = destructure_node node in - let child_name = name_of_node child in - let old_children' = remove_child_from_list old_children child_name in - Node (old_name, old_data, child :: old_children') + let children = node.children in + let children' = replace_child_in_list children child in + { node with children = children' } + +let find_child node name = + find_child_in_list node.children name let rec insert_child default_data node path data = match path with @@ -61,6 +60,6 @@ let rec insert_child default_data node path data = if names = [] then raise Duplicate_child else replace_child node new_node | None -> - let next_child' = Node (name, default_data, []) in + 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 |