From a5342e4d319c80cafbdae975af57cbba53cbd7b3 Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Fri, 5 Dec 2025 11:18:17 +0100 Subject: [PATCH 1/2] Add performance test for #205 When the timeout limit is raised, the test finishes after ~8s on my laptop. --- prettyprinter/test/Testsuite/Main.hs | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/prettyprinter/test/Testsuite/Main.hs b/prettyprinter/test/Testsuite/Main.hs index 956dc829..6b18f400 100644 --- a/prettyprinter/test/Testsuite/Main.hs +++ b/prettyprinter/test/Testsuite/Main.hs @@ -53,6 +53,8 @@ tests = testGroup "Tests" groupingPerformance , testCase "fillSep performance" fillSepPerformance + , testCase "Issue 205" + issue205 ] , testGroup "Regression tests" [ testCase "layoutSmart: softline behaves like a newline (#49)" @@ -285,6 +287,14 @@ fillSepPerformance = docPerformanceTest (pathological 1000) pathological :: Int -> Doc ann pathological n = iterate (\x -> fillSep ["a", x <+> "b"] ) "foobar" !! n +issue205 :: Assertion +issue205 = do + let doc = fillSep (replicate 30 (sep ["abc", "xyz" :: Doc ()])) + t = renderStrict (layoutSmart defaultLayoutOptions doc) + timeout 1000000 (evaluate t) >>= \t' -> case t' of + Nothing -> assertFailure "Timeout!" + Just _success -> pure () + regressionLayoutSmartSoftline :: Assertion regressionLayoutSmartSoftline = let doc = "a" <> softline <> "b" From c584f60778dc17bd9d8b1b7847133aae89bf669a Mon Sep 17 00:00:00 2001 From: Simon Jakobi Date: Mon, 30 Mar 2026 16:06:52 +0200 Subject: [PATCH 2/2] Fix layoutSmart regression from blank-line indentation Fixes #205. Assisted-by: Codex --- prettyprinter/src/Prettyprinter/Internal.hs | 58 ++++++++++++++++----- 1 file changed, 46 insertions(+), 12 deletions(-) diff --git a/prettyprinter/src/Prettyprinter/Internal.hs b/prettyprinter/src/Prettyprinter/Internal.hs index 25cd6afe..e61d6d88 100755 --- a/prettyprinter/src/Prettyprinter/Internal.hs +++ b/prettyprinter/src/Prettyprinter/Internal.hs @@ -1895,6 +1895,7 @@ layoutPretty -> SimpleDocStream ann layoutPretty (LayoutOptions pageWidth_@(AvailablePerLine lineLength ribbonFraction)) = layoutWadlerLeijen + smartLine (FittingPredicate (\lineIndent currentColumn _initialIndentY sdoc -> fits @@ -1982,7 +1983,8 @@ layoutSmart -> Doc ann -> SimpleDocStream ann layoutSmart (LayoutOptions pageWidth_@(AvailablePerLine lineLength ribbonFraction)) = - layoutWadlerLeijen (FittingPredicate fits) pageWidth_ + dropIndentationOnEmptyLines . + layoutWadlerLeijen plainLine (FittingPredicate fits) pageWidth_ where -- Why doesn't layoutSmart simply check the entire document? -- @@ -2001,7 +2003,14 @@ layoutSmart (LayoutOptions pageWidth_@(AvailablePerLine lineLength ribbonFractio go w (SChar _ x) = go (w - 1) x go w (SText l _t x) = go (w - l) x go _ (SLine i x) - | minNestingLevel < i = go (lineLength - i) x -- TODO: Take ribbon width into account?! (#142) + | minNestingLevel < i = + let i' = case x of + SEmpty -> 0 + SLine{} -> 0 + _ -> i + in if minNestingLevel < i' + then go (lineLength - i') x -- TODO: Take ribbon width into account?! (#142) + else True | otherwise = True go w (SAnnPush _ x) = go w x go w (SAnnPop x) = go w x @@ -2029,6 +2038,7 @@ layoutSmart (LayoutOptions Unbounded) = layoutUnbounded layoutUnbounded :: Doc ann -> SimpleDocStream ann layoutUnbounded = layoutWadlerLeijen + smartLine (FittingPredicate (\_lineIndent _currentColumn _initialIndentY sdoc -> not (failsOnFirstLine sdoc))) Unbounded @@ -2046,13 +2056,45 @@ layoutUnbounded = SAnnPush _ s -> go s SAnnPop s -> go s +plainLine :: Int -> SimpleDocStream ann -> SimpleDocStream ann +plainLine i x = SLine i x + +smartLine :: Int -> SimpleDocStream ann -> SimpleDocStream ann +smartLine i x = + let i' = case x of + SEmpty -> 0 + SLine{} -> 0 + _ -> i + in SLine i' x + +-- | Remove indentation that would otherwise survive on empty lines. +dropIndentationOnEmptyLines :: SimpleDocStream ann -> SimpleDocStream ann +dropIndentationOnEmptyLines = go + where + go sds = case sds of + SFail -> SFail + SEmpty -> SEmpty + SChar c x -> SChar c (go x) + SText l t x -> SText l t (go x) + SLine i x -> + let x' = go x + i' = case x' of + SEmpty -> 0 + SLine{} -> 0 + _ -> i + in SLine i' x' + SAnnPush ann x -> SAnnPush ann (go x) + SAnnPop x -> SAnnPop (go x) + -- | The Wadler/Leijen layout algorithm layoutWadlerLeijen - :: forall ann. FittingPredicate ann + :: forall ann. (Int -> SimpleDocStream ann -> SimpleDocStream ann) + -> FittingPredicate ann -> PageWidth -> Doc ann -> SimpleDocStream ann layoutWadlerLeijen + mkLine (FittingPredicate fits) pageWidth_ doc @@ -2073,15 +2115,7 @@ 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 -> 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 + Line -> mkLine i (best i i ds) 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)