make optional arg labelled

Author: zth

compiler/ml/cmt_utils.ml

@@ -11,6 +11,7 @@ type action_type =
   | RewriteArrayToTuple
   | RewriteIdentToModule of {module_name: string}
   | RewriteIdent of {new_ident: Longident.t}
+  | RewriteArgType of {to_type: [`Labelled | `Optional | `Unlabelled]}
   | PrefixVariableWithUnderscore
   | RemoveUnusedVariable
   | RemoveUnusedType
@@ -59,6 +60,11 @@ let action_to_string = function
   | RemoveRecordSpread -> "RemoveRecordSpread"
   | AssignToUnderscore -> "AssignToUnderscore"
   | PipeToIgnore -> "PipeToIgnore"
+  | RewriteArgType {to_type} -> (
+    match to_type with
+    | `Labelled -> "RewriteArgType(Labelled)"
+    | `Optional -> "RewriteArgType(Optional)"
+    | `Unlabelled -> "RewriteArgType(Unlabelled)")
 
 let _add_possible_action : (cmt_action -> unit) ref = ref (fun _ -> ())
 let add_possible_action action = !_add_possible_action action
@@ -102,6 +108,13 @@ let emit_possible_actions_from_warning loc w =
       {loc; action = PipeToIgnore; description = "Pipe to ignore()"};
     add_possible_action
       {loc; action = AssignToUnderscore; description = "Assign to let _ ="}
+  | Nonoptional_label _ ->
+    add_possible_action
+      {
+        loc;
+        action = RewriteArgType {to_type = `Labelled};
+        description = "Make argument optional";
+      }
     (* 
     
     === TODO === 
@@ -110,7 +123,6 @@ let emit_possible_actions_from_warning loc w =
   | Unused_pat -> (* Remove pattern *) ()
   | Unused_argument -> (* Remove unused argument or prefix with underscore *) ()
   | Unused_constructor _ -> (* Remove unused constructor *) ()
-  | Nonoptional_label _ -> (* Add `?` to make argument optional *) ()
   | Bs_unused_attribute _ -> (* Remove unused attribute *) ()
   | _ -> ()
 

compiler/ml/typecore.ml

@@ -4422,7 +4422,6 @@ let report_error env loc ppf error =
   | Apply_wrong_label (l, ty) ->
     let print_message ppf = function
       | Noloc.Nolabel ->
-        (* ?TODO(actions) Make labelled *)
         fprintf ppf "The argument at this position should be labelled."
       | l ->
         fprintf ppf "This function does not take the argument @{<info>%s@}."

tests/build_tests/actions/expected/Actions_MakeArgNonOptional_applied.res

@@ -0,0 +1,9 @@
+let myFunction = (~name: string) => {
+  ignore(name)
+}
+let name = "John"
+myFunction(~name)
+
+/* === AVAILABLE ACTIONS:
+- RewriteArgType(Labelled) - Make argument optional
+*/

tests/build_tests/actions/fixtures/Actions_MakeArgNonOptional.res

@@ -0,0 +1,5 @@
+let myFunction = (~name: string) => {
+  ignore(name)
+}
+let name = "John"
+myFunction(~name?)

tools/src/tools.ml

@@ -1606,6 +1606,40 @@ 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 ({args} as apply), RewriteArgType {to_type}
+                         ->
+                         let arg_locs =
+                           args
+                           |> List.filter_map (fun (lbl, _e) ->
+                                  match lbl with
+                                  | Asttypes.Labelled {loc} | Optional {loc} ->
+                                    Some loc
+                                  | Nolabel -> None)
+                         in
+                         if List.mem action.loc arg_locs then
+                           Some
+                             {
+                               expr with
+                               pexp_desc =
+                                 Pexp_apply
+                                   {
+                                     apply with
+                                     args =
+                                       args
+                                       |> List.map (fun (lbl, e) ->
+                                              ( (match (lbl, to_type) with
+                                                | ( Asttypes.Optional {txt; loc},
+                                                    `Labelled ) ->
+                                                  Asttypes.Labelled {txt; loc}
+                                                | ( Asttypes.Labelled {txt; loc},
+                                                    `Optional ) ->
+                                                  Asttypes.Optional {txt; loc}
+                                                | _ -> lbl),
+                                                Ast_mapper.default_mapper.expr
+                                                  mapper e ));
+                                   };
+                             }
+                         else None
                        | ( Pexp_let
                              ( Recursive,
                                ({pvb_pat = {ppat_loc}} :: _ as bindings),
@@ -1737,7 +1771,8 @@ module Actions = struct
                  | ForceOpen -> List.mem "ForceOpen" filter
                  | RemoveRecordSpread -> List.mem "RemoveRecordSpread" filter
                  | AssignToUnderscore -> List.mem "AssignToUnderscore" filter
-                 | PipeToIgnore -> List.mem "PipeToIgnore" filter)
+                 | PipeToIgnore -> List.mem "PipeToIgnore" filter
+                 | RewriteArgType _ -> List.mem "RewriteArgType" filter)
       in
       match applyActionsToFile path possible_actions with
       | Ok applied ->