diff options
Diffstat (limited to 'lib/configuration/read_conf.ml')
| -rw-r--r-- | lib/configuration/read_conf.ml | 178 |
1 files changed, 132 insertions, 46 deletions
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; |