[Super errors] Make the second worst ReasonReact error a bit shorter

jscomp/super_errors/super_reason_react.ml

@@ -8,32 +8,32 @@ let rec drill_through_tlink_and_tsubst t =
   match t.desc with
   | Tlink t
   | Tsubst t -> drill_through_tlink_and_tsubst t
-  | t -> t
+  | _ -> t
 
 let is_weak_type_after_drilling t =
   match drill_through_tlink_and_tsubst t with
-  | Tvar _ -> true
+  | {desc = Tvar _} -> true
   | _ -> false
 
 let component_spec_weak_type_variables t =
   match drill_through_tlink_and_tsubst t with
   (* ReasonReact <=0.3.4 *)
-  | Tconstr (
+  | {desc = Tconstr (
       Pdot ((Pident {name = "ReasonReact"}), "componentSpec", _),
       [state; _initial_state; retained_props; _initial_retained_props; action],
       _
-    ) ->
+    )} ->
     (
       state |> is_weak_type_after_drilling,
       retained_props |> is_weak_type_after_drilling,
       action |> is_weak_type_after_drilling
     )
   (* future ReasonReact version with retainedProps removed *)
-  | Tconstr (
+  | {desc = Tconstr (
       Pdot ((Pident {name = "ReasonReact"}), "componentSpec", _),
       [state; _initial_state; action],
       _
-    ) ->
+    )} ->
     (
       state |> is_weak_type_after_drilling,
       false,
@@ -57,31 +57,73 @@ let component_spec_weak_type_variables_in_module_type (mty : Types.module_type)
         )
   | _ -> []
 
-(* recursively drill down the types (first item is the type alias, if any. Second is the content of the alias) *)
-let rec get_to_bottom_of_aliases f = function
-  | (_alias1, type1) :: (_alias2, type2) :: rest ->
-    begin match get_to_bottom_of_aliases f rest with
-    | false -> f (type1, type2)
-    | true -> true
-    end
+(* `trace` is a funny data structure. It's an always even list of tuples. This error:
+  this is foo (aliased as array(int)), wanted bar (aliased as array(string))
+  the incompatible part: int vs string
+  gives the following `trace` data structure:
+  [
+    (foo, array(int)),
+    (bar, array(string)),
+    (_, int),
+    (_, string)
+  ]
+ *)
+(* recursively walk the trace from right to left, calling f and checking if f matches part of the trace *)
+let check_each_trace_chunk_bottom_up f = fun t ->
+  let t_flipped = List.rev t in
+  let rec check f = function
+  (* we flipped the trace, so instead of [t1, t2, t3, t4, ...] it's [t4, t3, ...] *)
+  | (_alias2, type2) :: (_alias1, type1) :: rest ->
+    if f (type1, type2) then true
+    else check f rest
   | _ -> false
+  in
+  check f t_flipped
 
-let state_escape_scope = get_to_bottom_of_aliases (function
+
+let state_escape_scope = check_each_trace_chunk_bottom_up (function
   (* https://github.com/BuckleScript/ocaml/blob/ddf5a739cc0978dab5e553443825791ba7b0cef9/typing/printtyp.ml?#L1348 *)
   (* so apparently that's the logic for detecting "the constructor out of scope" error *)
   | ({desc = Tconstr (p, _, _)}, {desc = Tvar _; level})
     when level < Path.binding_time p -> true
   | _ -> false
 )
 
-let is_array_wanted_reactElement = get_to_bottom_of_aliases (function
-  | ({desc = Tconstr (path1, _, _)}, {desc = Tconstr (path2, _, _)})
-    when Path.last path1 = "array" && Path.last path2 = "reactElement" -> true
+let trace_both_component_spec = check_each_trace_chunk_bottom_up (function
+  | ({desc = Tconstr (
+      (Pdot ((Pident {name = "ReasonReact"}), "componentSpec", _)),
+      ([state1; _; _; _; action1] | [state1; _; action1]),
+      _
+    )},
+    {desc = Tconstr (
+      (Pdot ((Pident {name = "ReasonReact"}), "componentSpec", _)),
+      ([state2; _; _; _; action2] | [state2; _; action2]),
+      _
+    )})
+    -> true
   | _ -> false
 )
 
-let is_componentSpec_wanted_reactElement = get_to_bottom_of_aliases (function
-  | ({desc = Tconstr (path1, _, _)}, {desc = Tconstr (path2, _, _)})
-    when Path.last path1 = "componentSpec" && Path.last path2 = "reactElement" -> true
+let is_array_wanted_react_element = check_each_trace_chunk_bottom_up (function
+  | ({desc = Tconstr (path1, _, _)},
+    {desc = Tconstr (
+      (Pdot ((Pident {name = "ReasonReact"}), "reactElement", _)),
+      _,
+      _
+    )}) when Path.last path1 = "array"-> true
+  | _ -> false
+)
+
+let is_component_spec_wanted_react_element = check_each_trace_chunk_bottom_up (function
+  | ({desc = Tconstr (
+      (Pdot ((Pident {name = "ReasonReact"}), "componentSpec", _)),
+      ([state1; _; _; _; action1] | [state1; _; action1]),
+      _
+    )},
+    {desc = Tconstr (
+      (Pdot ((Pident {name = "ReasonReact"}), "reactElement", _)),
+      _,
+      _
+    )}) -> true
   | _ -> false
 )

jscomp/super_errors/super_reason_react.mli

@@ -7,8 +7,11 @@ val component_spec_weak_type_variables_in_module_type: Types.module_type -> (boo
 val state_escape_scope: (Types.type_expr * Types.type_expr) list -> bool
 (** Used by super_typecore when we detect the message "The type constructor state would escape its scope" *)
 
-val is_array_wanted_reactElement: (Types.type_expr * Types.type_expr) list -> bool
+val trace_both_component_spec: (Types.type_expr * Types.type_expr) list -> bool
+(** Used by super_typecore when we detect the message "The type constructor state would escape its scope" *)
+
+val is_array_wanted_react_element: (Types.type_expr * Types.type_expr) list -> bool
 (** Used by super_typecore when we detect the message "This has type array but expected reactElement" *)
 
-val is_componentSpec_wanted_reactElement: (Types.type_expr * Types.type_expr) list -> bool
+val is_component_spec_wanted_react_element: (Types.type_expr * Types.type_expr) list -> bool
 (** Used by super_typecore when we detect the message "This has type componentSpec but expected reactElement" *)

jscomp/super_errors/super_typecore.ml

@@ -104,25 +104,26 @@ let check_bs_arity_mismatch ppf trace =
 let print_expr_type_clash env trace ppf =
   (* this is the most frequent error. Do whatever we can to provide specific
     guidance to this generic error before giving up *)
-  if Super_reason_react.state_escape_scope trace then
+  if Super_reason_react.state_escape_scope trace && Super_reason_react.trace_both_component_spec trace then
     fprintf ppf "@[<v>\
       @[@{<info>Is this a ReasonReact reducerComponent or component with retained props?@}@ \
-      If so, is the type for state, retained props or action declared _after_ the component declaration?@ \
-      Moving these types above the component declaration should resolve this!@]@,@,\
-      @[@{<info>Here's the original error message@}@]@,\
+      If so, is the type for state, retained props or action declared _after_@ the component declaration?@ \
+      @{<info>Moving these types above the component declaration@} should resolve this!@]\
     @]"
-  else if Super_reason_react.is_array_wanted_reactElement trace then
+    (* This one above shouldn't catch any false positives, so we can safely not display the original type clash error. *)
+  else begin
+    if Super_reason_react.is_array_wanted_react_element trace then
     fprintf ppf "@[<v>\
       @[@{<info>Did you pass an array as a ReasonReact DOM (lower-case) component's children?@}@ If not, disregard this.@ \
       If so, please use `ReasonReact.createDomElement`:@ https://reasonml.github.io/reason-react/docs/en/children.html@]@,@,\
       @[@{<info>Here's the original error message@}@]@,\
     @]"
-  else if Super_reason_react.is_componentSpec_wanted_reactElement trace then
-    fprintf ppf "@[<v>\
-      @[@{<info>Did you want to create a ReasonReact element without using JSX?@}@ If not, disregard this.@ \
-      If so, don't forget to wrap this value in `ReasonReact.element` yourself:@ https://reasonml.github.io/reason-react/docs/en/jsx.html#capitalized@]@,@,\
-      @[@{<info>Here's the original error message@}@]@,\
-    @]";
+    else if Super_reason_react.is_component_spec_wanted_react_element trace then
+      fprintf ppf "@[<v>\
+        @[@{<info>Did you want to create a ReasonReact element without using JSX?@}@ If not, disregard this.@ \
+        If so, don't forget to wrap this value in `ReasonReact.element` yourself:@ https://reasonml.github.io/reason-react/docs/en/jsx.html#capitalized@]@,@,\
+        @[@{<info>Here's the original error message@}@]@,\
+      @]";
   begin
     let bottom_aliases_result = bottom_aliases trace in
     let missing_arguments = match bottom_aliases_result with
@@ -137,7 +138,7 @@ let print_expr_type_clash env trace ppf =
           else fprintf ppf "@[(~%s: %a)@]" label type_expr argtype
         )
     in
-    begin match missing_arguments with
+    match missing_arguments with
     | Some [singleArgument] ->
       (* btw, you can't say "final arguments". Intermediate labeled
         arguments might be the ones missing *)
@@ -170,7 +171,7 @@ let print_expr_type_clash env trace ppf =
         (function ppf ->
             fprintf ppf "But somewhere wanted:");
       show_extra_help ppf env trace;
-    end;
+    end
   end
 (* taken from https://github.com/BuckleScript/ocaml/blob/d4144647d1bf9bc7dc3aadc24c25a7efa3a67915/typing/typecore.ml#L3769 *)
 (* modified branches are commented *)