mirror of
https://github.com/CatalaLang/catala.git
synced 2024-09-19 16:28:12 +03:00
Improve error reporting and remove language
This commit is contained in:
parent
4b0967d3c5
commit
f7f76e26ae
@ -18,7 +18,6 @@ open Catala_utils
|
|||||||
open Otoml
|
open Otoml
|
||||||
|
|
||||||
type modul = {
|
type modul = {
|
||||||
language : Global.backend_lang;
|
|
||||||
module_uses : (string * string option) list;
|
module_uses : (string * string option) list;
|
||||||
includes : string list;
|
includes : string list;
|
||||||
}
|
}
|
||||||
@ -38,9 +37,9 @@ let default =
|
|||||||
modules = String.Map.empty;
|
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
|
match find_opt modul (get_array get_value) ["module_uses"] with
|
||||||
| None -> []
|
| None | (exception _) -> [] (* [opt] is a lie. *)
|
||||||
| Some module_uses ->
|
| Some module_uses ->
|
||||||
List.map
|
List.map
|
||||||
(function
|
(function
|
||||||
@ -50,57 +49,87 @@ let parse_module_uses modul =
|
|||||||
module_name, Some module_alias
|
module_name, Some module_alias
|
||||||
| _ ->
|
| _ ->
|
||||||
Message.error
|
Message.error
|
||||||
"Invalid module use: expected a module name as string or an array \
|
"While parsing %a: in module @{<italic>%s@}, invalid value for \
|
||||||
of two strings (module name and its alias)")
|
@{<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
|
module_uses
|
||||||
|
|
||||||
let parse_name_and_language modul =
|
let check_module_sanity ~fname modul =
|
||||||
let name = Helpers.find_string_exn modul ["name"] in
|
match modul with
|
||||||
let lang =
|
| TomlTable kvs ->
|
||||||
let lang_opt =
|
let format_module_name ppf =
|
||||||
Helpers.find_string_opt modul ["language"]
|
match Helpers.find_string_opt modul ["name"] with
|
||||||
|> Option.map String.uncapitalize_ascii
|
| None | (exception _) -> () (* [opt] is a lie. *)
|
||||||
|
| Some name -> Format.fprintf ppf "in module @{<italic>%s@}, " name
|
||||||
in
|
in
|
||||||
match lang_opt with
|
List.iter
|
||||||
| None -> Message.error "Missing " "language" " field in configuration"
|
(function
|
||||||
| Some lang -> lang
|
| "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
|
in
|
||||||
match List.assoc_opt lang Cli.languages with
|
if not only_strings then
|
||||||
| None ->
|
Message.delayed_error ()
|
||||||
Message.error
|
"While parsing %a: %tinvalid value for key @{<red>includes@}.@\n\
|
||||||
"Unexpected language '%s' for module @{<bold>%s@}, valid entries are: \
|
It must only contain direct strings." File.format fname
|
||||||
@[<h>%a@]"
|
format_module_name
|
||||||
lang name
|
| "includes", _ ->
|
||||||
Format.(
|
Message.delayed_error ()
|
||||||
pp_print_list ~pp_sep:(fun fmt () -> fprintf fmt ",@ ") pp_print_string)
|
"While parsing %a: %tinvalid content for key @{<red>includes@}.@\n\
|
||||||
(List.map fst Cli.languages)
|
Expected an array of strings." File.format fname format_module_name
|
||||||
| Some x -> name, x
|
| 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 toml =
|
let find_and_parse_modules_exn ~fname toml =
|
||||||
let modules = find toml (get_array get_value) ["module"] in
|
let modules = find toml (get_array get_value) ["module"] in
|
||||||
let parse_module modul =
|
let parse_module modul =
|
||||||
let name, language = parse_name_and_language modul in
|
let () = check_module_sanity ~fname modul in
|
||||||
let module_uses = parse_module_uses modul in
|
let name = Helpers.find_string_exn modul ["name"] in
|
||||||
|
let module_uses = parse_module_uses ~fname ~name modul in
|
||||||
let includes =
|
let includes =
|
||||||
|
try
|
||||||
Helpers.find_strings_opt modul ["includes"] |> Option.value ~default:[]
|
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
|
in
|
||||||
name, { language; module_uses; includes }
|
name, { module_uses; includes }
|
||||||
in
|
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"];
|
catala_opts = Helpers.find_strings_exn toml ["build"; "catala_opts"];
|
||||||
build_dir = Helpers.find_string_exn toml ["build"; "build_dir"];
|
build_dir = Helpers.find_string_exn toml ["build"; "build_dir"];
|
||||||
include_dirs = Helpers.find_strings_exn toml ["project"; "include_dirs"];
|
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
|
table
|
||||||
[
|
[
|
||||||
"name", string name;
|
"name", string name;
|
||||||
"language", string (Cli.language_code language);
|
|
||||||
( "module_uses",
|
( "module_uses",
|
||||||
array
|
array
|
||||||
(List.map
|
(List.map
|
||||||
@ -190,7 +219,7 @@ let read f =
|
|||||||
~pos:(Pos.from_info f li col li (col + 1))
|
~pos:(Pos.from_info f li col li (col + 1))
|
||||||
"Error in Clerk configuration:@ %a" Format.pp_print_text msg
|
"Error in Clerk configuration:@ %a" Format.pp_print_text msg
|
||||||
in
|
in
|
||||||
toml_to_config (join f default_toml toml)
|
toml_to_config ~fname:f (join f default_toml toml)
|
||||||
|
|
||||||
let write f t =
|
let write f t =
|
||||||
let toml = config_to_toml t in
|
let toml = config_to_toml t in
|
||||||
|
@ -17,7 +17,6 @@
|
|||||||
open Catala_utils
|
open Catala_utils
|
||||||
|
|
||||||
type modul = {
|
type modul = {
|
||||||
language : Global.backend_lang;
|
|
||||||
module_uses : (string * string option) list;
|
module_uses : (string * string option) list;
|
||||||
includes : string list;
|
includes : string list;
|
||||||
}
|
}
|
||||||
|
@ -1128,6 +1128,9 @@ let main () =
|
|||||||
if Catala_utils.Global.options.debug then
|
if Catala_utils.Global.options.debug then
|
||||||
Printexc.print_raw_backtrace stderr bt;
|
Printexc.print_raw_backtrace stderr bt;
|
||||||
exit Cmd.Exit.some_error
|
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 ->
|
| Sys_error msg ->
|
||||||
let bt = Printexc.get_raw_backtrace () in
|
let bt = Printexc.get_raw_backtrace () in
|
||||||
Message.Content.emit
|
Message.Content.emit
|
||||||
|
Loading…
Reference in New Issue
Block a user