print type coercion hint when appropriate

Author: zth

compiler/ml/error_message_utils.ml

@@ -11,6 +11,8 @@ let with_configured_jsx_module s =
 module Parser : sig
   type comment
 
+  val extract_text_at_loc : Location.t -> string
+
   val parse_source : (string -> Parsetree.structure * comment list) ref
 
   val reprint_source : (Parsetree.structure -> comment list -> string) ref
@@ -38,10 +40,13 @@ end = struct
     let end_offset = end_pos.pos_cnum in
     String.sub src start_offset (end_offset - start_offset)
 
-  let parse_expr_at_loc loc =
+  let extract_text_at_loc loc =
     (* TODO: Maybe cache later on *)
     let src = Ext_io.load_file loc.Location.loc_start.pos_fname in
-    let sub_src = extract_location_string ~src loc in
+    extract_location_string ~src loc
+
+  let parse_expr_at_loc loc =
+    let sub_src = extract_text_at_loc loc in
     let parsed, comments = !parse_source sub_src in
     match parsed with
     | [{Parsetree.pstr_desc = Pstr_eval (exp, _)}] -> Some (exp, comments)
@@ -59,6 +64,12 @@ end = struct
     | None -> None
 end
 
+(* TODO: Move this to appropriate place where it can be shared with typecore.ml *)
+let type_expr ppf typ =
+  (* print a type and avoid infinite loops *)
+  Printtyp.reset_and_mark_loops typ;
+  Printtyp.type_expr ppf typ
+
 type type_clash_statement = FunctionCall
 type type_clash_context =
   | SetRecordField
@@ -345,6 +356,40 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf
          single JSX element.@,"
         (with_configured_jsx_module "array")
     | _ -> ())
+  | _, Some (t1, t2) ->
+    let is_subtype =
+      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
+    let suggested_rewrite =
+      match
+        !Parser.parse_source
+          (Printf.sprintf "(%s :> %s)" target_expr_text target_type_string)
+      with
+      | [], _ -> None
+      | structure, comments -> Some (!Parser.reprint_source structure comments)
+    in
+
+    if is_subtype then (
+      fprintf ppf
+        "@,\
+         @,\
+         Possible solutions: @,\
+         - These types are compatible at runtime. You can use the coercion \
+         operator @{<info>:>@} to convert to the expected type @{<info>%s@}."
+        target_type_string;
+      match suggested_rewrite with
+      | Some rewrite ->
+        fprintf ppf
+          "@,\
+          \  If you want to use coercion, rewrite the highlighted code to: \
+           @{<info>%s@}@,"
+          rewrite
+      | None -> ())
   | _ -> ()
 
 let type_clash_context_from_function sexp sfunct =

tests/build_tests/super_errors/expected/primitives1.res.expected

@@ -9,5 +9,11 @@
   This has type: int
   But it's expected to have type: float
 
+  Possible solutions: 
+  - These types are compatible at runtime. You can use the coercion operator :> to convert to the expected type float.
+    If you want to use coercion, rewrite the highlighted code to: (2 :> float)
+
+  
+  
   You can convert int to float with Int.toFloat.
   If this is a literal, try a number with a trailing dot (e.g. 20.).

tests/build_tests/super_errors/expected/primitives6.res.expected

@@ -10,5 +10,11 @@
   This has type: int
   But it's expected to have type: float
 
+  Possible solutions: 
+  - These types are compatible at runtime. You can use the coercion operator :> to convert to the expected type float.
+    If you want to use coercion, rewrite the highlighted code to: (10 :> float)
+
+  
+  
   You can convert int to float with Int.toFloat.
   If this is a literal, try a number with a trailing dot (e.g. 20.).

tests/build_tests/super_errors/expected/subtype_record.res.expected

@@ -0,0 +1,16 @@
+
+  We've found a bug for you!
+  /.../fixtures/subtype_record.res:23:23
+
+  21 │ }
+  22 │ 
+  23 │ let x = takesSomeType(v)
+  24 │ 
+
+  This has type: someOtherType
+  But this function argument is expecting: SomeModule.someType
+  
+  Possible solutions: 
+  - These types are compatible at runtime. You can use the coercion operator :> to convert to the expected type SomeModule.someType.
+    If you want to use coercion, rewrite the highlighted code to: (v :> SomeModule.someType)
+

tests/build_tests/super_errors/expected/subtype_string.res.expected

@@ -0,0 +1,16 @@
+
+  We've found a bug for you!
+  /.../fixtures/subtype_string.res:7:18-20
+
+  5 │ }
+  6 │ 
+  7 │ let x = takesStr(One)
+  8 │ 
+
+  This has type: variant
+  But it's expected to have type: string
+  
+  Possible solutions: 
+  - These types are compatible at runtime. You can use the coercion operator :> to convert to the expected type string.
+    If you want to use coercion, rewrite the highlighted code to: (One :> string)
+

tests/build_tests/super_errors/expected/type1.res.expected

@@ -8,5 +8,11 @@
   This has type: int
   But it's expected to have type: float
 
+  Possible solutions: 
+  - These types are compatible at runtime. You can use the coercion operator :> to convert to the expected type float.
+    If you want to use coercion, rewrite the highlighted code to: (2 :> float)
+
+  
+  
   You can convert int to float with Int.toFloat.
   If this is a literal, try a number with a trailing dot (e.g. 20.).

tests/build_tests/super_errors/fixtures/subtype_record.res

@@ -0,0 +1,23 @@
+module SomeModule = {
+  type someType = {
+    one: bool,
+    two: int,
+  }
+}
+
+type someOtherType = {
+  ...SomeModule.someType,
+  three: string,
+}
+
+let v = {
+  one: true,
+  two: 1,
+  three: "hello",
+}
+
+let takesSomeType = (s: SomeModule.someType) => {
+  s.one
+}
+
+let x = takesSomeType(v)

tests/build_tests/super_errors/fixtures/subtype_string.res

@@ -0,0 +1,7 @@
+type variant = One | Two
+
+let takesStr = (s: string) => {
+  s ++ "hello"
+}
+
+let x = takesStr(One)