JSX component error message improvements

CHANGELOG.md

@@ -25,6 +25,7 @@
 - Improve error messages for pattern matching on option vs non-option, and vice versa. https://github.com/rescript-lang/rescript-compiler/pull/7035
 - Improve bigint literal comparison. https://github.com/rescript-lang/rescript-compiler/pull/7029
 - Improve output of `@variadic` bindings. https://github.com/rescript-lang/rescript-compiler/pull/7030
+- Improve error messages around JSX components. https://github.com/rescript-lang/rescript-compiler/pull/7038
 
 # 12.0.0-alpha.3
 

jscomp/build_tests/super_errors/expected/component_invalid_prop.res.expected

@@ -0,0 +1,11 @@
+
+  We've found a bug for you!
+  /.../fixtures/component_invalid_prop.res:7:5-8
+
+  5 │ 
+  6 │   let make = (): props<'name> => {
+  7 │     test: false,
+  8 │   }
+  9 │ }
+
+  The prop test does not belong to the JSX component

jscomp/build_tests/super_errors/expected/component_missing_prop.res.expected

@@ -1,12 +1,12 @@
 
   We've found a bug for you!
-  /.../fixtures/component_missing_prop.res:5:34-35
+  /.../fixtures/component_missing_prop.res:6:34-35
 
-  3 │   type props<'name> = {name: 'name}
-  4 │ 
-  5 │   let make = (): props<'name> => {}
-  6 │ }
-  7 │ 
+  4 │   type props<'name> = {name: 'name}
+  5 │ 
+  6 │   let make = (): props<'name> => {}
+  7 │ }
+  8 │ 
 
-  Some required record fields are missing:
-  name. If this is a component, add the missing props.
+  The component is missing these required props:
+   name

jscomp/build_tests/super_errors/expected/component_prop_passed_multiple_times.res.expected

@@ -0,0 +1,12 @@
+
+  We've found a bug for you!
+  /.../fixtures/component_prop_passed_multiple_times.res:8:11-17
+
+   6 │   let make = (): props<'name> => {
+   7 │     name: "hello",
+   8 │     name: "world",
+   9 │   }
+  10 │ }
+
+  The prop name has already been passed to the component 
+You can't pass the same prop more than once.

jscomp/build_tests/super_errors/fixtures/component_invalid_prop.res

@@ -0,0 +1,9 @@
+// Since the React transform isn't active in the tests, mimic what the transform outputs.
+module Component = {
+  @res.jsxComponentProps
+  type props<'name> = {name: 'name}
+
+  let make = (): props<'name> => {
+    test: false,
+  }
+}

jscomp/build_tests/super_errors/fixtures/component_missing_prop.res

@@ -1,5 +1,6 @@
 // Since the React transform isn't active in the tests, mimic what the transform outputs.
 module Component = {
+  @res.jsxComponentProps
   type props<'name> = {name: 'name}
 
   let make = (): props<'name> => {}

jscomp/build_tests/super_errors/fixtures/component_prop_passed_multiple_times.res

@@ -0,0 +1,10 @@
+// Since the React transform isn't active in the tests, mimic what the transform outputs.
+module Component = {
+  @res.jsxComponentProps
+  type props<'name> = {name: 'name}
+
+  let make = (): props<'name> => {
+    name: "hello",
+    name: "world",
+  }
+}

jscomp/ml/error_message_utils.ml

@@ -1,3 +1,6 @@
+type extract_concrete_typedecl =
+  Env.t -> Types.type_expr -> Path.t * Path.t * Types.type_declaration
+
 type type_clash_statement = FunctionCall
 type type_clash_context =
   | SetRecordField
@@ -236,4 +239,60 @@ let print_contextual_unification_error ppf t1 t2 =
         @[<v 0>The value you're pattern matching on here is wrapped in an \
         @{<info>option@}, but you're trying to match on the actual value.@ Wrap \
         the highlighted pattern in @{<info>Some()@} to make it work.@]"
-  | _ -> ()
+  | _ -> ()
+
+type jsx_prop_error_info = {
+  fields: Types.label_declaration list;
+  props_record_path: Path.t;
+}
+
+let attributes_include_jsx_component_props (attrs : Parsetree.attributes) =
+  attrs
+  |> List.exists (fun ({Location.txt}, _) -> txt = "res.jsxComponentProps")
+
+let path_to_jsx_component_name p =
+  match p |> Path.name |> String.split_on_char '.' |> List.rev with
+  | "props" :: component_name :: _ -> Some component_name
+  | _ -> None
+
+let get_jsx_component_props
+    ~(extract_concrete_typedecl : extract_concrete_typedecl) env ty p =
+  match Path.last p with
+  | "props" -> (
+    try
+      match extract_concrete_typedecl env ty with
+      | ( _p0,
+          _p,
+          {Types.type_kind = Type_record (fields, _repr); type_attributes} )
+        when attributes_include_jsx_component_props type_attributes ->
+        Some {props_record_path = p; fields}
+      | _ -> None
+    with _ -> None)
+  | _ -> None
+
+let print_component_name ppf (p : Path.t) =
+  match path_to_jsx_component_name p with
+  | Some component_name -> fprintf ppf "@{<info><%s />@} " component_name
+  | None -> ()
+
+let print_component_wrong_prop_error ppf (p : Path.t)
+    (_fields : Types.label_declaration list) name =
+  fprintf ppf "@[<v>";
+  fprintf ppf
+    "@[<2>The prop @{<error>%s@} does not belong to the JSX component " name;
+  print_component_name ppf p;
+  fprintf ppf "@]@,@,"
+
+let print_component_labels_missing_error ppf labels
+    (error_info : jsx_prop_error_info) =
+  fprintf ppf "@[<hov>The component ";
+  print_component_name ppf error_info.props_record_path;
+  fprintf ppf "is missing these required props:@\n";
+  labels |> List.iter (fun lbl -> fprintf ppf "@ %s" lbl);
+  fprintf ppf "@]"
+
+let get_jsx_component_error_info ~extract_concrete_typedecl opath env ty_record () =
+  match opath with
+  | Some (p, _) ->
+    get_jsx_component_props ~extract_concrete_typedecl env ty_record p
+  | None -> None

jscomp/ml/typecore.ml

@@ -35,8 +35,8 @@ type error =
   | Expr_type_clash of (type_expr * type_expr) list * (type_clash_context option)
   | Apply_non_function of type_expr
   | Apply_wrong_label of arg_label * type_expr
-  | Label_multiply_defined of string
-  | Labels_missing of string list * bool
+  | Label_multiply_defined of {label: string; jsx_component_info: jsx_prop_error_info option}
+  | Labels_missing of {labels: string list; jsx_component_info: jsx_prop_error_info option}
   | Label_not_mutable of Longident.t
   | Wrong_name of string * type_expr * string * Path.t * string * string list
   | Name_type_mismatch of
@@ -960,15 +960,18 @@ let type_label_a_list ?labels loc closed env type_lbl_a opath lid_a_list k =
 (* Checks over the labels mentioned in a record pattern:
    no duplicate definitions (error); properly closed (warning) *)
 
-let check_recordpat_labels loc lbl_pat_list closed =
+let check_recordpat_labels ~get_jsx_component_error_info loc lbl_pat_list closed =
   match lbl_pat_list with
   | [] -> ()                            (* should not happen *)
-  | (_, label1, _) :: _ ->
+  | (_, label1, (tpat: Typedtree.pattern)) :: _ ->
       let all = label1.lbl_all in
       let defined = Array.make (Array.length all) false in
       let check_defined (_, label, _) =
         if defined.(label.lbl_pos)
-        then raise(Error(loc, Env.empty, Label_multiply_defined label.lbl_name))
+        then raise(Error(tpat.pat_loc, Env.empty, Label_multiply_defined {
+          label = label.lbl_name; 
+          jsx_component_info = get_jsx_component_error_info ();
+        }))
         else defined.(label.lbl_pos) <- true in
       List.iter check_defined lbl_pat_list;
       if closed = Closed
@@ -1292,6 +1295,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
           Some (p0, p), expected_ty
         with Not_found -> None, newvar ()
       in
+      let get_jsx_component_error_info = get_jsx_component_error_info ~extract_concrete_typedecl opath !env record_ty in
       let process_optional_label (ld, pat) =
         let exp_optional_attr = check_optional_attr !env ld pat.ppat_attributes pat.ppat_loc in
         let is_from_pamatch = match pat.ppat_desc with
@@ -1330,7 +1334,7 @@ and type_pat_aux ~constrs ~labels ~no_existentials ~mode ~explode ~env
           k (label_lid, label, arg))
       in
       let k' k lbl_pat_list =
-        check_recordpat_labels loc lbl_pat_list closed;
+        check_recordpat_labels ~get_jsx_component_error_info loc lbl_pat_list closed;
         unify_pat_types loc !env record_ty expected_ty;
         rp k {
         pat_desc = Tpat_record (lbl_pat_list, closed);
@@ -1897,11 +1901,14 @@ let duplicate_ident_types caselist env =
 (* type_label_a_list returns a list of labels sorted by lbl_pos *)
 (* note: check_duplicates would better be implemented in
          type_label_a_list directly *)  
-let rec check_duplicates loc env = function
-  | (_, lbl1, _) :: (_, lbl2, _) :: _ when lbl1.lbl_pos = lbl2.lbl_pos ->
-    raise(Error(loc, env, Label_multiply_defined lbl1.lbl_name))
+let rec check_duplicates ~get_jsx_component_error_info loc env = function
+  | (_, lbl1, _) :: (_, lbl2, (texp: Typedtree.expression)) :: _ when lbl1.lbl_pos = lbl2.lbl_pos ->
+    raise(Error(texp.exp_loc, env, Label_multiply_defined {
+      label = lbl1.lbl_name; 
+      jsx_component_info = get_jsx_component_error_info();
+      }))
   | _ :: rem ->
-      check_duplicates loc env rem
+      check_duplicates ~get_jsx_component_error_info loc env rem
   | [] -> ()  
 (* Getting proper location of already typed expressions.
 
@@ -1974,11 +1981,6 @@ let rec lower_args env seen ty_fun  =
 let not_function env ty =
   let ls, tvar = list_labels env ty in
   ls = [] && not tvar
-
-let check_might_be_component env ty_record =
-  match (expand_head env ty_record).desc with 
-  | Tconstr (path, _, _) when path |> Path.last = "props" -> true 
-  | _ -> false
 
 type lazy_args = 
   (Asttypes.arg_label * (unit -> Typedtree.expression) option) list
@@ -2279,6 +2281,10 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg=Rejected) env sexp ty
           | exception Not_found -> 
                newvar (), None, [], None
 
+        in
+        let get_jsx_component_error_info () = (match opath with 
+        | Some (p, _) -> get_jsx_component_props ~extract_concrete_typedecl env ty_record p
+        | None -> None)
         in
         let lbl_exp_list =
           wrap_disambiguate "This record expression is expected to have" ty_record
@@ -2288,7 +2294,7 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg=Rejected) env sexp ty
             (fun x -> x)
         in
         unify_exp_types loc env ty_record (instance env ty_expected);
-        check_duplicates loc env lbl_exp_list;
+        check_duplicates ~get_jsx_component_error_info loc env lbl_exp_list;
         let label_descriptions, representation = match lbl_exp_list, repr_opt with
         | (_, { lbl_all = label_descriptions; lbl_repres = representation}, _) :: _, _ -> label_descriptions, representation
         | [], Some (representation) when lid_sexp_list = [] ->
@@ -2304,8 +2310,10 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg=Rejected) env sexp ty
                 Some name in
             let labels_missing = fields |> List.filter_map filter_missing in
             if labels_missing <> [] then (
-              let might_be_component = check_might_be_component env ty_record in
-              raise(Error(loc, env, Labels_missing (labels_missing, might_be_component))));
+              raise(Error(loc, env, Labels_missing {
+                labels = labels_missing; 
+                jsx_component_info = get_jsx_component_error_info ();
+              })));
             [||], representation
         | [], _ ->
           if fields = [] && repr_opt <> None then
@@ -2330,8 +2338,10 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg=Rejected) env sexp ty
                   label_descriptions
         in
         if !labels_missing <> [] then (
-          let might_be_component = check_might_be_component env ty_record in
-          raise(Error(loc, env, Labels_missing ((List.rev !labels_missing), might_be_component))));
+          raise(Error(loc, env, Labels_missing {
+            labels=(List.rev !labels_missing);
+            jsx_component_info = get_jsx_component_error_info ();
+          })));
         let fields =
           Array.map2 (fun descr def -> descr, def)
             label_descriptions label_definitions
@@ -2372,6 +2382,7 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg=Rejected) env sexp ty
             end
         | op -> ty_expected, op
       in
+      let get_jsx_component_error_info = get_jsx_component_error_info ~extract_concrete_typedecl opath env ty_record in
       let closed = false in
       let lbl_exp_list =
         wrap_disambiguate "This record expression is expected to have" ty_record
@@ -2381,7 +2392,7 @@ and type_expect_ ?type_clash_context ?in_function ?(recarg=Rejected) env sexp ty
           (fun x -> x)
       in
       unify_exp_types loc env ty_record (instance env ty_expected);
-      check_duplicates loc env lbl_exp_list;
+      check_duplicates ~get_jsx_component_error_info loc env lbl_exp_list;
       let opt_exp, label_definitions =
         let (_lid, lbl, _lbl_exp) = List.hd lbl_exp_list in
         let matching_label lbl =
@@ -3846,17 +3857,25 @@ let report_error env ppf = function
         "@[<v>@[<2>The function applied to this argument has type@ %a@]@.\
           This argument cannot be applied %a@]"
         type_expr ty print_label l
-  | Label_multiply_defined s ->
-      fprintf ppf "The record field label %s is defined several times" s
-  | Labels_missing (labels, might_be_component) ->
+  | Label_multiply_defined {label; jsx_component_info = Some jsx_component_info} ->
+      fprintf ppf "The prop @{<info>%s@} has already been passed to the component " label;
+      print_component_name ppf jsx_component_info.props_record_path;
+      fprintf ppf "@,@,You can't pass the same prop more than once.";
+  | Label_multiply_defined {label} ->
+    fprintf ppf "The record field label %s is defined several times" label
+  | Labels_missing {labels; jsx_component_info = Some jsx_component_info} ->
+    print_component_labels_missing_error ppf labels jsx_component_info
+  | Labels_missing {labels} ->
       let print_labels ppf =
         List.iter (fun lbl -> fprintf ppf "@ %s" ( lbl)) in
-      let component_text = if might_be_component then " If this is a component, add the missing props." else "" in
-      fprintf ppf "@[<hov>Some required record fields are missing:%a.%s@]"
-        print_labels labels component_text
+      fprintf ppf "@[<hov>Some required record fields are missing:%a.@]"
+        print_labels labels
   | Label_not_mutable lid ->
       fprintf ppf "The record field %a is not mutable" longident lid
   | Wrong_name (eorp, ty, kind, p, name, valid_names) ->
+    (match get_jsx_component_props ~extract_concrete_typedecl env ty p with 
+    | Some {fields} -> print_component_wrong_prop_error ppf p fields name; spellcheck ppf name valid_names;
+    | None ->
     (* modified *)
     if Path.is_constructor_typath p then begin
       fprintf ppf "@[The field %s is not part of the record \
@@ -3876,6 +3895,7 @@ let report_error env ppf = function
       fprintf ppf "@]";      
     end;
     spellcheck ppf name valid_names;
+  )
   | Name_type_mismatch (kind, lid, tp, tpl) ->
       let name = label_of_kind kind in
       report_ambiguous_type_error ppf env tp tpl

jscomp/ml/typecore.mli

@@ -69,8 +69,8 @@ type error =
   | Expr_type_clash of (type_expr * type_expr) list * (Error_message_utils.type_clash_context option)
   | Apply_non_function of type_expr
   | Apply_wrong_label of arg_label * type_expr
-  | Label_multiply_defined of string
-  | Labels_missing of string list * bool
+  | Label_multiply_defined of {label: string; jsx_component_info: Error_message_utils.jsx_prop_error_info option}
+  | Labels_missing of {labels: string list; jsx_component_info: Error_message_utils.jsx_prop_error_info option}
   | Label_not_mutable of Longident.t
   | Wrong_name of string * type_expr * string * Path.t * string * string list
   | Name_type_mismatch of

jscomp/syntax/src/jsx_v4.ml

@@ -310,7 +310,8 @@ let make_label_decls named_type_list =
     | hd :: tl ->
       if mem_label hd tl then
         let _, label, _, loc, _ = hd in
-        Jsx_common.raise_error ~loc "JSX: found the duplicated prop `%s`" label
+        Jsx_common.raise_error ~loc
+          "The prop `%s` is defined several times in this component." label
       else check_duplicated_label tl
   in
   let () = named_type_list |> List.rev |> check_duplicated_label in
@@ -347,11 +348,16 @@ let make_type_decls_with_core_type props_name loc core_type typ_vars =
   ]
 
 let live_attr = ({txt = "live"; loc = Location.none}, PStr [])
+let jsx_component_props_attr =
+  ({txt = "res.jsxComponentProps"; loc = Location.none}, PStr [])
 
 (* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *)
 let make_props_record_type ~core_type_of_attr ~external_ ~typ_vars_of_core_type
     props_name loc named_type_list =
-  let attrs = if external_ then [live_attr] else [] in
+  let attrs =
+    if external_ then [jsx_component_props_attr; live_attr]
+    else [jsx_component_props_attr]
+  in
   Str.type_ Nonrecursive
     (match core_type_of_attr with
     | None -> make_type_decls ~attrs props_name loc named_type_list
@@ -362,7 +368,10 @@ let make_props_record_type ~core_type_of_attr ~external_ ~typ_vars_of_core_type
 (* type props<'x, 'y, ...> = { x: 'x, y?: 'y, ... } *)
 let make_props_record_type_sig ~core_type_of_attr ~external_
     ~typ_vars_of_core_type props_name loc named_type_list =
-  let attrs = if external_ then [live_attr] else [] in
+  let attrs =
+    if external_ then [jsx_component_props_attr; live_attr]
+    else [jsx_component_props_attr]
+  in
   Sig.type_ Nonrecursive
     (match core_type_of_attr with
     | None -> make_type_decls ~attrs props_name loc named_type_list