Line wrap when pp long expressions (fixes #16874)

This commit fixes #16874 by using `fsep` rather than `sep` when pretty
printing long patterns and expressions.

5 files changed, 27 insertions, 2 deletions

diff --git a/compiler/hsSyn/HsExpr.hs b/compiler/hsSyn/HsExpr.hs
index 6bfdad1600..69379bc1ad 100644
--- a/compiler/hsSyn/HsExpr.hs
+++ b/compiler/hsSyn/HsExpr.hs
@@ -1077,7 +1077,7 @@ ppr_apps (HsApp _ (L _ fun) arg)        args
   = ppr_apps fun (Left arg : args)
 ppr_apps (HsAppType _ (L _ fun) arg)    args
   = ppr_apps fun (Right arg : args)
-ppr_apps fun args = hang (ppr_expr fun) 2 (sep (map pp args))
+ppr_apps fun args = hang (ppr_expr fun) 2 (fsep (map pp args))
   where
     pp (Left arg)                             = ppr arg
     -- pp (Right (LHsWcTypeX (HsWC { hswc_body = L _ arg })))
diff --git a/compiler/hsSyn/HsPat.hs b/compiler/hsSyn/HsPat.hs
index 9f8d2a5ed4..06270e8a89 100644
--- a/compiler/hsSyn/HsPat.hs
+++ b/compiler/hsSyn/HsPat.hs
@@ -584,7 +584,7 @@ pprUserCon c details          = pprPrefixOcc c <+> pprConArgs details
 
 pprConArgs :: (OutputableBndrId (GhcPass p))
            => HsConPatDetails (GhcPass p) -> SDoc
-pprConArgs (PrefixCon pats) = sep (map (pprParendLPat appPrec) pats)
+pprConArgs (PrefixCon pats) = fsep (map (pprParendLPat appPrec) pats)
 pprConArgs (InfixCon p1 p2) = sep [ pprParendLPat appPrec p1
                                   , pprParendLPat appPrec p2 ]
 pprConArgs (RecCon rpats)   = ppr rpats
diff --git a/testsuite/tests/typecheck/should_fail/T16874.hs b/testsuite/tests/typecheck/should_fail/T16874.hs
new file mode 100644
index 0000000000..422340078e
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T16874.hs
@@ -0,0 +1,12 @@
+
+module Main where
+
+type A = Int
+data D = D A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A A
+
+test :: D -> D
+test (D a b c d e f g h i j k l m n o p q r s t u v w x y z aa bb cc dd ee ff gg hh ii jj kk ll mm nn)
+  = D a b c d e f g h i j k l m n o p q r s t u v w x y z aa bb cc dd ee ff gg hh ii jj kk ll mm nn
+
+main :: IO ()
+main = print ()
diff --git a/testsuite/tests/typecheck/should_fail/T16874.stderr b/testsuite/tests/typecheck/should_fail/T16874.stderr
new file mode 100644
index 0000000000..7c9d7ef6d5
--- /dev/null
+++ b/testsuite/tests/typecheck/should_fail/T16874.stderr
@@ -0,0 +1,12 @@
+
+T16874.hs:8:7: error:
+    • The constructor ‘D’ should have 41 arguments, but has been given 40
+    • In the pattern:
+        D a b c d e f g h i j k l m n o p q r s t u v w x y z aa bb cc dd
+          ee ff gg hh ii jj kk ll mm nn
+      In an equation for ‘test’:
+          test
+            (D a b c d e f g h i j k l m n o p q r s t u v w x y z aa bb cc dd
+               ee ff gg hh ii jj kk ll mm nn)
+            = D a b c d e f g h i j k l m n o p q r s t u v w x y z aa bb cc dd
+                ee ff gg hh ii jj kk ll mm nn
diff --git a/testsuite/tests/typecheck/should_fail/all.T b/testsuite/tests/typecheck/should_fail/all.T
index fd6790bb46..fc49dbbb68 100644
--- a/testsuite/tests/typecheck/should_fail/all.T
+++ b/testsuite/tests/typecheck/should_fail/all.T
@@ -527,6 +527,7 @@ test('T15883e', normal, compile_fail, [''])
 test('T16821', normal, compile_fail, [''])
 test('T16829a', normal, compile_fail, [''])
 test('T16829b', normal, compile_fail, [''])
+test('T16874', normal, compile_fail, [''])
 test('UnliftedNewtypesFail', normal, compile_fail, [''])
 test('UnliftedNewtypesNotEnabled', normal, compile_fail, [''])
 test('UnliftedNewtypesCoerceFail', normal, compile_fail, [''])