refactor printing type declarations to fix inline type declarations not being printed correctly in interface files

Author: zth

compiler/syntax/src/res_printer.ml

@@ -40,6 +40,13 @@ let add_braces doc =
 
 let add_async doc = Doc.concat [Doc.text "async "; doc]
 
+let has_inline_type_definitions type_declarations =
+  type_declarations
+  |> List.find_opt (fun (td : Parsetree.type_declaration) ->
+         Res_parsetree_viewer.has_inline_record_definition_attribute
+           td.ptype_attributes)
+  |> Option.is_some
+
 let get_first_leading_comment tbl loc =
   match Hashtbl.find tbl.CommentTable.leading loc with
   | comment :: _ -> Some comment
@@ -587,29 +594,7 @@ and print_structure_item ~state (si : Parsetree.structure_item) cmt_tbl =
       | Asttypes.Recursive -> Doc.text "rec "
     in
     print_value_bindings ~state ~rec_flag value_bindings cmt_tbl
-  | Pstr_type (Recursive, type_declarations)
-    when type_declarations
-         |> List.find_opt (fun (td : Parsetree.type_declaration) ->
-                Res_parsetree_viewer.has_inline_record_definition_attribute
-                  td.ptype_attributes)
-         |> Option.is_some ->
-    let inline_record_definitions, regular_declarations =
-      type_declarations
-      |> List.partition (fun (td : Parsetree.type_declaration) ->
-             Res_parsetree_viewer.has_inline_record_definition_attribute
-               td.ptype_attributes)
-    in
-    print_type_declarations ~inline_record_definitions ~state
-      ~rec_flag:
-        (if List.length regular_declarations > 1 then Doc.text "rec "
-         else Doc.nil)
-      regular_declarations cmt_tbl
   | Pstr_type (rec_flag, type_declarations) ->
-    let rec_flag =
-      match rec_flag with
-      | Asttypes.Nonrecursive -> Doc.nil
-      | Asttypes.Recursive -> Doc.text "rec "
-    in
     print_type_declarations ~state ~rec_flag type_declarations cmt_tbl
   | Pstr_primitive value_description ->
     print_value_description ~state value_description cmt_tbl
@@ -985,11 +970,6 @@ and print_signature_item ~state (si : Parsetree.signature_item) cmt_tbl =
   | Parsetree.Psig_value value_description ->
     print_value_description ~state value_description cmt_tbl
   | Psig_type (rec_flag, type_declarations) ->
-    let rec_flag =
-      match rec_flag with
-      | Asttypes.Nonrecursive -> Doc.nil
-      | Asttypes.Recursive -> Doc.text "rec "
-    in
     print_type_declarations ~state ~rec_flag type_declarations cmt_tbl
   | Psig_typext type_extension ->
     print_type_extension ~state type_extension cmt_tbl
@@ -1191,13 +1171,39 @@ and print_value_description ~state value_description cmt_tbl =
           else Doc.nil);
        ])
 
-and print_type_declarations ?inline_record_definitions ~state ~rec_flag
-    type_declarations cmt_tbl =
-  print_listi
-    ~get_loc:(fun n -> n.Parsetree.ptype_loc)
-    ~nodes:type_declarations
-    ~print:(print_type_declaration2 ?inline_record_definitions ~state ~rec_flag)
-    cmt_tbl
+and print_type_declarations ~state ~rec_flag type_declarations cmt_tbl =
+  if has_inline_type_definitions type_declarations then
+    let inline_record_definitions, regular_declarations =
+      type_declarations
+      |> List.partition (fun (td : Parsetree.type_declaration) ->
+             Res_parsetree_viewer.has_inline_record_definition_attribute
+               td.ptype_attributes)
+    in
+    let adjusted_rec_flag =
+      match rec_flag with
+      | Recursive ->
+        if List.length regular_declarations > 1 then Doc.text "rec "
+        else Doc.nil
+      | Nonrecursive -> Doc.nil
+    in
+    print_listi
+      ~get_loc:(fun n -> n.Parsetree.ptype_loc)
+      ~nodes:regular_declarations
+      ~print:
+        (print_type_declaration2 ~inline_record_definitions ~state
+           ~rec_flag:adjusted_rec_flag)
+      cmt_tbl
+  else
+    print_listi
+      ~get_loc:(fun n -> n.Parsetree.ptype_loc)
+      ~nodes:type_declarations
+      ~print:
+        (print_type_declaration2 ~state
+           ~rec_flag:
+             (match rec_flag with
+             | Nonrecursive -> Doc.nil
+             | Recursive -> Doc.text "rec "))
+      cmt_tbl
 
 (*
  * type_declaration = {

tests/syntax_tests/data/printer/signature/expected/type.resi.txt

@@ -6,3 +6,7 @@ type color =
   | Red
   | Blue
   | Black
+
+type options = {
+  permissions: {all: bool},
+}

tests/syntax_tests/data/printer/signature/type.resi

@@ -6,3 +6,9 @@ type color =
   | Red
   | Blue
   | Black
+
+type options = {
+  permissions: {
+    all: bool
+  }
+}