Use funPrec, not topPrec, to parenthesize GADT argument types

A simple oversight. Fixes #16527.

5 files changed, 27 insertions, 8 deletions

diff --git a/compiler/iface/IfaceSyn.hs b/compiler/iface/IfaceSyn.hs
index 5478c941c0..562d816938 100644
--- a/compiler/iface/IfaceSyn.hs
+++ b/compiler/iface/IfaceSyn.hs
@@ -1034,7 +1034,7 @@ pprIfaceConDecl ss gadt_style tycon tc_binders parent
     -- a compound field type is if it's preceded by a bang pattern.
     pprFieldArgTy (bang, ty) = ppr_arg_ty (bang_prec bang) bang ty
     -- If not using record syntax, a compound field type might need to be
-    -- parenthesize if one of the following holds:
+    -- parenthesized if one of the following holds:
     --
     -- 1. We're using Haskell98 syntax.
     -- 2. The field type is preceded with a bang pattern.
@@ -1046,18 +1046,23 @@ pprIfaceConDecl ss gadt_style tycon tc_binders parent
     -- If we're displaying the fields GADT-style, e.g.,
     --
     --   data Foo a where
-    --     MkFoo :: Maybe a -> Foo
+    --     MkFoo :: (Int -> Int) -> Maybe a -> Foo
     --
-    -- Then there is no inherent need to parenthesize compound fields like
-    -- `Maybe a` (bang patterns notwithstanding). If we're displaying the
-    -- fields Haskell98-style, e.g.,
+    -- Then we use `funPrec`, since that will ensure `Int -> Int` gets the
+    -- parentheses that it requires, but simple compound types like `Maybe a`
+    -- (which don't require parentheses in a function argument position) won't
+    -- get them, assuming that there are no bang patterns (see bang_prec).
     --
-    --   data Foo a = MkFoo (Maybe a)
+    -- If we're displaying the fields Haskell98-style, e.g.,
     --
-    -- Then we *must* parenthesize compound fields like (Maybe a).
+    --   data Foo a = MkFoo (Int -> Int) (Maybe a)
+    --
+    -- Then not only must we parenthesize `Int -> Int`, we must also
+    -- parenthesize compound fields like (Maybe a). Therefore, we pick
+    -- `appPrec`, which has higher precedence than `funPrec`.
     gadt_prec :: PprPrec
     gadt_prec
-      | gadt_style = topPrec
+      | gadt_style = funPrec
       | otherwise  = appPrec
 
     -- The presence of bang patterns or UNPACK annotations requires
diff --git a/testsuite/tests/ghci/scripts/T16527.hs b/testsuite/tests/ghci/scripts/T16527.hs
new file mode 100644
index 0000000000..d33071155a
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16527.hs
@@ -0,0 +1,7 @@
+{-# LANGUAGE GADTs #-}
+{-# LANGUAGE RankNTypes #-}
+module T16527 where
+
+data T where
+  MkT1 :: (Int -> Int) -> T
+  MkT2 :: (forall a. Maybe a) -> T
diff --git a/testsuite/tests/ghci/scripts/T16527.script b/testsuite/tests/ghci/scripts/T16527.script
new file mode 100644
index 0000000000..90c3f71f84
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16527.script
@@ -0,0 +1,2 @@
+:load T16527
+:info T
diff --git a/testsuite/tests/ghci/scripts/T16527.stdout b/testsuite/tests/ghci/scripts/T16527.stdout
new file mode 100644
index 0000000000..fd4e0ef735
--- /dev/null
+++ b/testsuite/tests/ghci/scripts/T16527.stdout
@@ -0,0 +1,4 @@
+data T where
+  MkT1 :: (Int -> Int) -> T
+  MkT2 :: (forall a. Maybe a) -> T
+  	-- Defined at T16527.hs:5:1
diff --git a/testsuite/tests/ghci/scripts/all.T b/testsuite/tests/ghci/scripts/all.T
index 1394a9af56..9ece912e1f 100755
--- a/testsuite/tests/ghci/scripts/all.T
+++ b/testsuite/tests/ghci/scripts/all.T
@@ -295,3 +295,4 @@ test('T15941', normal, ghci_script, ['T15941.script'])
 test('T16030', normal, ghci_script, ['T16030.script'])
 test('T11606', normal, ghci_script, ['T11606.script'])
 test('T16089', normal, ghci_script, ['T16089.script'])
+test('T16527', normal, ghci_script, ['T16527.script'])