Introduce modules in toml config (#663)

build_system/clerk_config.ml

@@ -18,7 +18,6 @@ open Catala_utils
 open Otoml
 
 type modul = {
-  language : Global.backend_lang;
   module_uses : (string * string option) list;
   includes : string list;
 }
@@ -38,9 +37,9 @@ let default =
     modules = String.Map.empty;
   }
 
-let parse_module_uses modul =
+let parse_module_uses ~fname ~name modul =
   match find_opt modul (get_array get_value) ["module_uses"] with
-  | None -> []
+  | None | (exception _) -> [] (* [opt] is a lie. *)
   | Some module_uses ->
     List.map
       (function
@@ -50,57 +49,87 @@ let parse_module_uses modul =
           module_name, Some module_alias
         | _ ->
           Message.error
-            "Invalid module use: expected a module name as string or an array \
-             of two strings (module name and its alias)")
+            "While parsing %a: in module @{<italic>%s@}, invalid value for \
+             @{<red>module_uses@}. Expected a module name as string or an \
+             array of two strings (module name and its alias)."
+            File.format fname name)
       module_uses
 
-let parse_name_and_language modul =
-  let name = Helpers.find_string_exn modul ["name"] in
-  let lang =
-    let lang_opt =
-      Helpers.find_string_opt modul ["language"]
-      |> Option.map String.uncapitalize_ascii
+let check_module_sanity ~fname modul =
+  match modul with
+  | TomlTable kvs ->
+    let format_module_name ppf =
+      match Helpers.find_string_opt modul ["name"] with
+      | None | (exception _) -> () (* [opt] is a lie. *)
+      | Some name -> Format.fprintf ppf "in module @{<italic>%s@}, " name
     in
-    match lang_opt with
-    | None -> Message.error "Missing " "language" " field in configuration"
-    | Some lang -> lang
-  in
-  match List.assoc_opt lang Cli.languages with
-  | None ->
-    Message.error
-      "Unexpected language '%s' for module @{<bold>%s@}, valid entries are: \
-       @[<h>%a@]"
-      lang name
-      Format.(
-        pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt ",@ ") pp_print_string)
-      (List.map fst Cli.languages)
-  | Some x -> name, x
-
-let find_and_parse_modules_exn toml =
+    List.iter
+      (function
+        | "name", TomlString _ -> ()
+        | "name", _ ->
+          Message.delayed_error ()
+            "While parsing %a: invalid value for key @{<red>name@}.@\n\
+             Expected a direct string." File.format fname
+        | "module_uses", TomlArray _ -> (* checked in [parse_module_uses] *) ()
+        | "module_uses", _ ->
+          Message.delayed_error ()
+            "While parsing %a: %tinvalid value for key @{<red>module_uses@}.@\n\
+             It must be an array." File.format fname format_module_name
+        | "includes", TomlArray srcs ->
+          let only_strings =
+            List.for_all (function TomlString _ -> true | _ -> false) srcs
+          in
+          if not only_strings then
+            Message.delayed_error ()
+              "While parsing %a: %tinvalid value for key @{<red>includes@}.@\n\
+               It must only contain direct strings." File.format fname
+              format_module_name
+        | "includes", _ ->
+          Message.delayed_error ()
+            "While parsing %a: %tinvalid content for key @{<red>includes@}.@\n\
+             Expected an array of strings." File.format fname format_module_name
+        | k, _ ->
+          Message.delayed_error ()
+            "While parsing %a: %tunexpected key @{<red>%S@}.@\n\
+             Allowed keys are: 'name', 'module_uses' and 'includes'."
+            File.format fname format_module_name k)
+      kvs
+  | _ ->
+    Message.delayed_error ()
+      "While parsing %a: invalid module definition, expected a table."
+      File.format fname
+
+let find_and_parse_modules_exn ~fname toml =
   let modules = find toml (get_array get_value) ["module"] in
   let parse_module modul =
-    let name, language = parse_name_and_language modul in
-    let module_uses = parse_module_uses modul in
+    let () = check_module_sanity ~fname modul in
+    let name = Helpers.find_string_exn modul ["name"] in
+    let module_uses = parse_module_uses ~fname ~name modul in
     let includes =
-      Helpers.find_strings_opt modul ["includes"] |> Option.value ~default:[]
+      try
+        Helpers.find_strings_opt modul ["includes"] |> Option.value ~default:[]
+      with _ ->
+        (* opt is a lie, the error will be triggered later on by the sanity
+           check. *)
+        []
     in
-    name, { language; module_uses; includes }
+    name, { module_uses; includes }
   in
-  List.map parse_module modules |> String.Map.of_list
+  Message.with_delayed_errors
+  @@ fun () -> List.map parse_module modules |> String.Map.of_list
 
-let toml_to_config toml =
+let toml_to_config ~fname toml =
   {
     catala_opts = Helpers.find_strings_exn toml ["build"; "catala_opts"];
     build_dir = Helpers.find_string_exn toml ["build"; "build_dir"];
     include_dirs = Helpers.find_strings_exn toml ["project"; "include_dirs"];
-    modules = find_and_parse_modules_exn toml;
+    modules = find_and_parse_modules_exn ~fname toml;
   }
 
-let module_to_toml name { language; module_uses; includes } =
+let module_to_toml name { module_uses; includes } =
   table
     [
       "name", string name;
-      "language", string (Cli.language_code language);
       ( "module_uses",
         array
           (List.map
@@ -190,7 +219,7 @@ let read f =
         ~pos:(Pos.from_info f li col li (col + 1))
         "Error in Clerk configuration:@ %a" Format.pp_print_text msg
   in
-  toml_to_config (join f default_toml toml)
+  toml_to_config ~fname:f (join f default_toml toml)
 
 let write f t =
   let toml = config_to_toml t in

build_system/clerk_config.mli

@@ -17,7 +17,6 @@
 open Catala_utils
 
 type modul = {
-  language : Global.backend_lang;
   module_uses : (string * string option) list;
   includes : string list;
 }

build_system/clerk_driver.ml

@@ -1128,6 +1128,9 @@ let main () =
     if Catala_utils.Global.options.debug then
       Printexc.print_raw_backtrace stderr bt;
     exit Cmd.Exit.some_error
+  | Message.CompilerErrors contents ->
+    List.iter (fun c -> Message.Content.emit c Error) contents;
+    exit Cmd.Exit.some_error
   | Sys_error msg ->
     let bt = Printexc.get_raw_backtrace () in
     Message.Content.emit