From 9e2dbe43abe97c4e60b158e5fa52172468a2afb8 Mon Sep 17 00:00:00 2001 From: Sébastien Dailly Date: Thu, 13 Mar 2025 20:17:51 +0100 Subject: Declare the files to load from an external configuration file --- lib/configuration/expression_parser.mly | 33 +++--- lib/configuration/importConf.ml | 14 ++- lib/configuration/importConf.mli | 10 +- lib/configuration/read_conf.ml | 178 +++++++++++++++++++++++--------- 4 files changed, 171 insertions(+), 64 deletions(-) (limited to 'lib/configuration') 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; -- cgit v1.2.3