Fix printing of nested types in uncurried mode.

Author: cristianoc

CHANGELOG.md

@@ -37,6 +37,7 @@ These are only breaking changes for unformatted code.
 #### :bug: Bug Fix
 
 - Fix issue where uncurried was not supported with pipe https://github.com/rescript-lang/rescript-compiler/pull/5803
+- Fix printing of nested types in uncurried mode https://github.com/rescript-lang/rescript-compiler/pull/5826
 
 #### :nail_care: Polish
 

lib/4.06.1/unstable/js_compiler.ml

@@ -54648,6 +54648,7 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl =
 
 and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
   let printArrow ~uncurried ?(arity = max_int) typExpr =
+    (* XXX *)
     let attrsBefore, args, returnType =
       ParsetreeViewer.arrowType ~arity typExpr
     in
@@ -54680,7 +54681,11 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
       let typDoc =
         let doc = printTypExpr ~state n cmtTbl in
         match n.ptyp_desc with
-        | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ -> addParens doc
+        | Ptyp_constr
+            ( {txt = Ldot (Ldot (Lident "Js", "Fn"), _)},
+              [{ptyp_desc = Ptyp_arrow _}] )
+        | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ ->
+          addParens doc
         | _ -> doc
       in
       Doc.group

lib/4.06.1/unstable/js_playground_compiler.ml

@@ -54648,6 +54648,7 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl =
 
 and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
   let printArrow ~uncurried ?(arity = max_int) typExpr =
+    (* XXX *)
     let attrsBefore, args, returnType =
       ParsetreeViewer.arrowType ~arity typExpr
     in
@@ -54680,7 +54681,11 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
       let typDoc =
         let doc = printTypExpr ~state n cmtTbl in
         match n.ptyp_desc with
-        | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ -> addParens doc
+        | Ptyp_constr
+            ( {txt = Ldot (Ldot (Lident "Js", "Fn"), _)},
+              [{ptyp_desc = Ptyp_arrow _}] )
+        | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ ->
+          addParens doc
         | _ -> doc
       in
       Doc.group

lib/4.06.1/whole_compiler.ml

@@ -109646,6 +109646,7 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl =
 
 and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
   let printArrow ~uncurried ?(arity = max_int) typExpr =
+    (* XXX *)
     let attrsBefore, args, returnType =
       ParsetreeViewer.arrowType ~arity typExpr
     in
@@ -109678,7 +109679,11 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
       let typDoc =
         let doc = printTypExpr ~state n cmtTbl in
         match n.ptyp_desc with
-        | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ -> addParens doc
+        | Ptyp_constr
+            ( {txt = Ldot (Ldot (Lident "Js", "Fn"), _)},
+              [{ptyp_desc = Ptyp_arrow _}] )
+        | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ ->
+          addParens doc
         | _ -> doc
       in
       Doc.group

res_syntax/src/res_printer.ml

@@ -1549,6 +1549,7 @@ and printLabelDeclaration ~state (ld : Parsetree.label_declaration) cmtTbl =
 
 and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
   let printArrow ~uncurried ?(arity = max_int) typExpr =
+    (* XXX *)
     let attrsBefore, args, returnType =
       ParsetreeViewer.arrowType ~arity typExpr
     in
@@ -1581,7 +1582,11 @@ and printTypExpr ~state (typExpr : Parsetree.core_type) cmtTbl =
       let typDoc =
         let doc = printTypExpr ~state n cmtTbl in
         match n.ptyp_desc with
-        | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ -> addParens doc
+        | Ptyp_constr
+            ( {txt = Ldot (Ldot (Lident "Js", "Fn"), _)},
+              [{ptyp_desc = Ptyp_arrow _}] )
+        | Ptyp_arrow _ | Ptyp_tuple _ | Ptyp_alias _ ->
+          addParens doc
         | _ -> doc
       in
       Doc.group

res_syntax/tests/parsing/grammar/expressions/UncurriedByDefault.res

@@ -31,6 +31,9 @@ type upp = (. ()) => (. ()) => int
 type uu2 = (. unit, unit) => unit
 type up2 = (. (), ()) => unit
 
+type cnested = (string => unit) => unit
+type unested = (. (. string) => unit) => unit
+
 let uannpoly: (. 'a) => string = xx
 let uannint: (. int) => string = xx
 
@@ -70,6 +73,9 @@ type upp = () => () => int
 type uu2 = (unit, unit) => unit
 type up2 = ((), ()) => unit
 
+type cnested = (. (. string) => unit) => unit
+type unested = (string => unit) => unit
+
 let pipe1 = 3->f
 
 let uannpoly: 'a => string = xx

res_syntax/tests/parsing/grammar/expressions/expected/UncurriedByDefault.res.txt

@@ -40,6 +40,8 @@ type nonrec uup = (unit -> int Js.Fn.arity0) Js.Fn.arity1
 type nonrec upp = int Js.Fn.arity0 Js.Fn.arity0
 type nonrec uu2 = (unit -> unit -> unit) Js.Fn.arity2
 type nonrec up2 = (unit -> unit -> unit) Js.Fn.arity2
+type nonrec cnested = (string -> unit) -> unit
+type nonrec unested = ((string -> unit) Js.Fn.arity1 -> unit) Js.Fn.arity1
 let (uannpoly : ('a -> string) Js.Fn.arity1) = xx
 let (uannint : (int -> string) Js.Fn.arity1) = xx
 [@@@uncurried ]
@@ -86,6 +88,8 @@ type nonrec uup = (unit -> int Js.Fn.arity0) Js.Fn.arity1
 type nonrec upp = int Js.Fn.arity0 Js.Fn.arity0
 type nonrec uu2 = (unit -> unit -> unit) Js.Fn.arity2
 type nonrec up2 = (unit -> unit -> unit) Js.Fn.arity2
+type nonrec cnested = (string -> unit) -> unit
+type nonrec unested = ((string -> unit) Js.Fn.arity1 -> unit) Js.Fn.arity1
 let pipe1 = 3 |.u f
 let (uannpoly : ('a -> string) Js.Fn.arity1) = xx
 let (uannint : (int -> string) Js.Fn.arity1) = xx

res_syntax/tests/printer/expr/UncurriedByDefault.res

@@ -31,6 +31,9 @@ type upp = (. ()) => (. ()) => int
 type uu2 = (. unit, unit) => unit
 type up2 = (. (), ()) => unit
 
+type cnested = (string => unit) => unit
+type unested = (. (. string) => unit) => unit
+
 let pipe = a->foo(. b, c)
 
 @@uncurried
@@ -69,4 +72,7 @@ type upp = () => () => int
 type uu2 = (unit, unit) => unit
 type up2 = ((), ()) => unit
 
+type cnested = (. (. string) => unit) => unit
+type unested = (string => unit) => unit
+
 let pipe = a->foo(b, c)

res_syntax/tests/printer/expr/expected/UncurriedByDefault.res.txt

@@ -31,6 +31,9 @@ type upp = (. ()) => (. ()) => int
 type uu2 = (. unit, unit) => unit
 type up2 = (. unit, unit) => unit
 
+type cnested = (string => unit) => unit
+type unested = (. (. string) => unit) => unit
+
 let pipe = a->foo(. b, c)
 
 @@uncurried
@@ -69,4 +72,7 @@ type upp = () => () => int
 type uu2 = (unit, unit) => unit
 type up2 = (unit, unit) => unit
 
+type cnested = (. (. string) => unit) => unit
+type unested = (string => unit) => unit
+
 let pipe = a->foo(b, c)