layoutWL: Don't let indentation result in trailing whitespace (#139)

This seems to add an overhead of about 3% in some benchmarks.
quchen · Jun 30, 2020 · 9635a5d · 9635a5d
1 parent c52840b
commit 9635a5d
Show file tree

Hide file tree

Showing 2 changed files with 19 additions and 1 deletion.
diff --git a/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs b/prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs
@@ -1967,7 +1967,15 @@ layoutWadlerLeijen
         Empty           -> best nl cc ds
         Char c          -> let !cc' = cc+1 in SChar c (best nl cc' ds)
         Text l t        -> let !cc' = cc+l in SText l t (best nl cc' ds)
-        Line            -> SLine i (best i i ds)
+        Line            -> let x = best i i ds
+                               -- Don't produce indentation if there's no
+                               -- following text on the same line.
+                               -- This prevents trailing whitespace.
+                               i' = case x of
+                                   SEmpty  -> 0
+                                   SLine{} -> 0
+                                   _       -> i
+                           in SLine i' x
         FlatAlt x _     -> best nl cc (Cons i x ds)
         Cat x y         -> best nl cc (Cons i x (Cons i y ds))
         Nest j x        -> let !ij = i+j in best nl cc (Cons ij x ds)

diff --git a/prettyprinter/test/Testsuite/Main.hs b/prettyprinter/test/Testsuite/Main.hs
@@ -89,6 +89,8 @@ tests = testGroup "Tests"
             , testCase "Line within align" regressionUnboundedGroupedLineWithinAlign
             ]
         ]
+        , testCase "Indentation on otherwise empty lines results in trailing whitespace (#139)"
+                   indentationShouldntCauseTrailingWhitespaceOnOtherwiseEmptyLines
     ]
 
 fusionDoesNotChangeRendering :: FusionDepth -> Property
@@ -380,3 +382,11 @@ regressionUnboundedGroupedLineWithinAlign
         sdoc = layoutPretty (LayoutOptions Unbounded) doc
         expected = SChar 'x' (SLine 0 (SChar 'y' SEmpty))
     in assertEqual "" expected sdoc
+
+indentationShouldntCauseTrailingWhitespaceOnOtherwiseEmptyLines :: Assertion
+indentationShouldntCauseTrailingWhitespaceOnOtherwiseEmptyLines
+  = let doc :: Doc ()
+        doc = indent 1 ("x" <> hardline <> hardline <> "y" <> hardline)
+        sdoc = layoutPretty (LayoutOptions Unbounded) doc
+        expected = SChar ' ' (SChar 'x' (SLine 0 (SLine 1 (SChar 'y' (SLine 0 SEmpty)))))
+    in assertEqual "" expected sdoc