Fix @this attribute dropping parens (rescript-lang#7025)

* WIP

* Check for existence of attr and arity

Check for existence of attr at Ptyp_constr (function$) as the @this
attribute is attached to the Ptyp_constr, not the Ptyp_arrow.

* Another way to do it

* Commit changes in test

* Cleanup

* Fix format

* Update CHANGELOG

---------

Co-authored-by: Shulhi Sapli <shulhi@mba-13.local>
Co-authored-by: Christoph Knittel <ck@cca.io>

Author: 3 people

CHANGELOG.md

@@ -20,6 +20,7 @@
 #### :bug: Bug fix
 
 - Fix tuple coercion. https://github.com/rescript-lang/rescript-compiler/pull/7024
+- Fix attribute printing. https://github.com/rescript-lang/rescript-compiler/pull/7025
 
 #### :nail_care: Polish
 

jscomp/syntax/src/res_parsetree_viewer.ml

@@ -1,6 +1,6 @@
 open Parsetree
 
-let arrow_type ?(arity = max_int) ct =
+let arrow_type ?(arity = max_int) ?(attrs = []) ct =
   let has_as_attr attrs =
     Ext_list.exists attrs (fun (x, _) -> x.Asttypes.txt = "as")
   in
@@ -45,10 +45,11 @@ let arrow_type ?(arity = max_int) ct =
     | typ -> (attrs_before, List.rev acc, typ)
   in
   match ct with
-  | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs} as
-    typ ->
+  | {ptyp_desc = Ptyp_arrow (Nolabel, _typ1, _typ2); ptyp_attributes = attrs1}
+    as typ ->
+    let attrs = attrs @ attrs1 in
     process attrs [] {typ with ptyp_attributes = []} arity
-  | typ -> process [] [] typ arity
+  | typ -> process attrs [] typ arity
 
 let functor_type modtype =
   let rec process acc modtype =

jscomp/syntax/src/res_parsetree_viewer.mli

@@ -3,6 +3,7 @@
    * we restructure the tree into (a, b, c) and its returnType d *)
 val arrow_type :
   ?arity:int ->
+  ?attrs:Parsetree.attributes ->
   Parsetree.core_type ->
   Parsetree.attributes
   * (Parsetree.attributes * Asttypes.arg_label * Parsetree.core_type) list

jscomp/syntax/src/res_printer.ml

@@ -1591,9 +1591,13 @@ and print_label_declaration ~state (ld : Parsetree.label_declaration) cmt_tbl =
        ])
 
 and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl =
+  let parent_attrs =
+    let attrs = ParsetreeViewer.filter_parsing_attrs typ_expr.ptyp_attributes in
+    if Ast_uncurried.core_type_is_uncurried_fun typ_expr then attrs else []
+  in
   let print_arrow ?(arity = max_int) typ_expr =
     let attrs_before, args, return_type =
-      ParsetreeViewer.arrow_type ~arity typ_expr
+      ParsetreeViewer.arrow_type ~arity ~attrs:parent_attrs typ_expr
     in
     let return_type_needs_parens =
       match return_type.ptyp_desc with
@@ -1841,6 +1845,8 @@ and print_typ_expr ~(state : State.t) (typ_expr : Parsetree.core_type) cmt_tbl =
   in
   let should_print_its_own_attributes =
     match typ_expr.ptyp_desc with
+    | Ptyp_constr _ when Ast_uncurried.core_type_is_uncurried_fun typ_expr ->
+      true
     | Ptyp_arrow _ (* es6 arrow types print their own attributes *) -> true
     | _ -> false
   in

jscomp/syntax/tests/printer/typexpr/expected/arrow.res.txt

@@ -125,13 +125,13 @@ type t = (
 type t = (@attr string, @attr float) => unit
 type t = (@attr @attr2 string, @attr @attr2 float, @attr3 int) => unit
 
-type t = @attr string => unit
+type t = @attr (string => unit)
 type t = @attr (foo, bar, baz) => unit
 type t = @attr (foo, @attr2 ~f: bar, @attr3 ~f: baz) => unit
 
-type t = @attr string => @attr int => unit
+type t = @attr (string => @attr (int => unit))
 type t = @attr (string, int) => @attr (int, float) => unit
-type t = @attr int => @attr (int, float) => @attr unit => unit => unit
+type t = @attr (int => @attr (int, float) => @attr (unit => unit => unit))
 type t = @attr (@attr2 ~f: int, @attr3 ~g: float) => unit
 
 type f = (
@@ -144,50 +144,50 @@ type f = (
   @attr3 ~h: ccccrazysldkfjslkdjflksdjkf=?,
 ) => unit
 
-type t = @attr
-stringWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong => @attr2
-floatWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong => @attr3
-intWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong => unitWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong
+type t = @attr (
+  stringWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong => @attr2 (
+    floatWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong => @attr3 (
+      intWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong => unitWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong
+    )
+  )
+)
 
-type t = @attr
-(
+type t = @attr (
   fooWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong,
   barWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong,
   bazWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong,
-) => @attr2
-(
+) => @attr2 (
   stringWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong,
   floatWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong,
 ) => unit
 
 type t = @attr
 @attrWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong
-@attrWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong
-(
+@attrWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong (
   fooWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong,
   barWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong,
   bazWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong,
 ) => @attr2
 @attrWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong
-@attrWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong
-(
+@attrWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong (
   stringWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong,
   floatWithSuperLongIdentifierNameLoooooooooooooooooooooooooooooooooooooooooooooong,
 ) => unit
 
 external debounce: (int, @meth unit) => unit = "debounce"
 
-external debounce: int => @meth unit => unit = "debounce"
+external debounce: int => @meth (unit => unit) = "debounce"
 
-external debounce: (int, @meth unit => unit) => @meth unit => unit = "debounce"
+external debounce: (int, @meth (unit => unit)) => @meth (unit => unit) = "debounce"
 
-external debounce: (int, @meth unit => unit, @meth unit => unit) => @meth unit => unit = "debounce"
+external debounce: (int, @meth (unit => unit), @meth (unit => unit)) => @meth (unit => unit) =
+  "debounce"
 
 external debounce: (
   int,
-  @meth unit => unit,
-  @meth unit => @meth unit => unit,
-) => @meth unit => unit = "debounce"
+  @meth (unit => unit),
+  @meth (unit => @meth (unit => unit)),
+) => @meth (unit => unit) = "debounce"
 
 type returnTyp = (int, int) => @magic float
 type returnTyp = (
@@ -214,7 +214,7 @@ type t = (@attrOnInt int, @attrOnInt int, @attrOnInt int, @attrOnInt int) => int
 type t = (@attr ~x: int, ~y: int, @attr ~z: int, @attr ~omega: int) => unit
 
 @val external requestAnimationFrame: (float => unit) => unit = "requestAnimationFrame"
-@val external requestAnimationFrame: @attr (float => unit) => unit = "requestAnimationFrame"
+@val external requestAnimationFrame: @attr ((float => unit) => unit) = "requestAnimationFrame"
 
 type arrows = (int, (float => unit) => unit, float) => unit
 

jscomp/test/reasonReact.res

@@ -117,8 +117,7 @@ and oldNewSelf<'state, 'retainedProps, 'action> = {
 type rec jsComponentThis<'state, 'props, 'retainedProps, 'action> = {
   "state": totalState<'state, 'retainedProps, 'action>,
   "props": {"reasonProps": 'props},
-  "setState": @meth
-  (
+  "setState": @meth (
     (
       totalState<'state, 'retainedProps, 'action>,
       'props,