packages feed

prettyprinter (empty) → 0.1

raw patch · 22 files changed

+3609/−0 lines, 22 filesdep +QuickCheckdep +ansi-wl-pprintdep +basesetup-changed

Dependencies added: QuickCheck, ansi-wl-pprint, base, bytestring, criterion, doctest, mtl, pgp-wordlist, prettyprinter, random, semigroups, tasty, tasty-quickcheck, template-haskell, text, transformers, void

Files

+ LICENSE.md view
@@ -0,0 +1,23 @@+Copyright 2008, Daan Leijen and Max Bolingbroke, 2016 David Luposchainsky. All+rights reserved.++Redistribution and use in source and binary forms, with or without modification,+are permitted provided that the following conditions are met:++  - Redistributions of source code must retain the above copyright notice, this+    list of conditions and the following disclaimer.++  - Redistributions in binary form must reproduce the above copyright notice,+    this list of conditions and the following disclaimer in the documentation+    and/or other materials provided with the distribution.++This software is provided by the copyright holders "as is" and any express or+implied warranties, including, but not limited to, the implied warranties of+merchantability and fitness for a particular purpose are disclaimed. In no event+shall the copyright holders be liable for any direct, indirect, incidental,+special, exemplary, or consequential damages (including, but not limited to,+procurement of substitute goods or services; loss of use, data, or profits; or+business interruption) however caused and on any theory of liability, whether in+contract, strict liability, or tort (including negligence or otherwise) arising+in any way out of the use of this software, even if advised of the possibility+of such damage.
+ README.md view
@@ -0,0 +1,173 @@+<!-- This file was auto-generated by the 'scripts/generate_readme' program. -->++++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)++++tl;dr+-----++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.++++Longer; want to read+--------------------++This package defines a prettyprinter to format text in a flexible and convenient+way. The idea is to combine a document out of many small components, then using+a layouter to convert it to an easily renderable simple document, which can then+be rendered to a variety of formats, for example plain `Text`, or Markdown.+*What you are reading right now was generated by this library (see+`GenerateReadme.hs`).*++++Why another prettyprinter?+--------------------------++Haskell, more specifically Hackage, has a zoo of Wadler/Leijen based+prettyprinters already. Each of them addresses a different concern with the+classic `wl-pprint` package. This package solves *all* these issues, and then+some.++++### `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+`String` definitions anywhere; using a `String` means an immediate conversion to+the internal `Text`-based format.++++### Extensive documentation++The library is stuffed with runnable examples, showing use cases for the vast+majority of exported values. Many things reference related definitions,+*everything* comes with at least a sentence explaining its purpose.++++### No name clashes++Many prettyprinters use the legacy API of the first Wadler/Leijen prettyprinter,+which used e.g. `(<$>)` to separate lines, which clashes with the ubiquitous+synonym for `fmap` that’s been in Base for ages. These definitions were either+removed or renamed, so there are no name clashes with standard libraries+anymore.++++### Annotation support++Text is not all letters and newlines. Often, we want to add more information,+the simplest kind being some form of styling. An ANSI terminal supports+coloring, a web browser a plethora of different formattings.++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.++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+usability nor performance.++++### Extensible backends++A document can be rendered in many different ways, for many different clients.+There is plain text, there is the ANSI terminal, there is the browser. Each of+these speak different languages, and the backend is responsible for the+translation to those languages. Backends should be readily available, or easy to+implement if a custom solution is desired.++As a result, each backend requires only minimal dependencies; if you don’t want+to print to an ANSI terminal for example, there is no need to have a dependency+on a terminal library.++++### Performance++Rendering large documents should be done efficiently, and the library should+make it easy to optimize common use cases for the programmer.++++### 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+exposed in a semi-internal module for this specific use case.++++The prettyprinter family+------------------------++The `prettyprinter` family of packages consists of:++  - `prettyprinter` is the core package. It defines the language to generate+    nicely laid out documents, which can then be given to renderers to display+    them in various ways, e.g. HTML, or plain text.+  - `prettyprinter-ansi-terminal` provides a renderer suitable for ANSI terminal+    output including colors (at the cost of a dependency more).+  - `prettyprinter-compat-wl-pprint` provides a drop-in compatibility layer for+    previous users of the `wl-pprint` package. Use it for easy adaption of the+    new `prettyprinter`, but don't develop anything new with it.+  - `prettyprinter-compat-ansi-wl-pprint` is the same, but for previous users of+    `ansi-wl-pprint`.+  - `prettyprinter-compat-annotated-wl-pprint` is the same, but for previous+    users of `annotated-wl-pprint`.++++Differences to the old Wadler/Leijen prettyprinters+---------------------------------------------------++The library originally started as a fork of `ansi-wl-pprint` until every line+had been touched. The result is still in the same spirit as its predecessors,+but modernized to match the current ecosystem and needs.++The most significant changes are:++  1. `(<$>)` is removed as an operator, since it clashes with the common alias+     for `fmap`.+  2. All but the essential `<>` and `<+>` operators were removed or replaced by+     ordinary names.+  3. Everything extensively documented, with references to other functions and+     runnable code examples.+  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.++++Historical notes+----------------++This module is based on previous work by Daan Leijen and Max Bolingbroke, who+implemented and significantly extended the prettyprinter given by a [paper by+Phil Wadler in his 1997 paper »A Prettier+Printer«](https://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf),+by adding lots of convenience functions, styling, and new functionality. Their+package, ansi-wl-pprint is widely used in the Haskell ecosystem, and is at the+time of writing maintained by Edward Kmett.
+ Setup.lhs view
@@ -0,0 +1,3 @@+#!/usr/bin/env runhaskell+> import Distribution.Simple+> main = defaultMain
+ app/GenerateReadme.hs view
@@ -0,0 +1,201 @@+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE QuasiQuotes       #-}++module Main (main) where++++import Prelude hiding (words)++import qualified Data.List                             as L+import           Data.Text                             (Text)+import qualified Data.Text                             as T+import qualified Data.Text.IO                          as T+import           Data.Text.Prettyprint.Doc+import           Data.Text.Prettyprint.Doc.Render.Text++import MultilineTh++++main :: IO ()+main = (T.putStrLn . renderStrict . layoutPretty layoutOptions) readmeContents+  where+    layoutOptions = LayoutOptions { layoutPageWidth = AvailablePerLine 80 1 }++readmeContents :: Doc ann+readmeContents = (mconcat . L.intersperse vspace)+    [ htmlComment "This file was auto-generated by the 'scripts/generate_readme' program."++    , 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)"+        ]++    , 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. |]++    , 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+        out of many small components, then using a layouter to convert it to an+        easily renderable simple document, which can then be rendered to a+        variety of formats, for example plain `Text`, or Markdown. *What you are+        reading right now was generated by this library (see+        `GenerateReadme.hs`).* |]++    , h2 "Why another prettyprinter?"+        , paragraph [multiline| Haskell, more specifically Hackage, has a zoo of+        Wadler/Leijen based prettyprinters already. Each of them addresses a+        different concern with the classic `wl-pprint` package. This package+        solves *all* these issues, and then some. |]++    , 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. |]++    , h3 "Extensive documentation"+        , paragraph [multiline| The library is stuffed with runnable examples,+        showing use cases for the vast majority of exported values. Many things+        reference related definitions, *everything* comes with at least a+        sentence explaining its purpose. |]++    , h3 "No name clashes"+        , paragraph [multiline| Many prettyprinters use the legacy API of the+        first Wadler/Leijen prettyprinter, which used e.g. `(<$>)` to separate+        lines, which clashes with the ubiquitous synonym for `fmap` that’s been+        in Base for ages. These definitions were either removed or renamed, so+        there are no name clashes with standard libraries anymore. |]++    , h3 "Annotation support"+        , paragraph [multiline| Text is not all letters and newlines. Often, we+        want to add more information, the simplest kind being some form of+        styling. An ANSI terminal supports coloring, a web browser a plethora of+        different formattings. |]++        , 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. |]++        , paragraph [multiline| 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 usability nor performance. |]++    , h3 "Extensible backends"+        , paragraph [multiline| A document can be rendered in many different+        ways, for many different clients. There is plain text, there is the ANSI+        terminal, there is the browser. Each of these speak different languages,+        and the backend is responsible for the translation to those languages.+        Backends should be readily available, or easy to implement if a custom+        solution is desired. |]++        , paragraph [multiline| As a result, each backend requires only minimal+        dependencies; if you don’t want to print to an ANSI terminal for+        example, there is no need to have a dependency on a terminal library. |]++    , h3 "Performance"+        , paragraph [multiline| Rendering large documents should be done+        efficiently, and the library should make it easy to optimize common use+        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. |]++    , h2 "The prettyprinter family"+    , paragraph "The `prettyprinter` family of packages consists of:"+    , (indent 2 . unorderedList . map paragraph)+        [ [multiline| `prettyprinter` is the core package. It defines the+          language to generate nicely laid out documents, which can then be+          given to renderers to display them in various ways, e.g. HTML, or+          plain text.|]+        , [multiline| `prettyprinter-ansi-terminal` provides a renderer suitable+          for ANSI terminal output including colors (at the cost of a+          dependency more).|]+        , [multiline| `prettyprinter-compat-wl-pprint` provides a drop-in+          compatibility layer for previous users of the `wl-pprint` package. Use+          it for easy adaption of the new `prettyprinter`, but don't develop+          anything new with it.|]+        , [multiline| `prettyprinter-compat-ansi-wl-pprint` is the same, but for+          previous users of `ansi-wl-pprint`.|]+        , [multiline| `prettyprinter-compat-annotated-wl-pprint` is the same,+          but for previous users of `annotated-wl-pprint`.|]+        ]++    , h2 "Differences to the old Wadler/Leijen prettyprinters"++    , paragraph [multiline| The library originally started as a fork of+    `ansi-wl-pprint` until every line had been touched. The result is still in+    the same spirit as its predecessors, but modernized to match the current+    ecosystem  and needs. |]++    , paragraph  "The most significant changes are:"+    , (indent 2 . orderedList . map paragraph)+        [ [multiline| `(<$>)` is removed as an operator, since it clashes with+          the common alias for `fmap`. |]+        , [multiline| All but the essential `<>` and `<+>` operators were+          removed or replaced by ordinary names. |]+        , [multiline| Everything extensively documented, with references to+          other functions and runnable code examples. |]+        , [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. |]+        ]++    , h2 "Historical notes"++        , paragraph [multiline| This module is based on previous work by Daan+        Leijen and Max Bolingbroke, who implemented and significantly extended+        the prettyprinter given by a [paper by Phil Wadler in his 1997 paper »A+        Prettier+        Printer«](https://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf),+        by adding lots of convenience functions, styling, and new functionality.+        Their package, ansi-wl-pprint is widely used in the Haskell ecosystem,+        and is at the time of writing maintained by Edward Kmett.|]++    ]++paragraph :: Text -> Doc ann+paragraph = align . fillSep . map pretty . T.words++vspace :: Doc ann+vspace = hardline <> hardline++h1 :: Doc ann -> Doc ann+h1 x = vspace <> underlineWith "=" x++h2 :: Doc ann -> Doc ann+h2 x = vspace <> underlineWith "-" x++h3 :: Doc ann -> Doc ann+h3 x = vspace <> "###" <+> x++underlineWith :: Text -> Doc ann -> Doc ann+underlineWith symbol x = align (width x (\w ->+    hardline <> pretty (T.take w (T.replicate w symbol))))++orderedList :: [Doc ann] -> Doc ann+orderedList = align . vsep . zipWith (\i x -> pretty i <> dot <+> align x) [1::Int ..]++unorderedList :: [Doc ann] -> Doc ann+unorderedList = align . vsep . map ("-" <+>)++htmlComment :: Doc ann -> Doc ann+htmlComment = enclose "<!-- " " -->"
+ app/MultilineTh.hs view
@@ -0,0 +1,30 @@+module MultilineTh (multiline) where++++import qualified Data.Text                  as T+import           Language.Haskell.TH+import           Language.Haskell.TH.Quote+import           Language.Haskell.TH.Syntax+import           Prelude++++multiline :: QuasiQuoter+multiline = QuasiQuoter+    { quoteExp = quoteUnlines+    , quotePat = const badUse+    , quoteType = const badUse+    , quoteDec = const badUse+    }+  where+    badUse = fail "multiline quasiquoter can only be used as an expression"++quoteUnlines :: String -> Q Exp+quoteUnlines =+      liftString+    . T.unpack+    . T.unwords+    . filter (not . T.null)+    . T.words+    . T.pack
+ bench/FasterUnsafeText.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE OverloadedStrings #-}++module Main (main) where++++import           Criterion.Main+import           Data.Char+import           Data.Text                          (Text)+import qualified Data.Text                          as T+import           Data.Text.Prettyprint.Doc.Internal++++-- The old implementation. Performance isn’t much worse to be honest, mostly+-- well within a σ.+alternative :: Text -> Doc ann+alternative t = case T.length t of+    0 -> Empty+    1 -> Char (T.head t)+    n -> Text n t++current :: Text -> Doc ann+current = unsafeText++main :: IO ()+main = defaultMain [ benchText (letters n) | n <- [0,1,2,3,5,10,50,100] ]++letters :: Int -> Text+letters n = T.pack (take n (filter isAlpha [minBound ..]))++benchText :: Text -> Benchmark+benchText input = bgroup (show (pretty (T.length input) <+> plural "letter" "letters" (T.length input)))+    [ bench "alternative" (whnf alternative input)+    , bench "current" (whnf current input) ]
+ bench/Fusion.hs view
@@ -0,0 +1,91 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}++#include "version-compatibility-macros.h"++module Main (main) where++++import           Control.Monad+import           Control.Monad.State+import           Criterion.Main+import           Data.Text           (Text)+import qualified Data.Text           as T+import           System.Random++import           Data.Text.Prettyprint.Doc+import           Data.Text.Prettyprint.Doc.Render.Text+import qualified Text.PrettyPrint.ANSI.Leijen          as WL++#if !(APPLICATIVE_MONAD)+import Control.Applicative+#endif++++main :: IO ()+main = defaultMain+    [ benchOptimize+    , benchWLComparison+    ]++benchOptimize :: Benchmark+benchOptimize = env randomShortWords benchmark+  where+    benchmark = \shortWords ->+        let doc = hsep (map pretty shortWords)+        in bgroup "Many small words"+            [ bench "Unoptimized"     (nf renderLazy (layoutPretty defaultLayoutOptions               doc))+            , bench "Shallowly fused" (nf renderLazy (layoutPretty defaultLayoutOptions (fuse Shallow doc)))+            , bench "Deeply fused"    (nf renderLazy (layoutPretty defaultLayoutOptions (fuse Deep    doc)))+            ]++    randomShortWords :: Applicative m => m [Text]+    randomShortWords = pure (evalState (randomShortWords' 100) (mkStdGen 0))++    randomShortWords' :: Int -> State StdGen [Text]+    randomShortWords' n = replicateM n randomShortWord++    randomShortWord :: State StdGen Text+    randomShortWord = do+        g <- get+        let (l, g') = randomR (0, 5) g+            (gNew, gFree) = split g'+            xs = take l (randoms gFree)+        put gNew+        pure (T.pack xs)++benchWLComparison :: Benchmark+benchWLComparison = bgroup "vs. other libs"+    [ bgroup "renderPretty"+        [ bench "this, unoptimized"     (nf (renderLazy . layoutPretty defaultLayoutOptions)               doc)+        , bench "this, shallowly fused" (nf (renderLazy . layoutPretty defaultLayoutOptions) (fuse Shallow doc))+        , bench "this, deeply fused"    (nf (renderLazy . layoutPretty defaultLayoutOptions) (fuse Deep    doc))+        , bench "ansi-wl-pprint"        (nf (\d -> WL.displayS (WL.renderPretty 0.4 80 d) "") wlDoc)+        ]+    , bgroup "renderSmart"+        [ bench "this, unoptimized"     (nf (renderLazy . layoutSmart defaultLayoutOptions)               doc)+        , bench "this, shallowly fused" (nf (renderLazy . layoutSmart defaultLayoutOptions) (fuse Shallow doc))+        , bench "this, deeply fused"    (nf (renderLazy . layoutSmart defaultLayoutOptions) (fuse Deep    doc))+        , bench "ansi-wl-pprint"        (nf (\d -> WL.displayS (WL.renderSmart 0.4 80 d) "") wlDoc)+        ]+    , bgroup "renderCompact"+        [ bench "this, unoptimized"     (nf (renderLazy . layoutCompact)               doc)+        , bench "this, shallowly fused" (nf (renderLazy . layoutCompact) (fuse Shallow doc))+        , bench "this, deeply fused"    (nf (renderLazy . layoutCompact) (fuse Deep    doc))+        , bench "ansi-wl-pprint"        (nf (\d -> WL.displayS (WL.renderCompact d) "") wlDoc)+        ]+    ]+  where+    doc :: Doc ann+    doc = let fun x = "fun" <> parens (softline <> x)+              funnn = chain 10 fun+          in funnn (sep (take 48 (cycle ["hello", "world"])))++    wlDoc :: WL.Doc+    wlDoc = let fun x = "fun" WL.<> WL.parens (WL.softline WL.<> x)+                funnn = chain 10 fun+            in funnn (WL.sep (take 48 (cycle ["hello", "world"])))++    chain n f = foldr (.) id (replicate n f)
+ misc/version-compatibility-macros.h view
@@ -0,0 +1,19 @@+#ifndef VERSION_COMPATIBILITY_MACROS+#define VERSION_COMPATIBILITY_MACROS++#ifndef MIN_VERSION_base+#error "MIN_VERSION_base macro not defined!"+#endif++-- These macros allow writing CPP compatibility hacks in a way that makes their+-- purpose much clearer than just demanding a specific version of a library.++#define APPLICATIVE_MONAD               MIN_VERSION_base(4,8,0)+#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 MONAD_FAIL                      MIN_VERSION_base(4,9,0)++#endif
+ prettyprinter.cabal view
@@ -0,0 +1,147 @@+name:                prettyprinter+version:             0.1+cabal-version:       >= 1.10+category:            User Interfaces, Text+synopsis:            A modern, extensible and well-documented prettyprinter.+description:         See README.md+license:             BSD2+license-file:        LICENSE.md+extra-source-files:  README.md+                   , misc/version-compatibility-macros.h+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+homepage:            http://github.com/quchen/prettyprinter+build-type:          Simple+tested-with:         GHC==7.8.4, GHC==7.10.2, GHC==7.10.3, GHC==8.0.1, GHC==8.0.2++++source-repository head+    type: git+    location: git://github.com/quchen/prettyprinter.git++++library+    exposed-modules:+          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.Text+        , Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial+        , Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial+        , Data.Text.Prettyprint.Doc.Render.Util.Panic+        , 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+    ghc-options: -Wall+    hs-source-dirs: src+    include-dirs: misc+    default-language: Haskell2010+    other-extensions:+          BangPatterns+        , CPP+        , LambdaCase+        , OverloadedStrings+        , QuasiQuotes+        , DefaultSignatures+        , ScopedTypeVariables++    build-depends:+          base < 127+        , text++    if impl(ghc >= 8.0)+        ghc-options: -Wcompat+    if impl(ghc < 8.0)+        build-depends: semigroups >= 0.1 && < 0.19+    if impl(ghc < 7.10)+        build-depends: void++++executable generate_readme+    hs-source-dirs: app+    main-is: GenerateReadme.hs+    build-depends:+          base < 127+        , prettyprinter+        , text+        , template-haskell+    default-language: Haskell2010+    other-modules: MultilineTh+    other-extensions: OverloadedStrings+                    , TemplateHaskell+    if impl (ghc < 7.10)+        buildable: False++++test-suite doctest+    type: exitcode-stdio-1.0+    hs-source-dirs: test/Doctest+    main-is: Main.hs+    build-depends:+          base < 127+        , doctest >= 0.9+        , QuickCheck >= 2.7+    ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+    default-language: Haskell2010+    if impl (ghc < 7.10)+        buildable: False+        -- Doctest does not support searching through directories in old versions++test-suite testsuite+    type: exitcode-stdio-1.0+    hs-source-dirs: test/Testsuite+    main-is: Main.hs+    build-depends:+          base+        , prettyprinter++        , pgp-wordlist+        , bytestring+        , tasty+        , tasty-quickcheck+        , text+    ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall+    default-language: Haskell2010++    if impl(ghc < 8.0)+        build-depends: semigroups >= 0.1 && < 0.19++++benchmark fusion+    type: exitcode-stdio-1.0+    hs-source-dirs: bench+    main-is: Fusion.hs+    build-depends:+          base+        , prettyprinter++        , criterion+        , mtl+        , random+        , text+        , transformers+        , ansi-wl-pprint+    ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N+    default-language: Haskell2010+    other-extensions: NumDecimals, OverloadedStrings++benchmark faster-unsafe-text+    build-depends: base >= 4.7 && < 5+                 , criterion+                 , text+                 , prettyprinter++    hs-source-dirs:      bench+    main-is:             FasterUnsafeText.hs+    ghc-options:         -threaded -rtsopts -with-rtsopts=-N -Wall+    default-language:    Haskell2010+    type:                exitcode-stdio-1.0
+ src/Data/Text/Prettyprint/Doc.hs view
@@ -0,0 +1,254 @@+-- |+-- Module      :  Data.Text.Prettyprint.Doc+-- Copyright   :  Daan Leijen (c) 2000, http://www.cs.uu.nl/~daan+--                Max Bolingbroke (c) 2008, http://blog.omega-prime.co.uk+--                David Luposchainsky (c) 2016, http://github.com/quchen+-- License     :  BSD-style (see the file LICENSE.md)+-- Maintainer  :  David Luposchainsky <dluposchainsky (λ) google>+-- Stability   :  experimental+-- Portability :  portable+--+-- = Overview+--+-- 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'.+--+-- The documentation consists of several parts:+--+--   1. Just below is some general information about the library.+--   2. The actual library with extensive documentation and examples+--   3. Migration guide for users familiar with (ansi-)wl-pprint+--+-- == Starting out+--+-- As a reading list for starters, some of the most commonly used functions in+-- this module include '<>', 'hsep', '<+>', 'vsep', 'align', 'hang'. These cover+-- many use cases already, and many other functions are variations or+-- combinations of these.+--+-- = Simple example+--+-- Let’s prettyprint a simple Haskell type definition. First, intersperse @->@+-- and add a leading @::@,+--+-- >>> let prettyType = align . sep . zipWith (<+>) ("::" : repeat "->")+--+-- The 'sep' function is one way of concatenating documents, there are multiple+-- others, e.g. 'vsep', 'cat' and 'fillSep'. In our case, 'sep' space-separates+-- all entries if there is space, and newlines if the remaining line is too+-- short.+--+-- Second, prepend the name to the type,+--+-- >>> let prettyDecl n tys = pretty n <+> prettyType tys+--+-- Now we can define a document that contains some type signature:+--+-- >>> let doc = prettyDecl "example" ["Int", "Bool", "Char", "IO ()"]+--+-- This document can now be printed, and it automatically adapts to available+-- space. If the page is wide enough (80 characters in this case), the+-- definitions are space-separated,+--+-- >>> putDocW 80 doc+-- example :: Int -> Bool -> Char -> IO ()+--+-- If we narrow the page width to only 20 characters, the /same document/+-- renders vertically aligned:+--+-- >>> putDocW 20 doc+-- example :: Int+--         -> Bool+--         -> Char+--         -> IO ()+--+-- Speaking of alignment, had we not used 'align', the @->@ would be at the+-- beginning of each line, and not beneath the @::@.+--+-- = General workflow+--+-- @+-- ╭───────────────╮      ╭───────────────────╮+-- │ 'vsep', 'pretty', │      │        'Doc'        │+-- │ '<+>', 'nest',    ├─────▷│  (rich document)  │+-- │ 'align', …      │      ╰─────────┬─────────╯+-- ╰───────────────╯                │+--                                  │ Layout algorithms+--                                  │ e.g. 'layoutPretty'+--                                  ▽+--                        ╭───────────────────╮+--                        │     'SimpleDoc'     │+--                        │ (simple document) │+--                        ╰─────────┬─────────╯+--                                  │+--                                  │ Renderers+--                                  │+--              ╭───────────────────┼───────────────────╮+--              │                   │                   │+--              ▽                   ▽                   ▽+--      ╭───────────────╮   ╭───────────────╮   ╭───────────────╮+--      │  Plain 'Text'   │   │ ANSI terminal │   │ other/custom  │+--      ╰───────────────╯   ╰───────────────╯   ╰───────────────╯+-- @+--+-- = How the layout works+--+-- There are two key concepts to laying a document out: the available width, and+-- 'group'ing.+--+-- == Available width+--+-- The page has a certain maximum width, which the layouter tries to not exceed,+-- by inserting line breaks where possible. The functions given in this module+-- make it fairly straightforward to specify where, and under what+-- circumstances, such a line break may be inserted by the layouter, for example+-- via the 'sep' function.+--+-- There is also the concept of /ribbon width/. The ribbon is the part of a line+-- that is printed, i.e. the line length without the leading indentation. The+-- layouters take a ribbon fraction argument, which specifies how much of a line+-- should be filled before trying to break it up. A ribbon width of 0.5 in a+-- document of width 80 will result in the layouter to try to not exceed @0.5*80 =+-- 40@ (ignoring current indentation depth).+--+-- == Grouping+--+-- A document can be 'group'ed, which tells the layouter that it should attempt+-- to collapse it to a single line. If the result does not fit within the+-- 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.+module Data.Text.Prettyprint.Doc (+    -- * Documents+    Doc,++    -- * Basic functionality+    Pretty(..),+    emptyDoc, nest, line, line', softline, softline', hardline, group, flatAlt,++    -- * Alignment functions+    --+    -- | The functions in this section cannot be described by Wadler's original+    -- functions. They align their output relative to the current output+    -- position - in contrast to @'nest'@ which always aligns to the current+    -- nesting level. This deprives these functions from being \'optimal\'. In+    -- practice however they prove to be very useful. The functions in this+    -- section should be used with care, since they are more expensive than the+    -- other functions. For example, @'align'@ shouldn't be used to pretty print+    -- all top-level declarations of a language, but using @'hang'@ for let+    -- expressions is fine.+    align, hang, indent, encloseSep, list, tupled,++    -- * Binary functions+    (<>), (<+>),++    -- * List functions++    -- | The 'sep' and 'cat' functions differ in one detail: when 'group'ed, the+    -- 'sep's replace newlines wich 'space's, while the 'cat's simply remove+    -- them. If you're not sure what you want, start with the 'sep's.++    concatWith,++    -- ** 'sep' family+    --+    -- | When 'group'ed, these will replace newlines with spaces.+    hsep, vsep, fillSep, sep,+    -- ** 'cat' family+    --+    -- | When 'group'ed, these will remove newlines.+    hcat, vcat, fillCat, cat,+    -- ** Others+    punctuate,++    -- * Reactive/conditional layouts+    --+    -- | Lay documents out differently based on current position and the page+    -- layout.+    column, nesting, width, pageWidth,++    -- * Filler functions+    --+    -- | Fill up available space+    fill, fillBreak,++    -- * General convenience+    --+    -- | Useful helper functions.+    plural, enclose, surround,++    -- * Bracketing functions+    --+    -- | Enclose documents in common ways.+    squotes, dquotes, parens, angles, brackets, braces,++    -- * Named characters+    --+    -- | Convenience definitions for common characters+    lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket, squote,+    dquote, semi, colon, comma, space, dot, slash, backslash, equals, pipe,++    -- ** Annotations+    annotate,+    unAnnotate,+    reAnnotate,+    unAnnotateS,+    reAnnotateS,++    -- * Optimization+    --+    -- Render documents faster+    fuse, FusionDepth(..),++    -- * 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(..),+    PageWidth(..), LayoutOptions(..), defaultLayoutOptions,+    layoutPretty, layoutCompact, layoutSmart,++    -- * Migration guide+    --+    -- $migration+) where++++import Data.Semigroup+import Data.Text.Prettyprint.Doc.Internal++-- $setup+--+-- (Definitions for the doctests)+--+-- >>> :set -XOverloadedStrings+-- >>> import Data.Text.Prettyprint.Doc.Render.Text+-- >>> import Data.Text.Prettyprint.Doc.Util++++-- $migration+--+-- 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:+--+--   - @char@, @string@, @double@, … – these are all special cases of the+--     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.+--   - 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.+--   - The /render/ functions are called /layout/ functions.+--   - Instead of providing an own colorization function for each+--     color\/intensity\/layer combination, they have been combined in 'color',+--     'colorDull', 'bgColor', and 'bgColorDull' functions.
+ src/Data/Text/Prettyprint/Doc/Internal.hs view
@@ -0,0 +1,1739 @@+{-# LANGUAGE BangPatterns        #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE DefaultSignatures   #-}+{-# LANGUAGE LambdaCase          #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-}++#include "version-compatibility-macros.h"++-- | __Warning: internal module!__ This means that the API may change+-- arbitrarily between versions without notice. Depending on this module may+-- lead to unexpected breakages, so proceed with caution!+--+-- For a stable API, use the non-internal modules. For the special case of+-- writing adaptors to this library’s @'Doc'@ type, see+-- "Data.Text.Prettyprint.Doc.Internal.Type".+module Data.Text.Prettyprint.Doc.Internal (+    module Data.Text.Prettyprint.Doc.Internal+) where++++import           Data.Int+import           Data.List.NonEmpty (NonEmpty (..))+import           Data.Maybe+import           Data.String        (IsString (..))+import           Data.Text          (Text)+import qualified Data.Text          as T+import qualified Data.Text.Lazy     as Lazy+import           Data.Void+import           Data.Word++-- Depending on the Cabal file, this might be from base, or for older builds,+-- from the semigroups package.+import Data.Semigroup++#if NATURAL_IN_BASE+import Numeric.Natural+#endif++#if !(FOLDABLE_TRAVERSABLE_IN_PRELUDE)+import Data.Foldable (Foldable (..))+import Prelude       hiding (foldr, foldr1)+#endif+#if !(MONOID_IN_PRELUDE)+import Data.Monoid hiding ((<>))+#endif++import Data.Text.Prettyprint.Doc.Render.Util.Panic++++-- $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@.+--+-- More specifically, a value of type @'Doc'@ represents a non-empty set of+-- possible layouts of a document. The layout functions select one of these+-- possibilities, taking into account things like the width of the output+-- document.+--+-- The annotation is an arbitrary piece of data associated with (part of) a+-- document. Annotations may be used by the rendering backends in order to+-- display output differently, such as+--+--   - 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)+--+-- The simplest way to display a 'Doc' is via the 'Show' class.+--+-- >>> putStrLn (show (vsep ["hello", "world"]))+-- hello+-- world+data Doc ann =++    -- | Occurs when flattening a line. The layouter will reject this document,+    -- choosing a more suitable rendering.+    Fail++    -- | The empty document; unit of 'Cat' (observationally)+    | Empty++    -- | invariant: char is 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+    -- @Char@; newlines should be replaced by e.g. @Line@.+    --+    -- Since the frequently used 'T.length' of 'Text' is /O(length)/, we cache+    -- it in this constructor.+    | Text !Int Text++    -- | 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.+    | FlatAlt (Doc ann) (Doc ann)++    -- | Concatenation of two documents+    | Cat (Doc ann) (Doc ann)++    -- | 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'.+    | Union (Doc ann) (Doc ann)++    -- | React on the current cursor position, see 'column'+    | Column (Int -> Doc ann)++    -- | React on the document's width, see 'pageWidth'+    | WithPageWidth (PageWidth -> Doc ann)++    -- | React on the current nesting level, see 'nesting'+    | Nesting (Int -> Doc ann)++    -- | 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)++-- |+-- @+-- x '<>' y = 'hcat' [x, y]+-- @+--+-- >>> "hello" <> "world" :: Doc ann+-- helloworld+instance Semigroup (Doc ann) where+    (<>) = Cat+    sconcat (x :| xs) = hcat (x:xs)++-- |+-- @+-- 'mempty' = 'emptyDoc'+-- 'mconcat' = 'hcat'+-- @+--+-- >>> mappend "hello" "world" :: Doc ann+-- helloworld+instance Monoid (Doc ann) where+    mempty = emptyDoc+    mappend = (<>)+    mconcat = hcat++-- | >>> pretty ("hello\nworld")+-- hello+-- world+--+-- This instance uses the 'Pretty' 'Text' instance, and uses the same newline to+-- 'line' conversion.+instance IsString (Doc ann) where+    fromString = pretty . T.pack++-- | Overloaded conversion to 'Doc'.+class Pretty a where++    -- | >>> pretty 1 <+> pretty "hello" <+> pretty 1.234+    -- 1 hello 1.234+    pretty :: a -> Doc ann++    default pretty :: Show a => a -> Doc ann+    pretty = viaShow++    -- | @'prettyList'@ is only used to define the @instance+    -- 'Pretty' a => 'Pretty' [a]@. In normal circumstances only the @'pretty'@+    -- function is used.+    --+    -- >>> prettyList [1, 23, 456]+    -- [1, 23, 456]+    prettyList :: [a] -> Doc ann+    prettyList = list . map pretty++-- | >>> pretty [1,2,3]+-- [1, 2, 3]+instance Pretty a => Pretty [a] where+    pretty = prettyList++instance Pretty a => Pretty (NonEmpty a) where+    pretty (x:|xs) = prettyList (x:xs)++-- | Does not change the text, but removes all annotations. __Pitfall__: since+-- this un-annotates its argument, nesting it means multiple, potentially+-- costly, traversals over the 'Doc'.+--+-- >>> pretty 123+-- 123+-- >>> pretty (pretty 123)+-- 123+instance Pretty (Doc ann) where+    pretty = unAnnotate++-- | >>> pretty ()+-- ()+--+-- The argument is not used,+--+-- >>> pretty (error "Strict?" :: ())+-- ()+instance Pretty () where+    pretty _ = "()"++-- | >>> pretty True+-- True+instance Pretty Bool where+    pretty = \case+        True  -> "True"+        False -> "False"++-- | Instead of @('pretty' '\n')@, consider using @'line'@ as a more readable+-- alternative.+--+-- >>> pretty 'f' <> pretty 'o' <> pretty 'o'+-- foo+-- >>> pretty ("string" :: String)+-- string+instance Pretty Char where+    pretty '\n' = line+    pretty c = Char c++    prettyList = pretty . (id :: Text -> Text) . fromString++-- | Convert a 'Show'able value to a 'Doc'. If the 'String' does not contain+-- newlines, consider using the more performant 'unsafeViaShow'.+viaShow :: Show a => a -> Doc ann+viaShow = pretty . T.pack . show++-- | 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++-- | >>> pretty (123 :: Int)+-- 123+instance Pretty Int where pretty = unsafeViaShow+instance Pretty Int8 where pretty = unsafeViaShow+instance Pretty Int16 where pretty = unsafeViaShow+instance Pretty Int32 where pretty = unsafeViaShow+instance Pretty Int64 where pretty = unsafeViaShow+instance Pretty Word where pretty = unsafeViaShow+instance Pretty Word8 where pretty = unsafeViaShow+instance Pretty Word16 where pretty = unsafeViaShow+instance Pretty Word32 where pretty = unsafeViaShow+instance Pretty Word64 where pretty = unsafeViaShow++-- | >>> pretty (2^123 :: Integer)+-- 10633823966279326983230456482242756608+instance Pretty Integer where pretty = unsafeViaShow++#if NATURAL_IN_BASE+instance Pretty Natural where pretty = unsafeViaShow+#endif++-- | >>> pretty (pi :: Float)+-- 3.1415927+instance Pretty Float where pretty = unsafeViaShow++-- | >>> pretty (exp 1 :: Double)+-- 2.718281828459045+instance Pretty Double where pretty = unsafeViaShow++-- | >>> pretty (123, "hello")+-- (123, hello)+instance (Pretty a1, Pretty a2) => Pretty (a1,a2) where+    pretty (x1,x2) = tupled [pretty x1, pretty x2]++-- | >>> pretty (123, "hello", False)+-- (123, hello, False)+instance (Pretty a1, Pretty a2, Pretty a3) => Pretty (a1,a2,a3) where+    pretty (x1,x2,x3) = tupled [pretty x1, pretty x2, pretty x3]++--    -- | >>> pretty (123, "hello", False, ())+--    -- (123, hello, False, ())+--    instance (Pretty a1, Pretty a2, Pretty a3, Pretty a4) => Pretty (a1,a2,a3,a4) where+--        pretty (x1,x2,x3,x4) = tupled [pretty x1, pretty x2, pretty x3, pretty x4]+--+--    -- | >>> pretty (123, "hello", False, (), 3.14)+--    -- (123, hello, False, (), 3.14)+--    instance (Pretty a1, Pretty a2, Pretty a3, Pretty a4, Pretty a5) => Pretty (a1,a2,a3,a4,a5) where+--        pretty (x1,x2,x3,x4,x5) = tupled [pretty x1, pretty x2, pretty x3, pretty x4, pretty x5]+--+--    -- | >>> pretty (123, "hello", False, (), 3.14, Just 2.71)+--    -- ( 123+--    -- , hello+--    -- , False+--    -- , ()+--    -- , 3.14+--    -- , 2.71 )+--    instance (Pretty a1, Pretty a2, Pretty a3, Pretty a4, Pretty a5, Pretty a6) => Pretty (a1,a2,a3,a4,a5,a6) where+--        pretty (x1,x2,x3,x4,x5,x6) = tupled [pretty x1, pretty x2, pretty x3, pretty x4, pretty x5, pretty x6]+--+--    -- | >>> pretty (123, "hello", False, (), 3.14, Just 2.71, [1,2,3])+--    -- ( 123+--    -- , hello+--    -- , False+--    -- , ()+--    -- , 3.14+--    -- , 2.71+--    -- , [1, 2, 3] )+--    instance (Pretty a1, Pretty a2, Pretty a3, Pretty a4, Pretty a5, Pretty a6, Pretty a7) => Pretty (a1,a2,a3,a4,a5,a6,a7) where+--        pretty (x1,x2,x3,x4,x5,x6,x7) = tupled [pretty x1, pretty x2, pretty x3, pretty x4, pretty x5, pretty x6, pretty x7]++-- | Ignore 'Nothing's, print 'Just' contents.+--+-- >>> pretty (Just True)+-- True+-- >>> braces (pretty (Nothing :: Maybe Bool))+-- {}+--+-- >>> pretty [Just 1, Nothing, Just 3, Nothing]+-- [1, 3]+instance Pretty a => Pretty (Maybe a) where+    pretty = maybe mempty pretty+    prettyList = prettyList . catMaybes++-- | Automatically converts all newlines to @'line'@.+--+-- >>> pretty ("hello\nworld" :: Text)+-- hello+-- world+--+-- Note that  @'line'@ can be undone by @'group'@:+--+-- >>> group (pretty ("hello\nworld" :: Text))+-- hello world+--+-- Manually use @'hardline'@ if you /definitely/ want newlines.+instance Pretty Text where pretty = vsep . map unsafeText . T.splitOn "\n"++-- | (lazy 'Text' instance, identical to the strict version)+instance Pretty Lazy.Text where pretty = pretty . Lazy.toStrict++-- | I tried finding a good example to show here but could not find one+instance Pretty Void where pretty = absurd++++-- | 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@.+--+-- 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+    Nothing -> Empty+    Just (t,ext)+        | T.null ext -> Char t+        | otherwise -> Text (T.length text) text++-- | The empty document behaves like @('pretty' "")@, so it has a height of 1.+-- This may lead to surprising behaviour if we expect it to bear no weight+-- inside e.g. 'vcat', where we get an empty line of output from it ('parens'+-- for visibility only):+--+-- >>> vsep ["hello", parens emptyDoc, "world"]+-- hello+-- ()+-- world+--+-- Together with '<>', 'emptyDoc' forms the 'Monoid' 'Doc'.+emptyDoc :: Doc ann+emptyDoc = Empty++-- | @('nest' i x)@ lays out the document @x@ with the current indentation level+-- increased by @i@. Negative values are allowed, and decrease the nesting level+-- accordingly.+--+-- >>> vsep [nest 4 (vsep ["lorem", "ipsum", "dolor"]), "sit", "amet"]+-- lorem+--     ipsum+--     dolor+-- sit+-- amet+--+-- See also 'hang', 'align' and 'indent'.+nest+    :: Int -- ^ Change of nesting level+    -> Doc ann+    -> Doc ann+nest = Nest++-- | The @'line'@ document advances to the next line and indents to the current+-- nesting level.+--+-- >>> let doc = "lorem ipsum" <> line <> "dolor sit amet"+-- >>> doc+-- lorem ipsum+-- dolor sit amet+--+-- @'line'@ behaves like @'space'@ if the line break is undone by 'group':+--+-- >>> group doc+-- lorem ipsum dolor sit amet+line :: Doc ann+line = FlatAlt Line space++-- | @'line''@ is like @'line'@, but behaves like @'mempty'@ if the line break+-- is undone by 'group' (instead of @'space'@).+--+-- >>> let doc = "lorem ipsum" <> line' <> "dolor sit amet"+-- >>> doc+-- lorem ipsum+-- dolor sit amet+-- >>> group doc+-- lorem ipsumdolor sit amet+line' :: Doc ann+line' = FlatAlt Line mempty++-- | @softline@ behaves like @'space'@ if the resulting output fits the page,+-- otherwise like @'line'@.+--+-- Here, we have enough space to put everything in one line:+--+-- >>> let doc = "lorem ipsum" <> softline <> "dolor sit amet"+-- >>> putDocW 80 doc+-- lorem ipsum dolor sit amet+--+-- If we narrow the page to width 10, the layouter produces a line break:+--+-- >>> putDocW 10 doc+-- lorem ipsum+-- dolor sit amet+--+-- @+-- 'softline' = 'group' 'line'+-- @+softline :: Doc ann+softline = group line++-- | @'softline''@ is like @'softline'@, but behaves like @'mempty'@ if the+-- resulting output does not fit on the page (instead of @'space'@). In other+-- words, @'line'@ is to @'line''@ how @'softline'@ is to @'softline''@.+--+-- With enough space, we get direct concatenation:+--+-- >>> let doc = "ThisWord" <> softline' <> "IsWayTooLong"+-- >>> putDocW 80 doc+-- ThisWordIsWayTooLong+--+-- If we narrow the page to width 10, the layouter produces a line break:+--+-- >>> putDocW 10 doc+-- ThisWord+-- IsWayTooLong+--+-- @+-- 'softline'' = 'group' 'line''+-- @+softline' :: Doc ann+softline' = group line'++-- | A @'hardline'@ is /always/ laid out as a line break, even when 'group'ed or+-- when there is plenty of space. Note that it might still be simply discarded+-- if it is part of a 'flatAlt' inside a 'group'.+--+-- >>> let doc = "lorem ipsum" <> hardline <> "dolor sit amet"+-- >>> putDocW 1000 doc+-- lorem ipsum+-- dolor sit amet+--+-- >>> group doc+-- lorem ipsum+-- dolor sit amet+hardline :: Doc ann+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.+--+-- See 'vcat', 'line', or 'flatAlt' for examples that are related, or make good+-- use of it.+group :: Doc ann -> Doc ann+group x = Union (flatten x) x++-- Choose the first element of each @Union@, and discard the first field of all+-- @FlatAlt@s.+flatten :: Doc ann -> Doc ann+flatten = \case+    FlatAlt _ y     -> flatten y+    Cat x y         -> Cat (flatten x) (flatten y)+    Nest i x        -> Nest i (flatten x)+    Line            -> Fail+    Union x _       -> flatten x+    Column f        -> Column (flatten . f)+    WithPageWidth f -> WithPageWidth (flatten . f)+    Nesting f       -> Nesting (flatten . f)+    Annotated ann x -> Annotated ann (flatten x)++    x@Fail   -> x+    x@Empty  -> x+    x@Char{} -> x+    x@Text{} -> x++++-- | @('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.+--+-- 'flatAlt' is particularly useful for defining conditional separators such as+--+-- @+-- softHyphen = 'flatAlt' 'mempty' "-"+-- softline   = 'flatAlt' 'space' 'line'+-- @+--+-- We can use this to render Haskell's do-notation nicely:+--+-- >>> let open        = flatAlt "" "{ "+-- >>> let close       = flatAlt "" " }"+-- >>> let separator   = flatAlt "" "; "+-- >>> let prettyDo xs = group ("do" <+> encloseSep open close separator xs)+-- >>> let statements  = ["name:_ <- getArgs", "let greet = \"Hello, \" <> name", "putStrLn greet"]+--+-- This is put into a single line with @{;}@ style if it fits,+--+-- >>> putDocW 80 (prettyDo statements)+-- do { name:_ <- getArgs; let greet = "Hello, " <> name; putStrLn greet }+--+-- When there is not enough space the statements are broken up into lines+-- nicely,+--+-- >>> putDocW 10 (prettyDo statements)+-- do name:_ <- getArgs+--    let greet = "Hello, " <> name+--    putStrLn greet+flatAlt+    :: Doc ann -- ^ Default+    -> Doc ann -- ^ Fallback when 'group'ed+    -> Doc ann+flatAlt = FlatAlt++++-- | @('align' x)@ lays out the document @x@ with the nesting level set to the+-- current column. It is used for example to implement 'hang'.+--+-- As an example, we will put a document right above another one, regardless of+-- the current nesting level. Without 'align'ment, the second line is put simply+-- below everything we've had so far,+--+-- >>> "lorem" <+> vsep ["ipsum", "dolor"]+-- lorem ipsum+-- dolor+--+-- If we add an 'align' to the mix, the @'vsep'@'s contents all start in the+-- same column,+--+-- >>> "lorem" <+> align (vsep ["ipsum", "dolor"])+-- lorem ipsum+--       dolor+align :: Doc ann -> Doc ann+align d = column (\k -> nesting (\i -> nest (k - i) d)) -- nesting might be negative!++-- | @('hang' i x)@ lays out the document @x@ with a nesting level set to the+-- /current column/ plus @i@. Negative values are allowed, and decrease the+-- nesting level accordingly.+--+-- >>> let doc = reflow "Indenting these words with hang"+-- >>> putDocW 24 ("prefix" <+> hang 4 doc)+-- prefix Indenting these+--            words with+--            hang+--+-- This differs from 'nest', which is based on the /current nesting level/ plus+-- @i@. When you're not sure, try the more efficient 'nest' first. In our+-- example, this would yield+--+-- >>> let doc = reflow "Indenting these words with nest"+-- >>> putDocW 24 ("prefix" <+> nest 4 doc)+-- prefix Indenting these+--     words with nest+--+-- @+-- 'hang' i doc = 'align' ('nest' i doc)+-- @+hang+    :: Int -- ^ Change of nesting level, relative to the start of the first line+    -> Doc ann+    -> Doc ann+hang i d = align (nest i d)++-- | @('indent' i x)@ indents document @x@ with @i@ spaces, starting from the+-- current cursor position.+--+-- >>> let doc = reflow "The indent function indents these words!"+-- >>> putDocW 24 ("prefix" <> indent 4 doc)+-- prefix    The indent+--           function+--           indents these+--           words!+--+-- @+-- 'indent' i d = 'hang' i ({i spaces} <> d)+-- @+indent+    :: Int -- ^ Number of spaces to increase indentation by+    -> Doc ann+    -> Doc ann+indent i d = hang i (spaces i <> d)++-- | @('encloseSep' l r sep xs)@ concatenates the documents @xs@ separated by+-- @sep@, and encloses the resulting document by @l@ and @r@.+--+-- The documents are laid out horizontally if that fits the page,+--+-- >>> let doc = "list" <+> encloseSep lbracket rbracket comma (map pretty [1,20,300,4000])+-- >>> putDocW 80 doc+-- list [1,20,300,4000]+--+-- If there is not enough space, then the input is split into lines entry-wise+-- therwise they are aligned vertically, with separators put in the front:+--+-- >>> putDocW 10 doc+-- list [1+--      ,20+--      ,300+--      ,4000]+--+-- For putting separators at the end of entries instead, have a look at+-- 'punctuate'.+encloseSep+    :: Doc ann   -- ^ left delimiter+    -> Doc ann   -- ^ right delimiter+    -> Doc ann   -- ^ separator+    -> [Doc ann] -- ^ input documents+    -> Doc ann+encloseSep l r s ds = case ds of+    []  -> l <> r+    [d] -> l <> d <> r+    _   -> align (cat (zipWith (<>) (l : repeat s) ds) <> r)++-- | Haskell-inspired variant of 'encloseSep' with braces and comma as+-- separator.+--+-- >>> let doc = list (map pretty [1,20,300,4000])+--+-- >>> putDocW 80 doc+-- [1, 20, 300, 4000]+--+-- >>> putDocW 10 doc+-- [ 1+-- , 20+-- , 300+-- , 4000 ]+list :: [Doc ann] -> Doc ann+list = group . encloseSep (flatAlt "[ " "[")+                          (flatAlt " ]" "]")+                          ", "++-- | Haskell-inspired variant of 'encloseSep' with parentheses and comma as+-- separator.+--+-- >>> let doc = tupled (map pretty [1,20,300,4000])+--+-- >>> putDocW 80 doc+-- (1, 20, 300, 4000)+--+-- >>> putDocW 10 doc+-- ( 1+-- , 20+-- , 300+-- , 4000 )+tupled :: [Doc ann] -> Doc ann+tupled = group . encloseSep (flatAlt "( " "(")+                            (flatAlt " )" ")")+                            ", "++++-- | @(x '<+>' y)@ concatenates document @x@ and @y@ with a @'space'@ in+-- between.+--+-- >>> "hello" <+> "world"+-- hello world+--+-- @+-- x '<+>' y = x '<>' 'space' '<>' y+-- @+(<+>) :: Doc ann -> Doc ann -> Doc ann+x <+> y = x <> space <> y++++-- | Concatenate all documents element-wise with a binary function.+--+-- @+-- 'concatWith' _ [] = 'mempty'+-- 'concatWith' (**) [x,y,z] = x ** y ** z+-- @+--+-- Multiple convenience definitions based on 'concatWith' are alredy predefined,+-- for example+--+-- @+-- 'hsep'    = 'concatWith' ('<+>')+-- 'fillSep' = 'concatWith' (\\x y -> x '<>' 'softline' '<>' y)+-- @+--+-- This is also useful to define customized joiners,+--+-- >>> concatWith (surround dot) ["Data", "Text", "Prettyprint", "Doc"]+-- Data.Text.Prettyprint.Doc+concatWith :: Foldable t => (Doc ann -> Doc ann -> Doc ann) -> t (Doc ann) -> Doc ann+concatWith f ds+#if !(FOLDABLE_TRAVERSABLE_IN_PRELUDE)+    | foldr (\_ _ -> False) True ds = mempty+#else+    | null ds = mempty+#endif+    | otherwise = foldr1 f ds+{-# INLINE concatWith #-}++-- | @('hsep' xs)@ concatenates all documents @xs@ horizontally with @'<+>'@,+-- i.e. it puts a space between all entries.+--+-- >>> let docs = Util.words "lorem ipsum dolor sit amet"+--+-- >>> hsep docs+-- lorem ipsum dolor sit amet+--+-- @'hsep'@ does not introduce line breaks on its own, even when the page is too+-- narrow:+--+-- >>> putDocW 5 (hsep docs)+-- lorem ipsum dolor sit amet+--+-- For automatic line breaks, consider using 'fillSep' instead.+hsep :: [Doc ann] -> Doc ann+hsep = concatWith (<+>)++-- | @('vsep' xs)@ concatenates all documents @xs@ above each other. If a+-- 'group' undoes the line breaks inserted by @vsep@, the documents are+-- separated with a 'space' instead.+--+-- Using 'vsep' alone yields+--+-- >>> "prefix" <+> vsep ["text", "to", "lay", "out"]+-- prefix text+-- to+-- lay+-- out+--+-- 'group'ing a 'vsep' separates the documents with a 'space' if it fits the+-- page (and does nothing otherwise). See the @'sep'@ convenience function for+-- this use case.+--+-- The 'align' function can be used to align the documents under their first+-- element:+--+-- >>> "prefix" <+> align (vsep ["text", "to", "lay", "out"])+-- prefix text+--        to+--        lay+--        out+--+-- Since 'group'ing a 'vsep' is rather common, 'sep' is a built-in for doing+-- that.+vsep :: [Doc ann] -> Doc ann+vsep = concatWith (\x y -> x <> line <> y)++-- | @('fillSep' xs)@ concatenates the documents @xs@ horizontally with @'<+>'@+-- as long as it fits the page, then inserts a @'line'@ and continues doing that+-- for all documents in @xs@. (@'line'@ means that if 'group'ed, the documents+-- are separated with a 'space' instead of newlines. Use 'fillCat' if you do not+-- want a 'space'.)+--+-- Let's print some words to fill the line:+--+-- >>> let docs = take 20 (cycle ["lorem", "ipsum", "dolor", "sit", "amet"])+-- >>> putDocW 80 ("Docs:" <+> fillSep docs)+-- Docs: lorem ipsum dolor sit amet lorem ipsum dolor sit amet lorem ipsum dolor+-- sit amet lorem ipsum dolor sit amet+--+-- The same document, printed at a width of only 40, yields+--+-- >>> putDocW 40 ("Docs:" <+> fillSep docs)+-- Docs: lorem ipsum dolor sit amet lorem+-- ipsum dolor sit amet lorem ipsum dolor+-- sit amet lorem ipsum dolor sit amet+fillSep :: [Doc ann] -> Doc ann+fillSep = concatWith (\x y -> x <> softline <> y)++-- | @('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.+--+-- >>> let doc = "prefix" <+> sep ["text", "to", "lay", "out"]+-- >>> putDocW 80 doc+-- prefix text to lay out+--+-- With a narrower layout, the entries are separated by newlines:+--+-- >>> putDocW 20 doc+-- prefix text+-- to+-- lay+-- out+--+-- @+-- 'sep' = 'group' . 'vsep'+-- @+sep :: [Doc ann] -> Doc ann+sep = group . vsep++++-- | @('hcat' xs)@ concatenates all documents @xs@ horizontally with @'<>'@+-- (i.e. without any spacing).+--+-- It is provided only for consistency, since it is identical to 'mconcat'.+--+-- >>> let docs = Util.words "lorem ipsum dolor"+-- >>> hcat docs+-- loremipsumdolor+hcat :: [Doc ann] -> Doc ann+hcat = concatWith (<>)++-- | @('vcat' xs)@ vertically concatenates the documents @xs@. If it is+-- 'group'ed, the line breaks are removed.+--+-- In other words @'vcat'@ is like @'vsep'@, with newlines removed instead of+-- replaced by 'space's.+--+-- >>> let docs = Util.words "lorem ipsum dolor"+-- >>> vcat docs+-- lorem+-- ipsum+-- dolor+--+-- Since 'group'ing a 'vcat' is rather common, 'cat' is a built-in shortcut for+-- it.+vcat :: [Doc ann] -> Doc ann+vcat = concatWith (\x y -> x <> line' <> y)++-- | @('fillCat' xs)@ concatenates documents @xs@ horizontally with @'<>'@ as+-- long as it fits the page, then inserts a @'line''@ and continues doing that+-- for all documents in @xs@. This is similar to how an ordinary word processor+-- lays out the text if you just keep typing after you hit the maximum line+-- length.+--+-- (@'line''@ means that if 'group'ed, the documents are separated with nothing+-- instead of newlines. See 'fillSep' if you want a 'space' instead.)+--+-- Observe the difference between 'fillSep' and 'fillCat'. 'fillSep'+-- concatenates the entries 'space'd when 'group'ed,+--+-- >>> let docs = take 20 (cycle (["lorem", "ipsum", "dolor", "sit", "amet"]))+-- >>> putDocW 40 ("Grouped:" <+> group (fillSep docs))+-- Grouped: lorem ipsum dolor sit amet+-- lorem ipsum dolor sit amet lorem ipsum+-- dolor sit amet lorem ipsum dolor sit+-- amet+--+-- On the other hand, 'fillCat' concatenates the entries directly when+-- 'group'ed,+--+-- >>> putDocW 40 ("Grouped:" <+> group (fillCat docs))+-- Grouped: loremipsumdolorsitametlorem+-- ipsumdolorsitametloremipsumdolorsitamet+-- loremipsumdolorsitamet+fillCat :: [Doc ann] -> Doc ann+fillCat = concatWith (\x y -> x <> softline' <> y)++-- | @('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.+--+-- >>> let docs = Util.words "lorem ipsum dolor"+-- >>> putDocW 80 ("Docs:" <+> cat docs)+-- Docs: loremipsumdolor+--+-- When there is enough space, the documents are put above one another,+--+-- >>> putDocW 10 ("Docs:" <+> cat docs)+-- Docs: lorem+-- ipsum+-- dolor+--+-- @+-- 'cat' = 'group' . 'vcat'+-- @+cat :: [Doc ann] -> Doc ann+cat = group . vcat++++-- | @('punctuate' p xs)@ appends @p@ to all but the last document in @xs@.+--+-- >>> let docs = punctuate comma (Util.words "lorem ipsum dolor sit amet")+-- >>> putDocW 80 (hsep docs)+-- lorem, ipsum, dolor, sit, amet+--+-- The separators are put at the end of the entries, which we can see if we+-- position the result vertically:+--+-- >>> putDocW 20 (vsep docs)+-- lorem,+-- ipsum,+-- dolor,+-- sit,+-- amet+--+-- If you want put the commas in front of their elements instead of at the end,+-- you should use 'tupled' or, in general, 'encloseSep'.+punctuate+    :: Doc ann -- ^ Punctuation, e.g. 'comma'+    -> [Doc ann]+    -> [Doc ann]+punctuate p = go+  where+    go []     = []+    go [d]    = [d]+    go (d:ds) = (d <> p) : go ds++++-- | Layout a document depending on which column it starts at. 'align' is+-- implemented in terms of 'column'.+--+-- >>> column (\l -> "Columns are" <+> pretty l <> "-based.")+-- Columns are 0-based.+--+-- >>> let doc = "prefix" <+> column (\l -> "| <- column" <+> pretty l)+-- >>> vsep [indent n doc | n <- [0,4,8]]+-- prefix | <- column 7+--     prefix | <- column 11+--         prefix | <- column 15+column :: (Int -> Doc ann) -> Doc ann+column = Column++-- | Layout a document depending on the current 'nest'ing level. 'align' is+-- implemented in terms of 'nesting'.+--+-- >>> let doc = "prefix" <+> nesting (\l -> brackets ("Nested:" <+> pretty l))+-- >>> vsep [indent n doc | n <- [0,4,8]]+-- prefix [Nested: 0]+--     prefix [Nested: 4]+--         prefix [Nested: 8]+nesting :: (Int -> Doc ann) -> Doc ann+nesting = Nesting++-- | @('width' doc f)@ lays out the document 'doc', and makes the column width+-- of it available to a function.+--+-- >>> let annotate doc = width (brackets doc) (\w -> " <- width:" <+> pretty w)+-- >>> align (vsep (map annotate ["---", "------", indent 3 "---", vsep ["---", indent 4 "---"]]))+-- [---] <- width: 5+-- [------] <- width: 8+-- [   ---] <- width: 8+-- [---+--     ---] <- width: 8+width :: Doc ann -> (Int -> Doc ann) -> Doc ann+width doc f+  = column (\colStart ->+        doc <> column (\colEnd ->+            f (colEnd - colStart)))++-- | Layout a document depending on the page width, if one has been specified.+--+-- >>> let prettyPageWidth (AvailablePerLine l r) = "Width:" <+> pretty l <> ", ribbon fraction:" <+> pretty r+-- >>> let doc = "prefix" <+> pageWidth (brackets . prettyPageWidth)+-- >>> putDocW 32 (vsep [indent n doc | n <- [0,4,8]])+-- prefix [Width: 32, ribbon fraction: 1.0]+--     prefix [Width: 32, ribbon fraction: 1.0]+--         prefix [Width: 32, ribbon fraction: 1.0]+pageWidth :: (PageWidth -> Doc ann) -> Doc ann+pageWidth = WithPageWidth++++-- | @('fill' i x)@ lays out the document @x@. It then appends @space@s until+-- the width is equal to @i@. If the width of @x@ is already larger, nothing is+-- appended.+--+-- This function is quite useful in practice to output a list of bindings:+--+-- >>> let types = [("empty","Doc"), ("nest","Int -> Doc -> Doc"), ("fillSep","[Doc] -> Doc")]+-- >>> let ptype (name, tp) = fill 5 (pretty name) <+> "::" <+> pretty tp+-- >>> "let" <+> align (vcat (map ptype types))+-- let empty :: Doc+--     nest  :: Int -> Doc -> Doc+--     fillSep :: [Doc] -> Doc+fill+    :: Int -- ^ Append spaces until the document is at least this wide+    -> Doc ann+    -> Doc ann+fill n doc = width doc (\w -> spaces (n - w))++-- | @('fillBreak' i x)@ first lays out the document @x@. It then appends @space@s+-- until the width is equal to @i@. If the width of @x@ is already larger than+-- @i@, the nesting level is increased by @i@ and a @line@ is appended. When we+-- redefine @ptype@ in the example given in 'fill' to use @'fillBreak'@, we get+-- a useful variation of the output:+--+-- >>> let types = [("empty","Doc"), ("nest","Int -> Doc -> Doc"), ("fillSep","[Doc] -> Doc")]+-- >>> let ptype (name, tp) = fillBreak 5 (pretty name) <+> "::" <+> pretty tp+-- >>> "let" <+> align (vcat (map ptype types))+-- let empty :: Doc+--     nest  :: Int -> Doc -> Doc+--     fillSep+--           :: [Doc] -> Doc+fillBreak+    :: Int -- ^ Append spaces until the document is at least this wide+    -> Doc ann+    -> Doc ann+fillBreak f x = width x (\w ->+    if w > f+        then nest f line'+        else spaces (f - w))++-- | Insert a number of spaces. Negative values count as 0.+spaces :: Int -> Doc ann+spaces n = unsafeText (T.replicate n " ")++-- $+-- prop> \(NonNegative n) -> length (show (spaces n)) == n+--+-- >>> case spaces 1 of Char ' ' -> True; _ -> False+-- True+--+-- >>> case spaces 0 of Empty -> True; _ -> False+-- True+--+-- prop> \(Positive n) -> case (spaces (-n)) of Empty -> True; _ -> False++++-- | @('plural' n one many)@ is @one@ if @n@ is @1@, and @many@ otherwise. A+-- typical use case is  adding a plural "s".+--+-- >>> let things = [True]+-- >>> let amount = length things+-- >>> "The list has" <+> pretty amount <+> plural "entry" "entries" amount+-- The list has 1 entry+plural+    :: (Num amount, Eq amount)+    => doc -- ^ @1@ case+    -> doc -- ^ other cases+    -> amount+    -> doc+plural one many n+    | n == 1    = one+    | otherwise = many++-- | @('enclose' l r x)@ encloses document @x@ between documents @l@ and @r@+-- using @'<>'@.+--+-- >>> enclose "A" "Z" "·"+-- A·Z+--+-- @+-- 'enclose' l r x = l '<>' x '<>' r+-- @+enclose+    :: Doc ann -- ^ L+    -> Doc ann -- ^ R+    -> Doc ann -- ^ x+    -> Doc ann -- ^ LxR+enclose l r x = l <> x <> r+++-- | @('surround' x l r)@ surrounds document @x@ with @l@ and @r@.+--+-- >>> surround "·" "A" "Z"+-- A·Z+--+-- This is merely an argument reordering of @'enclose'@, but allows for+-- definitions like+--+-- >>> concatWith (surround ".") ["Data", "Text", "Prettyprint", "Doc"]+-- Data.Text.Prettyprint.Doc+surround+    :: Doc ann+    -> Doc ann+    -> Doc ann+    -> Doc ann+surround x l r = l <> x <> r++++-- | >>> 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+-- "Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial" or+-- "Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial" modules.+--+-- This function is only relevant for custom formats with their own annotations,+-- and not relevant for basic prettyprinting. The predefined renderers, e.g.+-- "Data.Text.Prettyprint.Doc.Render.Text", should be enough for the most common+-- needs.+annotate :: ann -> Doc ann -> Doc ann+annotate = Annotated++-- | Remove all annotations.+--+-- Although 'unAnnotate' is idempotent with respect to rendering,+--+-- @+-- 'unAnnotate' . 'unAnnotate' = 'unAnnotate'+-- @+--+-- it should not be used without caution, for each invocation traverses the+-- entire contained document. If possible, it is preferrable to unannotate after+-- 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++    FlatAlt x y     -> FlatAlt (unAnnotate x) (unAnnotate y)+    Cat x y         -> Cat (unAnnotate x) (unAnnotate y)+    Nest i x        -> Nest i (unAnnotate x)+    Union x y       -> Union (unAnnotate x) (unAnnotate y)+    Column f        -> Column (unAnnotate . f)+    WithPageWidth f -> WithPageWidth (unAnnotate . f)+    Nesting f       -> Nesting (unAnnotate . f)+    Annotated _ x   -> unAnnotate x++-- | Change the annotation of a 'Doc'ument.+--+-- 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'.+--+-- Technically 'reAnnotate' makes 'Doc' a 'Functor', but since reannotation is+-- hardly intuitive we omit the instance.+reAnnotate :: (ann -> ann') -> Doc ann -> Doc ann'+reAnnotate re = go+  where+    go = \case+        Fail     -> Fail+        Empty    -> Empty+        Char c   -> Char c+        Text l t -> Text l t+        Line     -> Line++        FlatAlt x y     -> FlatAlt (go x) (go y)+        Cat x y         -> Cat (go x) (go y)+        Nest i x        -> Nest i (go x)+        Union x y       -> Union (go x) (go y)+        Column f        -> Column (go . f)+        WithPageWidth f -> WithPageWidth (go . f)+        Nesting f       -> Nesting (go . f)+        Annotated ann x -> Annotated (re ann) (go x)++-- | Remove all annotations. 'unAnnotate' for 'SimpleDoc'.+unAnnotateS :: SimpleDoc ann -> SimpleDoc xxx+unAnnotateS = go+  where+    go = \case+        SFail           -> SFail+        SEmpty          -> SEmpty+        SChar c rest    -> SChar c (go rest)+        SText l t rest  -> SText l t (go rest)+        SLine l rest    -> SLine l (go rest)+        SAnnPush _ rest -> go rest+        SAnnPop rest    -> go rest++-- | Change the annotation of a document. 'reAnnotate' for 'SimpleDoc'.+reAnnotateS :: (ann -> ann') -> SimpleDoc ann -> SimpleDoc ann'+reAnnotateS f = go+  where+    go = \case+        SFail             -> SFail+        SEmpty            -> SEmpty+        SChar c rest      -> SChar c (go rest)+        SText l t rest    -> SText l t (go rest)+        SLine l rest      -> SLine l (go rest)+        SAnnPush ann rest -> SAnnPush (f ann) (go rest)+        SAnnPop rest      -> SAnnPop (go rest)++++-- | Fusion depth parameter, used by 'fuse'.+data FusionDepth =++    -- | Do not dive deep into nested documents, fusing mostly concatenations of+    -- text nodes together.+    Shallow++    -- | Recurse into all parts of the 'Doc', including different layout+    -- alternatives, and location-sensitive values such as created by 'nesting'+    -- which cannot be fused before, but only during, the layout process. As a+    -- result, the performance cost of using deep fusion is often hard to+    -- predict, and depends on the interplay between page layout and document to+    -- prettyprint.+    --+    -- This value should only be used if profiling shows it is significantly+    -- faster than using 'Shallow'.+    | Deep+    deriving (Eq, Ord, Show)++-- | @('fuse' depth doc)@ combines text nodes so they can be rendered more+-- 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.+--+-- For example+--+-- >>> "a" <> "b" <> pretty 'c' <> "d"+-- abcd+--+-- results in a chain of four entries in a 'SimpleDoc', 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.+--+-- It is therefore a good idea to run 'fuse' on concatenations of lots of small+-- strings that are used many times,+--+-- >>> let oftenUsed = fuse Shallow ("a" <> "b" <> pretty 'c' <> "d")+-- >>> hsep (replicate 5 oftenUsed)+-- abcd abcd abcd abcd abcd+fuse :: FusionDepth -> Doc ann -> Doc ann+fuse depth = go+  where+    go = \case+        Cat Empty x                   -> go x+        Cat x Empty                   -> go x+        Cat (Char c1) (Char c2)       -> Text 2 (T.singleton c1 <> T.singleton c2)+        Cat (Text lt t) (Char c)      -> Text (lt+1) (T.snoc t c)+        Cat (Char c) (Text lt t)      -> Text (1+lt) (T.cons c t)+        Cat (Text l1 t1) (Text l2 t2) -> Text (l1+l2) (t1 <> t2)++        Cat x@Char{} (Cat y@Char{} z) -> go (Cat (go (Cat x y)) z)+        Cat x@Text{} (Cat y@Char{} z) -> go (Cat (go (Cat x y)) z)+        Cat x@Char{} (Cat y@Text{} z) -> go (Cat (go (Cat x y)) z)+        Cat x@Text{} (Cat y@Text{} z) -> go (Cat (go (Cat x y)) z)++        Cat (Cat x y@Char{}) z -> go (Cat x (go (Cat y z)))+        Cat (Cat x y@Text{}) z -> go (Cat x (go (Cat y z)))++        Cat x y -> Cat (go x) (go y)++        Nest i (Nest j x) -> let !fused = Nest (i+j) x+                             in go fused+        Nest _ x@Empty{} -> x+        Nest _ x@Text{}  -> x+        Nest _ x@Char{}  -> x+        Nest 0 x         -> go x+        Nest i x         -> Nest i (go x)++        Annotated _ Empty -> Empty++        FlatAlt x1 x2 -> FlatAlt (go x1) (go x2)+        Union x1 x2   -> Union (go x1) (go x2)++        other | depth == Shallow -> other++        Column f        -> Column (go . f)+        WithPageWidth f -> WithPageWidth (go . f)+        Nesting f       -> Nesting (go . f)++        other -> other++-- | Decide whether a 'SimpleDoc' 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)++-- | List of nesting level/document pairs yet to be laid out.+data LayoutPipeline ann =+      Nil+    | Cons !Int (Doc ann) (LayoutPipeline ann)+    | UndoAnn (LayoutPipeline ann)++-- | Maximum number of characters that fit in one line. The layout algorithms+-- will try not to exceed the set limit by inserting line breaks when applicable+-- (e.g. via 'softline'').+data PageWidth++    = AvailablePerLine Int Double+    -- ^ Layouters should not exceed the specified space per line.+    --+    --   - The 'Int' is the number of characters, including whitespace, that+    --     fit in a line. A typical value is 80.+    --+    --   - The 'Double' is the ribbon with, i.e. the fraction of the total+    --     page width that can be printed on. This allows limiting the length+    --     of printable text per line. Values must be between 0 and 1, and+    --     0.4 to 1 is typical.++    | Unbounded+    -- ^ Layouters should not introduce line breaks on their own.++    deriving (Eq, Ord, Show)++-- $ Test to avoid surprising behaviour+-- >>> Unbounded > AvailablePerLine maxBound 1+-- True++-- | Options to influence the layout algorithms.+newtype LayoutOptions = LayoutOptions { layoutPageWidth :: PageWidth }+    deriving (Eq, Ord, Show)++-- | The default layout options, suitable when you just want some output, and+-- don’t particularly care about the details. Used by the 'Show' instance, for+-- example.+--+-- >>> defaultLayoutOptions+-- LayoutOptions {layoutPageWidth = AvailablePerLine 80 0.4}+defaultLayoutOptions :: LayoutOptions+defaultLayoutOptions = LayoutOptions { layoutPageWidth = AvailablePerLine 80 0.4 }++-- | This is the default layout algorithm, and it is used by 'show', 'putDoc'+-- 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.+layoutPretty+    :: LayoutOptions+    -> Doc ann+    -> SimpleDoc ann+layoutPretty = layoutFits 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+           -> Bool+        go Nothing _               = True+        go (Just w) _ | w < 0      = False+        go _ SFail                 = False+        go _ SEmpty                = True+        go (Just w) (SChar _ x)    = go (Just (w - 1)) x+        go (Just w) (SText l _t x) = go (Just (w - l)) x+        go _ SLine{}               = True+        go (Just w) (SAnnPush _ x) = go (Just w) x+        go (Just w) (SAnnPop x)    = go (Just w) x++-- | A layout algorithm with more lookahead than 'layoutPretty', that introduces+-- line breaks earlier if the content does not (or will not, rather) fit into+-- one line.+--+-- Considre the following python-ish document,+--+-- >>> let fun x = hang 2 ("fun(" <> softline' <> x) <> ")"+-- >>> let doc = (fun . fun . fun . fun . fun) (list ["abcdef", "ghijklm"])+--+-- which we’ll be rendering using the following pipeline (where the layout+-- algorithm has been left open),+--+-- >>> import Data.Text.IO as T+-- >>> import Data.Text.Prettyprint.Doc.Render.Text+-- >>> let hr = pipe <> pretty (replicate (26-2) '-') <> pipe+-- >>> let go layouter x = (T.putStrLn . renderStrict . layouter (LayoutOptions (AvailablePerLine 26 1))) (vsep [hr, x, hr])+--+-- If we render this using @'layoutPretty'@ with a page width of 26 characters+-- per line, all the @fun@ calls fit into the first line so they will be put+-- there,+--+-- >>> go layoutPretty doc+-- |------------------------|+-- fun(fun(fun(fun(fun(+--                   [ abcdef+--                   , ghijklm ])))))+-- |------------------------|+--+-- Note that this exceeds the desired 26 character page width. The same+-- document, rendered with @'layoutSmart'@, fits the layout contstraints:+--+-- >>> go layoutSmart doc+-- |------------------------|+-- fun(+--   fun(+--     fun(+--       fun(+--         fun(+--           [ abcdef+--           , ghijklm ])))))+-- |------------------------|+--+-- The key difference between @'layoutPretty'@ and @'layoutSmart'@ is that the+-- latter will check the potential document up to the end of the current+-- indentation level, instead of just having one element lookahead.+layoutSmart+    :: LayoutOptions+    -> Doc ann+    -> SimpleDoc ann+layoutSmart = layoutFits fitsR+  where+    -- @fitsR@ has a little more lookahead: assuming that nesting roughly+    -- corresponds to syntactic depth, @fitsR@ checks that not only the current+    -- line fits, but the entire syntactic structure being formatted at this+    -- level of indentation fits. If we were to remove the second case for+    -- @SLine@, we would check that not only the current structure fits, but+    -- also the rest of the document, which would be slightly more intelligent+    -- but would have exponential runtime (and is prohibitively expensive in+    -- practice).+    fitsR :: FittingPredicate ann+    fitsR = FP go+      where+        go :: PageWidth+           -> Int       -- ^ Minimum nesting level to fit in+           -> Maybe Int -- ^ Width in which to fit the first line+           -> SimpleDoc ann+           -> Bool+        go _ _ Nothing _                        = False+        go _ _ (Just w) _ | w < 0               = False+        go _ _ _ SFail                          = False+        go _ _ _ SEmpty                         = True+        go pw m (Just w) (SChar _ x)            = go pw m (Just (w - 1)) x+        go pw m (Just w) (SText l _t x)         = go pw m (Just (w - l)) x+        go pw m _ (SLine i x)+          | m < i, AvailablePerLine cpl _ <- pw = go pw m (Just (cpl - i)) x+          | otherwise                           = True+        go pw m w (SAnnPush _ x)                = go pw m w x+        go pw m w (SAnnPop x)                   = go pw m w x++++layoutFits+    :: forall ann. FittingPredicate ann+    -> LayoutOptions+    -> Doc ann+    -> SimpleDoc ann+layoutFits+    fittingPredicate+    LayoutOptions { layoutPageWidth = pWidth }+    doc+  = best 0 0 (Cons 0 doc Nil)+  where++    -- * current column >= current nesting level+    -- * current column - current indentaion = number of chars inserted in line+    best+        :: Int -- Current nesting level+        -> Int -- Current column, i.e. "where the cursor is"+        -> LayoutPipeline ann -- Documents remaining to be handled (in order)+        -> SimpleDoc ann+    best !_ !_ Nil           = SEmpty+    best nl cc (UndoAnn ds)  = SAnnPop (best nl cc ds)+    best nl cc (Cons i d ds) = case d of+        Fail            -> SFail+        Empty           -> best nl cc ds+        Char c          -> let !cc' = cc+1 in SChar c (best nl cc' ds)+        Text l t        -> let !cc' = cc+l in SText l t (best nl cc' ds)+        Line            -> SLine i (best i i ds)+        FlatAlt x _     -> best nl cc (Cons i x ds)+        Cat x y         -> best nl cc (Cons i x (Cons i y ds))+        Nest j x        -> let !ij = i+j in best nl cc (Cons ij x ds)+        Union x y       -> let x' = best nl cc (Cons i x ds)+                               y' = best nl cc (Cons i y ds)+                           in selectNicer fittingPredicate nl cc x' y'+        Column f        -> best nl cc (Cons i (f cc) ds)+        WithPageWidth f -> best nl cc (Cons i (f pWidth) ds)+        Nesting f       -> best nl cc (Cons i (f i) ds)+        Annotated ann x -> SAnnPush ann (best nl cc (Cons i x (UndoAnn ds)))++    selectNicer+        :: 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.+    selectNicer (FP fits) lineIndent currentColumn x y+      | fits pWidth minNestingLevel availableWidth x = x+      | otherwise = y+      where+        minNestingLevel = min lineIndent currentColumn+        ribbonWidth = case pWidth of+            AvailablePerLine lineLength ribbonFraction ->+                (Just . max 0 . min lineLength . round)+                    (fromIntegral lineLength * ribbonFraction)+            Unbounded -> Nothing+        availableWidth = do+            columnsLeftInLine <- case pWidth of+                AvailablePerLine cpl _ribbonFrac -> Just (cpl - currentColumn)+                Unbounded -> Nothing+            columnsLeftInRibbon <- do+                li <- Just lineIndent+                rw <- ribbonWidth+                cc <- Just currentColumn+                Just (li + rw - cc)+            Just (min columnsLeftInLine columnsLeftInRibbon)++-- | @(layoutCompact x)@ lays out the document @x@ without adding any+-- indentation. Since no \'pretty\' printing is involved, this layouter is very+-- fast. The resulting output contains fewer characters than a prettyprinted+-- version and can be used for output that is read by other programs.+--+-- This layout function does not add any colorisation information.+--+-- >>> let doc = hang 4 (vsep ["lorem", "ipsum", hang 4 (vsep ["dolor", "sit"])])+-- >>> doc+-- lorem+--     ipsum+--     dolor+--         sit+--+-- >>> let putDocCompact = renderIO System.IO.stdout . layoutCompact+-- >>> putDocCompact doc+-- lorem+-- ipsum+-- dolor+-- sit+layoutCompact :: Doc ann -> SimpleDoc ann+layoutCompact doc = scan 0 [doc]+  where+    scan _ [] = SEmpty+    scan !k (d:ds) = case d of+        Fail            -> SFail+        Empty           -> scan k ds+        Char c          -> SChar c (scan (k+1) ds)+        Text l t        -> let !k' = k+l in SText l t (scan k' ds)+        FlatAlt x _     -> scan k (x:ds)+        Line            -> SLine 0 (scan 0 ds)+        Cat x y         -> scan k (x:y:ds)+        Nest _ x        -> scan k (x:ds)+        Union _ y       -> scan k (y:ds)+        Column f        -> scan k (f k:ds)+        WithPageWidth f -> scan k (f Unbounded : ds)+        Nesting f       -> scan k (f 0 : ds)+        Annotated _ x   -> scan k (x:ds)++-- | @('show' doc)@ prettyprints document @doc@ with 'defaultLayoutOptions',+-- ignoring all annotations.+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.+--+-- @+-- instance 'Show' MyType where+--     'showsPrec' _ = 'renderShowS' . 'layoutPretty' 'defaultLayoutOptions' . 'pretty'+-- @+renderShowS :: SimpleDoc ann -> ShowS+renderShowS = \case+    SFail        -> panicUncaughtFail+    SEmpty       -> id+    SChar c x    -> showChar c . renderShowS x+    SText _l t x -> showString (T.unpack t) . renderShowS x+    SLine i x    -> showString ('\n' : replicate i ' ') . renderShowS x+    SAnnPush _ x -> renderShowS x+    SAnnPop x    -> renderShowS x
+ src/Data/Text/Prettyprint/Doc/Internal/Type.hs view
@@ -0,0 +1,12 @@+-- | __Internal module with stability guarantees__+--+-- This module exposes the internals of the @'Doc'@ type so other libraries can+-- write adaptors to/from it. For all other uses, please use only the API+-- provided by non-internal modules.+--+-- Although this module is internal, it follows the usual package versioning+-- policy, AKA Haskell’s version of semantic versioning. In other words, this+-- module is as stable as the public API.+module Data.Text.Prettyprint.Doc.Internal.Type (Doc(..)) where++import Data.Text.Prettyprint.Doc.Internal
+ src/Data/Text/Prettyprint/Doc/Render/ShowS.hs view
@@ -0,0 +1,5 @@+module Data.Text.Prettyprint.Doc.Render.ShowS (+    renderShowS+) where++import Data.Text.Prettyprint.Doc.Internal
+ src/Data/Text/Prettyprint/Doc/Render/Text.hs view
@@ -0,0 +1,107 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}++#include "version-compatibility-macros.h"++-- | Render an unannotated 'SimpleDoc' as plain 'Text'.+module Data.Text.Prettyprint.Doc.Render.Text (+    -- * Conversion to plain 'Text'+    renderLazy, renderStrict,++    -- * Render to a 'Handle'+    renderIO,++    -- ** Convenience functions+    putDoc, hPutDoc+) where++++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++#if !(SEMIGROUP_IN_BASE)+import Data.Semigroup+#endif++-- $setup+--+-- (Definitions for the doctests)+--+-- >>> :set -XOverloadedStrings+-- >>> import qualified Data.Text.IO as T+-- >>> import qualified Data.Text.Lazy.IO as TL++++-- | @('renderLazy' sdoc)@ takes the output @sdoc@ from a rendering function+-- and transforms it to lazy text.+--+-- >>> let render = TL.putStrLn . renderLazy . layoutPretty defaultLayoutOptions+-- >>> let doc = "lorem" <+> align (vsep ["ipsum dolor", parens "foo bar", "sit amet"])+-- >>> render doc+-- 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' sdoc)@ takes the output @sdoc@ from a rendering and+-- transforms it to strict text.+renderStrict :: SimpleDoc ann -> Text+renderStrict = TL.toStrict . renderLazy++++-- | @('renderIO' h sdoc)@ writes @sdoc@ to the file @h@.+--+-- >>> renderIO System.IO.stdout (layoutPretty defaultLayoutOptions "hello\nworld")+-- hello+-- world+renderIO :: Handle -> SimpleDoc ann -> IO ()+renderIO h sdoc = TL.hPutStrLn h (renderLazy sdoc)++-- | @('putDoc' doc)@ prettyprints document @doc@ to standard output. Uses the+-- 'defaultLayoutOptions'.+--+-- >>> putDoc ("hello" <+> "world")+-- hello world+--+-- @+-- 'putDoc' = 'hPutDoc' 'stdout'+-- @+putDoc :: Doc ann -> IO ()+putDoc = hPutDoc stdout++-- | Like 'putDoc', but instead of using 'stdout', print to a user-provided+-- handle, e.g. a file or a socket. Uses the 'defaultLayoutOptions'.+--+-- @+-- main = 'withFile' filename (\h -> 'hPutDoc' h doc)+--   where+--     doc = 'vcat' ["vertical", "text"]+--     filename = "someFile.txt"+-- @+--+-- @+-- 'hPutDoc' h doc = 'renderIO' h ('layoutPretty' 'defaultLayoutOptions' doc)+-- @+hPutDoc :: Handle -> Doc ann -> IO ()+hPutDoc h doc = renderIO h (layoutPretty defaultLayoutOptions doc)
+ src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs view
@@ -0,0 +1,159 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}++#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+-- "Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial".+--+-- Rendering to ANSI terminal with colors is an important use case for stack+-- machine based rendering.+--+-- The module is written to be readable top-to-bottom in both Haddock and raw+-- source form.+module Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial (+    module Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial+) where++++import qualified Data.Text              as T+import qualified Data.Text.Lazy         as TL+import qualified Data.Text.Lazy.Builder as TLB++import Data.Text.Prettyprint.Doc+import Data.Text.Prettyprint.Doc.Render.Util.Panic+import Data.Text.Prettyprint.Doc.Render.Util.StackMachine++#if !(APPLICATIVE_MONAD)+import Control.Applicative+#endif++++-- $standalone-text+--+-- = The type of available markup+--+-- First, we define a set of valid annotations must be defined, with the goal of+-- defining a @'Doc' 'SimpleHtml'@. We will later define how to convert this to+-- the output format ('TL.Text').++data SimpleHtml = Bold | Italics | Color Color | Paragraph | Headline+data Color = Red | Green | Blue++++-- $standalone-text+--+-- == Conveinence definitions++bold, italics, paragraph, headline :: Doc SimpleHtml -> Doc SimpleHtml+bold = annotate Bold+italics = annotate Italics+paragraph = annotate Paragraph+headline = annotate Headline++color :: Color -> Doc SimpleHtml -> Doc SimpleHtml+color c = annotate (Color c)++++-- $standalone-text+--+-- = 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+-- final 'TL.Text' representation.++-- | 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.+--+-- 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 = \case+    SFail -> panicUncaughtFail+    SEmpty -> pure ()+    SChar c x -> do+        writeOutput (TLB.singleton c)+        renderStackMachine x+    SText _l t x -> do+        writeOutput (TLB.fromText t)+        renderStackMachine x+    SLine i x -> do+        writeOutput (TLB.singleton '\n' )+        writeOutput (TLB.fromText (T.replicate i " "))+        renderStackMachine x+    SAnnPush s x -> do+        pushStyle s+        writeOutput (fst (htmlTag s))+        renderStackMachine x+    SAnnPop x -> do+        s <- unsafePopStyle+        writeOutput (snd (htmlTag s))+        renderStackMachine x++-- | Convert a 'SimpleHtml' annotation to a pair of opening and closing tags.+-- This is where the translation of style to raw output happens.+htmlTag :: SimpleHtml -> (TLB.Builder, TLB.Builder)+htmlTag = \case+    Bold      -> ("<strong>", "</strong>")+    Italics   -> ("<em>", "</em>")+    Color c   -> ("<span style=\"color: " <> hexCode c <> "\">", "</span>")+    Paragraph -> ("<p>", "</p>")+    Headline  -> ("<h1>", "</h1>")+  where+    hexCode :: Color -> TLB.Builder+    hexCode = \case+        Red   -> "#f00"+        Green -> "#0f0"+        Blue  -> "#00f"++-- | We can now wrap our stack machine definition from 'renderStackMachine' in a+-- nicer interface; on successful conversion, we run the builder to give us the+-- final 'TL.Text', and before we do that we check that the style stack is empty+-- (i.e. there are no unmatched style applications) after the machine is run.+--+-- This function does only a bit of plumbing around 'renderStackMachine', and is+-- 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 doc+  = let (resultBuilder, remainingStyles) = execStackMachine [] (renderStackMachine doc)+    in if null remainingStyles+        then TLB.toLazyText resultBuilder+        else error ("There are "+                    <> show (length remainingStyles)+                    <> " unpaired styles! Please report this as a bug.")++-- $standalone-text+--+-- = Example invocation+--+-- We can now render an example document using our definitions:+--+-- >>> :set -XOverloadedStrings+-- >>> import qualified Data.Text.Lazy.IO as TL+-- >>> :{+-- >>> let go = TL.putStrLn . render . layoutPretty defaultLayoutOptions+-- >>> in go (vsep+-- >>>     [ headline "Example document"+-- >>>     , paragraph ("This is a" <+> color Red "paragraph" <> comma)+-- >>>     , paragraph ("and" <+> bold "this text is bold.")+-- >>>     ])+-- >>> :}+-- <h1>Example document</h1>+-- <p>This is a <span style="color: #f00">paragraph</span>,</p>+-- <p>and <strong>this text is bold.</strong></p>
+ src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs view
@@ -0,0 +1,128 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}++#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+-- may be more suitable for certain output formats, see+-- "Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial".+--+-- Rendering to HTML, particularly using libraries such as blaze-html or lucid,+-- is one important use case of tree-based rendering.+--+-- The module is written to be readable top-to-bottom in both Haddock and raw+-- source form.+module Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial (+    module Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial+) where++++import           Data.Semigroup+import qualified Data.Text              as T+import qualified Data.Text.Lazy         as TL+import qualified Data.Text.Lazy.Builder as TLB++import Data.Text.Prettyprint.Doc+import Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree++#if !(FOLDABLE_TRAVERSABLE_IN_PRELUDE)+import Data.Foldable (foldMap)+#endif++++-- $standalone-text+--+-- = The type of available markup+--+-- First, we define a set of valid annotations must be defined, with the goal of+-- defining a @'Doc' 'SimpleHtml'@. We will later define how to convert this to+-- the output format ('TL.Text').++data SimpleHtml = Bold | Italics | Color Color | Paragraph | Headline+data Color = Red | Green | Blue++++-- $standalone-text+--+-- == Conveinence definitions++bold, italics, paragraph, headline :: Doc SimpleHtml -> Doc SimpleHtml+bold = annotate Bold+italics = annotate Italics+paragraph = annotate Paragraph+headline = annotate Headline++color :: Color -> Doc SimpleHtml -> Doc SimpleHtml+color c = annotate (Color c)+++-- = 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.++-- | To render the HTML, we first convert the 'SimpleDoc' 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 = TLB.toLazyText . renderTree . treeForm++-- | Render a 'SimpleDocTree' to a 'TLB.Builder'; this is the workhorse of the+-- tree-based rendering approach, and equivalent to+-- 'Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial.renderStackMachine'+-- in the stack machine rendering tutorial.+renderTree :: SimpleDocTree SimpleHtml -> TLB.Builder+renderTree = \case+    STEmpty -> mempty+    STChar c -> TLB.singleton c+    STText _ t -> TLB.fromText t+    STLine i -> "\n" <> TLB.fromText (T.replicate i " ")+    STAnn ann content -> encloseInTagFor ann (renderTree content)+    STConcat contents -> foldMap renderTree contents++-- | Convert a 'SimpleHtml' to a function that encloses a 'TLB.Builder' in HTML+-- tags. This is where the translation of style to raw output happens.+encloseInTagFor :: SimpleHtml -> TLB.Builder -> TLB.Builder+encloseInTagFor = \case+    Bold      -> \x -> "<strong>" <> x <> "</strong>"+    Italics   -> \x -> "<em>" <> x <> "</em>"+    Color c   -> \x -> "<span style=\"color: " <> hexCode c <> "\">" <> x <> "</span>"+    Paragraph -> \x -> "<p>" <> x <> "</p>"+    Headline  -> \x -> "<h1>" <> x <> "</h1>"+  where+    hexCode :: Color -> TLB.Builder+    hexCode = \case+        Red   -> "#f00"+        Green -> "#0f0"+        Blue  -> "#00f"++-- $standalone-text+--+-- = Example invocation+--+-- We can now render an example document using our definitions:+--+-- >>> :set -XOverloadedStrings+-- >>> import qualified Data.Text.Lazy.IO as TL+-- >>> :{+-- >>> let go = TL.putStrLn . render . layoutPretty defaultLayoutOptions+-- >>> in go (vsep+-- >>>     [ headline "Example document"+-- >>>     , paragraph ("This is a" <+> color Red "paragraph" <> comma)+-- >>>     , paragraph ("and" <+> bold "this text is bold.")+-- >>>     ])+-- >>> :}+-- <h1>Example document</h1>+-- <p>This is a <span style="color: #f00">paragraph</span>,</p>+-- <p>and <strong>this text is bold.</strong></p>
+ src/Data/Text/Prettyprint/Doc/Render/Util/Panic.hs view
@@ -0,0 +1,31 @@+module Data.Text.Prettyprint.Doc.Render.Util.Panic (+    panicUncaughtFail,+    panicUnpairedPop,+    panicSimpleDocTreeConversionFailed,+    panicInputNotFullyConsumed,+) where++-- | Raise a hard 'error' if there is a 'Data.Text.Prettyprint.Doc.SFail' in a+-- 'Data.Text.Prettyprint.Doc.SimpleDoc'.+panicUncaughtFail :: a+panicUncaughtFail = error ("»SFail« must not appear in a rendered »SimpleDoc«. This is a bug in the layout algorithm! " ++ report)++-- | Raise a hard 'error' when an annotation terminator is encountered in an+-- unannotated region.+panicUnpairedPop :: a+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.Render.Util.SimpleDocTree.SimpleDocTree' conversion fails.+panicSimpleDocTreeConversionFailed :: a+panicSimpleDocTreeConversionFailed = error ("Conversion from SimpleDoc 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)++report :: String+report = "Please report this as a bug"
+ src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs view
@@ -0,0 +1,156 @@+{-# LANGUAGE CPP        #-}+{-# LANGUAGE LambdaCase #-}++#include "version-compatibility-macros.h"++-- | Conversion of the linked-list-like 'SimpleDoc' to a tree-like+-- 'SimpleDocTree'.+module Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree (+    SimpleDocTree(..),+    treeForm,++    unAnnotateST,+    reAnnotateST,+) where++++import Control.Applicative+import Data.Text           (Text)++import Data.Text.Prettyprint.Doc+import Data.Text.Prettyprint.Doc.Render.Util.Panic++#if MONAD_FAIL+import Control.Monad.Fail+#endif++++-- | A type for parsers of unique results. Token stream »s«, results »a«.+--+-- Hand-written to avoid a dependency on a parser lib.+newtype UniqueParser s a = UniqueParser { runParser :: s -> Maybe (a, s) }++instance Functor (UniqueParser s) where+    fmap f (UniqueParser mx) = UniqueParser (\s ->+        fmap (\(x,s') -> (f x, s')) (mx s))++instance Applicative (UniqueParser s) where+    pure x = UniqueParser (\rest -> Just (x, rest))+    UniqueParser mf <*> UniqueParser mx = UniqueParser (\s -> do+        (f, s') <- mf s+        (x, s'') <- mx s'+        pure (f x, s'') )++instance Monad (UniqueParser s) where+#if !(APPLICATIVE_MONAD)+    return = pure+#endif+    UniqueParser p >>= f = UniqueParser (\s -> do+        (a', s') <- p s+        (a'', s'') <- runParser (f a') s'+        pure (a'', s'') )++    fail _err = empty++#if MONAD_FAIL+instance MonadFail (UniqueParser s) where+    fail _err = empty+#endif++instance Alternative (UniqueParser s) where+    empty = UniqueParser (const empty)+    UniqueParser p <|> UniqueParser q = UniqueParser (\s -> p s <|> q s)++data SimpleDocTok ann+    = TokEmpty+    | TokChar Char+    | TokText !Int Text+    | TokLine Int+    | TokAnnPush ann+    | 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.+data SimpleDocTree ann+    = STEmpty+    | STChar Char+    | STText !Int Text+    | STLine !Int+    | STAnn ann (SimpleDocTree ann)+    | STConcat [SimpleDocTree ann]+    deriving (Eq, Ord, Show)++-- | Get the next token, consuming it in the process.+nextToken :: UniqueParser (SimpleDoc ann) (SimpleDocTok ann)+nextToken = UniqueParser (\case+    SFail             -> panicUncaughtFail+    SEmpty            -> empty+    SChar c rest      -> Just (TokChar c      , rest)+    SText l t rest    -> Just (TokText l t    , rest)+    SLine i rest      -> Just (TokLine i      , rest)+    SAnnPush ann rest -> Just (TokAnnPush ann , rest)+    SAnnPop rest      -> Just (TokAnnPop      , rest) )++sdocToTreeParser :: UniqueParser (SimpleDoc ann) (SimpleDocTree ann)+sdocToTreeParser = fmap wrap (many contentPiece)++  where++    wrap :: [SimpleDocTree ann] -> SimpleDocTree ann+    wrap = \case+        []  -> STEmpty+        [x] -> x+        xs  -> STConcat xs++    contentPiece = nextToken >>= \case+        TokEmpty       -> pure STEmpty+        TokChar c      -> pure (STChar c)+        TokText l t    -> pure (STText l t)+        TokLine i      -> pure (STLine i)+        TokAnnPop      -> empty+        TokAnnPush ann -> do annotatedContents <- sdocToTreeParser+                             TokAnnPop <- nextToken+                             pure (STAnn ann annotatedContents)++-- | Convert a 'SimpleDoc' to its 'SimpleDocTree' representation.+treeForm :: SimpleDoc ann -> SimpleDocTree ann+treeForm sdoc = case runParser sdocToTreeParser sdoc of+    Nothing               -> panicSimpleDocTreeConversionFailed+    Just (sdoct, SEmpty)  -> sdoct+    Just (_, _unconsumed) -> panicInputNotFullyConsumed++-- $+--+-- >>> :set -XOverloadedStrings+-- >>> treeForm (layoutPretty defaultLayoutOptions ("lorem" <+> "ipsum" <+> annotate True ("TRUE" <+> annotate False "FALSE") <+> "dolor"))+-- STConcat [STText 5 "lorem",STChar ' ',STText 5 "ipsum",STChar ' ',STAnn True (STConcat [STText 4 "TRUE",STChar ' ',STAnn False (STText 5 "FALSE")]),STChar ' ',STText 5 "dolor"]++-- | Remove all annotations. 'unAnnotate' for 'SimpleDocTree'.+unAnnotateST :: SimpleDocTree ann -> SimpleDocTree xxx+unAnnotateST = \case+    STEmpty      -> STEmpty+    STChar c     -> STChar c+    STText l t   -> STText l t+    STLine i     -> STLine i+    STAnn _ rest -> unAnnotateST rest+    STConcat xs  -> STConcat (map unAnnotateST xs)++-- | Change the annotation of a document. 'reAnnotate' for 'SimpleDocTree'.+reAnnotateST :: (ann -> ann') -> SimpleDocTree ann -> SimpleDocTree ann'+reAnnotateST f = go+  where+    go = \case+        STEmpty        -> STEmpty+        STChar c       -> STChar c+        STText l t     -> STText l t+        STLine i       -> STLine i+        STAnn ann rest -> STAnn (f ann) (go rest)+        STConcat xs    -> STConcat (map go xs)
+ src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs view
@@ -0,0 +1,86 @@+{-# LANGUAGE BangPatterns      #-}+{-# LANGUAGE CPP               #-}+{-# LANGUAGE LambdaCase        #-}+{-# LANGUAGE OverloadedStrings #-}++#include "version-compatibility-macros.h"++-- | A strict State/Writer monad to implement a stack machine for rendering+-- 'SimpleDoc's.+module Data.Text.Prettyprint.Doc.Render.Util.StackMachine (+    StackMachine,+    execStackMachine,++    pushStyle,+    unsafePopStyle,+    unsafePeekStyle,+    writeOutput,+) where++++import Data.Monoid++#if !(APPLICATIVE_MONAD)+import Control.Applicative+#endif++++-- | @WriterT output StateT [style] a@, but with a strict Writer value.+--+-- The @output@ type is used to append data chunks to, the @style@ is the member+-- of a stack of styles to model nested styles with.+newtype StackMachine output style a = StackMachine ([style] -> (a, output, [style]))++instance Functor (StackMachine output style) where+    fmap f (StackMachine r) = StackMachine (\s ->+        let (x1, w1, s1) = r s+        in (f x1, w1, s1))++instance Monoid output => Applicative (StackMachine output style) where+    pure x = StackMachine (\s -> (x, mempty, s))+    StackMachine f <*> StackMachine x = StackMachine (\s ->+        let (f1, w1, s1) = f s+            (x2, w2, s2) = x s1+            !w12 = w1 <> w2+        in (f1 x2, w12, s2))++instance Monoid output => Monad (StackMachine output style) where+#if !(APPLICATIVE_MONAD)+    return = pure+#endif+    StackMachine r >>= f = StackMachine (\s ->+        let (x1, w1, s1) = r s+            StackMachine r1 = f x1+            (x2, w2, s2) = r1 s1+            !w12 = w1 <> w2+        in (x2, w12, s2))++-- | Add a new style to the style stack.+pushStyle :: Monoid output => style -> StackMachine output style ()+pushStyle style = StackMachine (\styles -> ((), mempty, style : styles))++-- | Get the topmost style.+--+-- If the stack is empty, this raises an 'error'.+unsafePopStyle :: Monoid output => StackMachine output style style+unsafePopStyle = StackMachine (\case+    x:xs -> (x, mempty, xs)+    [] -> error "Popped an empty style stack! Please report this as a bug.")++-- | View the topmost style, but do not modify the stack.+--+-- If the stack is empty, this raises an 'error'.+unsafePeekStyle :: Monoid output => StackMachine output style style+unsafePeekStyle = StackMachine (\styles -> case styles of+    x:_ -> (x, mempty, styles)+    [] -> error "Peeked an empty style stack! Please report this as a bug.")++-- | Append a value to the output end.+writeOutput :: output -> StackMachine output style ()+writeOutput w = StackMachine (\styles -> ((), w, styles))++-- | Run the renderer and retrive the writing end+execStackMachine :: [styles] -> StackMachine output styles a -> (output, [styles])+execStackMachine styles (StackMachine r) = let (_, w, s) = r styles in (w, s)
+ src/Data/Text/Prettyprint/Doc/Util.hs view
@@ -0,0 +1,63 @@+-- | Frequently useful definitions for working with general prettyprinters.+module Data.Text.Prettyprint.Doc.Util (+    module Data.Text.Prettyprint.Doc.Util+) where++++import           Data.Text                             (Text)+import qualified Data.Text                             as T+import           Data.Text.Prettyprint.Doc.Render.Text+import           Prelude                               hiding (words)+import           System.IO++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"))+-- (Lorem, ipsum, dolor)+words :: Text -> [Doc ann]+words = map pretty . T.words++-- | Insert soft linebreaks between words, so that text is broken into multiple+-- lines when it exceeds the available width.+--+-- >>> putDocW 32 (reflow "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.")+-- Lorem ipsum dolor sit amet,+-- consectetur adipisicing elit,+-- sed do eiusmod tempor incididunt+-- ut labore et dolore magna+-- aliqua.+--+-- @+-- 'reflow' = 'fillSep' . 'words'+-- @+reflow :: Text -> Doc ann+reflow = fillSep . words++-- | Render a document with a certain width. Useful for quick-and-dirty testing+-- of layout behaviour. Used heavily in the doctests of this package, for+-- example.+--+-- >>> let doc = reflow "Lorem ipsum dolor sit amet, consectetur adipisicing elit"+-- >>> putDocW 20 doc+-- Lorem ipsum dolor+-- sit amet,+-- consectetur+-- adipisicing elit+-- >>> putDocW 30 doc+-- Lorem ipsum dolor sit amet,+-- consectetur adipisicing elit+putDocW :: Int -> Doc ann -> IO ()+putDocW w doc = renderIO System.IO.stdout (layoutPretty layoutOptions (unAnnotate doc))+  where+    layoutOptions = LayoutOptions { layoutPageWidth = AvailablePerLine w 1 }
+ test/Doctest/Main.hs view
@@ -0,0 +1,6 @@+module Main (main) where++import Test.DocTest++main :: IO ()+main = doctest [ "src" , "-Imisc"]
+ test/Testsuite/Main.hs view
@@ -0,0 +1,141 @@+{-# LANGUAGE CPP               #-}+{-# LANGUAGE OverloadedStrings #-}++#include "version-compatibility-macros.h"++module Main (main) where++++import qualified Data.ByteString.Lazy  as BSL+import qualified Data.Text             as T+import           Data.Text.PgpWordlist+import           Data.Word++import Data.Text.Prettyprint.Doc+import Data.Text.Prettyprint.Doc.Render.Text++import Test.Tasty+import Test.Tasty.QuickCheck++#if !(APPLICATIVE_MONAD)+import Control.Applicative+#endif+#if !(MONOID_IN_PRELUDE)+import Data.Monoid (mconcat)+#endif++++main :: IO ()+main = defaultMain tests++tests :: TestTree+tests = testGroup "Fusion"+    [ testProperty "Shallow fusion does not change rendering"+                   (fusionDoesNotChangeRendering Shallow)+    , testProperty "Deep fusion does not change rendering"+                   (fusionDoesNotChangeRendering Deep)+    ]++fusionDoesNotChangeRendering :: FusionDepth -> Property+fusionDoesNotChangeRendering depth+  = forAll document (\doc ->+        let rendered = render doc+            renderedFused = render (fuse depth doc)+        in counterexample (mkCounterexample rendered renderedFused)+                          (render doc == render (fuse depth doc)) )+  where+    render = renderStrict . layoutPretty defaultLayoutOptions+    mkCounterexample rendered renderedFused+      = (T.unpack . render . vsep)+            [ "Unfused and fused documents render differently!"+            , "Unfused:"+            , indent 4 (pretty rendered)+            , "Fused:"+            , indent 4 (pretty renderedFused) ]++newtype RandomDoc ann = RandomDoc (Doc ann)++instance Arbitrary (RandomDoc ann) where+    arbitrary = fmap RandomDoc document++document :: Gen (Doc ann)+document = (dampen . frequency)+    [ (20, content)+    , (1, newlines)+    , (1, nestingAndAlignment)+    , (1, grouping)+    , (20, concatenationOfTwo)+    , (5, concatenationOfMany)+    , (1, enclosingOfOne)+    , (1, enclosingOfMany) ]++content :: Gen (Doc ann)+content = frequency+    [ (1, pure emptyDoc)+    , (10, do word <- choose (minBound, maxBound :: Word8)+              let pgp8Word = toText (BSL.singleton word)+              pure (pretty pgp8Word) )+    , (1, (fmap pretty . elements . mconcat)+              [ ['a'..'z']+              , ['A'..'Z']+              , ['0'..'9']+              , "…_[]^!<>=&@:-()?*}{/\\#$|~`+%\"';" ] )+    ]++newlines :: Gen (Doc ann)+newlines = frequency+    [ (1, pure line)+    , (1, pure line')+    , (1, pure softline)+    , (1, pure softline')+    , (1, pure hardline) ]++nestingAndAlignment :: Gen (Doc ann)+nestingAndAlignment = frequency+    [ (1, nest   <$> arbitrary <*> concatenationOfMany)+    , (1, group  <$> document)+    , (1, hang   <$> arbitrary <*> concatenationOfMany)+    , (1, indent <$> arbitrary <*> concatenationOfMany) ]++grouping :: Gen (Doc ann)+grouping = frequency+    [ (1, align  <$> document)+    , (1, flatAlt <$> document <*> document) ]++concatenationOfTwo :: Gen (Doc ann)+concatenationOfTwo = frequency+    [ (1, (<>) <$> document <*> document)+    , (1, (<+>) <$> document <*> document) ]++concatenationOfMany :: Gen (Doc ann)+concatenationOfMany = frequency+    [ (1, hsep    <$> listOf document)+    , (1, vsep    <$> listOf document)+    , (1, fillSep <$> listOf document)+    , (1, sep     <$> listOf document)+    , (1, hcat    <$> listOf document)+    , (1, vcat    <$> listOf document)+    , (1, fillCat <$> listOf document)+    , (1, cat     <$> listOf document) ]++enclosingOfOne :: Gen (Doc ann)+enclosingOfOne = frequency+    [ (1, squotes  <$> document)+    , (1, dquotes  <$> document)+    , (1, parens   <$> document)+    , (1, angles   <$> document)+    , (1, brackets <$> document)+    , (1, braces   <$> document) ]++enclosingOfMany :: Gen (Doc ann)+enclosingOfMany = frequency+    [ (1, encloseSep <$> document <*> document <*> pure ", " <*> listOf document)+    , (1, list       <$> listOf document)+    , (1, tupled     <$> listOf document) ]++-- QuickCheck 2.8 does not have 'scale' yet, so for compatibility with older+-- releases we hand-code it here+dampen :: Gen a -> Gen a+dampen gen = sized (\n -> resize ((n*2) `quot` 3) gen)