prettyprinter 0.1 → 1

raw patch · 16 files changed

+543/−224 lines, 16 filesdep ~ansi-wl-pprintdep ~basedep ~bytestringPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: ansi-wl-pprint, base, bytestring, criterion, doctest, mtl, pgp-wordlist, random, semigroups, tasty, tasty-quickcheck, template-haskell, text, transformers

API changes (from Hackage documentation)

Files

• CONTRIBUTORS.md +24/−0
• README.md +34/−13
• app/GenerateReadme.hs +47/−21
• bench/FasterUnsafeText.hs +1/−1
• misc/version-compatibility-macros.h +1/−1
• prettyprinter.cabal +2/−1
• src/Data/Text/Prettyprint/Doc.hs +11/−9
• src/Data/Text/Prettyprint/Doc/Internal.hs +165/−107
• src/Data/Text/Prettyprint/Doc/Render/ShowS.hs +1/−1
• src/Data/Text/Prettyprint/Doc/Render/Text.hs +11/−19
• src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs +18/−10
• src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs +15/−7
• src/Data/Text/Prettyprint/Doc/Render/Util/Panic.hs +5/−5
• src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs +119/−17
• src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs +81/−6
• src/Data/Text/Prettyprint/Doc/Util.hs +8/−6

@@ -0,0 +1,24 @@+# 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)++- Moritz Kiefer, @cocreature+- Daniel Mendler, @minad – several ideas after the preliminary release+- 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

@@ -5,8 +5,8 @@ A modern Wadler/Leijen Prettyprinter ==================================== -[![status](https://img.shields.io/github/release/quchen/prettyprinter.svg?style=flat-square&label=Latest%20version)](https://github.com/quchen/prettyprinter/releases)-[![status](https://img.shields.io/travis/quchen/prettyprinter/master.svg?style=flat-square&label=Master%20build)](https://travis-ci.org/quchen/prettyprinter)+[![](https://img.shields.io/travis/quchen/prettyprinter/master.svg?style=flat-square&label=Master%20build)](https://travis-ci.org/quchen/prettyprinter)  +[![](https://img.shields.io/github/release/quchen/prettyprinter.svg?style=flat-square&label=Latest%20version&colorB=0a7bbb)](https://github.com/quchen/prettyprinter/releases) [![](https://img.shields.io/hackage/v/prettyprinter.svg?style=flat-square&label=Hackage&colorB=0a7bbb)](https://hackage.haskell.org/package/prettyprinter) [![](https://www.stackage.org/package/prettyprinter/badge/lts?style=flat-square&label=Stackage&colorB=0a7bbb)](https://www.stackage.org/package/prettyprinter)   @@ -15,10 +15,28 @@  A prettyprinter/text rendering engine. Easy to use, well-documented, ANSI terminal backend exists, HTML backend is trivial to implement, no name clashes,-Text-based, extensible.+`Text`-based, extensible. +```haskell+let prettyType = align . sep . zipWith (<+>) ("::" : repeat "->")+    prettySig name ty = pretty name <+> prettyType ty+in  prettySig "example" ["Int", "Bool", "Char", "IO ()"]+``` +```haskell+-- Output for wide enough formats:+example :: Int -> Bool -> Char -> IO () +-- Output for narrow formats:+example :: Int+        -> Bool+        -> Char+        -> IO ()+```++++ Longer; want to read -------------------- @@ -44,7 +62,7 @@ ### `Text` instead of `String`  `String` has exactly one use, and that’s showing Hello World in tutorials. For-all other uses, Text is what people should be using. The prettyprinter uses no+all other uses, `Text` is what people should be using. The prettyprinter uses no `String` definitions anywhere; using a `String` means an immediate conversion to the internal `Text`-based format. @@ -77,7 +95,8 @@ More complex uses of annotations include e.g. adding type annotations for mouse-over hovers when printing a syntax tree, adding URLs to documentation, or adding source locations to show where a certain piece of output comes from.-Idris is a project that makes extensive use of such a feature.+[Idris](https://github.com/idris-lang/Idris-dev) is a project that makes+extensive use of such a feature.  Special care has been applied to make annotations unobtrusive, so that if you don’t need or care about them there is no overhead, neither in terms of@@ -108,11 +127,11 @@  ### Open implementation -The type of documents is unanimously (!) abstract in the other Wadler/Leijen-prettyprinters, making it impossible to write adaptors from one library to-another. The type should be exposed for such purposes so it is possible to write-adaptors from library to library, or each of them is doomed to live on its own-small island of incompatibility. For this reason, the `Doc` type is fully+The type of documents is abstract in most of the other Wadler/Leijen+prettyprinters, making it hard to impossible to write adaptors from one library+to another. The type should be exposed for such purposes so it is possible to+write adaptors from library to library, or each of them is doomed to live on its+own small island of incompatibility. For this reason, the `Doc` type is fully exposed in a semi-internal module for this specific use case.  @@ -155,9 +174,11 @@   4. Use of `Text` instead of `String`.   5. A `fuse` function to optimize often-used documents before rendering for      efficiency.-  6. Instead of providing an own colorization function for each-     color/intensity/layer combination, they have been combined in 'color'-     'colorDull', 'bgColor', and 'bgColorDull' functions.+  6. SimpleDoc was renamed `SimpleDocStream`, to contrast the new+     `SimpleDocTree`.+  7. In the ANSI backend, instead of providing an own colorization function for+     each color/intensity/layer combination, they have been combined in /color/+     /colorDull/, /bgColor/, and /bgColorDull/ functions.   

@@ -29,16 +29,37 @@      , h1 "A modern Wadler/Leijen Prettyprinter" -    , cat-        [ "[![status](https://img.shields.io/github/release/quchen/prettyprinter.svg?style=flat-square&label=Latest%20version)](https://github.com/quchen/prettyprinter/releases)"-        , "[![status](https://img.shields.io/travis/quchen/prettyprinter/master.svg?style=flat-square&label=Master%20build)](https://travis-ci.org/quchen/prettyprinter)"-        ]+    , mconcat+        [ "[![](https://img.shields.io/travis/quchen/prettyprinter/master.svg?style=flat-square&label=Master%20build)](https://travis-ci.org/quchen/prettyprinter)"+        , "  " <> hardline -- Awkwardly enough, two trailing spaces are a small break in Markdown.+        , hsep+            [ "[![](https://img.shields.io/github/release/quchen/prettyprinter.svg?style=flat-square&label=Latest%20version&colorB=0a7bbb)](https://github.com/quchen/prettyprinter/releases)"+            , "[![](https://img.shields.io/hackage/v/prettyprinter.svg?style=flat-square&label=Hackage&colorB=0a7bbb)](https://hackage.haskell.org/package/prettyprinter)"+            , "[![](https://www.stackage.org/package/prettyprinter/badge/lts?style=flat-square&label=Stackage&colorB=0a7bbb)](https://www.stackage.org/package/prettyprinter)" ]]      , h2 "tl;dr"         , paragraph [multiline| A prettyprinter/text rendering engine. Easy to         use, well-documented, ANSI terminal backend exists, HTML backend is-        trivial to implement, no name clashes, Text-based, extensible. |]+        trivial to implement, no name clashes, `Text`-based, extensible. |]+        , (pretty . T.unlines)+            [ "```haskell"+            , "let prettyType = align . sep . zipWith (<+>) (\"::\" : repeat \"->\")"+            , "    prettySig name ty = pretty name <+> prettyType ty"+            , "in  prettySig \"example\" [\"Int\", \"Bool\", \"Char\", \"IO ()\"]"+            , "```"+            , ""+            , "```haskell"+            , "-- Output for wide enough formats:"+            , "example :: Int -> Bool -> Char -> IO ()"+            , ""+            , "-- Output for narrow formats:"+            , "example :: Int"+            , "        -> Bool"+            , "        -> Char"+            , "        -> IO ()"+            , "```" ] +     , h2 "Longer; want to read"         , paragraph [multiline| This package defines a prettyprinter to format         text in a flexible and convenient way. The idea is to combine a document@@ -56,10 +77,10 @@      , h3 "`Text` instead of `String`"         , paragraph [multiline| `String` has exactly one use, and that’s showing-        Hello World in tutorials. For all other uses, Text is what people should-        be using. The prettyprinter uses no `String` definitions anywhere; using-        a `String` means an immediate conversion to the internal `Text`-based-        format. |]+        Hello World in tutorials. For all other uses, `Text` is what people+        should be using. The prettyprinter uses no `String` definitions+        anywhere; using a `String` means an immediate conversion to the internal+        `Text`-based format. |]      , h3 "Extensive documentation"         , paragraph [multiline| The library is stuffed with runnable examples,@@ -83,8 +104,9 @@         , paragraph [multiline| More complex uses of annotations include e.g.         adding type annotations for mouse-over hovers when printing a syntax         tree, adding URLs to documentation, or adding source locations to show-        where a certain piece of output comes from. Idris is a project that-        makes extensive use of such a feature. |]+        where a certain piece of output comes from.+        [Idris](https://github.com/idris-lang/Idris-dev) is a project that makes+        extensive use of such a feature. |]          , paragraph [multiline| Special care has been applied to make         annotations unobtrusive, so that if you don’t need or care about them@@ -108,14 +130,15 @@         cases for the programmer. |]      , h3 "Open implementation"-        , paragraph [multiline| The type of documents is unanimously (!)-        abstract in the other Wadler/Leijen prettyprinters, making it impossible-        to write adaptors from one library to another. The type should be-        exposed for such purposes so it is possible to write adaptors from-        library to library, or each of them is doomed to live on its own small-        island of incompatibility. For this reason, the `Doc` type is fully-        exposed in a semi-internal module for this specific use case. |] +        , paragraph [multiline| The type of documents is abstract in most of the+        other Wadler/Leijen prettyprinters, making it hard to impossible to+        write adaptors from one library to another. The type should be exposed+        for such purposes so it is possible to write adaptors from library to+        library, or each of them is doomed to live on its own small island of+        incompatibility. For this reason, the `Doc` type is fully exposed in a+        semi-internal module for this specific use case. |]+     , h2 "The prettyprinter family"     , paragraph "The `prettyprinter` family of packages consists of:"     , (indent 2 . unorderedList . map paragraph)@@ -154,9 +177,12 @@         , [multiline| Use of `Text` instead of `String`. |]         , [multiline| A `fuse` function to optimize often-used documents before           rendering for efficiency. |]-        , [multiline| Instead of providing an own colorization function for each-          color/intensity/layer combination, they have been combined in 'color'-          'colorDull', 'bgColor', and 'bgColorDull' functions. |]+        , [multiline| SimpleDoc was renamed `SimpleDocStream`, to contrast the+          new `SimpleDocTree`. |]+        , [multiline| In the ANSI backend, instead of providing an own+          colorization function for each color/intensity/layer combination, they+          have been combined in /color/ /colorDull/, /bgColor/, and+          /bgColorDull/ functions. |]         ]      , h2 "Historical notes"

@@ -21,7 +21,7 @@     n -> Text n t  current :: Text -> Doc ann-current = unsafeText+current = unsafeTextWithoutNewlines  main :: IO () main = defaultMain [ benchText (letters n) | n <- [0,1,2,3,5,10,50,100] ]

@@ -12,8 +12,8 @@ #define FOLDABLE_TRAVERSABLE_IN_PRELUDE MIN_VERSION_base(4,8,0) #define MONOID_IN_PRELUDE               MIN_VERSION_base(4,8,0) #define NATURAL_IN_BASE                 MIN_VERSION_base(4,8,0)-#define SEMIGROUP_IN_BASE               MIN_VERSION_base(4,8,0) +#define SEMIGROUP_IN_BASE               MIN_VERSION_base(4,9,0) #define MONAD_FAIL                      MIN_VERSION_base(4,9,0)  #endif

@@ -1,5 +1,5 @@ name:                prettyprinter-version:             0.1+version:             1 cabal-version:       >= 1.10 category:            User Interfaces, Text synopsis:            A modern, extensible and well-documented prettyprinter.@@ -8,6 +8,7 @@ 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

@@ -13,8 +13,8 @@ -- This module defines a prettyprinter to format text in a flexible and -- convenient way. The idea is to combine a 'Doc'ument out of many small -- components, then using a layouter to convert it to an easily renderable--- 'SimpleDoc', which can then be rendered to a variety of formats, for example--- plain 'Text'.+-- 'SimpleDocStream', which can then be rendered to a variety of formats, for+-- example plain 'Text'. -- -- The documentation consists of several parts: --@@ -80,7 +80,7 @@ --                                  │ e.g. 'layoutPretty' --                                  ▽ --                        ╭───────────────────╮---                        │     'SimpleDoc'     │+--                        │  'SimpleDocStream'  │ --                        │ (simple document) │ --                        ╰─────────┬─────────╯ --                                  │@@ -205,12 +205,12 @@      -- * Layout     ---    -- | Laying a 'Doc'ument out produces a straightforward 'SimpleDoc' based on-    -- parameters such as page width and ribbon size, by evaluating how a 'Doc'-    -- fits these constraints the best. There are various ways to render a-    -- 'SimpleDoc'. For the common case of rendering a 'SimpleDoc' as plain-    -- 'Text' take a look at "Data.Text.Prettyprint.Doc.Render.Text".-    SimpleDoc(..),+    -- | Laying a 'Doc'ument out produces a straightforward 'SimpleDocStream'+    -- based on parameters such as page width and ribbon size, by evaluating how+    -- a 'Doc' fits these constraints the best. There are various ways to render+    -- a 'SimpleDocStream'. For the common case of rendering a 'SimpleDocStream'+    -- as plain 'Text' take a look at "Data.Text.Prettyprint.Doc.Render.Text".+    SimpleDocStream(..),     PageWidth(..), LayoutOptions(..), defaultLayoutOptions,     layoutPretty, layoutCompact, layoutSmart, @@ -249,6 +249,8 @@ --     example conversion to plain 'Text' is in the --     "Data.Text.Prettyprint.Doc.Render.Text" module. --   - The /render/ functions are called /layout/ functions.+--   - @SimpleDoc@ was renamed to @'SimpleDocStream'@, in order to make it+--     clearer in the presence of @SimpleDocTree@. --   - Instead of providing an own colorization function for each --     color\/intensity\/layer combination, they have been combined in 'color', --     'colorDull', 'bgColor', and 'bgColorDull' functions.

@@ -1,6 +1,8 @@+{-# LANGUAGE AutoDeriveTypeable  #-} {-# LANGUAGE BangPatterns        #-} {-# LANGUAGE CPP                 #-} {-# LANGUAGE DefaultSignatures   #-}+{-# LANGUAGE DeriveGeneric       #-} {-# LANGUAGE LambdaCase          #-} {-# LANGUAGE OverloadedStrings   #-} {-# LANGUAGE ScopedTypeVariables #-}@@ -29,6 +31,7 @@ import qualified Data.Text.Lazy     as Lazy import           Data.Void import           Data.Word+import           GHC.Generics       (Generic)  -- Depending on the Cabal file, this might be from base, or for older builds, -- from the semigroups package.@@ -38,10 +41,16 @@ import Numeric.Natural #endif +#if !(APPLICATIVE_MONAD)+import Control.Applicative+#endif+ #if !(FOLDABLE_TRAVERSABLE_IN_PRELUDE)-import Data.Foldable (Foldable (..))-import Prelude       hiding (foldr, foldr1)+import Data.Foldable    (Foldable (..))+import Data.Traversable (Traversable (..))+import Prelude          hiding (foldr, foldr1) #endif+ #if !(MONOID_IN_PRELUDE) import Data.Monoid hiding ((<>)) #endif@@ -50,17 +59,6 @@   --- $setup------ (Definitions for the doctests)------ >>> :set -XOverloadedStrings--- >>> import Data.Text.Prettyprint.Doc.Render.Text--- >>> import Data.Text.Prettyprint.Doc.Util as Util--- >>> import Test.QuickCheck.Modifiers--- -- | The abstract data type @'Doc' ann@ represents pretty documents that have -- been annotated with data of type @ann@. --@@ -75,8 +73,7 @@ -- --   - color information (e.g. when rendering to the terminal) --   - mouseover text (e.g. when rendering to rich HTML)---   - metailed whether to show something or not (to allow simple or detailed---     versions)+--   - whether to show something or not (to allow simple or detailed versions) -- -- The simplest way to display a 'Doc' is via the 'Show' class. --@@ -89,11 +86,11 @@     -- choosing a more suitable rendering.     Fail -    -- | The empty document; unit of 'Cat' (observationally)+    -- | The empty document; conceptually the unit of 'Cat'     | Empty -    -- | invariant: char is not '\n'-    | Char Char+    -- | invariant: not '\n'+    | Char !Char      -- | Invariants: at least two characters long, does not contain '\n'. For     -- empty documents, there is @Empty@; for singleton documents, there is@@ -101,9 +98,9 @@     --     -- Since the frequently used 'T.length' of 'Text' is /O(length)/, we cache     -- it in this constructor.-    | Text !Int Text+    | Text !Int !Text -    -- | Line break+    -- | Hard line break     | Line      -- | Lay out the first 'Doc', but when flattened (via 'group'), fall back to@@ -117,8 +114,9 @@     -- | Document indented by a number of columns     | Nest !Int (Doc ann) -    -- | Invariant: first lines of first '(Doc ann)' longer than the first lines of-    -- the second one. Used to implement layout alternatives for 'group'.+    -- | Invariant: The first lines of first document should be longer than the+    -- first lines of the second one, so the layout algorithm can pick the one+    -- that fits best. Used to implement layout alternatives for 'group'.     | Union (Doc ann) (Doc ann)      -- | React on the current cursor position, see 'column'@@ -133,6 +131,7 @@     -- | Add an annotation to the enclosed 'Doc'. Can be used for example to add     -- styling directives or alt texts that can then be used by the renderer.     | Annotated ann (Doc ann)+    deriving (Generic)  -- | -- @@@ -167,7 +166,20 @@ instance IsString (Doc ann) where     fromString = pretty . T.pack +-- | Alter the document’s annotations.+--+-- This instance makes 'Doc' more flexible (because it can be used in+-- 'Functor'-polymorphic values), but @'fmap'@ is much less readable compared to+-- using @'reAnnotate'@ in code that only works for @'Doc'@ anyway. Consider+-- using the latter when the type does not matter.+instance Functor Doc where+    fmap = reAnnotate+ -- | Overloaded conversion to 'Doc'.+--+-- Laws:+--+--   1. output should be pretty. :-) class Pretty a where      -- | >>> pretty 1 <+> pretty "hello" <+> pretty 1.234@@ -243,7 +255,7 @@ -- | Convert a 'Show'able value /that must not contain newlines/ to a 'Doc'. -- If there are newlines, use 'viaShow' instead. unsafeViaShow :: Show a => a -> Doc ann-unsafeViaShow = unsafeText . T.pack . show+unsafeViaShow = unsafeTextWithoutNewlines . T.pack . show  -- | >>> pretty (123 :: Int) -- 123@@ -340,7 +352,7 @@ -- hello world -- -- Manually use @'hardline'@ if you /definitely/ want newlines.-instance Pretty Text where pretty = vsep . map unsafeText . T.splitOn "\n"+instance Pretty Text where pretty = vsep . map unsafeTextWithoutNewlines . T.splitOn "\n"  -- | (lazy 'Text' instance, identical to the strict version) instance Pretty Lazy.Text where pretty = pretty . Lazy.toStrict@@ -350,45 +362,12 @@   --- | The data type @SimpleDoc@ represents laid out documents and is used by the--- display functions.------ A simplified view is that @'Doc' = ['SimpleDoc']@, and the layout functions--- pick one of the 'SimpleDoc's. This means that 'SimpleDoc' has all complexity--- contained in 'Doc' resolved, making it very easy to convert it to other--- formats, such as plain text or terminal output.------ To write your own @'Doc'@ to X converter, it is therefore sufficient to--- convert from @'SimpleDoc'@. The »Render« submodules provide some built-in--- converters to do so, and helpers to create own ones.-data SimpleDoc ann =-      SFail-    | SEmpty-    | SChar Char (SimpleDoc ann)--    -- | 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.-    | SText !Int Text (SimpleDoc ann)--    -- | @Int@ = indentation level for the line-    | SLine !Int (SimpleDoc ann)--    -- | Add an annotation to the remaining document.-    | SAnnPush ann (SimpleDoc ann)--    -- | Remove a previously pushed annotation.-    | SAnnPop (SimpleDoc ann)-    deriving (Eq, Ord, Show)------ | @(unsafeText s)@ contains the literal string @s@.+-- | @(unsafeTextWithoutNewlines s)@ contains the literal string @s@. -- -- The string must not contain any newline characters, since this is an -- invariant of the 'Text' constructor.-unsafeText :: Text -> Doc ann-unsafeText text = case T.uncons text of+unsafeTextWithoutNewlines :: Text -> Doc ann+unsafeTextWithoutNewlines text = case T.uncons text of     Nothing -> Empty     Just (t,ext)         | T.null ext -> Char t@@ -833,8 +812,8 @@  -- | @('sep' xs)@ tries laying out the documents @xs@ separated with 'space's, -- and if this does not fit the page, separates them with newlines. This is what--- differentiates it from 'vsep', which always layouts its contents beneath each--- other.+-- differentiates it from 'vsep', which always lays out its contents beneath+-- each other. -- -- >>> let doc = "prefix" <+> sep ["text", "to", "lay", "out"] -- >>> putDocW 80 doc@@ -878,6 +857,8 @@ -- lorem -- ipsum -- dolor+-- >>> group (vcat docs)+-- loremipsumdolor -- -- Since 'group'ing a 'vcat' is rather common, 'cat' is a built-in shortcut for -- it.@@ -915,8 +896,8 @@  -- | @('cat' xs)@ tries laying out the documents @xs@ separated with nothing, -- and if this does not fit the page, separates them with newlines. This is what--- differentiates it from 'vcat', which always layouts its contents beneath each--- other.+-- differentiates it from 'vcat', which always lays out its contents beneath+-- each other. -- -- >>> let docs = Util.words "lorem ipsum dolor" -- >>> putDocW 80 ("Docs:" <+> cat docs)@@ -1063,7 +1044,7 @@  -- | Insert a number of spaces. Negative values count as 0. spaces :: Int -> Doc ann-spaces n = unsafeText (T.replicate n " ")+spaces n = unsafeTextWithoutNewlines (T.replicate n " ")  -- $ -- prop> \(NonNegative n) -> length (show (spaces n)) == n@@ -1111,7 +1092,6 @@     -> Doc ann -- ^ LxR enclose l r x = l <> x <> r - -- | @('surround' x l r)@ surrounds document @x@ with @l@ and @r@. -- -- >>> surround "·" "A" "Z"@@ -1288,11 +1268,11 @@ -- producing the layout by using 'unAnnotateS'. unAnnotate :: Doc ann -> Doc xxx unAnnotate = \case-    Fail            -> Fail-    Empty           -> Empty-    Char c          -> Char c-    Text l t        -> Text l t-    Line            -> Line+    Fail     -> Fail+    Empty    -> Empty+    Char c   -> Char c+    Text l t -> Text l t+    Line     -> Line      FlatAlt x y     -> FlatAlt (unAnnotate x) (unAnnotate y)     Cat x y         -> Cat (unAnnotate x) (unAnnotate y)@@ -1308,11 +1288,12 @@ -- Useful in particular to embed documents with one form of annotation in a more -- generlly annotated document. ----- Since this traverses the entire 'Doc' tree, it is preferrable to reannotate--- after producing the layout by using 'reAnnotateS'.+-- Since this traverses the entire @'Doc'@ tree, including parts that are not+-- rendered due to other layouts fitting better, it is preferrable to reannotate+-- after producing the layout by using @'reAnnotateS'@. ----- Technically 'reAnnotate' makes 'Doc' a 'Functor', but since reannotation is--- hardly intuitive we omit the instance.+-- Since @'reAnnotate'@ has the right type and satisfies @'reAnnotate id = id'@,+-- it is used to define the @'Functor'@ instance of @'Doc'@. reAnnotate :: (ann -> ann') -> Doc ann -> Doc ann' reAnnotate re = go   where@@ -1332,8 +1313,8 @@         Nesting f       -> Nesting (go . f)         Annotated ann x -> Annotated (re ann) (go x) --- | Remove all annotations. 'unAnnotate' for 'SimpleDoc'.-unAnnotateS :: SimpleDoc ann -> SimpleDoc xxx+-- | Remove all annotations. 'unAnnotate' for 'SimpleDocStream'.+unAnnotateS :: SimpleDocStream ann -> SimpleDocStream xxx unAnnotateS = go   where     go = \case@@ -1345,8 +1326,8 @@         SAnnPush _ rest -> go rest         SAnnPop rest    -> go rest --- | Change the annotation of a document. 'reAnnotate' for 'SimpleDoc'.-reAnnotateS :: (ann -> ann') -> SimpleDoc ann -> SimpleDoc ann'+-- | Change the annotation of a document. 'reAnnotate' for 'SimpleDocStream'.+reAnnotateS :: (ann -> ann') -> SimpleDocStream ann -> SimpleDocStream ann' reAnnotateS f = go   where     go = \case@@ -1383,22 +1364,22 @@ -- efficiently. A fused document is always laid out identical to its unfused -- version. ----- When laying a 'Doc'ument out to a 'SimpleDoc', every component of the input--- is translated directly to the simpler output format. This sometimes yields--- undesirable chunking when many pieces have been concatenated together.+-- When laying a 'Doc'ument out to a 'SimpleDocStream', every component of the+-- input is translated directly to the simpler output format. This sometimes+-- yields undesirable chunking when many pieces have been concatenated together. -- -- For example -- -- >>> "a" <> "b" <> pretty 'c' <> "d" -- abcd ----- results in a chain of four entries in a 'SimpleDoc', although this is fully+-- results in a chain of four entries in a 'SimpleDocStream', although this is fully -- equivalent to the tightly packed -- -- >>> "abcd" :: Doc ann -- abcd ----- which is only a single 'SimpleDoc' entry, and can be processed faster.+-- which is only a single 'SimpleDocStream' entry, and can be processed faster. -- -- It is therefore a good idea to run 'fuse' on concatenations of lots of small -- strings that are used many times,@@ -1448,12 +1429,78 @@          other -> other --- | Decide whether a 'SimpleDoc' fits the constraints given, namely+++-- | The data type @SimpleDocStream@ represents laid out documents and is used+-- by the display functions. --+-- A simplified view is that @'Doc' = ['SimpleDocStream']@, and the layout+-- functions pick one of the 'SimpleDocStream's based on which one fits the+-- layout constraints best. This means that 'SimpleDocStream' has all complexity+-- contained in 'Doc' resolved, making it very easy to convert it to other+-- formats, such as plain text or terminal output.+--+-- To write your own @'Doc'@ to X converter, it is therefore sufficient to+-- convert from @'SimpleDocStream'@. The »Render« submodules provide some+-- built-in converters to do so, and helpers to create own ones.+data SimpleDocStream ann =+      SFail+    | SEmpty+    | SChar Char (SimpleDocStream ann)++    -- | 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.+    | SText !Int Text (SimpleDocStream ann)++    -- | @Int@ = indentation level for the line+    | SLine !Int (SimpleDocStream ann)++    -- | Add an annotation to the remaining document.+    | SAnnPush ann (SimpleDocStream ann)++    -- | Remove a previously pushed annotation.+    | SAnnPop (SimpleDocStream ann)+    deriving (Eq, Ord, Show, Generic)++-- | Alter the document’s annotations.+--+-- This instance makes 'SimpleDocStream' more flexible (because it can be used in+-- 'Functor'-polymorphic values), but @'fmap'@ is much less readable compared to+-- using @'reAnnotateST'@ in code that only works for @'SimpleDocStream'@ anyway.+-- Consider using the latter when the type does not matter.+instance Functor SimpleDocStream where+    fmap = reAnnotateS++-- | Collect all annotations from a document.+instance Foldable SimpleDocStream where+    foldMap f = \case+        SFail             -> mempty+        SEmpty            -> mempty+        SChar _ rest      -> foldMap f rest+        SText _ _ rest    -> foldMap f rest+        SLine _ rest      -> foldMap f rest+        SAnnPush ann rest -> f ann `mappend` foldMap f rest+        SAnnPop rest      -> foldMap f rest++-- | Transform a document based on its annotations, possibly leveraging+-- 'Applicative' effects.+instance Traversable SimpleDocStream where+    traverse f = \case+        SFail             -> pure SFail+        SEmpty            -> pure SEmpty+        SChar c rest      -> SChar c   <$> traverse f rest+        SText l t rest    -> SText l t <$> traverse f rest+        SLine i rest      -> SLine i   <$> traverse f rest+        SAnnPush ann rest -> SAnnPush  <$> f ann <*> traverse f rest+        SAnnPop rest      -> SAnnPop   <$> traverse f rest++-- | Decide whether a 'SimpleDocStream' fits the constraints given, namely+-- --   - page width --   - minimum nesting level to fit in --   - width in which to fit the first line; Nothing is unbounded-newtype FittingPredicate ann = FP (PageWidth -> Int -> Maybe Int -> SimpleDoc ann -> Bool)+newtype FittingPredicate ann = FP (PageWidth -> Int -> Maybe Int -> SimpleDocStream ann -> Bool)  -- | List of nesting level/document pairs yet to be laid out. data LayoutPipeline ann =@@ -1503,22 +1550,22 @@ -- and 'hPutDoc'. -- -- @'layoutPretty'@ commits to rendering something in a certain way if the next--- element fits the layout constraints; in other words, it has one 'SimpleDoc'--- element lookahead when rendering. Consider using the smarter, but a bit less--- performant, @'layoutSmart'@ algorithm if the results seem to run off to the--- right before having lots of line breaks.+-- element fits the layout constraints; in other words, it has one+-- 'SimpleDocStream' element lookahead when rendering. Consider using the+-- smarter, but a bit less performant, @'layoutSmart'@ algorithm if the results+-- seem to run off to the right before having lots of line breaks. layoutPretty     :: LayoutOptions     -> Doc ann-    -> SimpleDoc ann-layoutPretty = layoutFits fits1+    -> SimpleDocStream ann+layoutPretty = layout fits1   where     -- | @fits1@ does 1 line lookahead.     fits1 :: FittingPredicate ann     fits1 = FP (\_p _m w -> go w)       where         go :: Maybe Int -- ^ Width in which to fit the first line; Nothing is infinite-           -> SimpleDoc ann+           -> SimpleDocStream ann            -> Bool         go Nothing _               = True         go (Just w) _ | w < 0      = False@@ -1578,8 +1625,8 @@ layoutSmart     :: LayoutOptions     -> Doc ann-    -> SimpleDoc ann-layoutSmart = layoutFits fitsR+    -> SimpleDocStream ann+layoutSmart = layout fitsR   where     -- @fitsR@ has a little more lookahead: assuming that nesting roughly     -- corresponds to syntactic depth, @fitsR@ checks that not only the current@@ -1595,7 +1642,7 @@         go :: PageWidth            -> Int       -- ^ Minimum nesting level to fit in            -> Maybe Int -- ^ Width in which to fit the first line-           -> SimpleDoc ann+           -> SimpleDocStream ann            -> Bool         go _ _ Nothing _                        = False         go _ _ (Just w) _ | w < 0               = False@@ -1611,12 +1658,12 @@   -layoutFits+layout     :: forall ann. FittingPredicate ann     -> LayoutOptions     -> Doc ann-    -> SimpleDoc ann-layoutFits+    -> SimpleDocStream ann+layout     fittingPredicate     LayoutOptions { layoutPageWidth = pWidth }     doc@@ -1629,7 +1676,7 @@         :: Int -- Current nesting level         -> Int -- Current column, i.e. "where the cursor is"         -> LayoutPipeline ann -- Documents remaining to be handled (in order)-        -> SimpleDoc ann+        -> SimpleDocStream ann     best !_ !_ Nil           = SEmpty     best nl cc (UndoAnn ds)  = SAnnPop (best nl cc ds)     best nl cc (Cons i d ds) = case d of@@ -1653,9 +1700,9 @@         :: FittingPredicate ann         -> Int           -- ^ Current nesting level         -> Int           -- ^ Current column-        -> SimpleDoc ann -- ^ Choice A. Invariant: first lines should not be longer than B's.-        -> SimpleDoc ann -- ^ Choice B.-        -> SimpleDoc ann -- ^ Choice A if it fits, otherwise B.+        -> SimpleDocStream ann -- ^ Choice A. Invariant: first lines should not be longer than B's.+        -> SimpleDocStream ann -- ^ Choice B.+        -> SimpleDocStream ann -- ^ Choice A if it fits, otherwise B.     selectNicer (FP fits) lineIndent currentColumn x y       | fits pWidth minNestingLevel availableWidth x = x       | otherwise = y@@ -1697,7 +1744,7 @@ -- ipsum -- dolor -- sit-layoutCompact :: Doc ann -> SimpleDoc ann+layoutCompact :: Doc ann -> SimpleDocStream ann layoutCompact doc = scan 0 [doc]   where     scan _ [] = SEmpty@@ -1721,14 +1768,14 @@ instance Show (Doc ann) where     showsPrec _ doc = renderShowS (layoutPretty defaultLayoutOptions doc) --- | Render a 'SimpleDoc' to a 'ShowS', useful to write 'Show' instances based--- on the prettyprinter.+-- | Render a 'SimpleDocStream' to a 'ShowS', useful to write 'Show' instances+-- based on the prettyprinter. -- -- @ -- instance 'Show' MyType where --     'showsPrec' _ = 'renderShowS' . 'layoutPretty' 'defaultLayoutOptions' . 'pretty' -- @-renderShowS :: SimpleDoc ann -> ShowS+renderShowS :: SimpleDocStream ann -> ShowS renderShowS = \case     SFail        -> panicUncaughtFail     SEmpty       -> id@@ -1737,3 +1784,14 @@     SLine i x    -> showString ('\n' : replicate i ' ') . renderShowS x     SAnnPush _ x -> renderShowS x     SAnnPop x    -> renderShowS x++++-- $setup+--+-- (Definitions for the doctests)+--+-- >>> :set -XOverloadedStrings+-- >>> import Data.Text.Prettyprint.Doc.Render.Text+-- >>> import Data.Text.Prettyprint.Doc.Util as Util+-- >>> import Test.QuickCheck.Modifiers

@@ -2,4 +2,4 @@     renderShowS ) where -import Data.Text.Prettyprint.Doc.Internal+import Data.Text.Prettyprint.Doc.Internal (renderShowS)

@@ -1,10 +1,8 @@-{-# LANGUAGE CPP               #-}-{-# LANGUAGE LambdaCase        #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP #-}  #include "version-compatibility-macros.h" --- | Render an unannotated 'SimpleDoc' as plain 'Text'.+-- | Render an unannotated 'SimpleDocStream' as plain 'Text'. module Data.Text.Prettyprint.Doc.Render.Text (     -- * Conversion to plain 'Text'     renderLazy, renderStrict,@@ -19,19 +17,22 @@   import           Data.Text              (Text)-import qualified Data.Text              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) import Data.Semigroup #endif +#if !(APPLICATIVE_MONAD)+import Control.Applicative+#endif+ -- $setup -- -- (Definitions for the doctests)@@ -51,21 +52,12 @@ -- lorem ipsum dolor --       (foo bar) --       sit amet-renderLazy :: SimpleDoc ann -> TL.Text-renderLazy = TLB.toLazyText . build-  where-    build = \case-        SFail          -> panicUncaughtFail-        SEmpty         -> mempty-        SChar c x      -> TLB.singleton c <> build x-        SText _l t x   -> TLB.fromText t <> build x-        SLine i x      -> TLB.singleton '\n' <> TLB.fromText (T.replicate i " ") <> build x-        SAnnPush _ x   -> build x-        SAnnPop x      -> build x+renderLazy :: SimpleDocStream ann -> TL.Text+renderLazy = TLB.toLazyText . renderSimplyDecorated TLB.fromText (pure mempty) (pure mempty)  -- | @('renderLazy' sdoc)@ takes the output @sdoc@ from a rendering and -- transforms it to strict text.-renderStrict :: SimpleDoc ann -> Text+renderStrict :: SimpleDocStream ann -> Text renderStrict = TL.toStrict . renderLazy  @@ -75,7 +67,7 @@ -- >>> renderIO System.IO.stdout (layoutPretty defaultLayoutOptions "hello\nworld") -- hello -- world-renderIO :: Handle -> SimpleDoc ann -> IO ()+renderIO :: Handle -> SimpleDocStream ann -> IO () renderIO h sdoc = TL.hPutStrLn h (renderLazy sdoc)  -- | @('putDoc' doc)@ prettyprints document @doc@ to standard output. Uses the

@@ -5,9 +5,9 @@ #include "version-compatibility-macros.h"  -- | This module shows how to write a custom prettyprinter backend, based on--- directly converting a 'SimpleDoc' to an output format using a stack machine.--- For a tree serialization approach, which may be more suitable for certain--- output formats, see+-- directly converting a 'SimpleDocStream' to an output format using a stack+-- machine. For a tree serialization approach, which may be more suitable for+-- certain output formats, see -- "Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial". -- -- Rendering to ANSI terminal with colors is an important use case for stack@@ -68,20 +68,28 @@ -- = The rendering algorithm -- -- With the annotation definitions out of the way, we can now define a--- conversion function from 'SimpleDoc' annotated with our 'SimpleHtml' to the+-- conversion function from 'SimpleDocStream' annotated with our 'SimpleHtml' to the -- final 'TL.Text' representation.+--+-- There are two ways to render this; the simpler one is just using+-- 'renderSimplyDecorated'. However, some output formats require more+-- complicated functionality, so we explore this explicitly with a simple+-- example below. An example for something more complicated is ANSI terminal+-- rendering, where on popping we need to regenerate the previous style,+-- requiring a pop (discard current style) followed by a peek (regenerate+-- previous style).  -- | The 'StackMachine' type defines a stack machine suitable for many rendering -- needs. It has two auxiliary parameters: the type of the end result, and the -- type of the document’s annotations. ----- Most 'StackMachine' creations will look like this definition: a recursive walk--- through the 'SimpleDoc', pushing styles on the stack and popping them off--- again, and writing raw output.+-- Most 'StackMachine' creations will look like this definition: a recursive+-- walk through the 'SimpleDocStream', pushing styles on the stack and popping+-- them off again, and writing raw output. -- -- The equivalent to this in the tree based rendering approach is -- 'Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial.renderTree'.-renderStackMachine :: SimpleDoc SimpleHtml -> StackMachine TLB.Builder SimpleHtml ()+renderStackMachine :: SimpleDocStream SimpleHtml -> StackMachine TLB.Builder SimpleHtml () renderStackMachine = \case     SFail -> panicUncaughtFail     SEmpty -> pure ()@@ -92,7 +100,7 @@         writeOutput (TLB.fromText t)         renderStackMachine x     SLine i x -> do-        writeOutput (TLB.singleton '\n' )+        writeOutput (TLB.singleton '\n')         writeOutput (TLB.fromText (T.replicate i " "))         renderStackMachine x     SAnnPush s x -> do@@ -129,7 +137,7 @@ -- the main API function of a stack machine renderer. The tree renderer -- equivalent to this is -- 'Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial.render'.-render :: SimpleDoc SimpleHtml -> TL.Text+render :: SimpleDocStream SimpleHtml -> TL.Text render doc   = let (resultBuilder, remainingStyles) = execStackMachine [] (renderStackMachine doc)     in if null remainingStyles

@@ -5,7 +5,7 @@ #include "version-compatibility-macros.h"  -- | This module shows how to write a custom prettyprinter backend, based on a--- tree representation of a 'SimpleDoc'.  For a stack machine approach, which+-- tree representation of a 'SimpleDocStream'.  For a stack machine approach, which -- may be more suitable for certain output formats, see -- "Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial". --@@ -64,18 +64,26 @@ -- = The rendering algorithm -- -- With the annotation definitions out of the way, we can now define a--- conversion function from 'SimpleDoc' (annotated with our 'SimpleHtml') to the--- tree-shaped 'SimpleDocTree', which is easily convertible to a HTML/'Text'--- representation.+-- conversion function from 'SimpleDocStream' (annotated with our 'SimpleHtml')+-- to the tree-shaped 'SimpleDocTree', which is easily convertible to a+-- HTML/'Text' representation.+--+-- There are two ways to render this; the simpler one is just using+-- 'renderSimplyDecorated'. However, some output formats require more+-- complicated functionality, so we explore this explicitly with a simple+-- example below. An example for something more complicated is e.g. an XHTML+-- renderer, where a newline may not simply be a newline character followed by a+-- certain number of spaces, but e.g. involve adding a @<br/>@ tag. --- | To render the HTML, we first convert the 'SimpleDoc' to the 'SimpleDocTree'--- format, which makes enveloping sub-documents in markup easier.+-- | To render the HTML, we first convert the 'SimpleDocStream' to the+-- 'SimpleDocTree' format, which makes enveloping sub-documents in markup+-- easier. -- -- This function is the entry main API function of the renderer; as such, it is -- only glue for the internal functions. This is similar to -- 'Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial.render' from -- the stack machine tutorial in its purpose.-render :: SimpleDoc SimpleHtml -> TL.Text+render :: SimpleDocStream SimpleHtml -> TL.Text render = TLB.toLazyText . renderTree . treeForm  -- | Render a 'SimpleDocTree' to a 'TLB.Builder'; this is the workhorse of the

@@ -6,9 +6,9 @@ ) where  -- | Raise a hard 'error' if there is a 'Data.Text.Prettyprint.Doc.SFail' in a--- 'Data.Text.Prettyprint.Doc.SimpleDoc'.+-- 'Data.Text.Prettyprint.Doc.SimpleDocStream'. panicUncaughtFail :: a-panicUncaughtFail = error ("»SFail« must not appear in a rendered »SimpleDoc«. This is a bug in the layout algorithm! " ++ report)+panicUncaughtFail = error ("»SFail« must not appear in a rendered »SimpleDocStream«. This is a bug in the layout algorithm! " ++ report)  -- | Raise a hard 'error' when an annotation terminator is encountered in an -- unannotated region.@@ -16,16 +16,16 @@ panicUnpairedPop = error ("An unpaired style terminator was encountered. This is a bug in the layout algorithm! " ++ report)  -- | Raise a hard generic 'error' when the--- 'Data.Text.Prettyprint.Doc.SimpleDoc' to+-- 'Data.Text.Prettyprint.Doc.SimpleDocStream' to -- 'Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree.SimpleDocTree' conversion fails. panicSimpleDocTreeConversionFailed :: a-panicSimpleDocTreeConversionFailed = error ("Conversion from SimpleDoc to SimpleDocTree failed! " ++ report)+panicSimpleDocTreeConversionFailed = error ("Conversion from SimpleDocStream to SimpleDocTree failed! " ++ report)  -- | Raise a hard 'error' when the »to -- 'Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree.SimpleDocTree'« parser finishes -- without consuming the full input. panicInputNotFullyConsumed :: a-panicInputNotFullyConsumed = error ("Conversion from SimpleDoc to SimpleDocTree left unconsumed input! " ++ report)+panicInputNotFullyConsumed = error ("Conversion from SimpleDocStream to SimpleDocTree left unconsumed input! " ++ report)  report :: String report = "Please report this as a bug"

@@ -1,22 +1,34 @@-{-# LANGUAGE CPP        #-}-{-# LANGUAGE LambdaCase #-}+{-# LANGUAGE AutoDeriveTypeable #-}+{-# LANGUAGE CPP                #-}+{-# LANGUAGE DeriveGeneric      #-}+{-# LANGUAGE LambdaCase         #-}+{-# LANGUAGE OverloadedStrings  #-}  #include "version-compatibility-macros.h" --- | Conversion of the linked-list-like 'SimpleDoc' to a tree-like+-- | Conversion of the linked-list-like 'SimpleDocStream' to a tree-like -- 'SimpleDocTree'. module Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree (++    -- * Type and conversion     SimpleDocTree(..),     treeForm, +    -- * Manipulating annotations     unAnnotateST,     reAnnotateST,++    -- * Common use case shortcut definitions+    renderSimplyDecorated,+    renderSimplyDecoratedA, ) where   -import Control.Applicative-import Data.Text           (Text)+import           Control.Applicative+import           Data.Text           (Text)+import qualified Data.Text           as T+import           GHC.Generics  import Data.Text.Prettyprint.Doc import Data.Text.Prettyprint.Doc.Render.Util.Panic@@ -25,8 +37,68 @@ import Control.Monad.Fail #endif +#if !(MONOID_IN_PRELUDE)+import Data.Monoid (Monoid (..))+#endif +#if !(FOLDABLE_TRAVERSABLE_IN_PRELUDE)+import Data.Foldable    (Foldable (..))+import Data.Traversable (Traversable (..))+#endif +-- $setup+--+-- (Definitions for the doctests)+--+-- >>> import Data.Text.Prettyprint.Doc hiding ((<>))+-- >>> import qualified Data.Text.IO as T++++-- | Simplest possible tree-based renderer.+--+-- For example, here is a document annotated with @()@, and the behaviour is to+-- surround annotated regions with »>>>« and »<<<«:+--+-- >>> let doc = "hello" <+> annotate () "world" <> "!"+-- >>> let stdoc = treeForm (layoutPretty defaultLayoutOptions doc)+-- >>> T.putStrLn (renderSimplyDecorated id (\() x -> ">>>" <> x <> "<<<") stdoc)+-- hello >>>world<<<!+renderSimplyDecorated+    :: Monoid out+    => (Text -> out)       -- ^ Render plain 'Text'+    -> (ann -> out -> out) -- ^ How to modify an element with an annotation+    -> SimpleDocTree ann+    -> out+renderSimplyDecorated text renderAnn = go+  where+    go = \case+        STEmpty -> mempty+        STChar c -> text (T.singleton c)+        STText _ t -> text t+        STLine i -> text (T.singleton '\n' <> T.replicate i " ")+        STAnn ann rest -> renderAnn ann (go rest)+        STConcat xs -> foldMap go xs++-- | Version of 'renderSimplyDecoratedA' that allows for 'Applicative' effects.+renderSimplyDecoratedA+    :: (Applicative f, Monoid out)+    => (Text -> f out)         -- ^ Render plain 'Text'+    -> (ann -> f out -> f out) -- ^ How to modify an element with an annotation+    -> SimpleDocTree ann+    -> f out+renderSimplyDecoratedA text renderAnn = go+  where+    go = \case+        STEmpty -> pure mempty+        STChar c -> text (T.singleton c)+        STText _ t -> text t+        STLine i -> text (T.singleton '\n' <> T.replicate i " ")+        STAnn ann rest -> renderAnn ann (go rest)+        STConcat xs -> fmap mconcat (traverse go xs)+++ -- | A type for parsers of unique results. Token stream »s«, results »a«. -- -- Hand-written to avoid a dependency on a parser lib.@@ -72,13 +144,13 @@     | TokAnnPop     deriving (Eq, Ord, Show) --- | A 'SimpleDoc' is a linked list of different annotated cons cells ('SText'--- and then some further 'SimpleDoc', 'SLine' and then some further 'SimpleDoc', …).--- This format is very suitable as a target for a layout engine, but not very--- useful for rendering to a structured format such as HTML, where we don’t want--- to do a lookahead until the end of some markup. These formats benefit from a--- tree-like structure that explicitly marks its contents as annotated.--- 'SimpleDocTree' is that format.+-- | A 'SimpleDocStream' is a linked list of different annotated cons cells+-- ('SText' and then some further 'SimpleDocStream', 'SLine' and then some+-- further 'SimpleDocStream', …). This format is very suitable as a target for a+-- layout engine, but not very useful for rendering to a structured format such+-- as HTML, where we don’t want to do a lookahead until the end of some markup.+-- These formats benefit from a tree-like structure that explicitly marks its+-- contents as annotated. 'SimpleDocTree' is that format. data SimpleDocTree ann     = STEmpty     | STChar Char@@ -86,10 +158,19 @@     | STLine !Int     | STAnn ann (SimpleDocTree ann)     | STConcat [SimpleDocTree ann]-    deriving (Eq, Ord, Show)+    deriving (Eq, Ord, Show, Generic) +-- | Alter the document’s annotations.+--+-- This instance makes 'SimpleDocTree' more flexible (because it can be used in+-- 'Functor'-polymorphic values), but @'fmap'@ is much less readable compared to+-- using @'reAnnotateST'@ in code that only works for @'SimpleDocTree'@ anyway.+-- Consider using the latter when the type does not matter.+instance Functor SimpleDocTree where+    fmap = reAnnotateST+ -- | Get the next token, consuming it in the process.-nextToken :: UniqueParser (SimpleDoc ann) (SimpleDocTok ann)+nextToken :: UniqueParser (SimpleDocStream ann) (SimpleDocTok ann) nextToken = UniqueParser (\case     SFail             -> panicUncaughtFail     SEmpty            -> empty@@ -99,7 +180,7 @@     SAnnPush ann rest -> Just (TokAnnPush ann , rest)     SAnnPop rest      -> Just (TokAnnPop      , rest) ) -sdocToTreeParser :: UniqueParser (SimpleDoc ann) (SimpleDocTree ann)+sdocToTreeParser :: UniqueParser (SimpleDocStream ann) (SimpleDocTree ann) sdocToTreeParser = fmap wrap (many contentPiece)    where@@ -120,8 +201,8 @@                              TokAnnPop <- nextToken                              pure (STAnn ann annotatedContents) --- | Convert a 'SimpleDoc' to its 'SimpleDocTree' representation.-treeForm :: SimpleDoc ann -> SimpleDocTree ann+-- | Convert a 'SimpleDocStream' to its 'SimpleDocTree' representation.+treeForm :: SimpleDocStream ann -> SimpleDocTree ann treeForm sdoc = case runParser sdocToTreeParser sdoc of     Nothing               -> panicSimpleDocTreeConversionFailed     Just (sdoct, SEmpty)  -> sdoct@@ -154,3 +235,24 @@         STLine i       -> STLine i         STAnn ann rest -> STAnn (f ann) (go rest)         STConcat xs    -> STConcat (map go xs)++-- | Collect all annotations from a document.+instance Foldable SimpleDocTree where+    foldMap f = \case+        STEmpty        -> mempty+        STChar _       -> mempty+        STText _ _     -> mempty+        STLine _       -> mempty+        STAnn ann rest -> f ann `mappend` foldMap f rest+        STConcat xs    -> mconcat (map (foldMap f) xs)++-- | Transform a document based on its annotations, possibly leveraging+-- 'Applicative' effects.+instance Traversable SimpleDocTree where+    traverse f = \case+        STEmpty        -> pure STEmpty+        STChar c       -> pure (STChar c)+        STText l t     -> pure (STText l t)+        STLine i       -> pure (STLine i)+        STAnn ann rest -> STAnn <$> f ann <*> traverse f rest+        STConcat xs    -> STConcat <$> traverse (traverse f) xs

@@ -5,9 +5,23 @@  #include "version-compatibility-macros.h" --- | A strict State/Writer monad to implement a stack machine for rendering--- 'SimpleDoc's.+-- | Definitions to write renderers based on looking at a 'SimpleDocStream' as an+-- instruction tape for a stack machine: text is written, annotations are added+-- (pushed) and later removed (popped). module Data.Text.Prettyprint.Doc.Render.Util.StackMachine (++    -- * Simple, pre-defined stack machines+    --+    -- | These cover most basic use cases where there is not too much special+    -- logic, and all that’s important is how to render text, and how to+    -- add/remove an annotation.+    renderSimplyDecorated,+    renderSimplyDecoratedA,++    -- * General stack machine+    --+    -- | These definitions allow defining a full-blown stack machine renderer,+    -- allowing for arbitrary peeking, popping and what not.     StackMachine,     execStackMachine, @@ -19,11 +33,72 @@   -import Data.Monoid+import           Control.Applicative+import           Data.Monoid+import           Data.Text           (Text)+import qualified Data.Text           as T -#if !(APPLICATIVE_MONAD)-import Control.Applicative-#endif+import Data.Text.Prettyprint.Doc                   (SimpleDocStream (..))+import Data.Text.Prettyprint.Doc.Render.Util.Panic++-- $setup+--+-- (Definitions for the doctests)+--+-- >>> import Data.Text.Prettyprint.Doc hiding ((<>))+-- >>> import qualified Data.Text.IO as T++++-- | Simplest possible stack-based renderer.+--+-- For example, here is a document annotated with @()@, and the behaviour is to+-- write »>>>« at the beginning, and »<<<« at the end of the annotated region:+--+-- >>> let doc = "hello" <+> annotate () "world" <> "!"+-- >>> let sdoc = layoutPretty defaultLayoutOptions doc+-- >>> T.putStrLn (renderSimplyDecorated id (\() -> ">>>") (\() -> "<<<") sdoc)+-- hello >>>world<<<!+renderSimplyDecorated+    :: Monoid out+    => (Text -> out) -- ^ Render plain 'Text'+    -> (ann -> out)  -- ^ How to render an annotation+    -> (ann -> out)  -- ^ How to render the removed annotation+    -> SimpleDocStream ann+    -> out+renderSimplyDecorated text push pop = go []+  where+    go _           SFail               = panicUncaughtFail+    go []          SEmpty              = mempty+    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       (SAnnPush ann rest) = push ann <> go (ann : stack) rest+    go (ann:stack) (SAnnPop rest)      = pop ann <> go stack rest+    go []          SAnnPop{}           = panicUnpairedPop++-- | Version of 'renderSimplyDecoratedA' that allows for 'Applicative' effects.+renderSimplyDecoratedA+    :: (Applicative f, Monoid out)+    => (Text -> f out) -- ^ Render plain 'Text'+    -> (ann -> f out)  -- ^ How to render an annotation+    -> (ann -> f out)  -- ^ How to render the removed annotation+    -> SimpleDocStream ann+    -> f out+renderSimplyDecoratedA text push pop = go []+  where+    go _           SFail               = panicUncaughtFail+    go []          SEmpty              = pure mempty+    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       (SAnnPush ann rest) = push ann <++> go (ann : stack) rest+    go (ann:stack) (SAnnPop rest)      = pop ann <++> go stack rest+    go []          SAnnPop{}           = panicUnpairedPop++    (<++>) = liftA2 mappend   

@@ -13,14 +13,8 @@  import Data.Text.Prettyprint.Doc --- $setup------ (Definitions for the doctests)------ >>> :set -XOverloadedStrings  - -- | Split an input into word-sized 'Doc's. -- -- >>> putDoc (tupled (words "Lorem ipsum dolor"))@@ -61,3 +55,11 @@ putDocW w doc = renderIO System.IO.stdout (layoutPretty layoutOptions (unAnnotate doc))   where     layoutOptions = LayoutOptions { layoutPageWidth = AvailablePerLine w 1 }++++-- $setup+--+-- (Definitions for the doctests)+--+-- >>> :set -XOverloadedStrings