diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/reference_tree.ml | 13 | ||||
-rw-r--r-- | src/reference_tree.mli | 4 | ||||
-rw-r--r-- | src/util.ml | 3 | ||||
-rw-r--r-- | src/util.mli | 2 |
4 files changed, 22 insertions, 0 deletions
diff --git a/src/reference_tree.ml b/src/reference_tree.ml index 26b14b9..6f1a9c9 100644 --- a/src/reference_tree.ml +++ b/src/reference_tree.ml @@ -34,6 +34,8 @@ let default_data = { secret = false; } +let default = Vytree.make default_data "root" + (* Loading from XML *) let node_type_of_string s = @@ -120,6 +122,17 @@ let load_from_xml reftree file = | Xml.File_not_found msg -> raise (Bad_interface_definition msg) | Xml.Error e -> raise (Bad_interface_definition (Xml.error e)) +let load_interface_definitions dir = + let relative_paths = FileUtil.ls dir in + let absolute_paths = + try Ok (List.map Util.absolute_path relative_paths) + with Sys_error no_dir_msg -> Error no_dir_msg + in + try match absolute_paths with + | Ok paths -> Ok (List.fold_left load_from_xml default paths) + | Error msg -> Error msg + with Bad_interface_definition msg -> Error msg + (* Validation function *) let has_illegal_characters name = diff --git a/src/reference_tree.mli b/src/reference_tree.mli index f9b4b5e..6db696a 100644 --- a/src/reference_tree.mli +++ b/src/reference_tree.mli @@ -20,8 +20,12 @@ type t = ref_node_data Vytree.t val default_data : ref_node_data +val default : t + val load_from_xml : t -> string -> t +val load_interface_definitions : string -> (t, string) result + val validate_path : string -> t -> string list -> string list * string option val is_multi : t -> string list -> bool diff --git a/src/util.ml b/src/util.ml index 2bac3d6..afa0ef3 100644 --- a/src/util.ml +++ b/src/util.ml @@ -25,3 +25,6 @@ let substitute_default o d = match o with | None -> d | Some v -> v + +let absolute_path relative_path = + FilePath.make_absolute (Sys.getcwd ()) relative_path diff --git a/src/util.mli b/src/util.mli index 7d78a15..46fac71 100644 --- a/src/util.mli +++ b/src/util.mli @@ -3,3 +3,5 @@ val find_xml_child : string -> Xml.xml -> Xml.xml option val string_of_path : string list -> string val substitute_default : 'a option -> 'a -> 'a + +val absolute_path : FilePath.filename -> FilePath.filename |