adjust messages

Author: zth

compiler/ml/typecore.ml

@@ -4259,15 +4259,18 @@ let report_error env ppf error =
     | _ ->
       fprintf ppf
         "@[<v>@[<2>This can't be called, it's not a function.@]@,\
-         It has type: %a@]"
+         The function has type: %a@]"
         type_expr typ)
   | Apply_wrong_label (l, ty) ->
-    let print_label ppf = function
-      | Noloc.Nolabel -> fprintf ppf "an unlabelled argument at this position"
-      | l -> fprintf ppf "the argument @{<info>%s@}" (prefixed_label_name l)
+    let print_message ppf = function
+      | Noloc.Nolabel ->
+        fprintf ppf "The argument at this position should be labelled."
+      | l ->
+        fprintf ppf "This function does not take the argument @{<info>%s@}."
+          (prefixed_label_name l)
     in
-    fprintf ppf "@[<v>@[<2>This function does not take %a.@]@,It has type: %a@]"
-      print_label l type_expr ty
+    fprintf ppf "@[<v>@[<2>%a@]@,This function has type: %a@]" print_message l
+      type_expr ty
   | Label_multiply_defined {label; jsx_component_info = Some jsx_component_info}
     ->
     fprintf ppf
@@ -4482,9 +4485,10 @@ let report_error env ppf error =
       && mismatch_in_unlabelled_args = false
     in
 
-    if is_fallback then
-      fprintf ppf "@[<v>@[<2>This function call is incorrect.@]"
-    else fprintf ppf "@[<v>@[<2>This function call is incorrect:@]";
+    fprintf ppf "@[<v>@[<2>This function call is incorrect.@]";
+    fprintf ppf "@,The function has type:@ %a" type_expr typ;
+
+    if not is_fallback then fprintf ppf "@,";
 
     if List.length missing_required_args > 0 then
       fprintf ppf "@,- Missing arguments that must be provided: %s"
@@ -4496,21 +4500,22 @@ let report_error env ppf error =
       fprintf ppf "@,- Called with arguments it does not take: %s"
         (superfluous_args |> String.concat ", ");
 
+    let unlabelled_msg a b pos =
+      match (a, pos) with
+      | 0, `left -> "no"
+      | 0, `right -> "none"
+      | _ when a > b -> string_of_int a
+      | _ -> "just " ^ string_of_int a
+    in
+
     if mismatch_in_unlabelled_args then
       fprintf ppf
         "@,\
-         - It takes @{<info>%s@} unlabelled argument%s, but is called with \
-         @{<error>%s@}"
-        (if args_from_type_unlabelled > sargs_unlabelled then
-           string_of_int args_from_type_unlabelled
-         else "just " ^ string_of_int args_from_type_unlabelled)
+         - The function takes @{<info>%s@} unlabelled argument%s, but is \
+         called with @{<error>%s@}"
+        (unlabelled_msg args_from_type_unlabelled sargs_unlabelled `left)
         (if args_from_type_unlabelled = 1 then "" else "s")
-        (if sargs_unlabelled > args_from_type_unlabelled then
-           string_of_int sargs_unlabelled
-         else "just " ^ string_of_int sargs_unlabelled);
-
-    if not is_fallback then fprintf ppf "@,";
-    fprintf ppf "@,The function has type:@ %a" type_expr typ;
+        (unlabelled_msg sargs_unlabelled args_from_type_unlabelled `right);
 
     (* Print fallback if nothing above matched *)
     if is_fallback then

tests/build_tests/super_errors/expected/arity_mismatch.res.expected

@@ -6,8 +6,8 @@
   2 │ let makeVariables = makeVar(~f=f => f)
   3 │ 
 
-  This function call is incorrect:
-  - It takes 1 unlabelled argument, but is called with just 0
-  
+  This function call is incorrect.
   The function has type:
-  (~f: 'a => 'a, unit) => int
+  (~f: 'a => 'a, unit) => int
+  
+  - The function takes 1 unlabelled argument, but is called with none

tests/build_tests/super_errors/expected/arity_mismatch2.res.expected

@@ -6,8 +6,8 @@
   2 │ let makeVariables = makeVar(1, 2, 3)
   3 │ 
 
-  This function call is incorrect:
-  - It takes just 2 unlabelled arguments, but is called with 3
-  
+  This function call is incorrect.
   The function has type:
-  ('a, unit) => int
+  ('a, unit) => int
+  
+  - The function takes just 2 unlabelled arguments, but is called with 3

tests/build_tests/super_errors/expected/arity_mismatch4.res.expected

@@ -0,0 +1,13 @@
+
+  We've found a bug for you!
+  /.../fixtures/arity_mismatch4.res:2:21-27
+
+  1 │ let makeVar = (~f) => 34
+  2 │ let makeVariables = makeVar(1, ~f=f => f)
+  3 │ 
+
+  This function call is incorrect.
+  The function has type:
+  (~f: 'a) => int
+  
+  - The function takes no unlabelled arguments, but is called with 1

tests/build_tests/super_errors/expected/fun_return_poly1.res.expected

@@ -19,5 +19,5 @@
   4 │ let err = f(1, 2)
   5 │ 
 
-  This function does not take an unlabelled argument at this position.
-  It has type: ('a, ~def: int=?) => 'b
+  The argument at this position should be labelled.
+  This function has type: ('a, ~def: int=?) => 'b

tests/build_tests/super_errors/expected/fun_return_poly2.res.expected

@@ -20,4 +20,4 @@
   8 │ 
 
   This function does not take the argument ~initialValue.
-  It has type: (string, ~wrongLabelName: int=?) => 'a
+  This function has type: (string, ~wrongLabelName: int=?) => 'a

tests/build_tests/super_errors/expected/missing_label.res.expected

@@ -7,5 +7,5 @@
   3 │ let _ = f("")
   4 │ 
 
-  This function does not take an unlabelled argument at this position.
-  It has type: (~a: string) => string
+  The argument at this position should be labelled.
+  This function has type: (~a: string) => string

tests/build_tests/super_errors/expected/missing_labels.res.expected

@@ -7,5 +7,5 @@
   3 │ let _ = f("", "")
   4 │ 
 
-  This function does not take an unlabelled argument at this position.
-  It has type: (~a: string, ~b: string) => string
+  The argument at this position should be labelled.
+  This function has type: (~a: string, ~b: string) => string

tests/build_tests/super_errors/expected/moreArguments1.res.expected

@@ -6,8 +6,8 @@
   2 │ let y = x(~a=2) + 2
   3 │ 
 
-  This function call is incorrect:
-  - Missing arguments that must be provided: ~b
-  
+  This function call is incorrect.
   The function has type:
-  (~a: int, ~b: int) => int
+  (~a: int, ~b: int) => int
+  
+  - Missing arguments that must be provided: ~b

tests/build_tests/super_errors/expected/moreArguments2.res.expected

@@ -6,8 +6,8 @@
   2 │ let y = x(2) + 2
   3 │ 
 
-  This function call is incorrect:
-  - It takes 2 unlabelled arguments, but is called with just 1
-  
+  This function call is incorrect.
   The function has type:
-  (int, int) => int
+  (int, int) => int
+  
+  - The function takes 2 unlabelled arguments, but is called with just 1