prettyprinter 1.6.1 → 1.6.2
raw patch · 6 files changed
+176/−87 lines, 6 files
Files
- CHANGELOG.md +7/−0
- prettyprinter.cabal +1/−1
- src/Data/Text/Prettyprint/Doc.hs +4/−1
- src/Data/Text/Prettyprint/Doc/Internal.hs +151/−83
- src/Data/Text/Prettyprint/Doc/Internal/Type.hs +2/−0
- src/Data/Text/Prettyprint/Doc/Render/Text.hs +11/−2
CHANGELOG.md view
@@ -1,5 +1,12 @@+# 1.6.2++- Speed up rendering to lazy and strict `Text`.+- Documentation improvements for `group` and `flatAlt`.+- Internal refactoring of the `layoutWadlerLeijen`-based layouters.+ # 1.6.1 +- Slightly reduce the scope of the fitting predicates for some edge cases. - Use an export list in `Data.Text.Prettyprint.Doc.Internal`. - Improve `group` for `Union` and `FlatAlt`. - Speed up `removeTrailingWhitespace`.
prettyprinter.cabal view
@@ -1,5 +1,5 @@ name: prettyprinter-version: 1.6.1+version: 1.6.2 cabal-version: >= 1.10 category: User Interfaces, Text synopsis: A modern, easy to use, well-documented, extensible pretty-printer.
src/Data/Text/Prettyprint/Doc.hs view
@@ -197,7 +197,10 @@ -- * Basic functionality Pretty(..), viaShow, unsafeViaShow,- emptyDoc, nest, line, line', softline, softline', hardline, group, flatAlt,+ emptyDoc, nest, line, line', softline, softline', hardline,++ -- ** Primitives for alternative layouts+ group, flatAlt, -- * Alignment functions --
src/Data/Text/Prettyprint/Doc/Internal.hs view
@@ -6,6 +6,8 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# OPTIONS_HADDOCK not-home #-}+ #include "version-compatibility-macros.h" -- | __Warning: internal module!__ This means that the API may change@@ -22,8 +24,11 @@ -- * Basic functionality Pretty(..), viaShow, unsafeViaShow, unsafeTextWithoutNewlines,- emptyDoc, nest, line, line', softline, softline', hardline, group, flatAlt,+ emptyDoc, nest, line, line', softline, softline', hardline, + -- ** Primitives for alternative layouts+ group, flatAlt,+ -- * Alignment functions align, hang, indent, encloseSep, list, tupled, @@ -156,9 +161,11 @@ -- | Hard line break | Line - -- | Lay out the first 'Doc', but when flattened (via 'group'), fall back to- -- the second. The flattened version should in general be higher and- -- narrower than the fallback.+ -- | Lay out the first 'Doc', but when flattened (via 'group'), prefer+ -- the second.+ --+ -- The layout algorithms work under the assumption that the first+ -- alternative is less wide than the flattened second alternative. | FlatAlt (Doc ann) (Doc ann) -- | Concatenation of two documents@@ -569,10 +576,12 @@ hardline = Line -- | @('group' x)@ tries laying out @x@ into a single line by removing the--- contained line breaks; if this does not fit the page, @x@ is laid out without--- any changes. The 'group' function is key to layouts that adapt to available--- space nicely.+-- contained line breaks; if this does not fit the page, or when a 'hardline'+-- within @x@ prevents it from being flattened, @x@ is laid out without any+-- changes. --+-- The 'group' function is key to layouts that adapt to available space nicely.+-- -- See 'vcat', 'line', or 'flatAlt' for examples that are related, or make good -- use of it. group :: Doc ann -> Doc ann@@ -668,18 +677,33 @@ --- | @('flatAlt' x fallback)@ renders as @x@ by default, but falls back to--- @fallback@ when 'group'ed. Since the layout algorithms rely on 'group' having--- an effect of shortening the width of the contained text, careless usage of--- 'flatAlt' with wide fallbacks might lead to unappealingly long lines.+-- | By default, @('flatAlt' x y)@ renders as @x@. However when 'group'ed,+-- @y@ will be preferred, with @x@ as the fallback for the case when @y@+-- doesn't fit. --+-- >>> let doc = flatAlt "a" "b"+-- >>> putDoc doc+-- a+-- >>> putDoc (group doc)+-- b+-- >>> putDocW 0 (group doc)+-- a+-- -- 'flatAlt' is particularly useful for defining conditional separators such as -- -- @--- softHyphen = 'flatAlt' 'mempty' "-"--- softline = 'flatAlt' 'space' 'line'+-- softline = 'group' ('flatAlt' 'hardline' " ") -- @ --+-- >>> let hello = "Hello" <> softline <> "world!"+-- >>> putDocW 12 hello+-- Hello world!+-- >>> putDocW 11 hello+-- Hello+-- world!+--+-- === __Example: Haskell's do-notation__+-- -- We can use this to render Haskell's do-notation nicely: -- -- >>> let open = flatAlt "" "{ "@@ -700,9 +724,30 @@ -- do name:_ <- getArgs -- let greet = "Hello, " <> name -- putStrLn greet+--+-- === Notes+--+-- Users should be careful to choose @x@ to be less wide than @y@.+-- Otherwise, if @y@ turns out not to fit the page, we fall back on an even+-- wider layout:+--+-- >>> let ugly = group (flatAlt "even wider" "too wide")+-- >>> putDocW 7 ugly+-- even wider+--+-- Also note that 'group' will flatten @y@:+--+-- >>> putDoc (group (flatAlt "x" ("y" <> line <> "y")))+-- y y+--+-- This also means that an "unflattenable" @y@ which contains a hard linebreak+-- will /never/ be rendered:+--+-- >>> putDoc (group (flatAlt "x" ("y" <> hardline <> "y")))+-- x flatAlt :: Doc ann -- ^ Default- -> Doc ann -- ^ Fallback when 'group'ed+ -> Doc ann -- ^ Preferred when 'group'ed -> Doc ann flatAlt = FlatAlt @@ -1658,13 +1703,15 @@ -- | Decide whether a 'SimpleDocStream' fits the constraints given, namely ----- - page width--- - minimum nesting level to fit in+-- - original indentation of the current line+-- - current column+-- - initial indentation of the alternative 'SimpleDocStream' if it+-- starts with a line break (used by 'layoutSmart') -- - width in which to fit the first line newtype FittingPredicate ann- = FittingPredicate (PageWidth- -> Int+ = FittingPredicate (Int -> Int+ -> Maybe Int -> SimpleDocStream ann -> Bool) deriving Typeable@@ -1700,6 +1747,17 @@ defaultPageWidth :: PageWidth defaultPageWidth = AvailablePerLine 80 1 +-- | The remaining width on the current line.+remainingWidth :: Int -> Double -> Int -> Int -> Int+remainingWidth lineLength ribbonFraction lineIndent currentColumn =+ min columnsLeftInLine columnsLeftInRibbon+ where+ columnsLeftInLine = lineLength - currentColumn+ columnsLeftInRibbon = lineIndent + ribbonWidth - currentColumn+ ribbonWidth =+ (max 0 . min lineLength . round)+ (fromIntegral lineLength * ribbonFraction)+ -- $ Test to avoid surprising behaviour -- >>> Unbounded > AvailablePerLine maxBound 1 -- True@@ -1729,8 +1787,14 @@ :: LayoutOptions -> Doc ann -> SimpleDocStream ann-layoutPretty = layoutWadlerLeijen- (FittingPredicate (\_pWidth _minNestingLevel maxWidth sdoc -> fits maxWidth sdoc))+layoutPretty (LayoutOptions pageWidth_@(AvailablePerLine lineLength ribbonFraction)) =+ layoutWadlerLeijen+ (FittingPredicate+ (\lineIndent currentColumn _initialIndentY sdoc ->+ fits+ (remainingWidth lineLength ribbonFraction lineIndent currentColumn)+ sdoc))+ pageWidth_ where fits :: Int -- ^ Width in which to fit the first line -> SimpleDocStream ann@@ -1744,6 +1808,8 @@ fits w (SAnnPush _ x) = fits w x fits w (SAnnPop x) = fits w x +layoutPretty (LayoutOptions Unbounded) = layoutUnbounded+ -- | A layout algorithm with more lookahead than 'layoutPretty', that introduces -- line breaks earlier if the content does not (or will not, rather) fit into -- one line.@@ -1809,7 +1875,8 @@ :: LayoutOptions -> Doc ann -> SimpleDocStream ann-layoutSmart = layoutWadlerLeijen (FittingPredicate fits)+layoutSmart (LayoutOptions pageWidth_@(AvailablePerLine lineLength ribbonFraction)) =+ layoutWadlerLeijen (FittingPredicate fits) pageWidth_ where -- Why doesn't layoutSmart simply check the entire document? --@@ -1818,31 +1885,70 @@ -- depend on the fit of completely unrelated parts of the same document. -- See https://github.com/quchen/prettyprinter/issues/83 for a related -- bug.- fits :: PageWidth- -> Int -- ^ Minimum nesting level to fit in- -> Int -- ^ Width in which to fit the first line- -> SimpleDocStream ann- -> Bool- fits _ _ 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 _ (SLine i x)- | m < i, AvailablePerLine cpl _ <- pw = fits pw m (cpl - i) x- | otherwise = True- fits pw m w (SAnnPush _ x) = fits pw m w x- fits pw m w (SAnnPop x) = fits pw m w x + fits :: Int -> Int -> Maybe Int -> SimpleDocStream ann -> Bool+ fits lineIndent currentColumn initialIndentY = go availableWidth+ where+ go w _ | w < 0 = False+ go _ SFail = False+ go _ SEmpty = True+ 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)+ | otherwise = True+ go w (SAnnPush _ x) = go w x+ go w (SAnnPop x) = go w x++ availableWidth = remainingWidth lineLength ribbonFraction lineIndent currentColumn++ minNestingLevel =+ -- See the Note+ -- [Choosing the right minNestingLevel for consistent smart layouts]+ case initialIndentY of+ Just i ->+ -- y could be a (less wide) hanging layout. If so, let's+ -- check x a bit more thoroughly so we don't miss a potentially+ -- better fitting y.+ min i currentColumn+ Nothing ->+ -- y definitely isn't a hanging layout. Let's check x with the+ -- same minNestingLevel that any subsequent lines with the same+ -- indentation use.+ currentColumn++layoutSmart (LayoutOptions Unbounded) = layoutUnbounded++-- | Layout a document with @Unbounded@ page width.+layoutUnbounded :: Doc ann -> SimpleDocStream ann+layoutUnbounded =+ layoutWadlerLeijen+ (FittingPredicate+ (\_lineIndent _currentColumn _initialIndentY sdoc -> not (failsOnFirstLine sdoc)))+ Unbounded+ where+ -- See the Note [Detecting failure with Unbounded page width].+ failsOnFirstLine :: SimpleDocStream ann -> Bool+ failsOnFirstLine = go+ where+ go sds = case sds of+ SFail -> True+ SEmpty -> False+ SChar _ s -> go s+ SText _ _ s -> go s+ SLine _ _ -> False+ SAnnPush _ s -> go s+ SAnnPop s -> go s+ -- | The Wadler/Leijen layout algorithm layoutWadlerLeijen :: forall ann. FittingPredicate ann- -> LayoutOptions+ -> PageWidth -> Doc ann -> SimpleDocStream ann layoutWadlerLeijen (FittingPredicate fits)- LayoutOptions { layoutPageWidth = pWidth }+ pageWidth_ doc = best 0 0 (Cons 0 doc Nil) where@@ -1869,7 +1975,7 @@ y' = best nl cc (Cons i y ds) in selectNicer nl cc x' y' Column f -> best nl cc (Cons i (f cc) ds)- WithPageWidth f -> best nl cc (Cons i (f pWidth) ds)+ WithPageWidth f -> best nl cc (Cons i (f pageWidth_) ds) Nesting f -> best nl cc (Cons i (f i) ds) Annotated ann x -> SAnnPush ann (best nl cc (Cons i x (UndoAnn ds))) @@ -1886,35 +1992,9 @@ -> SimpleDocStream ann -- ^ Choice B. Should fit more easily -- (== be less wide) than choice A. -> SimpleDocStream ann -- ^ Choice A if it fits, otherwise B.- selectNicer lineIndent currentColumn x y = case pWidth of- AvailablePerLine lineLength ribbonFraction- | fits pWidth minNestingLevel availableWidth x -> x- where- minNestingLevel =- -- See the Note- -- [Choosing the right minNestingLevel for consistent smart layouts]- case initialIndentation y of- Just i ->- -- y could be a (less wide) hanging layout. If so, let's- -- check x a bit more thoroughly so we don't miss a potentially- -- better fitting y.- min i currentColumn- Nothing ->- -- y definitely isn't a hanging layout. Let's check x with the- -- same minNestingLevel that any subsequent lines with the same- -- indentation use.- currentColumn- availableWidth = min columnsLeftInLine columnsLeftInRibbon- where- columnsLeftInLine = lineLength - currentColumn- columnsLeftInRibbon = lineIndent + ribbonWidth - currentColumn- ribbonWidth =- (max 0 . min lineLength . round)- (fromIntegral lineLength * ribbonFraction)- Unbounded- -- See the Note [Detecting failure with Unbounded page width].- | not (failsOnFirstLine x) -> x- _ -> y+ selectNicer lineIndent currentColumn x y+ | fits lineIndent currentColumn (initialIndentation y) x = x+ | otherwise = y initialIndentation :: SimpleDocStream ann -> Maybe Int initialIndentation sds = case sds of@@ -1923,19 +2003,7 @@ SAnnPop s -> initialIndentation s _ -> Nothing - failsOnFirstLine :: SimpleDocStream ann -> Bool- failsOnFirstLine = go- where- go sds = case sds of- SFail -> True- SEmpty -> False- SChar _ s -> go s- SText _ _ s -> go s- SLine _ _ -> False- SAnnPush _ s -> go s- SAnnPop s -> go s - {- Note [Choosing the right minNestingLevel for consistent smart layouts] ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ Consider this document:@@ -2037,10 +2105,10 @@ To understand why it is sufficient to check the first line of the SimpleDocStream, trace how an SFail ends up there: -1. We group a Doc containing a Line, producing a (Union x y) where- x contains Fail.+1. We group a Doc containing a hard linebreak (hardline), producing a+ (Union x y) where x contains Fail. -2. In best, any Unions are handled recursively, rejecting any+2. In layoutWadlerLeijen.best, any Unions are handled recursively, rejecting any alternatives that would result in SFail. So once a SimpleDocStream reaches selectNicer, any SFail in it must
src/Data/Text/Prettyprint/Doc/Internal/Type.hs view
@@ -1,3 +1,5 @@+{-# OPTIONS_HADDOCK not-home #-}+ -- | __Internal module with stability guarantees__ -- -- This module exposes the internals of the @'Doc'@ type so other libraries can
src/Data/Text/Prettyprint/Doc/Render/Text.hs view
@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} #include "version-compatibility-macros.h"@@ -26,7 +27,6 @@ import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc.Internal import Data.Text.Prettyprint.Doc.Render.Util.Panic-import Data.Text.Prettyprint.Doc.Render.Util.StackMachine #if !(SEMIGROUP_IN_BASE) import Data.Semigroup@@ -56,7 +56,16 @@ -- (foo bar) -- sit amet renderLazy :: SimpleDocStream ann -> TL.Text-renderLazy = TLB.toLazyText . renderSimplyDecorated TLB.fromText (pure mempty) (pure mempty)+renderLazy = TLB.toLazyText . go+ where+ go = \case+ SFail -> panicUncaughtFail+ SEmpty -> mempty+ SChar c rest -> TLB.singleton c <> go rest+ SText _l t rest -> TLB.fromText t <> go rest+ SLine i rest -> TLB.singleton '\n' <> (TLB.fromText (textSpaces i) <> go rest)+ SAnnPush _ann rest -> go rest+ SAnnPop rest -> go rest -- | @('renderStrict' sdoc)@ takes the output @sdoc@ from a rendering function -- and transforms it to strict text.