allow inline records in constrs

zth · zth · commit 2f8d81bd0780 · 2025-01-11T21:00:37.000+01:00
diff --git a/compiler/syntax/src/res_core.ml b/compiler/syntax/src/res_core.ml
@@ -134,11 +134,15 @@ module ErrorMessages = struct
 
   let forbidden_inline_record_declaration =
     "An inline record type declaration is only allowed in a variant \
-     constructor's declaration"
+     constructor's declaration or nested inside of a record type declaration"
 
   let poly_var_int_with_suffix number =
     "A numeric polymorphic variant cannot be followed by a letter. Did you \
      mean `#" ^ number ^ "`?"
+
+  let multiple_inline_record_definitions_at_same_path =
+    "Only one inline record definition is allowed per record field. This \
+     defines more than one inline record."
 end
 
 module InExternal = struct
@@ -4087,7 +4091,22 @@ and parse_atomic_typ_expr ?current_type_name_path ?inline_types ~attrs p =
     | Lbracket -> parse_polymorphic_variant_type ~attrs p
     | Uident _ | Lident _ ->
       let constr = parse_value_path p in
-      let args = parse_type_constructor_args ~constr_name:constr p in
+      let args =
+        parse_type_constructor_args ?inline_types ?current_type_name_path
+          ~constr_name:constr p
+      in
+      let number_of_inline_records_in_args =
+        args
+        |> List.filter (fun (c : Parsetree.core_type) ->
+               c.ptyp_attributes
+               |> List.exists (fun (({txt}, _) : Parsetree.attribute) ->
+                      txt = "res.inlineRecordReference"))
+        |> List.length
+      in
+      if number_of_inline_records_in_args > 1 then
+        Parser.err ~start_pos ~end_pos:p.prev_end_pos p
+          (Diagnostics.message
+             ErrorMessages.multiple_inline_record_definitions_at_same_path);
       Ast_helper.Typ.constr
         ~loc:(mk_loc start_pos p.prev_end_pos)
         ~attrs constr args
@@ -4194,7 +4213,7 @@ and parse_record_or_object_type ?current_type_name_path ?inline_types ~attrs p =
 
     let lid = Location.mkloc (Longident.Lident inline_type_name) loc in
     Ast_helper.Typ.constr
-      ~attrs:[(Location.mknoloc "inlineRecordReference", PStr [])]
+      ~attrs:[(Location.mknoloc "res.inlineRecordReference", PStr [])]
       ~loc lid []
   | _ ->
     let () =
@@ -4472,15 +4491,17 @@ and parse_tuple_type ~attrs ~first ~start_pos p =
   let tuple_loc = mk_loc start_pos p.prev_end_pos in
   Ast_helper.Typ.tuple ~attrs ~loc:tuple_loc typexprs
 
-and parse_type_constructor_arg_region p =
-  if Grammar.is_typ_expr_start p.Parser.token then Some (parse_typ_expr p)
+and parse_type_constructor_arg_region ?inline_types ?current_type_name_path p =
+  if Grammar.is_typ_expr_start p.Parser.token then
+    Some (parse_typ_expr ?inline_types ?current_type_name_path p)
   else if p.token = LessThan then (
     Parser.next p;
-    parse_type_constructor_arg_region p)
+    parse_type_constructor_arg_region ?inline_types ?current_type_name_path p)
   else None
 
 (* Js.Nullable.value<'a> *)
-and parse_type_constructor_args ~constr_name p =
+and parse_type_constructor_args ?inline_types ?current_type_name_path
+    ~constr_name p =
   let opening = p.Parser.token in
   let opening_start_pos = p.start_pos in
   match opening with
@@ -4490,7 +4511,11 @@ and parse_type_constructor_args ~constr_name p =
     let type_args =
       (* TODO: change Grammar.TypExprList to TypArgList!!! Why did I wrote this? *)
       parse_comma_delimited_region ~grammar:Grammar.TypExprList
-        ~closing:GreaterThan ~f:parse_type_constructor_arg_region p
+        ~closing:GreaterThan
+        ~f:
+          (parse_type_constructor_arg_region ?inline_types
+             ?current_type_name_path)
+        p
     in
     let () =
       match p.token with
@@ -5589,7 +5614,7 @@ and parse_type_definition_or_extension ~attrs p =
       !inline_types
       |> List.map (fun (inline_type_name, loc, kind) ->
              Ast_helper.Type.mk
-               ~attrs:[(Location.mknoloc "inlineRecordDefinition", PStr [])]
+               ~attrs:[(Location.mknoloc "res.inlineRecordDefinition", PStr [])]
                ~loc ~kind
                {name with txt = inline_type_name})
     in
diff --git a/compiler/syntax/src/res_parsetree_viewer.ml b/compiler/syntax/src/res_parsetree_viewer.ml
@@ -204,7 +204,8 @@ let filter_parsing_attrs attrs =
               ( "res.braces" | "ns.braces" | "res.iflet" | "res.namedArgLoc"
               | "res.ternary" | "res.await" | "res.template"
               | "res.taggedTemplate" | "res.patVariantSpread"
-              | "res.dictPattern" );
+              | "res.dictPattern" | "res.inlineRecordReference"
+              | "res.inlineRecordDefinition" );
           },
           _ ) ->
         false
@@ -358,7 +359,8 @@ let has_attributes attrs =
       | ( {
             Location.txt =
               ( "res.braces" | "ns.braces" | "res.iflet" | "res.ternary"
-              | "res.await" | "res.template" );
+              | "res.await" | "res.template" | "res.inlineRecordReference"
+              | "res.inlineRecordDefinition" );
           },
           _ ) ->
         false
@@ -553,7 +555,8 @@ let is_printable_attribute attr =
   | ( {
         Location.txt =
           ( "res.iflet" | "res.braces" | "ns.braces" | "JSX" | "res.await"
-          | "res.template" | "res.ternary" );
+          | "res.template" | "res.ternary" | "res.inlineRecordReference"
+          | "res.inlineRecordDefinition" );
       },
       _ ) ->
     false
diff --git a/compiler/syntax/src/res_printer.ml b/compiler/syntax/src/res_printer.ml
@@ -553,12 +553,12 @@ end
 let is_inline_record_definition attrs =
   attrs
   |> List.exists (fun (({txt}, _) : Parsetree.attribute) ->
-         txt = "inlineRecordDefinition")
+         txt = "res.inlineRecordDefinition")
 
 let is_inline_record_reference attrs =
   attrs
   |> List.exists (fun (({txt}, _) : Parsetree.attribute) ->
-         txt = "inlineRecordReference")
+         txt = "res.inlineRecordReference")
 
 let rec print_structure ~state (s : Parsetree.structure) t =
   match s with
@@ -587,9 +587,7 @@ and print_structure_item ~state (si : Parsetree.structure_item) cmt_tbl =
     let inline_record_definitions, regular_declarations =
       type_declarations
       |> List.partition (fun (td : Parsetree.type_declaration) ->
-             td.ptype_attributes
-             |> List.exists (fun (({txt}, _) : Parsetree.attribute) ->
-                    txt = "inlineRecordDefinition"))
+             is_inline_record_definition td.ptype_attributes)
     in
     print_type_declarations ~inline_record_definitions ~state
       ~rec_flag:
@@ -1616,28 +1614,11 @@ and print_label_declaration ?inline_record_definitions ~state
          name;
          optional;
          (if is_dot then Doc.nil else Doc.text ": ");
-         (match
-            ( inline_record_definitions,
-              is_inline_record_reference ld.pld_type.ptyp_attributes,
-              ld.pld_type )
-          with
-         | ( Some inline_record_definitions,
-             true,
-             {ptyp_desc = Ptyp_constr ({txt = Lident constr_name}, _)} ) -> (
-           let record_definition =
-             inline_record_definitions
-             |> List.find_opt (fun (r : Parsetree.type_declaration) ->
-                    r.ptype_name.txt = constr_name)
-           in
-           match record_definition with
-           | Some {ptype_kind = Ptype_record lds} ->
-             print_record_declaration ~inline_record_definitions ~state lds
-               cmt_tbl
-           | _ -> assert false)
-         | _ -> print_typ_expr ~state ld.pld_type cmt_tbl);
+         print_typ_expr ?inline_record_definitions ~state ld.pld_type cmt_tbl;
        ])
 
-and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl =
+and print_typ_expr ?inline_record_definitions ~(state : State.t)
+    (typ_expr : Parsetree.core_type) cmt_tbl =
   let print_arrow ~arity typ_expr =
     let max_arity =
       match arity with
@@ -1742,6 +1723,22 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl =
     | Ptyp_object (fields, open_flag) ->
       print_object ~state ~inline:false fields open_flag cmt_tbl
     | Ptyp_arrow (_, _, _, arity) -> print_arrow ~arity typ_expr
+    | Ptyp_constr ({txt = Lident inline_record_name}, [])
+      when is_inline_record_reference typ_expr.ptyp_attributes -> (
+      let inline_record_definitions =
+        match inline_record_definitions with
+        | None -> []
+        | Some v -> v
+      in
+      let record_definition =
+        inline_record_definitions
+        |> List.find_opt (fun (r : Parsetree.type_declaration) ->
+               r.ptype_name.txt = inline_record_name)
+      in
+      match record_definition with
+      | Some {ptype_kind = Ptype_record lds} ->
+        print_record_declaration ~inline_record_definitions ~state lds cmt_tbl
+      | _ -> assert false)
     | Ptyp_constr
         (longident_loc, [{ptyp_desc = Ptyp_object (fields, open_flag)}]) ->
       (* for foo<{"a": b}>, when the object is long and needs a line break, we
@@ -1782,15 +1779,17 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl =
                         ~sep:(Doc.concat [Doc.comma; Doc.line])
                         (List.map
                            (fun typexpr ->
-                             print_typ_expr ~state typexpr cmt_tbl)
+                             print_typ_expr ?inline_record_definitions ~state
+                               typexpr cmt_tbl)
                            constr_args);
                     ]);
                Doc.trailing_comma;
                Doc.soft_line;
                Doc.greater_than;
              ]))
     | Ptyp_tuple types -> print_tuple_type ~state ~inline:false types cmt_tbl
-    | Ptyp_poly ([], typ) -> print_typ_expr ~state typ cmt_tbl
+    | Ptyp_poly ([], typ) ->
+      print_typ_expr ?inline_record_definitions ~state typ cmt_tbl
     | Ptyp_poly (string_locs, typ) ->
       Doc.concat
         [
diff --git a/tests/tests/src/nested_records.mjs b/tests/tests/src/nested_records.mjs
@@ -6,6 +6,12 @@ let options = {
     name: "test",
     superExtra: {
       age: 2222
+    },
+    otherExtra: {
+      test: true,
+      anotherInlined: {
+        record: true
+      }
     }
   }
 };
diff --git a/tests/tests/src/nested_records.res b/tests/tests/src/nested_records.res
@@ -2,6 +2,7 @@ type options = {
   extra?: {
     name: string,
     superExtra?: {age: int},
+    otherExtra: option<{test: bool, anotherInlined: {record: bool}}>,
   },
 }
 
@@ -11,5 +12,6 @@ let options = {
     superExtra: {
       age: 2222,
     },
+    otherExtra: Some({test: true, anotherInlined: {record: true}}),
   },
 }

Original file line number	Diff line number	Diff line change
`@@ -6,6 +6,12 @@ let options = {`
`6`	`6`	`name: "test",`
`7`	`7`	`superExtra: {`
`8`	`8`	`age: 2222`
	`9`	`+ },`
	`10`	`+ otherExtra: {`
	`11`	`+ test: true,`
	`12`	`+ anotherInlined: {`
	`13`	`+ record: true`
	`14`	`+ }`
`9`	`15`	`}`
`10`	`16`	`}`
`11`	`17`	`};`
Original file line number	Diff line number	Diff line change
`@@ -2,6 +2,7 @@ type options = {`
`2`	`2`	`extra?: {`
`3`	`3`	`name: string,`
`4`	`4`	`superExtra?: {age: int},`
	`5`	`+ otherExtra: option<{test: bool, anotherInlined: {record: bool}}>,`
`5`	`6`	`},`
`6`	`7`	`}`
`7`	`8`
`@@ -11,5 +12,6 @@ let options = {`
`11`	`12`	`superExtra: {`
`12`	`13`	`age: 2222,`
`13`	`14`	`},`
	`15`	`+ otherExtra: Some({test: true, anotherInlined: {record: true}}),`
`14`	`16`	`},`
`15`	`17`	`}`