Skip to content

Fix #91 by removing the shortcuts from the fitting predicates #97

New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Closed
sjakobi wants to merge 2 commits into from
Closed

Fix #91 by removing the shortcuts from the fitting predicates #97

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
2 commits
Select commit Hold shift + click to select a range
8916b91
Add regression test for #91
sjakobi Nov 8, 2019
a06e0cd
Fix #91 by removing the shortcuts from the fitting predicates
sjakobi Nov 8, 2019
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
37 changes: 16 additions & 21 deletions prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -1654,21 +1654,19 @@ layoutPretty
-> Doc ann
-> SimpleDocStream ann
layoutPretty = layoutWadlerLeijen
(FittingPredicate (\_pWidth _minNestingLevel maxWidth sdoc -> case maxWidth of
Nothing -> True
Just w -> fits w sdoc ))
(FittingPredicate (\_pWidth _minNestingLevel maxWidth sdoc -> fits maxWidth sdoc))
where
fits :: Int -- ^ Width in which to fit the first line
fits :: Maybe Int -- ^ Width in which to fit the first line
-> SimpleDocStream ann
-> Bool
fits w _ | w < 0 = False
fits _ SFail = False
fits _ SEmpty = True
fits w (SChar _ x) = fits (w - 1) x
fits w (SText l _t x) = fits (w - l) x
fits _ SLine{} = True
fits w (SAnnPush _ x) = fits w x
fits w (SAnnPop x) = fits w x
fits (Just w) _ | w < 0 = False
fits _ SFail = False
fits _ SEmpty = True
fits w (SChar _ x) = fits (pred <$> w) x
fits w (SText l _t x) = fits (subtract l <$> w) x
fits _ SLine{} = True
fits w (SAnnPush _ x) = fits w x
fits w (SAnnPop x) = fits w x

-- | A layout algorithm with more lookahead than 'layoutPretty', that introduces
-- line breaks earlier if the content does not (or will not, rather) fit into
Expand Down Expand Up @@ -1719,10 +1717,7 @@ layoutSmart
:: LayoutOptions
-> Doc ann
-> SimpleDocStream ann
layoutSmart = layoutWadlerLeijen
(FittingPredicate (\pWidth minNestingLevel maxWidth sdoc -> case maxWidth of
Nothing -> True
Just w -> fits pWidth minNestingLevel w sdoc ))
layoutSmart = layoutWadlerLeijen (FittingPredicate fits)
where
-- Search with more lookahead: assuming that nesting roughly corresponds to
-- syntactic depth, @fits@ checks that not only the current line fits, but
Expand All @@ -1733,16 +1728,16 @@ layoutSmart = layoutWadlerLeijen
-- exponential runtime (and is prohibitively expensive in practice).
fits :: PageWidth
-> Int -- ^ Minimum nesting level to fit in
-> Int -- ^ Width in which to fit the first line
-> Maybe Int -- ^ Width in which to fit the first line
-> SimpleDocStream ann
-> Bool
fits _ _ w _ | w < 0 = False
fits _ _ (Just w) _ | w < 0 = False
fits _ _ _ SFail = False
fits _ _ _ SEmpty = True
fits pw m w (SChar _ x) = fits pw m (w - 1) x
fits pw m w (SText l _t x) = fits pw m (w - l) x
fits pw m w (SChar _ x) = fits pw m (pred <$> w) x
fits pw m w (SText l _t x) = fits pw m (subtract l <$> w) x
fits pw m _ (SLine i x)
| m < i, AvailablePerLine cpl _ <- pw = fits pw m (cpl - i) x
| m < i, AvailablePerLine cpl _ <- pw = fits pw m (Just (cpl - i)) x
| otherwise = True
Copy link
Copy Markdown
Collaborator Author

@sjakobi sjakobi Nov 8, 2019 •
edited
Loading

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

What I don't understand is why it doesn't seem to be necessary to continue checking for the absence of SFail when using the Unbounded layout – at least the property tests don't seem to mind (and neither does dhall!)

fits pw m w (SAnnPush _ x) = fits pw m w x
fits pw m w (SAnnPop x) = fits pw m w x
Expand Down
8 changes: 8 additions & 0 deletions prettyprinter/test/Testsuite/Main.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -80,6 +80,8 @@ tests = testGroup "Tests"
, testCase "Preserve leading indentation"
removeTrailingWhitespacePreserveIndentation
]
, testCase "Unbounded layout of `group`ed Line fails (#91)"
regressionUnboundedGroupedLine
]
]

Expand Down Expand Up @@ -296,3 +298,9 @@ removeTrailingWhitespacePreserveIndentation
= let sdoc :: SimpleDocStream ()
sdoc = SLine 2 (SChar 'x' SEmpty)
in assertEqual "" sdoc (removeTrailingWhitespace sdoc)

regressionUnboundedGroupedLine :: Assertion
regressionUnboundedGroupedLine
= let sdoc :: SimpleDocStream ()
sdoc = layoutPretty (LayoutOptions Unbounded) (group hardline)
in assertEqual "" (SLine 0 SEmpty) sdoc