aboutsummaryrefslogtreecommitdiff
path: root/lib/configuration
diff options
context:
space:
mode:
Diffstat (limited to 'lib/configuration')
-rw-r--r--lib/configuration/expression_parser.mly33
-rw-r--r--lib/configuration/importConf.ml14
-rw-r--r--lib/configuration/importConf.mli10
-rw-r--r--lib/configuration/read_conf.ml178
4 files changed, 171 insertions, 64 deletions
diff --git a/lib/configuration/expression_parser.mly b/lib/configuration/expression_parser.mly
index 1761cce..9b97637 100644
--- a/lib/configuration/expression_parser.mly
+++ b/lib/configuration/expression_parser.mly
@@ -34,20 +34,25 @@ column_expr:
path_:
| COLUMN
- column = IDENT
- { ImportExpression.T.Path
- ImportDataTypes.Path.{ alias = None
- ; column = ImportDataTypes.Path.column_of_string column
- }
- }
-
- | COLUMN
- table = IDENT
- DOT
- column = IDENT
- { ImportExpression.T.Path
- ImportDataTypes.Path.{ alias = Some table
- ; column = ImportDataTypes.Path.column_of_string column}
+ (* The dot character is required as a separator between the table and the
+ colum, like in [:table.XX] but the table name can also contains [.]
+ (this is allowed in the toml configuration syntax, as long as the
+ identifier is quoted.
+
+ So we have to handle cases like [:foo.bar.XX]
+ *)
+ path = separated_nonempty_list(DOT, IDENT)
+ { let reversed_path = List.rev path in
+ (* reversed_path is nonempty, and we can take head and tail safely *)
+ let tail = List.tl reversed_path in
+ let alias = match tail with
+ | [] -> None
+ | tl -> Some (String.concat "." (List.rev tl))
+ in
+
+ ImportExpression.T.Path
+ ImportDataTypes.Path.{ alias
+ ; column = ImportDataTypes.Path.column_of_string (List.hd reversed_path)}
}
column_:
diff --git a/lib/configuration/importConf.ml b/lib/configuration/importConf.ml
index 2df24bd..4b49686 100644
--- a/lib/configuration/importConf.ml
+++ b/lib/configuration/importConf.ml
@@ -1,14 +1,22 @@
module TomlReader = Read_conf.Make (Helpers.Toml.Decode)
-let t_of_toml : Otoml.t -> (ImporterSyntax.t, string) result =
- fun toml ->
+type loader_context = TomlReader.loader_context = {
+ checkFile : string -> bool;
+ loadFile : string -> Otoml.t;
+}
+
+let t_of_toml :
+ context:loader_context -> Otoml.t -> (ImporterSyntax.t, string) result =
+ fun ~context toml ->
let version =
Otoml.find_or ~default:ImporterSyntax.latest_version toml
(Otoml.get_integer ~strict:false)
[ "version" ]
in
match version with
- | n when n = ImporterSyntax.latest_version -> TomlReader.read toml
+ | n when n = ImporterSyntax.latest_version -> begin
+ TomlReader.read context toml
+ end
| _ ->
Printf.eprintf "Unsuported version : %d\n" version;
exit 1
diff --git a/lib/configuration/importConf.mli b/lib/configuration/importConf.mli
index d2f65f2..7234499 100644
--- a/lib/configuration/importConf.mli
+++ b/lib/configuration/importConf.mli
@@ -1,4 +1,12 @@
-val t_of_toml : Otoml.t -> (ImporterSyntax.t, string) result
+type loader_context = {
+ checkFile : string -> bool;
+ loadFile : string -> Otoml.t;
+}
+
+val t_of_toml :
+ context:loader_context -> Otoml.t -> (ImporterSyntax.t, string) result
+(** [fileChecker] is called when a file is declared in the configuration. An
+ arror will be raised if the computation return false *)
val expression_from_string :
string -> (ImportDataTypes.Path.t ImportExpression.T.t, string) result
diff --git a/lib/configuration/read_conf.ml b/lib/configuration/read_conf.ml
index d406b0e..c3c78cc 100644
--- a/lib/configuration/read_conf.ml
+++ b/lib/configuration/read_conf.ml
@@ -178,14 +178,61 @@ module Make (S : Decoders.Decode.S) = struct
let ( >>= ) = S.( >>= )
let ( >|= ) = S.( >|= )
- class loader =
+ type loader_context = {
+ checkFile : string -> bool;
+ loadFile : string -> S.value;
+ }
+
+ type dataSet = S.value * (string * string) list
+
+ class loader (context : loader_context) =
object (self)
+ method path_checker : string S.decoder -> string S.decoder =
+ fun check ->
+ Decoders.Decoder.bind
+ (fun path ->
+ if context.checkFile path then Decoders.Decoder.pure path
+ else Decoders.Decoder.fail "Expected a path to an existing file")
+ check
+ (** Check if a file given in the configuration exists: an error is raised
+ if the function [checkFile] retun false.
+
+ In the unit tests, the effect is mapped to a function returning alway
+ true. *)
+
+ method keep : type a. a S.decoder -> (S.value * a) S.decoder =
+ fun decoder value -> S.map (fun v -> (value, v)) decoder value
+ (** [keep decoder] transform a decoder and keep the initial value with the
+ decoded value.
+
+ This helps to build custom error message, if we want to report an
+ error from a different place. *)
+
+ method load_resources : dataSet option S.decoder =
+ (* Do not accept dash in the keys, as the caracter is used to alias
+ the same file in differents mappings *)
+ let no_dash_decoder =
+ let* s = S.string in
+ match String.exists s ~f:(Char.equal '-') with
+ | true -> S.fail "Expected a key without '-'"
+ | false -> S.succeed s
+ in
+ let list_files_decoders =
+ self#keep (S.key_value_pairs' no_dash_decoder S.string)
+ in
+ let get_field = S.field "files" list_files_decoders in
+
+ let* result = S.map context.loadFile (self#path_checker S.string) in
+ let files = get_field result in
+ let dataSetResult = Result.map (fun v -> Some v) files in
+ S.from_result dataSetResult
+ (** Load an external file containing the list of files to include.*)
+
method parse_expression : type a.
?groups:a ImportExpression.T.t list ->
eq:(a -> a -> bool) ->
a ExpressionParser.path_builder ->
- S.value ->
- (a ImportExpression.T.t, S.value Decoders.Error.t) result =
+ a ImportExpression.T.t S.decoder =
fun ?(groups = []) ~eq path ->
S.string >>= fun v ->
match ExpressionParser.of_string path v with
@@ -202,41 +249,83 @@ module Make (S : Decoders.Decode.S) = struct
S.fail
"A group function cannot contains another group function")
- method source =
- let* file = S.field "file" S.string
- and* name = S.field "name" S.string
- and* tab = S.field_opt_or ~default:1 "tab" S.int in
- S.succeed { Table.file; name; tab }
-
- method external_ name =
- let* intern_key =
- S.field "intern_key"
- (self#parse_expression ~eq:Path.equal ExpressionParser.path)
- and* extern_key =
- S.field "extern_key"
- (self#parse_expression ~eq:Int.equal ExpressionParser.column)
- and* file = S.field "file" S.string
- and* tab = S.field_opt_or ~default:1 "tab" S.int
- and* allow_missing =
- S.field_opt_or ~default:false "allow_missing" S.bool
- in
+ method look_file :
+ dataset:dataSet option -> name:string -> string S.decoder =
+ fun ~dataset ~name ->
+ self#path_checker
+ (S.one_of
+ [
+ (* If the file is declared, use it *)
+ ("file", S.field "file" S.string);
+ ( "dataset",
+ (* Otherwise search in the data set *)
+
+ (* We work inside an option monad :
+ - Do we have a dataset
+ - Do we have a valid root name to look for
+ - De we have a match in the dataset
+ *)
+ let ( let* ) = Option.bind in
+ let element =
+ let* _, resources = dataset in
+ let* root =
+ match String.split_on_char ~sep:'-' name with
+ | hd :: _ -> Some hd
+ | _ -> None
+ in
+ let* elem = List.assoc_opt root resources in
+ Some elem
+ in
+ match (element, dataset) with
+ | Some value, _ -> S.succeed value
+ | None, Some (t, _) ->
+ let message = "Looking for \"" ^ name ^ "\"" in
+ S.fail_with (Decoders.Error.make ~context:t message)
+ | None, None -> S.fail "No dataset declared" );
+ ])
+
+ method source : dataSet option -> Table.t S.decoder =
+ fun dataset ->
+ (* The file shall either be present in the external, or be declared
+ in the dataset *)
+ let* name = S.field "name" S.string in
+ let* file = self#look_file ~dataset ~name
+ and* tab = S.field_opt_or ~default:1 "tab" S.int in
+ S.succeed { Table.file; Table.name; Table.tab }
- S.succeed
- ImporterSyntax.Extern.
- {
- intern_key;
- extern_key;
- target = { name; file; tab };
- allow_missing;
- match_rule = None;
- }
+ method external' :
+ dataSet option -> string -> ImporterSyntax.Extern.t S.decoder =
+ fun dataset name ->
+ let* intern_key =
+ S.field "intern_key"
+ (self#parse_expression ~eq:Path.equal ExpressionParser.path)
+ and* extern_key =
+ S.field "extern_key"
+ (self#parse_expression ~eq:Int.equal ExpressionParser.column)
+ and* file = self#look_file ~dataset ~name
+ and* tab = S.field_opt_or ~default:1 "tab" S.int
+ and* allow_missing =
+ S.field_opt_or ~default:false "allow_missing" S.bool
+ in
+
+ S.succeed
+ ImporterSyntax.Extern.
+ {
+ intern_key;
+ extern_key;
+ target = { name; file; tab };
+ allow_missing;
+ match_rule = None;
+ }
+ (** Load the configuration for an external file to link *)
method sheet =
(* Check the uniq property first, beecause the group functions need
to include the same expression (at least) *)
let* uniq =
S.field_opt_or ~default:[] "uniq"
- @@ S.list (self#parse_expression ~eq:Path.equal ExpressionParser.path)
+ @@ S.list
+ @@ self#parse_expression ~eq:Path.equal ExpressionParser.path
in
let* columns =
@@ -247,23 +336,27 @@ module Make (S : Decoders.Decode.S) = struct
and* filters =
S.field_opt_or ~default:[] "filters"
@@ S.list
- (self#parse_expression ~eq:Path.equal ~groups:uniq
- ExpressionParser.path)
+ @@ self#parse_expression ~eq:Path.equal ~groups:uniq
+ ExpressionParser.path
and* sort =
S.field_opt_or ~default:[] "sort"
@@ S.list
- (self#parse_expression ~eq:Path.equal ~groups:uniq
- ExpressionParser.path)
+ @@ self#parse_expression ~eq:Path.equal ~groups:uniq
+ ExpressionParser.path
in
S.succeed @@ fun version source externals locale ->
ImporterSyntax.
{ version; source; externals; columns; filters; sort; uniq; locale }
method conf =
- let* source = S.field "source" self#source
+ let* dataset : dataSet option =
+ S.field_opt_or ~default:None "dataset" self#load_resources
+ in
+
+ let* source = S.field "source" (self#source dataset)
and* externals =
S.field_opt_or ~default:[] "externals"
- (S.key_value_pairs_seq self#external_)
+ @@ S.key_value_pairs_seq (self#external' dataset)
and* locale = S.field_opt "locale" S.string in
let* sheet =
S.field "sheet" self#sheet >|= fun v -> v 1 source externals locale
@@ -272,15 +365,8 @@ module Make (S : Decoders.Decode.S) = struct
S.succeed sheet
end
- let read_file file =
- S.decode_file (new loader)#conf file
- |> Result.map_error (fun v ->
- let formatter = Format.str_formatter in
- Format.fprintf formatter "%a@." S.pp_error v;
- Format.flush_str_formatter ())
-
- let read toml =
- S.decode_value (new loader)#conf toml
+ let read context toml =
+ S.decode_value (new loader context)#conf toml
|> Result.map_error (fun v ->
let formatter = Format.str_formatter in
Format.fprintf formatter "%a@." S.pp_error v;
generated by cgit v1.2.3 (git 2.39.1) at 2025-04-19 18:22:44 +0000