prettyprinter 1.1 → 1.1.0.1
raw patch · 15 files changed
+779/−210 lines, 15 filesdep +containersdep +deepseqdep ~ansi-wl-pprintdep ~basedep ~bytestring
Dependencies added: containers, deepseq
Dependency ranges changed: ansi-wl-pprint, base, bytestring, criterion, mtl, pgp-wordlist, random, semigroups, tasty, tasty-hunit, tasty-quickcheck, text, transformers
Files
- CONTRIBUTORS.md +0/−22
- README.md +5/−1
- app/GenerateReadme.hs +6/−1
- bench/LargeOutput.hs +196/−0
- prettyprinter.cabal +48/−26
- src/Data/Text/Prettyprint/Doc.hs +71/−13
- src/Data/Text/Prettyprint/Doc/Internal.hs +7/−131
- src/Data/Text/Prettyprint/Doc/Render/ShowS.hs +1/−1
- src/Data/Text/Prettyprint/Doc/Render/String.hs +10/−0
- src/Data/Text/Prettyprint/Doc/Render/Text.hs +25/−3
- src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs +12/−0
- src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs +6/−2
- src/Data/Text/Prettyprint/Doc/Symbols/Ascii.hs +154/−0
- src/Data/Text/Prettyprint/Doc/Symbols/Unicode.hs +212/−0
- test/Testsuite/Main.hs +26/−10
− CONTRIBUTORS.md
@@ -1,22 +0,0 @@-# Contributors--A list of people that have contributed to this library, be it code, ideas, or-even just as rubber ducks. :-)--Ordered by earliest appearance in the git log.--## `prettyprinter` library (this one)--- David Luposchainsky, @quchen – current maintainer--## `ansi-wl-pprint` (origin forked from)--- Edward Kmett, @edwardk – maintainer of `ansi-wl-pprint`-- Herbert Valerio Riedel, @hvr-- Bradford Larsen-- Sebastian Witte-- Andrew Shulaev-- David Fox-- Max Bolingbroke-- Samir Jindel-- Bryan O'Sullivan, @bos
README.md view
@@ -6,7 +6,7 @@ ==================================== [](https://travis-ci.org/quchen/prettyprinter) -[](https://github.com/quchen/prettyprinter/releases) [](https://hackage.haskell.org/package/prettyprinter) [](https://www.stackage.org/package/prettyprinter)+[](https://github.com/quchen/prettyprinter/releases) [](https://hackage.haskell.org/package/prettyprinter) [](https://www.stackage.org/package/prettyprinter) [](https://www.stackage.org/package/prettyprinter) @@ -153,6 +153,10 @@ `ansi-wl-pprint`. - `prettyprinter-compat-annotated-wl-pprint` is the same, but for previous users of `annotated-wl-pprint`.+ - `prettyprinter-convert-ansi-wl-pprint` is a *converter*, not a drop-in+ replacement, for documents generated by `ansi-wl-pprint`. Useful for+ interfacing with other libraries that use the other format, like Trifecta+ and Optparse-Applicative.
app/GenerateReadme.hs view
@@ -35,7 +35,8 @@ , hsep [ "[](https://github.com/quchen/prettyprinter/releases)" , "[](https://hackage.haskell.org/package/prettyprinter)"- , "[](https://www.stackage.org/package/prettyprinter)" ]]+ , "[](https://www.stackage.org/package/prettyprinter)"+ , "[](https://www.stackage.org/package/prettyprinter)" ]] , h2 "tl;dr" , paragraph [multiline| A prettyprinter/text rendering engine. Easy to@@ -157,6 +158,10 @@ previous users of `ansi-wl-pprint`.|] , [multiline| `prettyprinter-compat-annotated-wl-pprint` is the same, but for previous users of `annotated-wl-pprint`.|]+ , [multiline| `prettyprinter-convert-ansi-wl-pprint` is a *converter*,+ not a drop-in replacement, for documents generated by `ansi-wl-pprint`.+ Useful for interfacing with other libraries that use the other format,+ like Trifecta and Optparse-Applicative. |] ] , h2 "Differences to the old Wadler/Leijen prettyprinters"
+ bench/LargeOutput.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-}++{-# OPTIONS_GHC -fno-warn-orphans #-}++module Main (main) where++++import Control.DeepSeq+import Control.Monad+import Criterion+import Criterion.Main+import Data.Char+import Data.Map (Map)+import qualified Data.Map as M+import Data.Semigroup+import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T+import qualified Data.Text.Lazy as TL+import Data.Text.Prettyprint.Doc+import Data.Text.Prettyprint.Doc.Render.Text+import GHC.Generics+import Test.QuickCheck+import Test.QuickCheck.Gen+import Test.QuickCheck.Random+import qualified Text.PrettyPrint.ANSI.Leijen as WL++++newtype Program = Program Binds deriving (Show, Generic)+newtype Binds = Binds (Map Text LambdaForm) deriving (Show, Generic)+data LambdaForm = LambdaForm ![Text] ![Text] !Expr deriving (Show, Generic)+data Expr+ = Let Binds Expr+ | Case Expr [Alt]+ | AppF Text [Text]+ | AppC Text [Text]+ | AppP Text Text Text+ | LitE Int+ deriving (Show, Generic)+data Alt = Alt Text [Text] Expr deriving (Show, Generic)++instance NFData Program+instance NFData Binds+instance NFData LambdaForm+instance NFData Expr+instance NFData Alt++instance Arbitrary Program where arbitrary = fmap Program arbitrary+instance Arbitrary Binds where+ arbitrary = do+ NonEmpty xs <- arbitrary+ pure (Binds (M.fromList xs))+instance Arbitrary LambdaForm where+ arbitrary = LambdaForm <$> fromTo 0 2 arbitrary <*> fromTo 0 2 arbitrary <*> arbitrary++instance Arbitrary Expr where+ arbitrary = (oneof . map scaled)+ [ Let <$> arbitrary <*> arbitrary+ , Case <$> arbitrary <*> (do NonEmpty xs <- arbitrary; pure xs)+ , AppF <$> arbitrary <*> fromTo 0 3 arbitrary+ , AppC <$> ucFirst arbitrary <*> fromTo 0 3 arbitrary+ , AppP <$> arbitrary <*> arbitrary <*> arbitrary+ , LitE <$> arbitrary ]+instance Arbitrary Alt where arbitrary = Alt <$> ucFirst arbitrary <*> fromTo 0 3 arbitrary <*> arbitrary+instance Arbitrary Text where+ arbitrary = do+ n <- choose (3,6)+ str <- replicateM n (elements ['a'..'z'])+ if str `elem` ["let", "in", "case", "of"]+ then arbitrary+ else pure (T.pack str)++ucFirst :: Gen Text -> Gen Text+ucFirst gen = do+ x <- gen+ case T.uncons x of+ Nothing -> pure x+ Just (t,ext) -> pure (T.cons (toUpper t) ext)++instance Pretty Program where pretty (Program binds) = pretty binds+instance Pretty Binds where+ pretty (Binds bs) = align (vsep (map prettyBinding (M.assocs bs)))+ where+ prettyBinding (var, lambda) = pretty var <+> "=" <+> pretty lambda++instance Pretty LambdaForm where+ pretty (LambdaForm free bound body) = (prettyExp . (<+> "->") . prettyBound . prettyFree) "\\"+ where+ prettyFree | null free = id+ | otherwise = (<> lparen <> hsep (map pretty free) <> rparen)+ prettyBound | null bound = id+ | null free = (<> hsep (map pretty bound))+ | otherwise = (<+> hsep (map pretty bound))+ prettyExp = (<+> pretty body)++instance Pretty Expr where+ pretty = \case+ Let binds body ->+ align (vsep [ "let" <+> align (pretty binds)+ , "in" <+> pretty body ])++ Case scrutinee alts -> vsep+ [ "case" <+> pretty scrutinee <+> "of"+ , indent 4 (align (vsep (map pretty alts))) ]++ AppF f [] -> pretty f+ AppF f args -> pretty f <+> hsep (map pretty args)++ AppC c [] -> pretty c+ AppC c args -> pretty c <+> hsep (map pretty args)++ AppP op x y -> pretty op <+> pretty x <+> pretty y++ LitE lit -> pretty lit++instance Pretty Alt where+ pretty (Alt con [] body) = pretty con <+> "->" <+> pretty body+ pretty (Alt con args body) = pretty con <+> hsep (map pretty args) <+> "->" <+> pretty body++instance WL.Pretty Program where pretty (Program binds) = WL.pretty binds+instance WL.Pretty Binds where+ pretty (Binds bs) = WL.align (WL.vsep (map prettyBinding (M.assocs bs)))+ where+ prettyBinding (var, lambda) = WL.pretty var WL.<+> "=" WL.<+> WL.pretty lambda++instance WL.Pretty Text where+ pretty = WL.string . T.unpack++instance WL.Pretty LambdaForm where+ pretty (LambdaForm free bound body) = (prettyExp . (WL.<+> "->") . prettyBound . prettyFree) "\\"+ where+ prettyFree | null free = id+ | otherwise = (<> WL.lparen <> WL.hsep (map WL.pretty free) <> WL.rparen)+ prettyBound | null bound = id+ | null free = (<> WL.hsep (map WL.pretty bound))+ | otherwise = (WL.<+> WL.hsep (map WL.pretty bound))+ prettyExp = (WL.<+> WL.pretty body)++instance WL.Pretty Expr where+ pretty = \case+ Let binds body ->+ WL.align (WL.vsep [ "let" WL.<+> WL.align (WL.pretty binds)+ , "in" WL.<+> WL.pretty body ])++ Case scrutinee alts -> WL.vsep+ [ "case" WL.<+> WL.pretty scrutinee WL.<+> "of"+ , WL.indent 4 (WL.align (WL.vsep (map WL.pretty alts))) ]++ AppF f [] -> WL.pretty f+ AppF f args -> WL.pretty f WL.<+> WL.hsep (map WL.pretty args)++ AppC c [] -> WL.pretty c+ AppC c args -> WL.pretty c WL.<+> WL.hsep (map WL.pretty args)++ AppP op x y -> WL.pretty op WL.<+> WL.pretty x WL.<+> WL.pretty y++ LitE lit -> WL.pretty lit++instance WL.Pretty Alt where+ pretty (Alt con [] body) = WL.text (T.unpack con) WL.<+> "->" WL.<+> WL.pretty body+ pretty (Alt con args body) = WL.text (T.unpack con) WL.<+> WL.hsep (map WL.pretty args) WL.<+> "->" WL.<+> WL.pretty body++scaled :: Gen a -> Gen a+scaled = scale (\n -> n * 2 `quot` 3)++fromTo :: Int -> Int -> Gen b -> Gen b+fromTo a b gen = do+ n <- choose (min a b, max a b)+ resize n gen++randomProgram+ :: Int -- ^ Seed+ -> Int -- ^ Generator size+ -> Program+randomProgram seed size = let MkGen gen = arbitrary in gen (mkQCGen seed) size++main :: IO ()+main = do+ let prog = randomProgram 1 60+ renderedProg = (renderLazy . layoutPretty defaultLayoutOptions { layoutPageWidth = Unbounded } . pretty) prog+ (progLines, progWidth) = let l = TL.lines renderedProg in (length l, maximum (map TL.length l))+ putDoc ("Program size:" <+> pretty progLines <+> "lines, maximum width:" <+> pretty progWidth)++ rnf prog `seq` T.putStrLn "Staring benchmark…"+ defaultMain+ [ bgroup "80 characters, 50% ribbon"+ [ bench "prettyprinter" (nf (renderLazy . layoutPretty defaultLayoutOptions { layoutPageWidth = AvailablePerLine 80 0.5 } . pretty) prog)+ , bench "ansi-wl-pprint" (nf (($ "") . WL.displayS . WL.renderPretty 0.5 80 . WL.pretty) prog) ]+ , bgroup "Infinite/large page width"+ [ bench "prettyprinter" (nf (renderLazy . layoutPretty defaultLayoutOptions { layoutPageWidth = Unbounded } . pretty) prog)+ , bench "ansi-wl-pprint" (nf (($ "") . WL.displayS . WL.renderPretty 1 (fromIntegral progWidth + 10) . WL.pretty) prog) ]+ ]
prettyprinter.cabal view
@@ -1,5 +1,5 @@ name: prettyprinter-version: 1.1+version: 1.1.0.1 cabal-version: >= 1.10 category: User Interfaces, Text synopsis: A modern, easy to use, well-documented, extensible prettyprinter.@@ -8,7 +8,6 @@ license-file: LICENSE.md extra-source-files: README.md , misc/version-compatibility-macros.h- , CONTRIBUTORS.md author: Phil Wadler, Daan Leijen, Max Bolingbroke, Edward Kmett, David Luposchainsky maintainer: David Luposchainsky <dluposchainsky at google> bug-reports: http://github.com/quchen/prettyprinter/issues@@ -29,7 +28,7 @@ Data.Text.Prettyprint.Doc , Data.Text.Prettyprint.Doc.Internal , Data.Text.Prettyprint.Doc.Internal.Type- , Data.Text.Prettyprint.Doc.Render.ShowS+ , Data.Text.Prettyprint.Doc.Render.String , Data.Text.Prettyprint.Doc.Render.Text , Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial , Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial@@ -37,8 +36,13 @@ , Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree , Data.Text.Prettyprint.Doc.Render.Util.StackMachine , Data.Text.Prettyprint.Doc.Util- -- Hidden for now, until I figure out where to put it:- -- , Data.Text.Prettyprint.Doc.Unicode++ , Data.Text.Prettyprint.Doc.Symbols.Unicode+ , Data.Text.Prettyprint.Doc.Symbols.Ascii++ -- Deprecated+ , Data.Text.Prettyprint.Doc.Render.ShowS+ ghc-options: -Wall hs-source-dirs: src include-dirs: misc@@ -54,12 +58,12 @@ build-depends: base >= 4.7 && < 5- , text == 1.2.*+ , text >= 1.2 if impl(ghc >= 8.0) ghc-options: -Wcompat if impl(ghc < 8.0)- build-depends: semigroups >= 0.1 && < 0.19+ build-depends: semigroups >= 0.1 if impl(ghc < 7.10) build-depends: void @@ -77,8 +81,8 @@ base >= 4.7 && < 5 , prettyprinter - , text == 1.2.*- , template-haskell >= 2.9 && < 2.12+ , text+ , template-haskell >= 2.9 default-language: Haskell2010 other-modules: MultilineTh other-extensions: OverloadedStrings@@ -96,8 +100,7 @@ main-is: Main.hs build-depends: base >= 4.7 && < 5- , doctest >= 0.9 && < 0.12- , QuickCheck >= 2.7+ , doctest >= 0.9 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 if impl (ghc < 7.10)@@ -112,17 +115,17 @@ base , prettyprinter - , pgp-wordlist == 0.1.*- , bytestring == 0.10.*- , tasty >= 0.10 && < 0.12- , tasty-hunit == 0.9.*- , tasty-quickcheck == 0.8.*- , text == 1.2.*+ , pgp-wordlist >= 0.1+ , bytestring >= 0.10+ , tasty >= 0.10+ , tasty-hunit >= 0.9+ , tasty-quickcheck >= 0.8+ , text ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall default-language: Haskell2010 if impl(ghc < 8.0)- build-depends: semigroups >= 0.6 && < 0.19+ build-depends: semigroups >= 0.6 @@ -134,12 +137,12 @@ base >= 4.7 && < 5 , prettyprinter - , criterion >= 1.1 && < 1.3- , mtl >= 2.1 && < 2.3- , random >= 1.0 && < 1.2- , text == 1.2.*- , transformers >= 0.3 && < 0.6- , ansi-wl-pprint == 0.6.*+ , criterion >= 1.1+ , mtl >= 2.1+ , random >= 1.0+ , text+ , transformers >= 0.3+ , ansi-wl-pprint >= 0.6 ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N default-language: Haskell2010 other-extensions: NumDecimals, OverloadedStrings@@ -149,11 +152,30 @@ base >= 4.7 && < 5 , prettyprinter - , criterion >= 1.1 && < 1.3- , text == 1.2.*+ , criterion >= 1.1+ , text hs-source-dirs: bench main-is: FasterUnsafeText.hs+ ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+ default-language: Haskell2010+ type: exitcode-stdio-1.0+++benchmark large-output+ build-depends:+ base >= 4.7 && < 5+ , prettyprinter+ , ansi-wl-pprint++ , criterion >= 1.1+ , QuickCheck >= 2.7+ , containers+ , text+ , deepseq++ hs-source-dirs: bench+ main-is: LargeOutput.hs ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall default-language: Haskell2010 type: exitcode-stdio-1.0
src/Data/Text/Prettyprint/Doc.hs view
@@ -83,18 +83,20 @@ -- │ 'SimpleDocStream' │ -- │ (simple document) │ -- ╰─────────┬─────────╯--- ╭───────────────────┤--- │ │--- 'Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree.treeForm' │ │--- ▽ │ Renderers--- ╭───────────────╮ │--- │ 'Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree.SimpleDocTree' │ │--- ╰───────┬───────╯ ├───────────────────┬───────────────────╮--- │ │ │ │--- ▽ ▽ ▽ ▽--- ╭───────────────╮ ╭───────────────╮ ╭───────────────╮ ╭───────────────╮--- │ HTML │ │ Plain 'Text' │ │ ANSI terminal │ │ other/custom │--- ╰───────────────╯ ╰───────────────╯ ╰───────────────╯ ╰───────────────╯+-- │+-- ╭───────────────────┴───────────────────╮+-- 'Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree.treeForm' │ │+-- ▽ │+-- ╭───────────────╮ │+-- │ 'Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree.SimpleDocTree' │ Renderers │+-- ╰───────┬───────╯ │+-- │ │+-- ├───────────────╮ ╭───────────────┼───────────────────╮+-- │ │ │ │ │+-- ▽ ▽ ▽ ▽ ▽+-- ╭───────────────╮ ╭───────────────╮ ╭───────────────╮ ╭───────────────╮+-- │ HTML │ │ other/custom │ │ Plain 'Text' │ │ ANSI terminal │+-- ╰───────────────╯ ╰───────────────╯ ╰───────────────╯ ╰───────────────╯ -- @ -- -- = How the layout works@@ -124,6 +126,52 @@ -- constraints (given by page and ribbon widths), the document is rendered -- unaltered. This allows fallback definitions, so that we get nice results even -- when the original document would exceed the layout constraints.+--+-- = Things the prettyprinter /cannot/ do+--+-- Due to how the Wadler/Leijen algorithm is designed, a couple of things are+-- unsupported right now, with a high possibility of having no sensible+-- implementation without significantly changing the layout algorithm. In+-- particular, this includes+--+-- * Leading symbols instead of just spaces for indentation, as used by the+-- Linux @tree@ tool for example+-- * Multi-column layouts, in particular tables with multiple cells of equal+-- width adjacent to each other+--+-- = Some helpful tips+--+-- == Which kind of annotation should I use?+--+-- __Summary:__ Use semantic annotations for @'Doc'@, and after layouting map to+-- backend-specific ones.+--+-- For example, suppose you want to prettyprint some programming language code.+-- If you want keywords to be red, you should annotate the @'Doc'@ with a type+-- that has a 'Keyword' field (without any notion of color), and then after+-- layouting convert the annotations to map @'Keyword'@ to e.g. @'Red'@ (using+-- @'reAnnotateS'@). The alternative that I /do not/ recommend is directly+-- annotating the @'Doc'@ with 'Red'.+--+-- While both versions would superficially work equally well and would create+-- identical output, the recommended way has two significant advantages:+-- modularity and extensibility.+--+-- /Modularity:/ To change the color of keywords later, you have to touch one+-- point, namely the mapping in @'reAnnotateS'@, where @'Keyword'@ is mapped to+-- 'Red'. If you have @'annotate Red …'@ everywher, you’ll have to do a full+-- text replacement, producing a large diff and touching lots of places for a+-- very small change.+--+-- /Extensibility:/ Addng a different backend in the recommended version is+-- simply adding another @'reAnnotateS'@ to convert the @'Doc'@ annotation to+-- something else. On the other hand, if you have @'Red'@ as an annotation in+-- the @'Doc'@ already and the other backend does not support anything red+-- (think of plain text or a website where red doesn’t work well with the rest+-- of the style), you’ll have to worry about what to map »redness« to, which has+-- no canonical answer. Should it be omitted? What does »red« mean anyway –+-- maybe keywords and variables are red, and you want to change only the color+-- of variables? module Data.Text.Prettyprint.Doc ( -- * Documents Doc,@@ -228,6 +276,7 @@ import Data.Semigroup import Data.Text.Prettyprint.Doc.Internal+import Data.Text.Prettyprint.Doc.Symbols.Ascii -- $setup --@@ -241,6 +290,14 @@ -- $migration --+-- There are 3 main ways to migrate:+--+-- 1. Direct: just replace the previous package and fix the errors+-- 2. Using a drop-in replacement mimicing the API of the former module, see+-- the @prettyprinter-compat-<former package>@ packages+-- 3. Using a converter from the old @Doc@ type to the new one, see the+-- @prettyprinter-convert-<former package>@ packages+-- -- If you're already familiar with (ansi-)wl-pprint, you'll recognize many -- functions in this module, and they work just the same way. However, a couple -- of definitions are missing:@@ -249,7 +306,8 @@ -- overloaded @'pretty'@ function. -- - @\<$>@, @\<$$>@, @\</>@, @\<//>@ are special cases of -- @'vsep'@, @'vcat'@, @'fillSep'@, @'fillCat'@ with only two documents.--- - If you need 'String' output, use 'T.unpack' on the generated renderings.+-- - If you need 'String' output, use the backends in the+-- "Data.Text.Prettyprint.Doc.Render.String" module. -- - The /display/ functions are moved to the rendering submodules, for -- example conversion to plain 'Text' is in the -- "Data.Text.Prettyprint.Doc.Render.Text" module.
src/Data/Text/Prettyprint/Doc/Internal.hs view
@@ -195,6 +195,8 @@ prettyList :: [a] -> Doc ann prettyList = list . map pretty + {-# MINIMAL pretty #-}+ -- | >>> pretty [1,2,3] -- [1, 2, 3] instance Pretty a => Pretty [a] where@@ -409,7 +411,7 @@ -- >>> group doc -- lorem ipsum dolor sit amet line :: Doc ann-line = FlatAlt Line space+line = FlatAlt Line (Char ' ') -- | @'line''@ is like @'line'@, but behaves like @'mempty'@ if the line break -- is undone by 'group' (instead of @'space'@).@@ -743,7 +745,7 @@ -- x '<+>' y = x '<>' 'space' '<>' y -- @ (<+>) :: Doc ann -> Doc ann -> Doc ann-x <+> y = x <> space <> y+x <+> y = x <> Char ' ' <> y @@ -775,6 +777,7 @@ #endif | otherwise = foldr1 f ds {-# INLINE concatWith #-}+{-# SPECIALIZE concatWith :: (Doc ann -> Doc ann -> Doc ann) -> [Doc ann] -> Doc ann #-} -- | @('hsep' xs)@ concatenates all documents @xs@ horizontally with @'<+>'@, -- i.e. it puts a space between all entries.@@ -1147,137 +1150,9 @@ --- | >>> squotes "·"--- '·'-squotes :: Doc ann -> Doc ann-squotes = enclose squote squote --- | >>> dquotes "·"--- "·"-dquotes :: Doc ann -> Doc ann-dquotes = enclose dquote dquote --- | >>> parens "·"--- (·)-parens :: Doc ann -> Doc ann-parens = enclose lparen rparen --- | >>> angles "·"--- <·>-angles :: Doc ann -> Doc ann-angles = enclose langle rangle---- | >>> brackets "·"--- [·]-brackets :: Doc ann -> Doc ann-brackets = enclose lbracket rbracket---- | >>> braces "·"--- {·}-braces :: Doc ann -> Doc ann-braces = enclose lbrace rbrace---- | >>> squote--- '-squote :: Doc ann-squote = "'"---- | >>> dquote--- "-dquote :: Doc ann-dquote = "\""---- | >>> lparen--- (-lparen :: Doc ann-lparen = "("---- | >>> rparen--- )-rparen :: Doc ann-rparen = ")"---- | >>> langle--- <-langle :: Doc ann-langle = "<"---- | >>> rangle--- >-rangle :: Doc ann-rangle = ">"---- | >>> lbracket--- [-lbracket :: Doc ann-lbracket = "["--- | >>> rbracket--- ]-rbracket :: Doc ann-rbracket = "]"---- | >>> lbrace--- {-lbrace :: Doc ann-lbrace = "{"--- | >>> rbrace--- }-rbrace :: Doc ann-rbrace = "}"---- | >>> semi--- ;-semi :: Doc ann-semi = ";"---- | >>> colon--- :-colon :: Doc ann-colon = ":"---- | >>> comma--- ,-comma :: Doc ann-comma = ","---- | >>> "a" <> space <> "b"--- a b------ This is mostly used via @'<+>'@,------ >>> "a" <+> "b"--- a b-space :: Doc ann-space = " "---- | >>> dot--- .-dot :: Doc ann-dot = "."---- | >>> slash--- /-slash :: Doc ann-slash = "/"---- | >>> backslash--- \\--backslash :: Doc ann-backslash = "\\"---- | >>> equals--- =-equals :: Doc ann-equals = "="---- | >>> pipe--- |-pipe :: Doc ann-pipe = "|"--- -- | Add an annotation to a @'Doc'@. This annotation can then be used by the -- renderer to e.g. add color to certain parts of the output. For a full -- tutorial example on how to use it, see the@@ -1501,7 +1376,7 @@ -- constructor. | SText !Int Text (SimpleDocStream ann) - -- | @Int@ = indentation level for the line+ -- | @Int@ = indentation level for the (next) line | SLine !Int (SimpleDocStream ann) -- | Add an annotation to the remaining document.@@ -1843,5 +1718,6 @@ -- -- >>> :set -XOverloadedStrings -- >>> import Data.Text.Prettyprint.Doc.Render.Text+-- >>> import Data.Text.Prettyprint.Doc.Symbols.Ascii -- >>> import Data.Text.Prettyprint.Doc.Util as Util -- >>> import Test.QuickCheck.Modifiers
src/Data/Text/Prettyprint/Doc/Render/ShowS.hs view
@@ -1,4 +1,4 @@-module Data.Text.Prettyprint.Doc.Render.ShowS (+module Data.Text.Prettyprint.Doc.Render.ShowS {-# DEPRECATED "Use Data.Text.Prettyprint.Doc.Render.String instead" #-} ( renderShowS ) where
+ src/Data/Text/Prettyprint/Doc/Render/String.hs view
@@ -0,0 +1,10 @@+module Data.Text.Prettyprint.Doc.Render.String (+ renderString,+ renderShowS,+) where++import Data.Text.Prettyprint.Doc.Internal (SimpleDocStream, renderShowS)++-- | Render a 'SimpleDocStream' to a 'String'.+renderString :: SimpleDocStream ann -> String+renderString s = renderShowS s ""
src/Data/Text/Prettyprint/Doc/Render/Text.hs view
@@ -1,4 +1,6 @@-{-# LANGUAGE CPP #-}+{-# LANGUAGE CPP #-}+{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE OverloadedStrings #-} #include "version-compatibility-macros.h" @@ -17,12 +19,14 @@ import Data.Text (Text)+import qualified Data.Text as T+import qualified Data.Text.IO as T import qualified Data.Text.Lazy as TL import qualified Data.Text.Lazy.Builder as TLB-import qualified Data.Text.Lazy.IO as TL import System.IO import Data.Text.Prettyprint.Doc+import Data.Text.Prettyprint.Doc.Render.Util.Panic import Data.Text.Prettyprint.Doc.Render.Util.StackMachine #if !(SEMIGROUP_IN_BASE)@@ -67,8 +71,26 @@ -- >>> renderIO System.IO.stdout (layoutPretty defaultLayoutOptions "hello\nworld") -- hello -- world+--+-- This function is more efficient than @'T.hPutStr' h ('renderStrict' sdoc)@,+-- since it writes to the handle directly, skipping the intermediate 'Text'+-- representation. renderIO :: Handle -> SimpleDocStream ann -> IO ()-renderIO h sdoc = TL.hPutStrLn h (renderLazy sdoc)+renderIO h = go+ where+ go :: SimpleDocStream ann -> IO ()+ go = \case+ SFail -> panicUncaughtFail+ SEmpty -> pure ()+ SChar c rest -> do hPutChar h c+ go rest+ SText _ t rest -> do T.hPutStr h t+ go rest+ SLine n rest -> do hPutChar h '\n'+ T.hPutStr h (T.replicate n " ")+ go rest+ SAnnPush _ann rest -> go rest+ SAnnPop rest -> go rest -- | @('putDoc' doc)@ prettyprints document @doc@ to standard output. Uses the -- 'defaultLayoutOptions'.
src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs view
@@ -80,6 +80,7 @@ STLine i -> text (T.singleton '\n' <> T.replicate i " ") STAnn ann rest -> renderAnn ann (go rest) STConcat xs -> foldMap go xs+{-# INLINE renderSimplyDecorated #-} -- | Version of 'renderSimplyDecoratedA' that allows for 'Applicative' effects. renderSimplyDecoratedA@@ -97,6 +98,7 @@ STLine i -> text (T.singleton '\n' <> T.replicate i " ") STAnn ann rest -> renderAnn ann (go rest) STConcat xs -> fmap mconcat (traverse go xs)+{-# INLINE renderSimplyDecoratedA #-} @@ -155,9 +157,19 @@ data SimpleDocTree ann = STEmpty | STChar Char++ -- | Some layout algorithms use the Since the frequently used 'T.length' of+ -- the 'Text', which scales linearly with its length, we cache it in this+ -- constructor. | STText !Int Text++ -- | @Int@ = indentation level for the (next) line | STLine !Int++ -- | Annotate the contained document. | STAnn ann (SimpleDocTree ann)++ -- | Horizontal concatenation of multiple documents. | STConcat [SimpleDocTree ann] deriving (Eq, Ord, Show, Generic)
src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs view
@@ -59,6 +59,8 @@ -- >>> let sdoc = layoutPretty defaultLayoutOptions doc -- >>> T.putStrLn (renderSimplyDecorated id (\() -> ">>>") (\() -> "<<<") sdoc) -- hello >>>world<<<!+--+-- The monoid will be concatenated in a /right associative/ fashion. renderSimplyDecorated :: Monoid out => (Text -> out) -- ^ Render plain 'Text'@@ -73,10 +75,11 @@ go (_:_) SEmpty = panicInputNotFullyConsumed go stack (SChar c rest) = text (T.singleton c) <> go stack rest go stack (SText _l t rest) = text t <> go stack rest- go stack (SLine i rest) = text (T.singleton '\n' <> T.replicate i " ") <> go stack rest+ go stack (SLine i rest) = text (T.singleton '\n') <> text (T.replicate i " ") <> go stack rest go stack (SAnnPush ann rest) = push ann <> go (ann : stack) rest go (ann:stack) (SAnnPop rest) = pop ann <> go stack rest go [] SAnnPop{} = panicUnpairedPop+{-# INLINE renderSimplyDecorated #-} -- | Version of 'renderSimplyDecoratedA' that allows for 'Applicative' effects. renderSimplyDecoratedA@@ -93,12 +96,13 @@ go (_:_) SEmpty = panicInputNotFullyConsumed go stack (SChar c rest) = text (T.singleton c) <++> go stack rest go stack (SText _l t rest) = text t <++> go stack rest- go stack (SLine i rest) = text (T.singleton '\n' <> T.replicate i " ") <++> go stack rest+ go stack (SLine i rest) = text (T.singleton '\n') <++> text (T.replicate i " ") <++> go stack rest go stack (SAnnPush ann rest) = push ann <++> go (ann : stack) rest go (ann:stack) (SAnnPop rest) = pop ann <++> go stack rest go [] SAnnPop{} = panicUnpairedPop (<++>) = liftA2 mappend+{-# INLINE renderSimplyDecoratedA #-}
+ src/Data/Text/Prettyprint/Doc/Symbols/Ascii.hs view
@@ -0,0 +1,154 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE OverloadedStrings #-}++#include "version-compatibility-macros.h"++-- | Common symbols composed out of the ASCII subset of Unicode. For non-ASCII+-- symbols, see "Data.Text.Prettyprint.Doc.Symbols.Unicode".+module Data.Text.Prettyprint.Doc.Symbols.Ascii where++++import Data.Text.Prettyprint.Doc.Internal++++-- | >>> squotes "·"+-- '·'+squotes :: Doc ann -> Doc ann+squotes = enclose squote squote++-- | >>> dquotes "·"+-- "·"+dquotes :: Doc ann -> Doc ann+dquotes = enclose dquote dquote++-- | >>> parens "·"+-- (·)+parens :: Doc ann -> Doc ann+parens = enclose lparen rparen++-- | >>> angles "·"+-- <·>+angles :: Doc ann -> Doc ann+angles = enclose langle rangle++-- | >>> brackets "·"+-- [·]+brackets :: Doc ann -> Doc ann+brackets = enclose lbracket rbracket++-- | >>> braces "·"+-- {·}+braces :: Doc ann -> Doc ann+braces = enclose lbrace rbrace++-- | >>> squote+-- '+squote :: Doc ann+squote = "'"++-- | >>> dquote+-- "+dquote :: Doc ann+dquote = "\""++-- | >>> lparen+-- (+lparen :: Doc ann+lparen = "("++-- | >>> rparen+-- )+rparen :: Doc ann+rparen = ")"++-- | >>> langle+-- <+langle :: Doc ann+langle = "<"++-- | >>> rangle+-- >+rangle :: Doc ann+rangle = ">"++-- | >>> lbracket+-- [+lbracket :: Doc ann+lbracket = "["+-- | >>> rbracket+-- ]+rbracket :: Doc ann+rbracket = "]"++-- | >>> lbrace+-- {+lbrace :: Doc ann+lbrace = "{"+-- | >>> rbrace+-- }+rbrace :: Doc ann+rbrace = "}"++-- | >>> semi+-- ;+semi :: Doc ann+semi = ";"++-- | >>> colon+-- :+colon :: Doc ann+colon = ":"++-- | >>> comma+-- ,+comma :: Doc ann+comma = ","++-- | >>> "a" <> space <> "b"+-- a b+--+-- This is mostly used via @'<+>'@,+--+-- >>> "a" <+> "b"+-- a b+space :: Doc ann+space = " "++-- | >>> dot+-- .+dot :: Doc ann+dot = "."++-- | >>> slash+-- /+slash :: Doc ann+slash = "/"++-- | >>> backslash+-- \\++backslash :: Doc ann+backslash = "\\"++-- | >>> equals+-- =+equals :: Doc ann+equals = "="++-- | >>> pipe+-- |+pipe :: Doc ann+pipe = "|"++++-- $setup+--+-- (Definitions for the doctests)+--+-- >>> :set -XOverloadedStrings+-- >>> import Data.Semigroup+-- >>> import Data.Text.Prettyprint.Doc.Render.Text+-- >>> import Data.Text.Prettyprint.Doc.Util
+ src/Data/Text/Prettyprint/Doc/Symbols/Unicode.hs view
@@ -0,0 +1,212 @@+{-# LANGUAGE OverloadedStrings #-}++-- | A collection of predefined Unicode values outside of ASCII range. For+-- ASCII, see "Data.Text.Prettyprint.Doc.Symbols.Ascii".+module Data.Text.Prettyprint.Doc.Symbols.Unicode (+ -- * Quotes++ -- ** Enclosing+ d9966quotes,+ d6699quotes,+ s96quotes,+ s69quotes,+ dGuillemetsOut,+ dGuillemetsIn,+ sGuillemetsOut,+ sGuillemetsIn,++ -- ** Standalone+ b99dquote,+ t66dquote,+ t99dquote,+ b9quote,+ t6quote,+ t9quote,++ rdGuillemet,+ ldGuillemet,+ rsGuillemet,+ lsGuillemet,++ -- * Various typographical symbols+ bullet,+ endash,++ -- * Currencies+ euro,+ cent,+ yen,+ pound,+) where++++import Data.Text.Prettyprint.Doc++++-- | Double „99-66“ quotes, as used in German typography.+--+-- >>> putDoc (d9966quotes "·")+-- „·“+d9966quotes :: Doc ann -> Doc ann+d9966quotes = enclose b99dquote t66dquote++-- | Double “66-99” quotes, as used in English typography.+--+-- >>> putDoc (d6699quotes "·")+-- “·”+d6699quotes :: Doc ann -> Doc ann+d6699quotes = enclose t66dquote t99dquote++-- | Single ‚9-6‘ quotes, as used in German typography.+--+-- >>> putDoc (s96quotes "·")+-- ‚·‘+s96quotes :: Doc ann -> Doc ann+s96quotes = enclose b9quote t6quote++-- | Single ‘6-9’ quotes, as used in English typography.+--+-- >>> putDoc (s69quotes "·")+-- ‘·’+s69quotes :: Doc ann -> Doc ann+s69quotes = enclose t6quote t9quote++-- | Double «guillemets», pointing outwards (without adding any spacing).+--+-- >>> putDoc (dGuillemetsOut "·")+-- «·»+dGuillemetsOut :: Doc ann -> Doc ann+dGuillemetsOut = enclose ldGuillemet rdGuillemet++-- | Double »guillemets«, pointing inwards (without adding any spacing).+--+-- >>> putDoc (dGuillemetsIn "·")+-- »·«+dGuillemetsIn :: Doc ann -> Doc ann+dGuillemetsIn = enclose rdGuillemet ldGuillemet++-- | Single ‹guillemets›, pointing outwards (without adding any spacing).+--+-- >>> putDoc (sGuillemetsOut "·")+-- ‹·›+sGuillemetsOut :: Doc ann -> Doc ann+sGuillemetsOut = enclose lsGuillemet rsGuillemet++-- | Single ›guillemets‹, pointing inwards (without adding any spacing).+--+-- >>> putDoc (sGuillemetsIn "·")+-- ›·‹+sGuillemetsIn :: Doc ann -> Doc ann+sGuillemetsIn = enclose rsGuillemet lsGuillemet++-- | Bottom „99“ style double quotes.+--+-- >>> putDoc b99dquote+-- „+b99dquote :: Doc ann+b99dquote = "„"++-- | Top “66” style double quotes.+--+-- >>> putDoc t66dquote+-- “+t66dquote :: Doc ann+t66dquote = "“"++-- | Top “99” style double quotes.+--+-- >>> putDoc t99dquote+-- ”+t99dquote :: Doc ann+t99dquote = "”"++-- | Bottom ‚9‘ style single quote.+--+-- >>> putDoc b9quote+-- ‚+b9quote :: Doc ann+b9quote = "‚"++-- | Top ‘66’ style single quote.+--+-- >>> putDoc t6quote+-- ‘+t6quote :: Doc ann+t6quote = "‘"++-- | Top ‘9’ style single quote.+--+-- >>> putDoc t9quote+-- ’+t9quote :: Doc ann+t9quote = "’"++-- | Right-pointing double guillemets+--+-- >>> putDoc rdGuillemet+-- »+rdGuillemet :: Doc ann+rdGuillemet = "»"++-- | Left-pointing double guillemets+--+-- >>> putDoc ldGuillemet+-- «+ldGuillemet :: Doc ann+ldGuillemet = "«"++-- | Right-pointing single guillemets+--+-- >>> putDoc rsGuillemet+-- ›+rsGuillemet :: Doc ann+rsGuillemet = "›"++-- | Left-pointing single guillemets+--+-- >>> putDoc lsGuillemet+-- ‹+lsGuillemet :: Doc ann+lsGuillemet = "‹"++-- | >>> putDoc bullet+-- •+bullet :: Doc ann+bullet = "•"++-- | >>> putDoc endash+-- –+endash :: Doc ann+endash = "–"++-- | >>> putDoc euro+-- €+euro :: Doc ann+euro = "€"++-- | >>> putDoc cent+-- ¢+cent :: Doc ann+cent = "¢"++-- | >>> putDoc yen+-- ¥+yen :: Doc ann+yen = "¥"++-- | >>> putDoc pound+-- £+pound :: Doc ann+pound = "£"++++-- $setup+--+-- (Definitions for the doctests)+--+-- >>> :set -XOverloadedStrings+-- >>> import Data.Text.Prettyprint.Doc.Render.Text+-- >>> import Data.Text.Prettyprint.Doc.Util
test/Testsuite/Main.hs view
@@ -42,9 +42,11 @@ , testProperty "Deep fusion does not change rendering" (fusionDoesNotChangeRendering Deep) ]- , testGroup "Regression tests"- [ testCase "Pathological grouping performance"- pathologicalGroupingPerformance+ , testGroup "Performance tests"+ [ testCase "Grouping performance"+ groupingPerformance+ , testCase "fillSep performance"+ fillSepPerformance ] ] @@ -150,16 +152,30 @@ dampen :: Gen a -> Gen a dampen gen = sized (\n -> resize ((n*2) `quot` 3) gen) -+docPerformanceTest :: Doc ann -> Assertion+docPerformanceTest doc+ = timeout 10000000 (forceDoc doc) >>= \case+ Nothing -> assertFailure "Timeout!"+ Just _success -> pure ()+ where+ forceDoc :: Doc ann -> IO ()+ forceDoc = evaluate . foldr seq () . show -- Deeply nested group/flatten calls can result in exponential performance. -- -- See https://github.com/quchen/prettyprinter/issues/22-pathologicalGroupingPerformance :: Assertion-pathologicalGroupingPerformance- = timeout 10000000 (poorMansForce (pathological 1000)) >>= \case- Nothing -> assertFailure "Timeout!"- Just _success -> pure ()+groupingPerformance :: Assertion+groupingPerformance = docPerformanceTest (pathological 1000) where+ pathological :: Int -> Doc ann pathological n = iterate (\x -> hsep [x, sep []] ) "foobar" !! n- poorMansForce = evaluate . length . show++-- This test case was written because the `pretty` package had an issue with+-- this specific example.+--+-- See https://github.com/haskell/pretty/issues/32+fillSepPerformance :: Assertion+fillSepPerformance = docPerformanceTest (pathological 1000)+ where+ pathological :: Int -> Doc ann+ pathological n = iterate (\x -> fillSep ["a", x <+> "b"] ) "foobar" !! n