allow inline records in constrs

Author: zth

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
@@ -4071,7 +4075,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
@@ -4178,7 +4197,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 () =
@@ -4447,15 +4466,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
@@ -4465,7 +4486,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
@@ -5563,7 +5588,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

compiler/syntax/src/res_parsetree_viewer.ml

@@ -352,7 +352,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
@@ -547,7 +548,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

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:
@@ -1614,28 +1612,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
@@ -1740,6 +1721,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
@@ -1780,15 +1777,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
         [

tests/tests/src/nested_records.mjs

@@ -6,6 +6,12 @@ let options = {
     name: "test",
     superExtra: {
       age: 2222
+    },
+    otherExtra: {
+      test: true,
+      anotherInlined: {
+        record: true
+      }
     }
   }
 };

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}}),
   },
 }