partially apply function

Author: zth

compiler/ml/cmt_utils.ml

@@ -21,6 +21,7 @@ type action_type =
   | ForceOpen
   | AssignToUnderscore
   | PipeToIgnore
+  | PartiallyApplyFunction
 
 (* TODO: 
 - Unused var in patterns (and aliases )*)
@@ -65,6 +66,7 @@ let action_to_string = function
     | `Labelled -> "RewriteArgType(Labelled)"
     | `Optional -> "RewriteArgType(Optional)"
     | `Unlabelled -> "RewriteArgType(Unlabelled)")
+  | PartiallyApplyFunction -> "PartiallyApplyFunction"
 
 let _add_possible_action : (cmt_action -> unit) ref = ref (fun _ -> ())
 let add_possible_action action = !_add_possible_action action

compiler/ml/typecore.ml

@@ -4656,13 +4656,18 @@ let report_error env loc ppf error =
 
     if not is_fallback then fprintf ppf "@,";
 
-    if List.length missing_required_args > 0 then
+    if List.length missing_required_args > 0 then (
       (* TODO(actions) Add missing arguments *)
-      (* TODO(actions) Partially apply *)
+      Cmt_utils.add_possible_action
+        {
+          loc;
+          action = PartiallyApplyFunction;
+          description = "Partially apply function";
+        };
       fprintf ppf "@,- Missing arguments that must be provided: %s"
         (missing_required_args
         |> List.map (fun v -> "~" ^ v)
-        |> String.concat ", ");
+        |> String.concat ", "));
 
     if List.length superfluous_args > 0 then
       (* TODO(actions) Remove arguments *)

tests/build_tests/actions/expected/Actions_PartiallyApplyFunction_applied.res

@@ -0,0 +1,7 @@
+// actionFilter=PartiallyApplyFunction
+let x = (~a, ~b) => a + b
+let y = x(~a=2, ...) + 2
+
+/* === AVAILABLE ACTIONS:
+- PartiallyApplyFunction - Partially apply function
+*/

tests/build_tests/actions/fixtures/Actions_PartiallyApplyFunction.res

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

tools/src/tools.ml

@@ -1606,6 +1606,15 @@ 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} as apply_args),
+                           PartiallyApplyFunction )
+                         when funct.pexp_loc = action.loc ->
+                         Some
+                           {
+                             expr with
+                             pexp_desc =
+                               Pexp_apply {apply_args with partial = true};
+                           }
                        | Pexp_apply ({args} as apply), RewriteArgType {to_type}
                          ->
                          let arg_locs =
@@ -1772,6 +1781,8 @@ module Actions = struct
                  | RemoveRecordSpread -> List.mem "RemoveRecordSpread" filter
                  | AssignToUnderscore -> List.mem "AssignToUnderscore" filter
                  | PipeToIgnore -> List.mem "PipeToIgnore" filter
+                 | PartiallyApplyFunction ->
+                   List.mem "PartiallyApplyFunction" filter
                  | RewriteArgType _ -> List.mem "RewriteArgType" filter)
       in
       match applyActionsToFile path possible_actions with