From b76125fe449daa259c1aacad2c21c0681a39d3f9 Mon Sep 17 00:00:00 2001 From: Daniil Baturin Date: Thu, 14 Feb 2019 23:41:19 +0100 Subject: Add functions for copying and moving nodes. --- src/vytree.ml | 21 +++++++++++++++------ src/vytree.mli | 6 +++++- test/vytree_test.ml | 29 +++++++++++++++++++++++++++++ 3 files changed, 49 insertions(+), 7 deletions(-) diff --git a/src/vytree.ml b/src/vytree.ml index 57c3612..a3e2750 100644 --- a/src/vytree.ml +++ b/src/vytree.ml @@ -11,7 +11,6 @@ exception Duplicate_child exception Nonexistent_path exception Insert_error of string - let make data name = { name = name; data = data; children = [] } let make_full data name children = { name = name; data = data; children = children } @@ -20,8 +19,8 @@ let name_of_node node = node.name let data_of_node node = node.data let children_of_node node = node.children -let insert_immediate ?(position=Default) node name data = - let new_node = make data name in +let insert_immediate ?(position=Default) node name data children = + let new_node = make_full data name children in let children' = match position with | Default -> new_node :: node.children @@ -69,19 +68,19 @@ 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 ?(position=Default) node path data = +let rec insert ?(position=Default) ?(children=[]) node path data = match path with | [] -> raise Empty_path | [name] -> (let last_child = find node name in match last_child with - | None -> insert_immediate ~position:position node name data + | None -> insert_immediate ~position:position node name data children | (Some _) -> raise Duplicate_child) | name :: names -> let next_child = find node name in match next_child with | Some next_child' -> - let new_node = insert ~position:position next_child' names data in + let new_node = insert ~position:position ~children:children next_child' names data in replace node new_node | None -> raise (Insert_error "Path does not exist") @@ -181,3 +180,13 @@ let sorted_children_of_node cmp node = let names = list_children node in let names = List.sort cmp names in List.map (find_or_fail node) names + +let copy node old_path new_path = + if exists node new_path then raise Duplicate_child else + let child = get node old_path in + insert ~position:End ~children:child.children node new_path child.data + +let move node path position = + let child = get node path in + let node = delete node path in + insert ~position:position ~children:child.children node path child.data diff --git a/src/vytree.mli b/src/vytree.mli index 556ca77..451e130 100644 --- a/src/vytree.mli +++ b/src/vytree.mli @@ -19,7 +19,7 @@ val find_or_fail : 'a t -> string -> 'a t val adopt : 'a t -> 'a t -> 'a t -val insert : ?position:position -> 'a t -> string list -> 'a -> 'a t +val insert : ?position:position -> ?children:('a t list) -> 'a t -> string list -> 'a -> 'a t val insert_multi_level : 'a -> 'a t -> string list -> string list -> 'a -> 'a t @@ -44,3 +44,7 @@ val exists : 'a t -> string list -> bool val children_of_path : 'a t -> string list -> string list val sorted_children_of_node : (string -> string -> int) -> 'a t -> ('a t) list + +val copy : 'a t -> string list -> string list -> 'a t + +val move : 'a t -> string list -> position -> 'a t diff --git a/test/vytree_test.ml b/test/vytree_test.ml index 23c52ce..6133fb3 100644 --- a/test/vytree_test.ml +++ b/test/vytree_test.ml @@ -164,6 +164,32 @@ let test_merge_children_has_duplicates test_ctxt = assert_equal (list_children node') ["foo"; "quux"]; assert_equal (get node' ["foo"] |> list_children) ["bar"; "baz"] +let test_copy test_ctxt = + let node = make 0 "root" in + let node = insert node ["foo"] 1 in + let node = insert node ["foo"; "bar"] 1 in + let node = copy node ["foo"] ["quux"] in + assert_equal (list_children node) ["foo"; "quux"]; + assert_equal (get node ["quux"] |> list_children) ["bar"] + +let test_move_before test_ctxt = + let node = make 0 "root" in + let node = insert node ["foo"] 1 in + let node = insert ~position:End node ["bar"] 1 in + let node = insert node ["bar"; "quux"] 1 in + let node = move node ["bar"] (Before "foo") in + assert_equal (list_children node) ["bar"; "foo"]; + assert_equal (get node ["bar"] |> list_children) ["quux"] + +let test_move_after test_ctxt = + let node = make 0 "root" in + let node = insert node ["bar"] 1 in + let node = insert node ["bar"; "quux"] 1 in + let node = insert ~position:End node ["foo"] 1 in + let node = move node ["bar"] (After "foo") in + assert_equal (list_children node) ["foo"; "bar"]; + assert_equal (get node ["bar"] |> list_children) ["quux"] + let suite = "VyConf tree tests" >::: [ "test_make_node" >:: test_make_node; @@ -187,6 +213,9 @@ let suite = "test_get_data" >:: test_get_data; "test_merge_children_has_duplicates" >:: test_merge_children_has_duplicates; "test_merge_children_no_duplicates" >:: test_merge_children_no_duplicates; + "test_copy" >:: test_copy; + "test_move_before" >:: test_move_before; + "test_move_after" >:: test_move_after; ] let () = -- cgit v1.2.3