diff options
| -rw-r--r-- | src/reference_tree.ml | 2 | ||||
| -rw-r--r-- | src/session.ml | 4 | ||||
| -rw-r--r-- | src/util.ml | 13 | ||||
| -rw-r--r-- | src/util.mli | 4 | ||||
| -rw-r--r-- | test/util_test.ml | 6 |
5 files changed, 19 insertions, 10 deletions
diff --git a/src/reference_tree.ml b/src/reference_tree.ml index 6f1a9c9..8c8e515 100644 --- a/src/reference_tree.ml +++ b/src/reference_tree.ml @@ -155,7 +155,7 @@ let has_illegal_characters name = in the reference tree *) let rec validate_path validators_dir node path = - let show_path p = Printf.sprintf "[%s]" @@ Util.string_of_path (List.rev p) in + let show_path p = Printf.sprintf "[%s]" @@ Util.string_of_list (List.rev p) in let rec aux node path acc = let data = Vytree.data_of_node node in match data.node_type with diff --git a/src/session.ml b/src/session.ml index 86374dd..90ab5c8 100644 --- a/src/session.ml +++ b/src/session.ml @@ -36,12 +36,12 @@ let make world client_app user = { let string_of_op op = match op with | CfgSet (path, value, _) -> - let path_str = Util.string_of_path path in + let path_str = Util.string_of_list path in (match value with | None -> Printf.sprintf "set %s" path_str | Some v -> Printf.sprintf "set %s \"%s\"" path_str v) | CfgDelete (path, value) -> - let path_str = Util.string_of_path path in + let path_str = Util.string_of_list path in (match value with | None -> Printf.sprintf "delete %s" path_str | Some v -> Printf.sprintf "delete %s \"%s\"" path_str v) diff --git a/src/util.ml b/src/util.ml index de85e3e..c4bbd96 100644 --- a/src/util.ml +++ b/src/util.ml @@ -1,5 +1,6 @@ (** The unavoidable module for functions that don't fit anywhere else *) +(** Find a child node in xml-lite *) let find_xml_child name xml = let find_aux e = match e with @@ -10,17 +11,23 @@ let find_xml_child name xml = | Xml.Element (_, _, children) -> Vylist.find find_aux children | Xml.PCData _ -> None -(* Dirty pretty printer *) -let string_of_path path = +(** Convert a list of strings to a string of unquoted, space separated words *) +let string_of_list ss = let rec aux xs acc = match xs with | [] -> acc | x :: xs' -> aux xs' (Printf.sprintf "%s %s" acc x) in - match path with + match ss with | [] -> "" | x :: xs -> Printf.sprintf "%s%s" x (aux xs "") +(** Convert a list of strings to JSON *) +let json_of_list ss = + let ss = List.map (fun x -> `String x) ss in + Yojson.Safe.to_string (`List ss) + +(** Convert a relative path to an absolute path based on the current working directory *) let absolute_path relative_path = FilePath.make_absolute (Sys.getcwd ()) relative_path diff --git a/src/util.mli b/src/util.mli index 68d0094..4c11d9e 100644 --- a/src/util.mli +++ b/src/util.mli @@ -1,6 +1,8 @@ val find_xml_child : string -> Xml.xml -> Xml.xml option -val string_of_path : string list -> string +val string_of_list : string list -> string + +val json_of_list : string list -> string val absolute_path : FilePath.filename -> FilePath.filename diff --git a/test/util_test.ml b/test/util_test.ml index 58fd6e9..2f5bf5d 100644 --- a/test/util_test.ml +++ b/test/util_test.ml @@ -14,15 +14,15 @@ let test_find_xml_child_nonexistent test_ctxt = let elem = Xml.Element ("foo", [], [Xml.Element ("quux", [], [])]) in assert_equal (find_xml_child "bar" elem) None -let test_string_of_path test_ctxt = +let test_string_of_list test_ctxt = let path = ["foo"; "bar"; "baz"] in - assert_equal (String.trim (string_of_path path)) "foo bar baz" + assert_equal (String.trim (string_of_list path)) "foo bar baz" let suite = "Util tests" >::: [ "test_find_xml_child_existent" >:: test_find_xml_child_existent; "test_find_xml_child_nonexistent" >:: test_find_xml_child_nonexistent; - "test_string_of_path" >:: test_string_of_path; + "test_string_of_path" >:: test_string_of_list; ] let () = |