improve a few error messages around polymorphic variants

Author: zth

compiler/ml/error_message_utils.ml

@@ -493,11 +493,22 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf
        @{<info>?%s@}"
       (Parser.extract_text_at_loc loc)
   | _, Some (t1, t2) ->
-    let is_subtype =
-      try
-        Ctype.subtype env t1 t2 ();
-        true
-      with _ -> false
+    let can_show_coercion_message =
+      match (t1.desc, t2.desc) with
+      | Tvariant _, Tvariant _ ->
+        (* Subtyping polymorphic variants give some weird messages sometimes,
+        so let's turn it off for now. For an example, turn them on again and try:
+        ```
+        let a: [#Resize | #KeyDown] = #Resize
+        let b: [#Click] = a
+        ```
+        *)
+        false
+      | _ -> (
+        try
+          Ctype.subtype env t1 t2 ();
+          true
+        with _ -> false)
     in
     let target_type_string = Format.asprintf "%a" type_expr t2 in
     let target_expr_text = Parser.extract_text_at_loc loc in
@@ -519,7 +530,7 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf
       | _ -> false
     in
 
-    if is_subtype && not is_constant then (
+    if can_show_coercion_message && not is_constant then (
       fprintf ppf
         "@,\
          @,\

compiler/ml/printtyp.ml

@@ -1385,17 +1385,52 @@ let explanation unif t3 t4 ppf =
       (row1.row_fields, row1.row_closed, row2.row_fields, row2.row_closed)
     with
     | [], true, [], true ->
-      fprintf ppf "@,These two variant types have no intersection"
+      fprintf ppf
+        "@,\
+         @,\
+         These polymorphic variants are incompatible - they share no common \
+         constructors."
     | [], true, (_ :: _ as fields), _ ->
+      let constructors_txt =
+        if List.length fields = 1 then "constructor" else "constructors"
+      in
       fprintf ppf
-        "@,@[The first variant type does not allow tag(s)@ @[<hov>%a@]@]"
-        print_tags fields
+        "@,\
+         @,\
+         The first polymorphic variant is @{<info>closed@} and doesn't include \
+         the %s: @{<error>%a@}.@,\
+         @,\
+         Possible solutions:\n\
+        \  - Either make the first variant @{<info>open@} so it can accept \
+         constructors it hasn't listed itself. To do this, make sure the type \
+         starts with @{<info>[>@} instead of @{<info>[@}\n\
+        \  - Or add the missing %s to it."
+        constructors_txt print_tags fields constructors_txt
     | (_ :: _ as fields), _, [], true ->
+      let constructors_txt =
+        if List.length fields = 1 then "constructor" else "constructors"
+      in
       fprintf ppf
-        "@,@[The second variant type does not allow tag(s)@ @[<hov>%a@]@]"
-        print_tags fields
+        "@,\
+         @,\
+         The second polymorphic variant is @{<info>closed@} and doesn't \
+         include the %s: @{<error>%a@}.@,\
+         @,\
+         Possible solutions:\n\
+        \  - Either make the second variant @{<info>open@} so it can accept \
+         constructors it hasn't listed itself. To do this, make sure the type \
+         starts with @{<info>[>@} instead of @{<info>[@}\n\
+        \  - Or add the missing %s to it."
+        constructors_txt print_tags fields constructors_txt
     | [(l1, _)], true, [(l2, _)], true when l1 = l2 ->
-      fprintf ppf "@,Types for tag %s are incompatible"
+      fprintf ppf
+        "@,\
+         @,\
+         Both polymorphic variants have the constructor @{<info>%s@}, but \
+         their payload types are incompatible.@,\
+         Make sure the payload types for @{<info>%s@} match exactly in both \
+         polymorphic variants."
+        (!print_res_poly_identifier l1)
         (!print_res_poly_identifier l1)
     | _ -> ())
   | _ -> ()

tests/build_tests/super_errors/expected/polyvariant_constructor_payload_mismatch.res.expected

@@ -0,0 +1,16 @@
+
+  We've found a bug for you!
+  /.../fixtures/polyvariant_constructor_payload_mismatch.res:4:16
+
+  2 │ type test2 = [#Click(string)]
+  3 │ let a: test = #Click(1)
+  4 │ let b: test2 = a
+  5 │ 
+
+  This has type: test
+  But it's expected to have type: test2
+  
+  Both polymorphic variants have the constructor #Click, but their payload types are incompatible.
+  Make sure the payload types for #Click match exactly in both polymorphic variants.
+  
+  You can convert int to string with Int.toString.

tests/build_tests/super_errors/expected/polyvariant_constructors_mismatch_second.res.expected

@@ -0,0 +1,17 @@
+
+  We've found a bug for you!
+  /.../fixtures/polyvariant_constructors_mismatch_second.res:7:16-22
+
+  5 │   }
+  6 │ 
+  7 │ let _ = handle(#Resize)
+  8 │ 
+
+  This has type: [> #Resize]
+  But this function argument is expecting: [#Click | #KeyDown]
+  
+  The second polymorphic variant is closed and doesn't include the constructor: #Resize.
+  
+  Possible solutions:
+  - Either make the second variant open so it can accept constructors it hasn't listed itself. To do this, make sure the type starts with [> instead of [
+  - Or add the missing constructor to it.

tests/build_tests/super_errors/expected/polyvariant_name_formatting.res.expected

@@ -10,4 +10,9 @@
 
   This pattern matches values of type [? #Invalid]
   but a pattern was expected which matches values of type polyvariant
-  The second variant type does not allow tag(s) #Invalid
+  
+  The second polymorphic variant is closed and doesn't include the constructor: #Invalid.
+  
+  Possible solutions:
+  - Either make the second variant open so it can accept constructors it hasn't listed itself. To do this, make sure the type starts with [> instead of [
+  - Or add the missing constructor to it.

tests/build_tests/super_errors/expected/polyvariants_no_overlap.res.expected

@@ -0,0 +1,12 @@
+
+  We've found a bug for you!
+  /.../fixtures/polyvariants_no_overlap.res:2:19
+
+  1 │ let a: [#Resize | #KeyDown] = #Resize
+  2 │ let b: [#Click] = a
+  3 │ 
+
+  This has type: [#KeyDown | #Resize]
+  But it's expected to have type: [#Click]
+  
+  These polymorphic variants are incompatible - they share no common constructors.

tests/build_tests/super_errors/fixtures/polyvariant_constructor_payload_mismatch.res

@@ -0,0 +1,4 @@
+type test = [#Click(int)]
+type test2 = [#Click(string)]
+let a: test = #Click(1)
+let b: test2 = a

tests/build_tests/super_errors/fixtures/polyvariant_constructors_mismatch_second.res

@@ -0,0 +1,7 @@
+let handle = (ev: [#Click | #KeyDown]) =>
+  switch ev {
+  | #Click => Js.log("clicked")
+  | #KeyDown => Js.log("key down")
+  }
+
+let _ = handle(#Resize)

tests/build_tests/super_errors/fixtures/polyvariants_no_overlap.res

@@ -0,0 +1,2 @@
+let a: [#Resize | #KeyDown] = #Resize
+let b: [#Click] = a