pass record field expr as optional

Author: zth

compiler/ml/ast_iterator.ml

@@ -44,6 +44,8 @@ type iterator = {
   open_description: iterator -> open_description -> unit;
   pat: iterator -> pattern -> unit;
   payload: iterator -> payload -> unit;
+  record_field: iterator -> expression record_element -> unit;
+  record_field_pat: iterator -> pattern record_element -> unit;
   signature: iterator -> signature -> unit;
   signature_item: iterator -> signature_item -> unit;
   structure: iterator -> structure -> unit;
@@ -309,11 +311,7 @@ module E = struct
       iter_opt (sub.expr sub) arg
     | Pexp_variant (_lab, eo) -> iter_opt (sub.expr sub) eo
     | Pexp_record (l, eo) ->
-      List.iter
-        (fun {lid; x = exp} ->
-          iter_loc sub lid;
-          sub.expr sub exp)
-        l;
+      List.iter (sub.record_field sub) l;
       iter_opt (sub.expr sub) eo
     | Pexp_field (e, lid) ->
       sub.expr sub e;
@@ -399,12 +397,7 @@ module P = struct
       iter_loc sub l;
       iter_opt (sub.pat sub) p
     | Ppat_variant (_l, p) -> iter_opt (sub.pat sub) p
-    | Ppat_record (lpl, _cf) ->
-      List.iter
-        (fun {lid; x = pat} ->
-          iter_loc sub lid;
-          sub.pat sub pat)
-        lpl
+    | Ppat_record (lpl, _cf) -> List.iter (sub.record_field_pat sub) lpl
     | Ppat_array pl -> List.iter (sub.pat sub) pl
     | Ppat_or (p1, p2) ->
       sub.pat sub p1;
@@ -528,4 +521,12 @@ let default_iterator =
         | PPat (x, g) ->
           this.pat this x;
           iter_opt (this.expr this) g);
+    record_field =
+      (fun this {lid; x; opt = _} ->
+        iter_loc this lid;
+        this.expr this x);
+    record_field_pat =
+      (fun this {lid; x; opt = _} ->
+        iter_loc this lid;
+        this.pat this x);
   }

compiler/ml/ast_iterator.mli

@@ -42,6 +42,8 @@ type iterator = {
   open_description: iterator -> open_description -> unit;
   pat: iterator -> pattern -> unit;
   payload: iterator -> payload -> unit;
+  record_field: iterator -> expression record_element -> unit;
+  record_field_pat: iterator -> pattern record_element -> unit;
   signature: iterator -> signature -> unit;
   signature_item: iterator -> signature_item -> unit;
   structure: iterator -> structure -> unit;

compiler/ml/ast_mapper.ml

@@ -48,6 +48,9 @@ type mapper = {
   open_description: mapper -> open_description -> open_description;
   pat: mapper -> pattern -> pattern;
   payload: mapper -> payload -> payload;
+  record_field:
+    mapper -> expression record_element -> expression record_element;
+  record_field_pat: mapper -> pattern record_element -> pattern record_element;
   signature: mapper -> signature -> signature;
   signature_item: mapper -> signature_item -> signature_item;
   structure: mapper -> structure -> structure;
@@ -305,10 +308,7 @@ module E = struct
       variant ~loc ~attrs lab (map_opt (sub.expr sub) eo)
     | Pexp_record (l, eo) ->
       record ~loc ~attrs
-        (List.map
-           (fun {lid; x = exp; opt} ->
-             {lid = map_loc sub lid; x = sub.expr sub exp; opt})
-           l)
+        (List.map (sub.record_field sub) l)
         (map_opt (sub.expr sub) eo)
     | Pexp_field (e, lid) ->
       field ~loc ~attrs (sub.expr sub e) (map_loc sub lid)
@@ -391,12 +391,7 @@ module P = struct
       construct ~loc ~attrs (map_loc sub l) (map_opt (sub.pat sub) p)
     | Ppat_variant (l, p) -> variant ~loc ~attrs l (map_opt (sub.pat sub) p)
     | Ppat_record (lpl, cf) ->
-      record ~loc ~attrs
-        (List.map
-           (fun {lid; x = pat; opt} ->
-             {lid = map_loc sub lid; x = sub.pat sub pat; opt})
-           lpl)
-        cf
+      record ~loc ~attrs (List.map (sub.record_field_pat sub) lpl) cf
     | Ppat_array pl -> array ~loc ~attrs (List.map (sub.pat sub) pl)
     | Ppat_or (p1, p2) -> or_ ~loc ~attrs (sub.pat sub p1) (sub.pat sub p2)
     | Ppat_constraint (p, t) ->
@@ -509,6 +504,12 @@ let default_mapper =
         | PSig x -> PSig (this.signature this x)
         | PTyp x -> PTyp (this.typ this x)
         | PPat (x, g) -> PPat (this.pat this x, map_opt (this.expr this) g));
+    record_field =
+      (fun this {lid; x; opt} ->
+        {lid = map_loc this lid; x = this.expr this x; opt});
+    record_field_pat =
+      (fun this {lid; x; opt} ->
+        {lid = map_loc this lid; x = this.pat this x; opt});
   }
 
 let rec extension_of_error {loc; msg; if_highlight; sub} =

compiler/ml/ast_mapper.mli

@@ -76,6 +76,9 @@ type mapper = {
   open_description: mapper -> open_description -> open_description;
   pat: mapper -> pattern -> pattern;
   payload: mapper -> payload -> payload;
+  record_field:
+    mapper -> expression record_element -> expression record_element;
+  record_field_pat: mapper -> pattern record_element -> pattern record_element;
   signature: mapper -> signature -> signature;
   signature_item: mapper -> signature_item -> signature_item;
   structure: mapper -> structure -> structure;

compiler/ml/cmt_utils.ml

@@ -54,6 +54,7 @@ type action_type =
   | PipeToIgnore
   | PartiallyApplyFunction
   | InsertMissingArguments of {missing_args: Asttypes.Noloc.arg_label list}
+  | ChangeRecordFieldOptional of {optional: bool}
 
 (* TODO: 
 - Unused var in patterns (and aliases )*)
@@ -108,6 +109,9 @@ let action_to_string = function
              | Asttypes.Noloc.Optional txt -> "?" ^ txt
              | Asttypes.Noloc.Nolabel -> "<unlabelled>")
       |> String.concat ", ")
+  | ChangeRecordFieldOptional {optional} ->
+    Printf.sprintf "ChangeRecordFieldOptional(%s)"
+      (if optional then "true" else "false")
 
 let _add_possible_action : (cmt_action -> unit) ref = ref (fun _ -> ())
 let add_possible_action action = !_add_possible_action action

compiler/ml/error_message_utils.ml

@@ -589,7 +589,12 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf
   | ( Some (RecordField {optional = true; field_name; jsx = None}),
       Some ({desc = Tconstr (p, _, _)}, _) )
     when Path.same Predef.path_option p ->
-    (* TODO(actions) Prepend with `?` *)
+    Cmt_utils.add_possible_action
+      {
+        loc;
+        action = ChangeRecordFieldOptional {optional = true};
+        description = "Pass field as optional";
+      };
     fprintf ppf
       "@,\
        @,\
@@ -608,7 +613,7 @@ let print_extra_type_clash_help ~extract_concrete_typedecl ~env loc ppf
   | ( Some (RecordField {optional = true; field_name; jsx = Some _}),
       Some ({desc = Tconstr (p, _, _)}, _) )
     when Path.same Predef.path_option p ->
-    (* TODO(actions) Prepend with `?` *)
+    (* TODO(actions) JSX: Prepend with `?` *)
     fprintf ppf
       "@,\
        @,\

tests/build_tests/actions/expected/Actions_PassRecordFieldAsOptional_applied.res

@@ -0,0 +1,8 @@
+type record = {a: int, test?: bool}
+let test = Some(true)
+
+let x = {a: 10, ?test}
+
+/* === AVAILABLE ACTIONS:
+- ChangeRecordFieldOptional(true) - Pass field as optional
+*/

tests/build_tests/actions/fixtures/Actions_PassRecordFieldAsOptional.res

@@ -0,0 +1,4 @@
+type record = {a: int, test?: bool}
+let test = Some(true)
+
+let x = {a: 10, test}

tools/src/tools.ml

@@ -1295,10 +1295,39 @@ end
 
 module Migrate = Migrate
 module Actions = struct
+  let change_record_field_optional (record_el : _ Parsetree.record_element)
+      target_loc actions =
+    let change_record_field_optional_action =
+      actions
+      |> List.find_map (fun (action : Cmt_utils.cmt_action) ->
+             match action.action with
+             | ChangeRecordFieldOptional {optional} when target_loc = action.loc
+               ->
+               Some optional
+             | _ -> None)
+    in
+    match change_record_field_optional_action with
+    | Some opt -> {record_el with opt}
+    | None -> record_el
+
   let applyActionsToFile path actions =
     let mapper =
       {
         Ast_mapper.default_mapper with
+        record_field =
+          (fun mapper record_el ->
+            let record_el =
+              change_record_field_optional record_el record_el.x.pexp_loc
+                actions
+            in
+            Ast_mapper.default_mapper.record_field mapper record_el);
+        record_field_pat =
+          (fun mapper record_el ->
+            let record_el =
+              change_record_field_optional record_el record_el.x.ppat_loc
+                actions
+            in
+            Ast_mapper.default_mapper.record_field_pat mapper record_el);
         structure_item =
           (fun mapper str_item ->
             let remove_rec_flag_action_locs =
@@ -1803,7 +1832,9 @@ module Actions = struct
                    List.mem "PartiallyApplyFunction" filter
                  | RewriteArgType _ -> List.mem "RewriteArgType" filter
                  | InsertMissingArguments _ ->
-                   List.mem "InsertMissingArguments" filter)
+                   List.mem "InsertMissingArguments" filter
+                 | ChangeRecordFieldOptional _ ->
+                   List.mem "ChangeRecordFieldOptional" filter)
       in
       match applyActionsToFile path possible_actions with
       | Ok applied ->