summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/directories.ml42
-rw-r--r--src/directories.mli11
2 files changed, 53 insertions, 0 deletions
diff --git a/src/directories.ml b/src/directories.ml
new file mode 100644
index 0000000..625b2e3
--- /dev/null
+++ b/src/directories.ml
@@ -0,0 +1,42 @@
+module F = Filename
+module FU = FileUtil
+
+type t = {
+ components: string;
+ validators: string;
+ migrators: string;
+ component_definitions: string;
+ interface_definitions: string;
+}
+
+let relative_dirs = {
+ components = "components";
+ validators = "validators";
+ migrators = "migration";
+ component_definitions = "components";
+ interface_definitions = "interfaces";
+}
+
+let make conf =
+ let open Vyconf_config in
+ {
+ components = F.concat conf.program_dir relative_dirs.components;
+ validators = F.concat conf.program_dir relative_dirs.validators;
+ migrators = F.concat conf.program_dir relative_dirs.migrators;
+ component_definitions = F.concat conf.data_dir relative_dirs.component_definitions;
+ interface_definitions = F.concat conf.data_dir relative_dirs.interface_definitions
+ }
+
+(** Check if required directories exist
+ We do not try to check if they are readable at this point, it's just to fail early
+ if they don't even exist and we shouldn't bother trying
+ *)
+let test dirs =
+ let check_dir d =
+ if FU.test FU.Is_dir d then ()
+ else raise (Failure (Printf.sprintf "%s does not exist or is not a directory" d)) in
+ let l = [dirs.components; dirs.validators; dirs.migrators;
+ dirs.component_definitions; dirs.interface_definitions] in
+ try
+ List.iter check_dir l; Ok ()
+ with Failure msg -> Error msg
diff --git a/src/directories.mli b/src/directories.mli
new file mode 100644
index 0000000..623d6f1
--- /dev/null
+++ b/src/directories.mli
@@ -0,0 +1,11 @@
+type t = {
+ components: string;
+ validators: string;
+ migrators: string;
+ component_definitions: string;
+ interface_definitions: string;
+}
+
+val make : Vyconf_config.t -> t
+
+val test : t -> (unit, string) result