From 27a2d5ad1afb7baac317672620ff138f9802ccbf Mon Sep 17 00:00:00 2001
From: Shon Feder <abathologist@gmail.com>
Date: Tue, 17 Jan 2017 03:31:28 -0500
Subject: T231: Add a function for loading interface definitions from a
 directory (#5)

* T231: Load directory of interface definitions

* T231: Add ounit package to merlin config

* T231: Add tests for loading dir of definitions

* squash! T231: Load directory of interface definitions

* squash! T231: Add tests for loading dir of definitions
---
 src/reference_tree.ml  | 13 +++++++++++++
 src/reference_tree.mli |  4 ++++
 src/util.ml            |  3 +++
 src/util.mli           |  2 ++
 4 files changed, 22 insertions(+)

(limited to 'src')

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
-- 
cgit v1.2.3