diff options
| -rw-r--r-- | src/vytree.ml | 20 | ||||
| -rw-r--r-- | src/vytree.mli | 3 | ||||
| -rw-r--r-- | test/vyconf_tree_test.ml | 28 |
3 files changed, 27 insertions, 24 deletions
diff --git a/src/vytree.ml b/src/vytree.ml index 6eccc55..728e26d 100644 --- a/src/vytree.ml +++ b/src/vytree.ml @@ -11,6 +11,7 @@ type node_type = Leaf | Tag | Other exception Empty_path exception Duplicate_child exception Nonexistent_path +exception Insert_error of string let make data name = { name = name; data = data; children = [] } @@ -59,26 +60,27 @@ let rec do_with_child fn node path = let new_node = do_with_child fn next_child names in replace node new_node -let rec insert default_data node path data = - match path with - | [] -> raise Empty_path - | [name] -> +let rec insert node path data_list = + match (path, data_list) with + | ([], _) -> raise Empty_path + | (_ :: _, []) -> raise (Insert_error "No data found") + | ([name], [datum]) -> begin (* Check for duplicate item *) let last_child = find node name in match last_child with - | None -> insert_immediate node name data + | None -> insert_immediate node name datum | (Some _) -> raise Duplicate_child end - | name :: names -> + | (name :: names, datum :: data) -> let next_child = find node name in match next_child with | Some next_child' -> - let new_node = insert default_data next_child' names data in + let new_node = insert next_child' names data in replace node new_node | None -> - let next_child' = make default_data name in - let new_node = insert default_data next_child' names data in + let next_child' = make datum name in + let new_node = insert next_child' names data in adopt node new_node let delete node path = diff --git a/src/vytree.mli b/src/vytree.mli index d268db4..cebbcde 100644 --- a/src/vytree.mli +++ b/src/vytree.mli @@ -3,6 +3,7 @@ type 'a t exception Empty_path exception Duplicate_child exception Nonexistent_path +exception Insert_error of string type position = Before of string | After of string | Default @@ -15,7 +16,7 @@ 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 : 'a -> 'a t -> string list -> 'a -> 'a t +val insert : 'a t -> string list -> 'a list -> 'a t val delete : 'a t -> string list -> 'a t diff --git a/test/vyconf_tree_test.ml b/test/vyconf_tree_test.ml index 14dd14b..26d350b 100644 --- a/test/vyconf_tree_test.ml +++ b/test/vyconf_tree_test.ml @@ -17,7 +17,7 @@ let test_make_node test_ctxt = children list *) let test_insert_immediate_child test_ctxt = let node = make () "root" in - let node' = insert () node ["foo"] () in + let node' = insert node ["foo"] [()] in assert_equal (children_of_node node') [make () "foo"] @@ -25,8 +25,8 @@ let test_insert_immediate_child test_ctxt = end of the children list *) let test_insert_multiple_children test_ctxt = let node = make () "root" in - let node' = insert () node ["foo"] () in - let node'' = insert () node' ["bar"] () in + let node' = insert node ["foo"] [()] in + let node'' = insert node' ["bar"] [()] in assert_equal (children_of_node node'') [make () "bar"; make () "foo"] @@ -34,7 +34,7 @@ let test_insert_multiple_children test_ctxt = two levels deep *) let test_insert_multi_level test_ctxt = let node = make () "root" in - let node' = insert () node ["foo"; "bar"] () in + let node' = insert node ["foo"; "bar"] [(); ()] in let bar = make () "bar" in let foo = make_full () "foo" [bar] in let root = make_full () "root" [foo] in @@ -43,28 +43,28 @@ let test_insert_multi_level test_ctxt = (* Inserting duplicate child fails *) let test_insert_duplicate_child test_ctxt = let node = make () "root" in - let node' = insert () node ["foo"] () in - assert_raises Duplicate_child (fun () -> insert () node' ["foo"] ()) + let node' = insert node ["foo"] [()] in + assert_raises Duplicate_child (fun () -> insert node' ["foo"] [()]) (* list_children correctly returns a list of children names *) let test_list_children test_ctxt = let node = make () "root" in - let node' = insert () node ["foo"] () in - let node'' = insert () node' ["bar"] () in + let node' = insert node ["foo"] [()] in + let node'' = insert node' ["bar"] [()] in assert_equal (list_children node'') ["bar"; "foo"] (* Deleting a child, well, deletes it *) let test_delete_immediate_child test_ctxt = let node = make () "root" in - let node' = insert () node ["foo"] () in + let node' = insert node ["foo"] [()] in let node'' = delete node' ["foo"] in assert_equal node node'' (* Deleting a child at multi-level path works *) let test_delete_multi_level test_ctxt = let node = make () "root" in - let node' = insert () node ["foo"; "bar"] () in - let foo_node = insert () node ["foo"] () in + let node' = insert node ["foo"; "bar"] [(); ()] in + let foo_node = insert node ["foo"] [()] in let node'' = delete node' ["foo"; "bar"] in assert_equal node'' foo_node @@ -76,13 +76,13 @@ let test_delete_nonexistent test_ctxt = (* get_child works with immediate children *) let test_get_immediate_child test_ctxt = let node = make () "root" in - let node' = insert () node ["foo"] () in + let node' = insert node ["foo"] [()] in assert_equal (name_of_node (get node' ["foo"])) "foo" (* get_child works with multi-level paths *) let test_get_child_multilevel test_ctxt = let node = make () "root" in - let node' = insert () node ["foo"; "bar"] () in + let node' = insert node ["foo"; "bar"] [(); ()] in assert_equal (name_of_node (get node' ["foo"; "bar"])) "bar" (* get_child raises Nonexistent_path for non-existent paths *) @@ -93,7 +93,7 @@ let test_get_child_nonexistent test_ctxt = (* update works *) let test_update test_ctxt = let node = make 0 "root" in - let node = insert 0 node ["foo"] 1 in + let node = insert node ["foo"] [1] in assert_equal (data_of_node (get (update node ["foo"] 9) ["foo"])) 9 let suite = |