Fix visible forall in ppr_ty (#18522)wip/t18522-b

Before this patch, this type:
  T :: forall k -> (k ~ k) => forall j -> k -> j -> Type
was printed incorrectly as:
  T :: forall k j -> (k ~ k) => k -> j -> Type

4 files changed, 30 insertions, 2 deletions

diff --git a/compiler/GHC/Iface/Type.hs b/compiler/GHC/Iface/Type.hs
index 28a628344f..2a152074f0 100644
--- a/compiler/GHC/Iface/Type.hs
+++ b/compiler/GHC/Iface/Type.hs
@@ -441,6 +441,7 @@ splitIfaceSigmaTy ty
     (theta, tau)   = split_rho rho
 
     split_foralls (IfaceForAllTy bndr ty)
+        | isInvisibleArgFlag (binderArgFlag bndr)
         = case split_foralls ty of { (bndrs, rho) -> (bndr:bndrs, rho) }
     split_foralls rho = ([], rho)
 
@@ -448,6 +449,12 @@ splitIfaceSigmaTy ty
         = case split_rho ty2 of { (ps, tau) -> (ty1:ps, tau) }
     split_rho tau = ([], tau)
 
+splitIfaceReqForallTy :: IfaceType -> ([IfaceForAllBndr], IfaceType)
+splitIfaceReqForallTy (IfaceForAllTy bndr ty)
+  | isVisibleArgFlag (binderArgFlag bndr)
+  = case splitIfaceReqForallTy ty of { (bndrs, rho) -> (bndr:bndrs, rho) }
+splitIfaceReqForallTy rho = ([], rho)
+
 suppressIfaceInvisibles :: PrintExplicitKinds -> [IfaceTyConBinder] -> [a] -> [a]
 suppressIfaceInvisibles (PrintExplicitKinds True) _tys xs = xs
 suppressIfaceInvisibles (PrintExplicitKinds False) tys xs = suppress tys xs
@@ -1184,8 +1191,23 @@ pprIfaceSigmaType show_forall ty
   = hideNonStandardTypes ppr_fn ty
   where
     ppr_fn iface_ty =
-      let (tvs, theta, tau) = splitIfaceSigmaTy iface_ty
-       in ppr_iface_forall_part show_forall tvs theta (ppr tau)
+      let (invis_tvs, theta, tau) = splitIfaceSigmaTy iface_ty
+          (req_tvs, tau') = splitIfaceReqForallTy tau
+          -- splitIfaceSigmaTy is recursive, so it will gather the binders after
+          -- the theta, i.e.  forall a. theta => forall b. tau
+          -- will give you    ([a,b], theta, tau).
+          --
+          -- This isn't right when it comes to visible forall (see
+          --  testsuite/tests/polykinds/T18522-ppr),
+          -- so we split off required binders separately,
+          -- using splitIfaceReqForallTy.
+          --
+          -- An alternative solution would be to make splitIfaceSigmaTy
+          -- non-recursive (see #18458).
+          -- Then it could handle both invisible and required binders, and
+          -- splitIfaceReqForallTy wouldn't be necessary here.
+       in ppr_iface_forall_part show_forall invis_tvs theta $
+          sep [pprIfaceForAll req_tvs, ppr tau']
 
 pprUserIfaceForAll :: [IfaceForAllBndr] -> SDoc
 pprUserIfaceForAll tvs
diff --git a/testsuite/tests/polykinds/T18522-ppr.script b/testsuite/tests/polykinds/T18522-ppr.script
new file mode 100644
index 0000000000..54d3619c6e
--- /dev/null
+++ b/testsuite/tests/polykinds/T18522-ppr.script
@@ -0,0 +1,4 @@
+:set -XPolyKinds -XDataKinds -XRankNTypes -XTypeFamilies
+import Data.Kind (Type)
+type family T :: forall k -> (k ~ k) => forall j -> k -> j -> Type
+:k T
diff --git a/testsuite/tests/polykinds/T18522-ppr.stdout b/testsuite/tests/polykinds/T18522-ppr.stdout
new file mode 100644
index 0000000000..241530bbed
--- /dev/null
+++ b/testsuite/tests/polykinds/T18522-ppr.stdout
@@ -0,0 +1 @@
+T :: forall k -> (k ~ k) => forall j -> k -> j -> *
diff --git a/testsuite/tests/polykinds/all.T b/testsuite/tests/polykinds/all.T
index 436bb9dbce..68bf260e64 100644
--- a/testsuite/tests/polykinds/all.T
+++ b/testsuite/tests/polykinds/all.T
@@ -223,3 +223,4 @@ test('T18300', normal, compile_fail, [''])
 test('T18451', normal, compile_fail, [''])
 test('T18451a', normal, compile_fail, [''])
 test('T18451b', normal, compile_fail, [''])
+test('T18522-ppr', normal, ghci_script, ['T18522-ppr.script'])