add missing args

Author: zth

compiler/ml/cmt_utils.ml

@@ -22,6 +22,7 @@ type action_type =
   | AssignToUnderscore
   | PipeToIgnore
   | PartiallyApplyFunction
+  | InsertMissingArguments of {missing_args: Asttypes.Noloc.arg_label list}
 
 (* TODO: 
 - Unused var in patterns (and aliases )*)
@@ -67,6 +68,15 @@ let action_to_string = function
     | `Optional -> "RewriteArgType(Optional)"
     | `Unlabelled -> "RewriteArgType(Unlabelled)")
   | PartiallyApplyFunction -> "PartiallyApplyFunction"
+  | InsertMissingArguments {missing_args} ->
+    Printf.sprintf "InsertMissingArguments(%s)"
+      (missing_args
+      |> List.map (fun arg ->
+             match arg with
+             | Asttypes.Noloc.Labelled txt -> "~" ^ txt
+             | Asttypes.Noloc.Optional txt -> "?" ^ txt
+             | Asttypes.Noloc.Nolabel -> "<unlabelled>")
+      |> String.concat ", ")
 
 let _add_possible_action : (cmt_action -> unit) ref = ref (fun _ -> ())
 let add_possible_action action = !_add_possible_action action

compiler/ml/typecore.ml

@@ -4656,7 +4656,18 @@ let report_error env loc ppf error =
     if not is_fallback then fprintf ppf "@,";
 
     if List.length missing_required_args > 0 then (
-      (* TODO(actions) Add missing arguments *)
+      Cmt_utils.add_possible_action
+        {
+          loc;
+          action =
+            InsertMissingArguments
+              {
+                missing_args =
+                  missing_required_args
+                  |> List.map (fun arg -> Noloc.Labelled arg);
+              };
+          description = "Insert missing arguments";
+        };
       Cmt_utils.add_possible_action
         {
           loc;

tests/build_tests/actions/expected/Actions_InsertMissingArguments_applied.res

@@ -0,0 +1,8 @@
+// actionFilter=InsertMissingArguments
+let x = (~a, ~b) => a + b
+let y = x(~a=2, ~b=%todo) + 2
+
+/* === AVAILABLE ACTIONS:
+- PartiallyApplyFunction - Partially apply function
+- InsertMissingArguments(~b) - Insert missing arguments
+*/

tests/build_tests/actions/expected/Actions_PartiallyApplyFunction_applied.res

@@ -4,4 +4,5 @@ let y = x(~a=2, ...) + 2
 
 /* === AVAILABLE ACTIONS:
 - PartiallyApplyFunction - Partially apply function
+- InsertMissingArguments(~b) - Insert missing arguments
 */

tests/build_tests/actions/fixtures/Actions_InsertMissingArguments.res

@@ -0,0 +1,3 @@
+// actionFilter=InsertMissingArguments
+let x = (~a, ~b) => a + b
+let y = x(~a=2) + 2

tools/src/tools.ml

@@ -1606,6 +1606,23 @@ module Actions = struct
                      else
                        (* Other cases when the loc is on something else in the expr *)
                        match (expr.pexp_desc, action.action) with
+                       | ( Pexp_apply ({funct; args} as apply),
+                           InsertMissingArguments {missing_args} )
+                         when funct.pexp_loc = action.loc ->
+                         let args_to_insert =
+                           missing_args
+                           |> List.map (fun (lbl : Asttypes.Noloc.arg_label) ->
+                                  ( Asttypes.to_arg_label lbl,
+                                    Ast_helper.Exp.extension
+                                      (Location.mknoloc "todo", PStr []) ))
+                         in
+                         Some
+                           {
+                             expr with
+                             pexp_desc =
+                               Pexp_apply
+                                 {apply with args = args @ args_to_insert};
+                           }
                        | ( Pexp_apply ({funct} as apply_args),
                            PartiallyApplyFunction )
                          when funct.pexp_loc = action.loc ->
@@ -1783,7 +1800,9 @@ module Actions = struct
                  | PipeToIgnore -> List.mem "PipeToIgnore" filter
                  | PartiallyApplyFunction ->
                    List.mem "PartiallyApplyFunction" filter
-                 | RewriteArgType _ -> List.mem "RewriteArgType" filter)
+                 | RewriteArgType _ -> List.mem "RewriteArgType" filter
+                 | InsertMissingArguments _ ->
+                   List.mem "InsertMissingArguments" filter)
       in
       match applyActionsToFile path possible_actions with
       | Ok applied ->