├── .github └── workflows │ ├── haskell-ci.yml │ └── no-text.yml ├── .gitignore ├── .hlint.yaml ├── .stylish-haskell.yaml ├── LICENSE.md ├── README.md ├── aux ├── flowchart └── version-compatibility-macros.h ├── cabal.haskell-ci ├── cabal.project ├── prettyprinter-ansi-terminal ├── CHANGELOG.md ├── LICENSE.md ├── README.md ├── Setup.lhs ├── bench │ └── LargeOutput.hs ├── misc │ └── version-compatibility-macros.h ├── prettyprinter-ansi-terminal.cabal ├── src │ ├── Data │ │ └── Text │ │ │ └── Prettyprint │ │ │ └── Doc │ │ │ └── Render │ │ │ ├── Terminal.hs │ │ │ └── Terminal │ │ │ └── Internal.hs │ └── Prettyprinter │ │ └── Render │ │ ├── Terminal.hs │ │ └── Terminal │ │ └── Internal.hs └── test │ └── Doctest │ └── Main.hs ├── prettyprinter-compat-annotated-wl-pprint ├── LICENSE.md ├── README.md ├── Setup.lhs ├── misc │ └── version-compatibility-macros.h ├── prettyprinter-compat-annotated-wl-pprint.cabal └── src │ └── Text │ └── PrettyPrint │ └── Annotated │ └── Leijen.hs ├── prettyprinter-compat-ansi-wl-pprint ├── LICENSE.md ├── README.md ├── Setup.lhs ├── prettyprinter-compat-ansi-wl-pprint.cabal └── src │ └── Text │ └── PrettyPrint │ └── ANSI │ └── Leijen.hs ├── prettyprinter-compat-wl-pprint ├── LICENSE.md ├── README.md ├── Setup.lhs ├── prettyprinter-compat-wl-pprint.cabal └── src │ └── Text │ └── PrettyPrint │ └── Leijen.hs ├── prettyprinter-convert-ansi-wl-pprint ├── LICENSE.md ├── README.md ├── Setup.lhs ├── prettyprinter-convert-ansi-wl-pprint.cabal ├── src │ ├── Data │ │ └── Text │ │ │ └── Prettyprint │ │ │ └── Convert │ │ │ └── AnsiWlPprint.hs │ └── Prettyprinter │ │ └── Convert │ │ └── AnsiWlPprint.hs └── test │ └── Doctest │ └── Main.hs ├── prettyprinter ├── CHANGELOG.md ├── LICENSE.md ├── README.md ├── Setup.lhs ├── app │ ├── GenerateReadme.hs │ └── MultilineTh.hs ├── bench │ ├── FasterUnsafeText.hs │ ├── Fusion.hs │ └── LargeOutput.hs ├── misc │ └── version-compatibility-macros.h ├── prettyprinter.cabal ├── src-text │ └── Data │ │ ├── Text.hs │ │ └── Text │ │ ├── IO.hs │ │ ├── Lazy.hs │ │ └── Lazy │ │ └── Builder.hs ├── src │ ├── Data │ │ └── Text │ │ │ └── Prettyprint │ │ │ ├── Doc.hs │ │ │ └── Doc │ │ │ ├── Internal.hs │ │ │ ├── Internal │ │ │ ├── Debug.hs │ │ │ └── Type.hs │ │ │ ├── Render │ │ │ ├── String.hs │ │ │ ├── Text.hs │ │ │ ├── Tutorials │ │ │ │ ├── StackMachineTutorial.hs │ │ │ │ └── TreeRenderingTutorial.hs │ │ │ └── Util │ │ │ │ ├── Panic.hs │ │ │ │ ├── SimpleDocTree.hs │ │ │ │ └── StackMachine.hs │ │ │ ├── Symbols │ │ │ ├── Ascii.hs │ │ │ └── Unicode.hs │ │ │ └── Util.hs │ ├── Prettyprinter.hs │ └── Prettyprinter │ │ ├── Internal.hs │ │ ├── Internal │ │ ├── Debug.hs │ │ └── Type.hs │ │ ├── Render │ │ ├── String.hs │ │ ├── Text.hs │ │ ├── Tutorials │ │ │ ├── StackMachineTutorial.hs │ │ │ └── TreeRenderingTutorial.hs │ │ └── Util │ │ │ ├── Panic.hs │ │ │ ├── SimpleDocTree.hs │ │ │ └── StackMachine.hs │ │ ├── Symbols │ │ ├── Ascii.hs │ │ └── Unicode.hs │ │ └── Util.hs └── test │ ├── Doctest │ └── Main.hs │ └── Testsuite │ ├── Main.hs │ └── StripTrailingSpace.hs ├── scripts ├── benchmark ├── ci │ ├── checks │ │ ├── negated-cpp-macro-syntax │ │ └── readme-was-generated │ └── install │ │ ├── hlint │ │ └── stack ├── find-language-extensions ├── generate_readme └── haddock ├── stack.yaml └── stack.yaml.lock /.github/workflows/no-text.yml: -------------------------------------------------------------------------------- 1 | name: no-text 2 | on: 3 | push: 4 | branches: 5 | - master 6 | pull_request: 7 | branches: 8 | - master 9 | 10 | defaults: 11 | run: 12 | shell: bash 13 | 14 | jobs: 15 | build: 16 | runs-on: ${{ matrix.os }} 17 | strategy: 18 | matrix: 19 | os: ['ubuntu-latest'] 20 | ghc: ['latest', '7.10'] 21 | fail-fast: false 22 | steps: 23 | - uses: actions/checkout@v2 24 | - uses: haskell/actions/setup@v1 25 | id: setup-haskell-cabal 26 | with: 27 | ghc-version: ${{ matrix.ghc }} 28 | - name: Update cabal package database 29 | run: cabal update 30 | - uses: actions/cache@v2 31 | name: Cache cabal stuff 32 | with: 33 | path: ${{ steps.setup-haskell-cabal.outputs.cabal-store }} 34 | key: ${{ runner.os }}-${{ matrix.ghc }} 35 | - name: Build 36 | # There are linking error when building hashable, see #212. 37 | run: cabal build -f-text --constraint 'semigroups -hashable' prettyprinter:prettyprinter 38 | -------------------------------------------------------------------------------- /.gitignore: -------------------------------------------------------------------------------- 1 | dist/ 2 | .stack-work/ 3 | dist-newstyle/ 4 | -------------------------------------------------------------------------------- /.hlint.yaml: -------------------------------------------------------------------------------- 1 | - arguments: 2 | - --cpp-include=aux 3 | - --cpp-define=MIN_VERSION_base=1 4 | 5 | 6 | # Avoiding lambdas is not always a good idea if you keep in mind that GHC's 7 | # inliner will only consider fully applied functions. 8 | - ignore: {name: "Avoid lambda"} 9 | 10 | # Naming can be useful 11 | - ignore: {name: "Eta reduce"} 12 | - ignore: {name: "Redundant lambda"} 13 | - ignore: {name: "Use const"} 14 | 15 | # Sometimes, it can make code more readable if underscores are allowed as a 16 | # form of a "large" separator. For example, one might give all tests the prefix 17 | # "test_", followed by a camel-case test name. 18 | - ignore: {name: "Use camelCase"} 19 | 20 | # Sometimes a »case« can be clearer 21 | - ignore: {name: "Use fromMaybe"} 22 | - ignore: {name: "Use if"} 23 | 24 | # Obfuscation much? 25 | - ignore: {name: "Use uncurry"} 26 | - ignore: {name: "Use first"} 27 | - ignore: {name: "Use second"} 28 | - ignore: {name: "Use tuple-section"} 29 | 30 | # Use LambdaCase -- we cannot, GHC-7.6+ feature 31 | - ignore: {name: "Use lambda-case"} 32 | 33 | # Not all 3-liners should be deduplicated 34 | - ignore: {name: Reduce duplication, within: Prettyprinter.Render.Terminal.Internal} 35 | 36 | # I don’t like $ 37 | - error: 38 | name: Use parentheses instead of $ 39 | lhs: f $ x 40 | rhs: f (x) 41 | 42 | # AMP fallout 43 | - error: 44 | name: generalize mapM 45 | lhs: mapM 46 | rhs: traverse 47 | - error: 48 | name: generalize mapM_ 49 | lhs: mapM_ 50 | rhs: traverse_ 51 | - error: 52 | name: generalize forM 53 | lhs: forM 54 | rhs: for 55 | - error: 56 | name: generalize forM_ 57 | lhs: forM_ 58 | rhs: for_ 59 | - error: 60 | name: Avoid return 61 | lhs: return 62 | rhs: pure 63 | -------------------------------------------------------------------------------- /.stylish-haskell.yaml: -------------------------------------------------------------------------------- 1 | # stylish-haskell configuration file 2 | # ================================== 3 | 4 | # Auto-generated by stylish-haskell 0.9.2.1 via stylish-haskell --defaults 5 | 6 | # The stylish-haskell tool is mainly configured by specifying steps. These steps 7 | # are a list, so they have an order, and one specific step may appear more than 8 | # once (if needed). Each file is processed by these steps in the given order. 9 | steps: 10 | # Convert some ASCII sequences to their Unicode equivalents. This is disabled 11 | # by default. 12 | # - unicode_syntax: 13 | # # In order to make this work, we also need to insert the UnicodeSyntax 14 | # # language pragma. If this flag is set to true, we insert it when it's 15 | # # not already present. You may want to disable it if you configure 16 | # # language extensions using some other method than pragmas. Default: 17 | # # true. 18 | # add_language_pragma: true 19 | 20 | # Align the right hand side of some elements. This is quite conservative 21 | # and only applies to statements where each element occupies a single 22 | # line. 23 | - simple_align: 24 | cases: false 25 | top_level_patterns: false 26 | records: false 27 | 28 | # Import cleanup 29 | - imports: 30 | # There are different ways we can align names and lists. 31 | # 32 | # - global: Align the import names and import list throughout the entire 33 | # file. 34 | # 35 | # - file: Like global, but don't add padding when there are no qualified 36 | # imports in the file. 37 | # 38 | # - group: Only align the imports per group (a group is formed by adjacent 39 | # import lines). 40 | # 41 | # - none: Do not perform any alignment. 42 | # 43 | # Default: global. 44 | align: group 45 | 46 | # The following options affect only import list alignment. 47 | # 48 | # List align has following options: 49 | # 50 | # - after_alias: Import list is aligned with end of import including 51 | # 'as' and 'hiding' keywords. 52 | # 53 | # > import qualified Data.List as List (concat, foldl, foldr, head, 54 | # > init, last, length) 55 | # 56 | # - with_alias: Import list is aligned with start of alias or hiding. 57 | # 58 | # > import qualified Data.List as List (concat, foldl, foldr, head, 59 | # > init, last, length) 60 | # 61 | # - new_line: Import list starts always on new line. 62 | # 63 | # > import qualified Data.List as List 64 | # > (concat, foldl, foldr, head, init, last, length) 65 | # 66 | # Default: after_alias 67 | list_align: after_alias 68 | 69 | # Right-pad the module names to align imports in a group: 70 | # 71 | # - true: a little more readable 72 | # 73 | # > import qualified Data.List as List (concat, foldl, foldr, 74 | # > init, last, length) 75 | # > import qualified Data.List.Extra as List (concat, foldl, foldr, 76 | # > init, last, length) 77 | # 78 | # - false: diff-safe 79 | # 80 | # > import qualified Data.List as List (concat, foldl, foldr, init, 81 | # > last, length) 82 | # > import qualified Data.List.Extra as List (concat, foldl, foldr, 83 | # > init, last, length) 84 | # 85 | # Default: true 86 | pad_module_names: true 87 | 88 | # Long list align style takes effect when import is too long. This is 89 | # determined by 'columns' setting. 90 | # 91 | # - inline: This option will put as much specs on same line as possible. 92 | # 93 | # - new_line: Import list will start on new line. 94 | # 95 | # - new_line_multiline: Import list will start on new line when it's 96 | # short enough to fit to single line. Otherwise it'll be multiline. 97 | # 98 | # - multiline: One line per import list entry. 99 | # Type with constructor list acts like single import. 100 | # 101 | # > import qualified Data.Map as M 102 | # > ( empty 103 | # > , singleton 104 | # > , ... 105 | # > , delete 106 | # > ) 107 | # 108 | # Default: inline 109 | long_list_align: new_line_multiline 110 | 111 | # Align empty list (importing instances) 112 | # 113 | # Empty list align has following options 114 | # 115 | # - inherit: inherit list_align setting 116 | # 117 | # - right_after: () is right after the module name: 118 | # 119 | # > import Vector.Instances () 120 | # 121 | # Default: inherit 122 | empty_list_align: inherit 123 | 124 | # List padding determines indentation of import list on lines after import. 125 | # This option affects 'long_list_align'. 126 | # 127 | # - : constant value 128 | # 129 | # - module_name: align under start of module name. 130 | # Useful for 'file' and 'group' align settings. 131 | list_padding: 4 132 | 133 | # Separate lists option affects formatting of import list for type 134 | # or class. The only difference is single space between type and list 135 | # of constructors, selectors and class functions. 136 | # 137 | # - true: There is single space between Foldable type and list of it's 138 | # functions. 139 | # 140 | # > import Data.Foldable (Foldable (fold, foldl, foldMap)) 141 | # 142 | # - false: There is no space between Foldable type and list of it's 143 | # functions. 144 | # 145 | # > import Data.Foldable (Foldable(fold, foldl, foldMap)) 146 | # 147 | # Default: true 148 | separate_lists: true 149 | 150 | # Space surround option affects formatting of import lists on a single 151 | # line. The only difference is single space after the initial 152 | # parenthesis and a single space before the terminal parenthesis. 153 | # 154 | # - true: There is single space associated with the enclosing 155 | # parenthesis. 156 | # 157 | # > import Data.Foo ( foo ) 158 | # 159 | # - false: There is no space associated with the enclosing parenthesis 160 | # 161 | # > import Data.Foo (foo) 162 | # 163 | # Default: false 164 | space_surround: false 165 | 166 | # Language pragmas 167 | - language_pragmas: 168 | # We can generate different styles of language pragma lists. 169 | # 170 | # - vertical: Vertical-spaced language pragmas, one per line. 171 | # 172 | # - compact: A more compact style. 173 | # 174 | # - compact_line: Similar to compact, but wrap each line with 175 | # `{-#LANGUAGE #-}'. 176 | # 177 | # Default: vertical. 178 | style: vertical 179 | 180 | # Align affects alignment of closing pragma brackets. 181 | # 182 | # - true: Brackets are aligned in same column. 183 | # 184 | # - false: Brackets are not aligned together. There is only one space 185 | # between actual import and closing bracket. 186 | # 187 | # Default: true 188 | align: true 189 | 190 | # stylish-haskell can detect redundancy of some language pragmas. If this 191 | # is set to true, it will remove those redundant pragmas. Default: true. 192 | remove_redundant: true 193 | 194 | # Replace tabs by spaces. This is disabled by default. 195 | # - tabs: 196 | # # Number of spaces to use for each tab. Default: 8, as specified by the 197 | # # Haskell report. 198 | # spaces: 8 199 | 200 | # Remove trailing whitespace 201 | - trailing_whitespace: {} 202 | 203 | # Squash multiple spaces between the left and right hand sides of some 204 | # elements into single spaces. Basically, this undoes the effect of 205 | # simple_align but is a bit less conservative. 206 | # - squash: {} 207 | 208 | # A common setting is the number of columns (parts of) code will be wrapped 209 | # to. Different steps take this into account. Default: 80. 210 | columns: 80 211 | 212 | # By default, line endings are converted according to the OS. You can override 213 | # preferred format here. 214 | # 215 | # - native: Native newline format. CRLF on Windows, LF on other OSes. 216 | # 217 | # - lf: Convert to LF ("\n"). 218 | # 219 | # - crlf: Convert to CRLF ("\r\n"). 220 | # 221 | # Default: native. 222 | newline: lf 223 | 224 | # Sometimes, language extensions are specified in a cabal file or from the 225 | # command line instead of using language pragmas in the file. stylish-haskell 226 | # needs to be aware of these, so it can parse the file correctly. 227 | # 228 | # No language extensions are enabled by default. 229 | # language_extensions: 230 | # - TemplateHaskell 231 | # - QuasiQuotes 232 | -------------------------------------------------------------------------------- /LICENSE.md: -------------------------------------------------------------------------------- 1 | Copyright 2008, Daan Leijen and Max Bolingbroke, 2016 David Luposchainsky. All 2 | rights reserved. 3 | 4 | Redistribution and use in source and binary forms, with or without modification, 5 | are permitted provided that the following conditions are met: 6 | 7 | - Redistributions of source code must retain the above copyright notice, this 8 | list of conditions and the following disclaimer. 9 | 10 | - Redistributions in binary form must reproduce the above copyright notice, 11 | this list of conditions and the following disclaimer in the documentation 12 | and/or other materials provided with the distribution. 13 | 14 | This software is provided by the copyright holders "as is" and any express or 15 | implied warranties, including, but not limited to, the implied warranties of 16 | merchantability and fitness for a particular purpose are disclaimed. In no event 17 | shall the copyright holders be liable for any direct, indirect, incidental, 18 | special, exemplary, or consequential damages (including, but not limited to, 19 | procurement of substitute goods or services; loss of use, data, or profits; or 20 | business interruption) however caused and on any theory of liability, whether in 21 | contract, strict liability, or tort (including negligence or otherwise) arising 22 | in any way out of the use of this software, even if advised of the possibility 23 | of such damage. 24 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | A modern Wadler/Leijen Prettyprinter 6 | ==================================== 7 | 8 | [![](https://img.shields.io/hackage/v/prettyprinter.svg?style=flat-square&label=Hackage&colorB=0a7bbb)](https://hackage.haskell.org/package/prettyprinter) 9 | 10 | tl;dr 11 | ----- 12 | 13 | A prettyprinter/text rendering engine. Easy to use, well-documented, ANSI 14 | terminal backend exists, HTML backend is trivial to implement, no name clashes, 15 | `Text`-based, extensible. 16 | 17 | ```haskell 18 | let prettyType = align . sep . zipWith (<+>) ("::" : repeat "->") 19 | prettySig name ty = pretty name <+> prettyType ty 20 | in prettySig "example" ["Int", "Bool", "Char", "IO ()"] 21 | ``` 22 | 23 | ```haskell 24 | -- Output for wide enough formats: 25 | example :: Int -> Bool -> Char -> IO () 26 | 27 | -- Output for narrow formats: 28 | example :: Int 29 | -> Bool 30 | -> Char 31 | -> IO () 32 | ``` 33 | 34 | 35 | 36 | 37 | Longer; want to read 38 | -------------------- 39 | 40 | This package defines a prettyprinter to format text in a flexible and convenient 41 | way. The idea is to combine a document out of many small components, then using 42 | a layouter to convert it to an easily renderable simple document, which can then 43 | be rendered to a variety of formats, for example plain `Text`, or Markdown. 44 | *What you are reading right now was generated by this library (see 45 | `GenerateReadme.hs`).* 46 | 47 | 48 | 49 | Why another prettyprinter? 50 | -------------------------- 51 | 52 | Haskell, more specifically Hackage, has a zoo of Wadler/Leijen based 53 | prettyprinters already. Each of them addresses a different concern with the 54 | classic `wl-pprint` package. This package solves *all* these issues, and then 55 | some. 56 | 57 | 58 | 59 | ### `Text` instead of `String` 60 | 61 | `String` has exactly one use, and that’s showing Hello World in tutorials. For 62 | all other uses, `Text` is what people should be using. The prettyprinter uses no 63 | `String` definitions anywhere; using a `String` means an immediate conversion to 64 | the internal `Text`-based format. 65 | 66 | 67 | 68 | ### Extensive documentation 69 | 70 | The library is stuffed with runnable examples, showing use cases for the vast 71 | majority of exported values. Many things reference related definitions, 72 | *everything* comes with at least a sentence explaining its purpose. 73 | 74 | 75 | 76 | ### No name clashes 77 | 78 | Many prettyprinters use the legacy API of the first Wadler/Leijen prettyprinter, 79 | which used e.g. `(<$>)` to separate lines, which clashes with the ubiquitous 80 | synonym for `fmap` that’s been in Base for ages. These definitions were either 81 | removed or renamed, so there are no name clashes with standard libraries 82 | anymore. 83 | 84 | 85 | 86 | ### Annotation support 87 | 88 | Text is not all letters and newlines. Often, we want to add more information, 89 | the simplest kind being some form of styling. An ANSI terminal supports 90 | coloring, a web browser a plethora of different formattings. 91 | 92 | More complex uses of annotations include e.g. adding type annotations for 93 | mouse-over hovers when printing a syntax tree, adding URLs to documentation, or 94 | adding source locations to show where a certain piece of output comes from. 95 | [Idris](https://github.com/idris-lang/Idris-dev) is a project that makes 96 | extensive use of such a feature. 97 | 98 | Special care has been applied to make annotations unobtrusive, so that if you 99 | don’t need or care about them there is no overhead, neither in terms of 100 | usability nor performance. 101 | 102 | 103 | 104 | ### Extensible backends 105 | 106 | A document can be rendered in many different ways, for many different clients. 107 | There is plain text, there is the ANSI terminal, there is the browser. Each of 108 | these speak different languages, and the backend is responsible for the 109 | translation to those languages. Backends should be readily available, or easy to 110 | implement if a custom solution is desired. 111 | 112 | As a result, each backend requires only minimal dependencies; if you don’t want 113 | to print to an ANSI terminal for example, there is no need to have a dependency 114 | on a terminal library. 115 | 116 | 117 | 118 | ### Performance 119 | 120 | Rendering large documents should be done efficiently, and the library should 121 | make it easy to optimize common use cases for the programmer. 122 | 123 | 124 | 125 | ### Open implementation 126 | 127 | The type of documents is abstract in most of the other Wadler/Leijen 128 | prettyprinters, making it hard to impossible to write adaptors from one library 129 | to another. The type should be exposed for such purposes so it is possible to 130 | write adaptors from library to library, or each of them is doomed to live on its 131 | own small island of incompatibility. For this reason, the `Doc` type is fully 132 | exposed in a semi-internal module for this specific use case. 133 | 134 | 135 | 136 | The prettyprinter family 137 | ------------------------ 138 | 139 | The `prettyprinter` family of packages consists of: 140 | 141 | - `prettyprinter` is the core package. It defines the language to generate 142 | nicely laid out documents, which can then be given to renderers to display 143 | them in various ways, e.g. HTML, or plain text. 144 | - `prettyprinter-ansi-terminal` provides a renderer suitable for ANSI terminal 145 | output including colors (at the cost of a dependency more). 146 | - `prettyprinter-compat-wl-pprint` provides a drop-in compatibility layer for 147 | previous users of the `wl-pprint` package. Use it for easy adaption of the 148 | new `prettyprinter`, but don't develop anything new with it. 149 | - `prettyprinter-compat-ansi-wl-pprint` is the same, but for previous users of 150 | `ansi-wl-pprint`. 151 | - `prettyprinter-compat-annotated-wl-pprint` is the same, but for previous 152 | users of `annotated-wl-pprint`. 153 | - `prettyprinter-convert-ansi-wl-pprint` is a *converter*, not a drop-in 154 | replacement, for documents generated by `ansi-wl-pprint`. Useful for 155 | interfacing with other libraries that use the other format, like Trifecta 156 | and Optparse-Applicative. 157 | 158 | 159 | 160 | Differences to the old Wadler/Leijen prettyprinters 161 | --------------------------------------------------- 162 | 163 | The library originally started as a fork of `ansi-wl-pprint` until every line 164 | had been touched. The result is still in the same spirit as its predecessors, 165 | but modernized to match the current ecosystem and needs. 166 | 167 | The most significant changes are: 168 | 169 | 1. `(<$>)` is removed as an operator, since it clashes with the common alias 170 | for `fmap`. 171 | 2. All but the essential `<>` and `<+>` operators were removed or replaced by 172 | ordinary names. 173 | 3. Everything extensively documented, with references to other functions and 174 | runnable code examples. 175 | 4. Use of `Text` instead of `String`. 176 | 5. A `fuse` function to optimize often-used documents before rendering for 177 | efficiency. 178 | 6. SimpleDoc was renamed `SimpleDocStream`, to contrast the new 179 | `SimpleDocTree`. 180 | 7. In the ANSI backend, instead of providing an own colorization function for 181 | each color/intensity/layer combination, they have been combined in `color`, 182 | `colorDull`, `bgColor`, and `bgColorDull` functions, which can be found in 183 | the ANSI terminal specific `prettyprinter-ansi-terminal` package. 184 | 185 | 186 | 187 | Historical notes 188 | ---------------- 189 | 190 | This module is based on previous work by Daan Leijen and Max Bolingbroke, who 191 | implemented and significantly extended the prettyprinter given by a [paper by 192 | Phil Wadler in his 1997 paper »A Prettier 193 | Printer«](https://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf), 194 | by adding lots of convenience functions, styling, and new functionality. Their 195 | package, ansi-wl-pprint is widely used in the Haskell ecosystem, and is at the 196 | time of writing maintained by Edward Kmett. 197 | -------------------------------------------------------------------------------- /aux/flowchart: -------------------------------------------------------------------------------- 1 | ╔══════════╗ 2 | ║ ║ ╭────────────────────╮ 3 | ║ ║ │ vsep, pretty, <+>, │ 4 | ║ ║ │ nest, align, … │ 5 | ║ ║ ╰─────────┬──────────╯ 6 | ║ ║ │ 7 | ║ Create ║ │ 8 | ║ ║ │ 9 | ║ ║ ▽ 10 | ║ ║ ╭───────────────────╮ 11 | ║ ║ │ Doc │ 12 | ╠══════════╣ │ (rich document) │ 13 | ║ ║ ╰─────────┬─────────╯ 14 | ║ ║ │ 15 | ║ ║ │ Layout algorithms 16 | ║ Layout ║ │ e.g. layoutPretty 17 | ║ ║ ▽ 18 | ║ ║ ╭───────────────────╮ 19 | ║ ║ │ SimpleDocStream │ 20 | ╠══════════╣ │ (simple document) │ 21 | ║ ║ ╰─────────┬─────────╯ 22 | ║ ║ │ 23 | ║ ║ ├─────────────────────────────╮ 24 | ║ ║ │ │ treeForm 25 | ║ ║ │ ▽ 26 | ║ ║ │ ╭───────────────╮ 27 | ║ ║ │ │ SimpleDocTree │ 28 | ║ Render ║ │ ╰───────┬───────╯ 29 | ║ ║ │ │ 30 | ║ ║ ╭───────────────────┼─────────────────╮ ╭────────┴────────╮ 31 | ║ ║ │ │ │ │ │ 32 | ║ ║ ▽ ▽ ▽ ▽ ▽ 33 | ║ ║ ╭───────────────╮ ╭───────────────╮ ╭───────────────╮ ╭───────────────╮ 34 | ║ ║ │ ANSI terminal │ │ Plain Text │ │ other/custom │ │ HTML │ 35 | ║ ║ ╰───────────────╯ ╰───────────────╯ ╰───────────────╯ ╰───────────────╯ 36 | ║ ║ 37 | ╚══════════╝ 38 | -------------------------------------------------------------------------------- /aux/version-compatibility-macros.h: -------------------------------------------------------------------------------- 1 | #ifndef VERSION_COMPATIBILITY_MACROS 2 | #define VERSION_COMPATIBILITY_MACROS 3 | 4 | #ifndef MIN_VERSION_base 5 | #error "MIN_VERSION_base macro not defined!" 6 | #endif 7 | 8 | -- These macros allow writing CPP compatibility hacks in a way that makes their 9 | -- purpose much clearer than just demanding a specific version of a library. 10 | 11 | #define APPLICATIVE_MONAD MIN_VERSION_base(4,8,0) 12 | #define FOLDABLE_TRAVERSABLE_IN_PRELUDE MIN_VERSION_base(4,8,0) 13 | #define FUNCTOR_IDENTITY_IN_BASE MIN_VERSION_base(4,8,0) 14 | #define MONOID_IN_PRELUDE MIN_VERSION_base(4,8,0) 15 | #define NATURAL_IN_BASE MIN_VERSION_base(4,8,0) 16 | 17 | #define SEMIGROUP_IN_BASE MIN_VERSION_base(4,9,0) 18 | 19 | #define SEMIGROUP_MONOID_SUPERCLASS MIN_VERSION_base(4,11,0) 20 | 21 | #define FAIL_IN_MONAD !(MIN_VERSION_base(4,13,0)) 22 | 23 | #endif 24 | -------------------------------------------------------------------------------- /cabal.haskell-ci: -------------------------------------------------------------------------------- 1 | -- configuration for haskell-ci 2 | -- so we don't need to pass all via command line arguments 3 | 4 | -- build only master branch, or PRs to master branch 5 | branches: master 6 | 7 | -- Doctests fail with GHC 7.10 8 | 9 | -- FIXME: Enable tests for GHC 9.4 once doctest is compatible: 10 | -- https://github.com/sol/doctest/pull/375 11 | tests: >=8.0 && <9.4 12 | 13 | cabal-check: False 14 | 15 | hlint: True 16 | hlint-job: 8.10.7 17 | hlint-yaml: .hlint.yaml 18 | hlint-download-binary: True 19 | -- haskell-ci runs hlint within the package directories, so the CPP include 20 | -- path has to be adjusted so it can find version-compatibility-macros.h. 21 | hlint-options: --cpp-include=misc 22 | -------------------------------------------------------------------------------- /cabal.project: -------------------------------------------------------------------------------- 1 | -- http://cabal.readthedocs.io/en/latest/nix-local-build-overview.html 2 | 3 | packages: prettyprinter 4 | , prettyprinter-ansi-terminal 5 | , prettyprinter-compat-wl-pprint 6 | , prettyprinter-compat-ansi-wl-pprint 7 | , prettyprinter-convert-ansi-wl-pprint 8 | , prettyprinter-compat-annotated-wl-pprint 9 | tests: true 10 | benchmarks: true 11 | -------------------------------------------------------------------------------- /prettyprinter-ansi-terminal/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # [1.1.3] 2 | 3 | - [Deprecate the `Data.Text.Prettyprint.*` modules](https://github.com/quchen/prettyprinter/pull/203) 4 | * Users should migrate to the new `Prettyprinter` module hierarchy. 5 | * The old modules will be removed no sooner than September 2022. 6 | 7 | [1.1.3]: https://github.com/quchen/prettyprinter/compare/ansi-terminal-v1.1.2...ansi-terminal-v1.1.3 8 | 9 | # [1.1.2] 10 | 11 | - [Add shallower `Prettyprinter` module hierarchy exposing the same API.](https://github.com/quchen/prettyprinter/pull/174) 12 | * The current plan for the existing `Data.Text.Prettyprint.Doc*` modules is: 13 | * Start deprecation in early 2021. 14 | * Remove the modules after a deprecation period of at least one year. 15 | - [Make `renderLazy` lazy, and speed it up.](https://github.com/quchen/prettyprinter/pull/176) 16 | - [Add export list for Prettyprinter.Render.Terminal.Internal.](https://github.com/quchen/prettyprinter/pull/148) 17 | - [Optimize generating spaces for indentation.](https://github.com/quchen/prettyprinter/pull/132) 18 | - [Enable `-O2`.](https://github.com/quchen/prettyprinter/pull/144) 19 | - [Extend GHC support to 7.6 and 7.4.](https://github.com/quchen/prettyprinter/pull/74) 20 | 21 | [1.1.2]: https://github.com/quchen/prettyprinter/compare/ansi-terminal-v1.1.1.2...ansi-terminal-v1.1.2 22 | 23 | # 1.1.1.2 24 | 25 | - Fix documentation claiming there would be a trailing newline in `renderIO` 26 | when there is none 27 | 28 | # 1.1.1.1 29 | 30 | - `renderIO` now renders directly to STDOUT, instead of first building a textual 31 | rendering and then printing that to STDOUT. 32 | 33 | # 1.1.1 34 | 35 | - Expose `AnsiStyle`’s constructors for adaptability 36 | 37 | # 1.1 38 | 39 | - Overhauled the API significantly – Styles are now combined using the 40 | `Semigroup` instance from a number of readable primitives. 41 | 42 | # 1.0.1 43 | 44 | Fix version shenanigans, since the prerelease was released to Hackage as version 45 | 1 already, so uploading the »new« version 1 did not work 46 | 47 | # 1 48 | 49 | Initial release 50 | -------------------------------------------------------------------------------- /prettyprinter-ansi-terminal/LICENSE.md: -------------------------------------------------------------------------------- 1 | ../LICENSE.md -------------------------------------------------------------------------------- /prettyprinter-ansi-terminal/README.md: -------------------------------------------------------------------------------- 1 | ANSI terminal prettyprinter renderer 2 | ==================================== 3 | 4 | This package defines a renderer for documents generated by the `prettyprinter` 5 | package, suitable for displaying them on ANSI-compatible terminals, including 6 | colors, boldening, underlining and italication. 7 | 8 | For more information about the prettyprinter in general, refer to the main 9 | `prettyprinter` package documentation. 10 | -------------------------------------------------------------------------------- /prettyprinter-ansi-terminal/Setup.lhs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | > import Distribution.Simple 3 | > main = defaultMain 4 | -------------------------------------------------------------------------------- /prettyprinter-ansi-terminal/bench/LargeOutput.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | {-# OPTIONS_GHC -fno-warn-orphans #-} 5 | 6 | -- | This benchmark is derived from the large-output benchmark in prettyprinter, but contains additional annotations. 7 | module Main (main) where 8 | 9 | import Prelude () 10 | import Prelude.Compat 11 | 12 | import Control.DeepSeq 13 | import Control.Monad.Compat 14 | import Data.Char 15 | import Data.Map (Map) 16 | import qualified Data.Map as M 17 | import Data.Text (Text) 18 | import qualified Data.Text as T 19 | import qualified Data.Text.IO as T 20 | import qualified Data.Text.Lazy as TL 21 | import GHC.Generics 22 | import Prettyprinter 23 | import Prettyprinter.Render.Terminal as Terminal 24 | import qualified Prettyprinter.Render.Text as Text 25 | import Test.QuickCheck 26 | import Test.QuickCheck.Gen 27 | import Test.QuickCheck.Random 28 | import Test.Tasty.Bench 29 | 30 | 31 | 32 | newtype Program = Program Binds deriving (Show, Generic) 33 | newtype Binds = Binds (Map Text LambdaForm) deriving (Show, Generic) 34 | data LambdaForm = LambdaForm ![Text] ![Text] !Expr deriving (Show, Generic) 35 | data Expr 36 | = Let Binds Expr 37 | | Case Expr [Alt] 38 | | AppF Text [Text] 39 | | AppC Text [Text] 40 | | AppP Text Text Text 41 | | LitE Int 42 | deriving (Show, Generic) 43 | data Alt = Alt Text [Text] Expr deriving (Show, Generic) 44 | 45 | instance NFData Program 46 | instance NFData Binds 47 | instance NFData LambdaForm 48 | instance NFData Expr 49 | instance NFData Alt 50 | 51 | instance Arbitrary Program where arbitrary = fmap Program arbitrary 52 | instance Arbitrary Binds where 53 | arbitrary = do 54 | NonEmpty xs <- arbitrary 55 | pure (Binds (M.fromList xs)) 56 | instance Arbitrary LambdaForm where 57 | arbitrary = LambdaForm <$> fromTo 0 2 arbitrary <*> fromTo 0 2 arbitrary <*> arbitrary 58 | 59 | instance Arbitrary Expr where 60 | arbitrary = (oneof . map scaled) 61 | [ Let <$> arbitrary <*> arbitrary 62 | , Case <$> arbitrary <*> (do NonEmpty xs <- arbitrary; pure xs) 63 | , AppF <$> arbitrary <*> fromTo 0 3 arbitrary 64 | , AppC <$> ucFirst arbitrary <*> fromTo 0 3 arbitrary 65 | , AppP <$> arbitrary <*> arbitrary <*> arbitrary 66 | , LitE <$> arbitrary ] 67 | instance Arbitrary Alt where arbitrary = Alt <$> ucFirst arbitrary <*> fromTo 0 3 arbitrary <*> arbitrary 68 | instance Arbitrary Text where 69 | arbitrary = do 70 | n <- choose (3,6) 71 | str <- replicateM n (elements ['a'..'z']) 72 | if str `elem` ["let", "in", "case", "of"] 73 | then arbitrary 74 | else pure (T.pack str) 75 | 76 | ucFirst :: Gen Text -> Gen Text 77 | ucFirst gen = do 78 | x <- gen 79 | case T.uncons x of 80 | Nothing -> pure x 81 | Just (t,ext) -> pure (T.cons (toUpper t) ext) 82 | 83 | anCol :: Color -> Doc AnsiStyle -> Doc AnsiStyle 84 | anCol = annotate . color 85 | 86 | prettyProgram :: Program -> Doc AnsiStyle 87 | prettyProgram (Program binds) = annotate italicized $ prettyBinds binds 88 | 89 | prettyBinds :: Binds -> Doc AnsiStyle 90 | prettyBinds (Binds bs) = align (vsep (map prettyBinding (M.assocs bs))) 91 | where 92 | prettyBinding (var, lambda) = pretty var <+> anCol Red "=" <+> prettyLambdaForm lambda 93 | 94 | prettyLambdaForm :: LambdaForm -> Doc AnsiStyle 95 | prettyLambdaForm (LambdaForm free bound body) = prettyExp . (<+> anCol Blue "->") . prettyBound . prettyFree $ anCol Blue "\\" 96 | where 97 | prettyFree | null free = id 98 | | otherwise = (<> anCol Blue lparen <> hsep (map pretty free) <> anCol Blue rparen) 99 | prettyBound | null bound = id 100 | | null free = (<> hsep (map pretty bound)) 101 | | otherwise = (<+> hsep (map pretty bound)) 102 | prettyExp = (<+> prettyExpr body) 103 | 104 | prettyExpr :: Expr -> Doc AnsiStyle 105 | prettyExpr = \expr -> case expr of 106 | Let binds body -> 107 | align (vsep [ anCol Red "let" <+> align (prettyBinds binds) 108 | , anCol Red "in" <+> prettyExpr body ]) 109 | 110 | Case scrutinee alts -> vsep 111 | [ anCol Yellow "case" <+> prettyExpr scrutinee <+> anCol Yellow "of" 112 | , indent 4 (align (vsep (map prettyAlt alts))) ] 113 | 114 | AppF f [] -> annotate bold . anCol Green $ pretty f 115 | AppF f args -> annotate bold . anCol Green $ pretty f <+> hsep (map pretty args) 116 | 117 | AppC c [] -> annotate bold . anCol Green $ pretty c 118 | AppC c args -> annotate bold . anCol Green $ pretty c <+> hsep (map pretty args) 119 | 120 | AppP op x y -> annotate bold . anCol Green $ pretty op <+> pretty x <+> pretty y 121 | 122 | LitE lit -> annotate bold . anCol Green $ pretty lit 123 | 124 | prettyAlt :: Alt -> Doc AnsiStyle 125 | prettyAlt (Alt con [] body) = pretty con <+> anCol Yellow "->" <+> prettyExpr body 126 | prettyAlt (Alt con args body) = pretty con <+> hsep (map pretty args) <+> anCol Yellow "->" <+> prettyExpr body 127 | 128 | scaled :: Gen a -> Gen a 129 | scaled = scale (\n -> n * 2 `quot` 3) 130 | 131 | fromTo :: Int -> Int -> Gen b -> Gen b 132 | fromTo a b gen = do 133 | n <- choose (min a b, max a b) 134 | resize n gen 135 | 136 | randomProgram 137 | :: Int -- ^ Seed 138 | -> Int -- ^ Generator size 139 | -> Program 140 | randomProgram seed size = let MkGen gen = arbitrary in gen (mkQCGen seed) size 141 | 142 | main :: IO () 143 | main = do 144 | let prog = randomProgram 1 60 145 | layoutOpts = defaultLayoutOptions { layoutPageWidth = Unbounded } 146 | renderedProg = (renderLazy . layoutPretty layoutOpts . prettyProgram) prog 147 | (progLines, progWidth) = let l = TL.lines renderedProg in (length l, maximum (map TL.length l)) 148 | putDoc ("Program size:" <+> pretty progLines <+> "lines, maximum width:" <+> pretty progWidth) 149 | 150 | let render :: (SimpleDocStream AnsiStyle -> TL.Text) -> Program -> TL.Text 151 | render r = r . layoutPretty layoutOpts . prettyProgram 152 | 153 | rnf prog `seq` T.putStrLn "Starting benchmark…" 154 | 155 | defaultMain 156 | [ bench "prettyprinter-ansi-terminal" $ nf (render Terminal.renderLazy) prog 157 | , bench "prettyprinter" $ nf (render Text.renderLazy) prog 158 | ] 159 | -------------------------------------------------------------------------------- /prettyprinter-ansi-terminal/misc/version-compatibility-macros.h: -------------------------------------------------------------------------------- 1 | ../../aux/version-compatibility-macros.h -------------------------------------------------------------------------------- /prettyprinter-ansi-terminal/prettyprinter-ansi-terminal.cabal: -------------------------------------------------------------------------------- 1 | name: prettyprinter-ansi-terminal 2 | version: 1.1.3 3 | cabal-version: >= 1.10 4 | category: User Interfaces, Text 5 | synopsis: ANSI terminal backend for the »prettyprinter« package. 6 | description: See README.md 7 | license: BSD2 8 | license-file: LICENSE.md 9 | extra-source-files: README.md 10 | , misc/version-compatibility-macros.h 11 | , CHANGELOG.md 12 | author: David Luposchainsky 13 | maintainer: Simon Jakobi , David Luposchainsky 14 | bug-reports: http://github.com/quchen/prettyprinter/issues 15 | homepage: http://github.com/quchen/prettyprinter 16 | build-type: Simple 17 | tested-with: GHC==9.4.1, GHC==9.2.4, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 18 | 19 | source-repository head 20 | type: git 21 | location: git://github.com/quchen/prettyprinter.git 22 | 23 | library 24 | exposed-modules: Data.Text.Prettyprint.Doc.Render.Terminal 25 | , Data.Text.Prettyprint.Doc.Render.Terminal.Internal 26 | , Prettyprinter.Render.Terminal 27 | , Prettyprinter.Render.Terminal.Internal 28 | ghc-options: -Wall -O2 29 | hs-source-dirs: src 30 | include-dirs: misc 31 | default-language: Haskell2010 32 | other-extensions: 33 | CPP 34 | , OverloadedStrings 35 | 36 | 37 | build-depends: 38 | base >= 4.5 && < 5 39 | , ansi-terminal >= 0.4.0 40 | , text >= 1.2 41 | , prettyprinter >= 1.7.0 42 | 43 | if impl(ghc >= 8.0) 44 | ghc-options: -Wcompat 45 | if !impl(ghc >= 8.0) 46 | build-depends: semigroups >= 0.1 47 | 48 | test-suite doctest 49 | type: exitcode-stdio-1.0 50 | hs-source-dirs: test/Doctest 51 | main-is: Main.hs 52 | build-depends: 53 | base >= 4.7 && < 5 54 | , doctest >= 0.9 55 | ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N 56 | default-language: Haskell2010 57 | if impl (ghc < 7.10) 58 | buildable: False 59 | -- Doctest cannot search folders in old versions it seems :-( 60 | 61 | benchmark large-output 62 | build-depends: 63 | base >= 4.5 && < 5 64 | , base-compat >=0.9.3 && <0.12 65 | , containers 66 | , deepseq 67 | , tasty-bench >= 0.2 68 | , prettyprinter 69 | , prettyprinter-ansi-terminal 70 | , QuickCheck >= 2.7 71 | , text 72 | 73 | hs-source-dirs: bench 74 | main-is: LargeOutput.hs 75 | ghc-options: -O2 -rtsopts -Wall 76 | default-language: Haskell2010 77 | type: exitcode-stdio-1.0 78 | 79 | -- For GHC.Generics 80 | if !impl(ghc >= 7.6) 81 | build-depends: ghc-prim 82 | -------------------------------------------------------------------------------- /prettyprinter-ansi-terminal/src/Data/Text/Prettyprint/Doc/Render/Terminal.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Render.Terminal {-# DEPRECATED "Use \"Prettyprinter.Render.Terminal\" instead." #-} ( 2 | module Prettyprinter.Render.Terminal 3 | ) where 4 | 5 | import Prettyprinter.Render.Terminal 6 | 7 | -------------------------------------------------------------------------------- /prettyprinter-ansi-terminal/src/Data/Text/Prettyprint/Doc/Render/Terminal/Internal.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Render.Terminal.Internal {-# DEPRECATED "Use \"Prettyprinter.Render.Terminal.Internal\" instead." #-} ( 2 | module Prettyprinter.Render.Terminal.Internal 3 | ) where 4 | 5 | import Prettyprinter.Render.Terminal.Internal 6 | 7 | 8 | -------------------------------------------------------------------------------- /prettyprinter-ansi-terminal/src/Prettyprinter/Render/Terminal.hs: -------------------------------------------------------------------------------- 1 | -- | Render 'SimpleDocStream' in a terminal. 2 | module Prettyprinter.Render.Terminal ( 3 | -- * Styling 4 | AnsiStyle, 5 | Color(..), 6 | 7 | -- ** Font color 8 | color, colorDull, 9 | 10 | -- ** Background color 11 | bgColor, bgColorDull, 12 | 13 | -- ** Font style 14 | bold, italicized, underlined, 15 | 16 | -- ** Internal markers 17 | -- 18 | -- | These should only be used for writing adaptors to other libraries; for 19 | -- the average use case, use 'bold', 'bgColorDull', etc. 20 | Intensity(..), 21 | Bold(..), 22 | Underlined(..), 23 | Italicized(..), 24 | 25 | -- * Conversion to ANSI-infused 'Text' 26 | renderLazy, renderStrict, 27 | 28 | -- * Render directly to 'stdout' 29 | renderIO, 30 | 31 | -- ** Convenience functions 32 | putDoc, hPutDoc, 33 | ) where 34 | 35 | import Prettyprinter.Render.Terminal.Internal 36 | -------------------------------------------------------------------------------- /prettyprinter-ansi-terminal/src/Prettyprinter/Render/Terminal/Internal.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | {-# OPTIONS_HADDOCK not-home #-} 5 | 6 | #include "version-compatibility-macros.h" 7 | 8 | -- | __Warning:__ Internal module. May change arbitrarily between versions. 9 | module Prettyprinter.Render.Terminal.Internal ( 10 | -- * Styling 11 | AnsiStyle(..), 12 | Color(..), 13 | 14 | -- ** Font color 15 | color, colorDull, 16 | 17 | -- ** Background color 18 | bgColor, bgColorDull, 19 | 20 | -- ** Font style 21 | bold, italicized, underlined, 22 | 23 | -- ** Internal markers 24 | Intensity(..), 25 | Bold(..), 26 | Underlined(..), 27 | Italicized(..), 28 | 29 | -- * Conversion to ANSI-infused 'Text' 30 | renderLazy, renderStrict, 31 | 32 | -- * Render directly to 'stdout' 33 | renderIO, 34 | 35 | -- ** Convenience functions 36 | putDoc, hPutDoc, 37 | ) where 38 | 39 | 40 | 41 | import Control.Applicative 42 | import Data.IORef 43 | import Data.Maybe 44 | import Data.Text (Text) 45 | import qualified Data.Text as T 46 | import qualified Data.Text.IO as T 47 | import qualified Data.Text.Lazy as TL 48 | import qualified Data.Text.Lazy.Builder as TLB 49 | import qualified System.Console.ANSI as ANSI 50 | import System.IO (Handle, hPutChar, stdout) 51 | 52 | import Prettyprinter 53 | import Prettyprinter.Render.Util.Panic 54 | 55 | #if !(SEMIGROUP_MONOID_SUPERCLASS) 56 | import Data.Semigroup 57 | #endif 58 | 59 | #if !(MIN_VERSION_base(4,6,0)) 60 | modifyIORef' :: IORef a -> (a -> a) -> IO () 61 | modifyIORef' ref f = do 62 | x <- readIORef ref 63 | let x' = f x 64 | x' `seq` writeIORef ref x' 65 | #endif 66 | 67 | -- $setup 68 | -- 69 | -- (Definitions for the doctests) 70 | -- 71 | -- >>> :set -XOverloadedStrings 72 | -- >>> import qualified Data.Text.Lazy.IO as TL 73 | -- >>> import qualified Data.Text.Lazy as TL 74 | -- >>> import Prettyprinter.Render.Terminal 75 | 76 | 77 | 78 | -- | The 8 ANSI terminal colors. 79 | data Color = Black | Red | Green | Yellow | Blue | Magenta | Cyan | White 80 | deriving (Eq, Ord, Show) 81 | 82 | -- | Dull or vivid coloring, as supported by ANSI terminals. 83 | data Intensity = Vivid | Dull 84 | deriving (Eq, Ord, Show) 85 | 86 | -- | Foreground (text) or background (paper) color 87 | data Layer = Foreground | Background 88 | deriving (Eq, Ord, Show) 89 | 90 | data Bold = Bold deriving (Eq, Ord, Show) 91 | data Underlined = Underlined deriving (Eq, Ord, Show) 92 | data Italicized = Italicized deriving (Eq, Ord, Show) 93 | 94 | -- | Style the foreground with a vivid color. 95 | color :: Color -> AnsiStyle 96 | color c = mempty { ansiForeground = Just (Vivid, c) } 97 | 98 | -- | Style the background with a vivid color. 99 | bgColor :: Color -> AnsiStyle 100 | bgColor c = mempty { ansiBackground = Just (Vivid, c) } 101 | 102 | -- | Style the foreground with a dull color. 103 | colorDull :: Color -> AnsiStyle 104 | colorDull c = mempty { ansiForeground = Just (Dull, c) } 105 | 106 | -- | Style the background with a dull color. 107 | bgColorDull :: Color -> AnsiStyle 108 | bgColorDull c = mempty { ansiBackground = Just (Dull, c) } 109 | 110 | -- | Render in __bold__. 111 | bold :: AnsiStyle 112 | bold = mempty { ansiBold = Just Bold } 113 | 114 | -- | Render in /italics/. 115 | italicized :: AnsiStyle 116 | italicized = mempty { ansiItalics = Just Italicized } 117 | 118 | -- | Render underlined. 119 | underlined :: AnsiStyle 120 | underlined = mempty { ansiUnderlining = Just Underlined } 121 | 122 | -- | @('renderLazy' doc)@ takes the output @doc@ from a rendering function 123 | -- and transforms it to lazy text, including ANSI styling directives for things 124 | -- like colorization. 125 | -- 126 | -- ANSI color information will be discarded by this function unless you are 127 | -- running on a Unix-like operating system. This is due to a technical 128 | -- limitation in Windows ANSI support. 129 | -- 130 | -- With a bit of trickery to make the ANSI codes printable, here is an example 131 | -- that would render colored in an ANSI terminal: 132 | -- 133 | -- >>> let render = TL.putStrLn . TL.replace "\ESC" "\\e" . renderLazy . layoutPretty defaultLayoutOptions 134 | -- >>> let doc = annotate (color Red) ("red" <+> align (vsep [annotate (color Blue <> underlined) ("blue+u" <+> annotate bold "bold" <+> "blue+u"), "red"])) 135 | -- >>> render (unAnnotate doc) 136 | -- red blue+u bold blue+u 137 | -- red 138 | -- >>> render doc 139 | -- \e[0;91mred \e[0;94;4mblue+u \e[0;94;1;4mbold\e[0;94;4m blue+u\e[0;91m 140 | -- red\e[0m 141 | -- 142 | -- Run the above via @echo -e '...'@ in your terminal to see the coloring. 143 | renderLazy :: SimpleDocStream AnsiStyle -> TL.Text 144 | renderLazy = 145 | let push x = (x :) 146 | 147 | unsafePeek [] = panicPeekedEmpty 148 | unsafePeek (x:_) = x 149 | 150 | unsafePop [] = panicPoppedEmpty 151 | unsafePop (x:xs) = (x, xs) 152 | 153 | go :: [AnsiStyle] -> SimpleDocStream AnsiStyle -> TLB.Builder 154 | go s sds = case sds of 155 | SFail -> panicUncaughtFail 156 | SEmpty -> mempty 157 | SChar c rest -> TLB.singleton c <> go s rest 158 | SText _ t rest -> TLB.fromText t <> go s rest 159 | SLine i rest -> TLB.singleton '\n' <> TLB.fromText (T.replicate i " ") <> go s rest 160 | SAnnPush style rest -> 161 | let currentStyle = unsafePeek s 162 | newStyle = style <> currentStyle 163 | in TLB.fromText (styleToRawText newStyle) <> go (push style s) rest 164 | SAnnPop rest -> 165 | let (_currentStyle, s') = unsafePop s 166 | newStyle = unsafePeek s' 167 | in TLB.fromText (styleToRawText newStyle) <> go s' rest 168 | 169 | in TLB.toLazyText . go [mempty] 170 | 171 | 172 | -- | @('renderIO' h sdoc)@ writes @sdoc@ to the handle @h@. 173 | -- 174 | -- >>> let render = renderIO System.IO.stdout . layoutPretty defaultLayoutOptions 175 | -- >>> let doc = annotate (color Red) ("red" <+> align (vsep [annotate (color Blue <> underlined) ("blue+u" <+> annotate bold "bold" <+> "blue+u"), "red"])) 176 | -- 177 | -- We render the 'unAnnotate'd version here, since the ANSI codes don’t display 178 | -- well in Haddock, 179 | -- 180 | -- >>> render (unAnnotate doc) 181 | -- red blue+u bold blue+u 182 | -- red 183 | -- 184 | -- This function behaves just like 185 | -- 186 | -- @ 187 | -- 'renderIO' h sdoc = 'TL.hPutStr' h ('renderLazy' sdoc) 188 | -- @ 189 | -- 190 | -- but will not generate any intermediate text, rendering directly to the 191 | -- handle. 192 | renderIO :: Handle -> SimpleDocStream AnsiStyle -> IO () 193 | renderIO h sdoc = do 194 | styleStackRef <- newIORef [mempty] 195 | 196 | let push x = modifyIORef' styleStackRef (x :) 197 | unsafePeek = readIORef styleStackRef >>= \tok -> case tok of 198 | [] -> panicPeekedEmpty 199 | x:_ -> pure x 200 | unsafePop = readIORef styleStackRef >>= \tok -> case tok of 201 | [] -> panicPoppedEmpty 202 | x:xs -> writeIORef styleStackRef xs >> pure x 203 | 204 | let go = \sds -> case sds of 205 | SFail -> panicUncaughtFail 206 | SEmpty -> pure () 207 | SChar c rest -> do 208 | hPutChar h c 209 | go rest 210 | SText _ t rest -> do 211 | T.hPutStr h t 212 | go rest 213 | SLine i rest -> do 214 | hPutChar h '\n' 215 | T.hPutStr h (T.replicate i (T.singleton ' ')) 216 | go rest 217 | SAnnPush style rest -> do 218 | currentStyle <- unsafePeek 219 | let newStyle = style <> currentStyle 220 | push newStyle 221 | T.hPutStr h (styleToRawText newStyle) 222 | go rest 223 | SAnnPop rest -> do 224 | _currentStyle <- unsafePop 225 | newStyle <- unsafePeek 226 | T.hPutStr h (styleToRawText newStyle) 227 | go rest 228 | go sdoc 229 | readIORef styleStackRef >>= \stack -> case stack of 230 | [] -> panicStyleStackFullyConsumed 231 | [_] -> pure () 232 | xs -> panicStyleStackNotFullyConsumed (length xs) 233 | 234 | panicStyleStackFullyConsumed :: void 235 | panicStyleStackFullyConsumed 236 | = error ("There is no empty style left at the end of rendering" ++ 237 | " (but there should be). Please report this as a bug.") 238 | 239 | panicStyleStackNotFullyConsumed :: Int -> void 240 | panicStyleStackNotFullyConsumed len 241 | = error ("There are " <> show len <> " styles left at the" ++ 242 | "end of rendering (there should be only 1). Please report" ++ 243 | " this as a bug.") 244 | 245 | -- $ 246 | -- >>> let render = renderIO System.IO.stdout . layoutPretty defaultLayoutOptions 247 | -- >>> let doc = annotate (color Red) ("red" <+> align (vsep [annotate (color Blue <> underlined) ("blue+u" <+> annotate bold "bold" <+> "blue+u"), "red"])) 248 | -- >>> render (unAnnotate doc) 249 | -- red blue+u bold blue+u 250 | -- red 251 | -- 252 | -- This test won’t work since I don’t know how to type \ESC for doctest :-/ 253 | -- -- >>> render doc 254 | -- -- \ESC[0;91mred \ESC[0;94;4mblue+u \ESC[0;94;1;4mbold\ESC[0;94;4m blue+u\ESC[0;91m 255 | -- -- red\ESC[0m 256 | 257 | -- | Render the annotated document in a certain style. Styles not set in the 258 | -- annotation will use the style of the surrounding document, or the terminal’s 259 | -- default if none has been set yet. 260 | -- 261 | -- @ 262 | -- style = 'color' 'Green' '<>' 'bold' 263 | -- styledDoc = 'annotate' style "hello world" 264 | -- @ 265 | data AnsiStyle = SetAnsiStyle 266 | { ansiForeground :: Maybe (Intensity, Color) -- ^ Set the foreground color, or keep the old one. 267 | , ansiBackground :: Maybe (Intensity, Color) -- ^ Set the background color, or keep the old one. 268 | , ansiBold :: Maybe Bold -- ^ Switch on boldness, or don’t do anything. 269 | , ansiItalics :: Maybe Italicized -- ^ Switch on italics, or don’t do anything. 270 | , ansiUnderlining :: Maybe Underlined -- ^ Switch on underlining, or don’t do anything. 271 | } deriving (Eq, Ord, Show) 272 | 273 | -- | Keep the first decision for each of foreground color, background color, 274 | -- boldness, italication, and underlining. If a certain style is not set, the 275 | -- terminal’s default will be used. 276 | -- 277 | -- Example: 278 | -- 279 | -- @ 280 | -- 'color' 'Red' '<>' 'color' 'Green' 281 | -- @ 282 | -- 283 | -- is red because the first color wins, and not bold because (or if) that’s the 284 | -- terminal’s default. 285 | instance Semigroup AnsiStyle where 286 | cs1 <> cs2 = SetAnsiStyle 287 | { ansiForeground = ansiForeground cs1 <|> ansiForeground cs2 288 | , ansiBackground = ansiBackground cs1 <|> ansiBackground cs2 289 | , ansiBold = ansiBold cs1 <|> ansiBold cs2 290 | , ansiItalics = ansiItalics cs1 <|> ansiItalics cs2 291 | , ansiUnderlining = ansiUnderlining cs1 <|> ansiUnderlining cs2 } 292 | 293 | -- | 'mempty' does nothing, which is equivalent to inheriting the style of the 294 | -- surrounding doc, or the terminal’s default if no style has been set yet. 295 | instance Monoid AnsiStyle where 296 | mempty = SetAnsiStyle Nothing Nothing Nothing Nothing Nothing 297 | mappend = (<>) 298 | 299 | styleToRawText :: AnsiStyle -> Text 300 | styleToRawText = T.pack . ANSI.setSGRCode . stylesToSgrs 301 | where 302 | stylesToSgrs :: AnsiStyle -> [ANSI.SGR] 303 | stylesToSgrs (SetAnsiStyle fg bg b i u) = catMaybes 304 | [ Just ANSI.Reset 305 | , fmap (\(intensity, c) -> ANSI.SetColor ANSI.Foreground (convertIntensity intensity) (convertColor c)) fg 306 | , fmap (\(intensity, c) -> ANSI.SetColor ANSI.Background (convertIntensity intensity) (convertColor c)) bg 307 | , fmap (\_ -> ANSI.SetConsoleIntensity ANSI.BoldIntensity) b 308 | , fmap (\_ -> ANSI.SetItalicized True) i 309 | , fmap (\_ -> ANSI.SetUnderlining ANSI.SingleUnderline) u 310 | ] 311 | 312 | convertIntensity :: Intensity -> ANSI.ColorIntensity 313 | convertIntensity = \i -> case i of 314 | Vivid -> ANSI.Vivid 315 | Dull -> ANSI.Dull 316 | 317 | convertColor :: Color -> ANSI.Color 318 | convertColor = \c -> case c of 319 | Black -> ANSI.Black 320 | Red -> ANSI.Red 321 | Green -> ANSI.Green 322 | Yellow -> ANSI.Yellow 323 | Blue -> ANSI.Blue 324 | Magenta -> ANSI.Magenta 325 | Cyan -> ANSI.Cyan 326 | White -> ANSI.White 327 | 328 | 329 | 330 | -- | @('renderStrict' sdoc)@ takes the output @sdoc@ from a rendering and 331 | -- transforms it to strict text. 332 | renderStrict :: SimpleDocStream AnsiStyle -> Text 333 | renderStrict = TL.toStrict . renderLazy 334 | 335 | -- | @('putDoc' doc)@ prettyprints document @doc@ to standard output using 336 | -- 'defaultLayoutOptions'. 337 | -- 338 | -- >>> putDoc ("hello" <+> "world") 339 | -- hello world 340 | -- 341 | -- @ 342 | -- 'putDoc' = 'hPutDoc' 'stdout' 343 | -- @ 344 | putDoc :: Doc AnsiStyle -> IO () 345 | putDoc = hPutDoc stdout 346 | 347 | -- | Like 'putDoc', but instead of using 'stdout', print to a user-provided 348 | -- handle, e.g. a file or a socket using 'defaultLayoutOptions'. 349 | -- 350 | -- > main = withFile "someFile.txt" (\h -> hPutDoc h (vcat ["vertical", "text"])) 351 | -- 352 | -- @ 353 | -- 'hPutDoc' h doc = 'renderIO' h ('layoutPretty' 'defaultLayoutOptions' doc) 354 | -- @ 355 | hPutDoc :: Handle -> Doc AnsiStyle -> IO () 356 | hPutDoc h doc = renderIO h (layoutPretty defaultLayoutOptions doc) 357 | -------------------------------------------------------------------------------- /prettyprinter-ansi-terminal/test/Doctest/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Test.DocTest 4 | 5 | main :: IO () 6 | main = doctest [ "src" , "-Imisc"] 7 | -------------------------------------------------------------------------------- /prettyprinter-compat-annotated-wl-pprint/LICENSE.md: -------------------------------------------------------------------------------- 1 | ../LICENSE.md -------------------------------------------------------------------------------- /prettyprinter-compat-annotated-wl-pprint/README.md: -------------------------------------------------------------------------------- 1 | annotated-wl-pprint compatibility package 2 | ========================================= 3 | 4 | This package defines a compatibility layer between the old `annotated-wl-pprint` 5 | package, and the newer `prettyprinter` package. 6 | 7 | This allows easily transitioning dependent packages from the old to the new 8 | package, by simply replacing `annotated-wl-pprint` with `prettyprinter` in the 9 | `.cabal` file. 10 | 11 | Note that this package is **only for transitional purposes**, and therefore 12 | deprecated and wholly undocumented. For new development, use the current version 13 | of `prettyprinter`. 14 | -------------------------------------------------------------------------------- /prettyprinter-compat-annotated-wl-pprint/Setup.lhs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | > import Distribution.Simple 3 | > main = defaultMain 4 | -------------------------------------------------------------------------------- /prettyprinter-compat-annotated-wl-pprint/misc/version-compatibility-macros.h: -------------------------------------------------------------------------------- 1 | ../../aux/version-compatibility-macros.h -------------------------------------------------------------------------------- /prettyprinter-compat-annotated-wl-pprint/prettyprinter-compat-annotated-wl-pprint.cabal: -------------------------------------------------------------------------------- 1 | name: prettyprinter-compat-annotated-wl-pprint 2 | version: 1.1 3 | cabal-version: >= 1.10 4 | category: User Interfaces, Text 5 | synopsis: Drop-in compatibility package to migrate from »annotated-wl-pprint« to »prettyprinter«. 6 | description: See README.md 7 | license: BSD2 8 | license-file: LICENSE.md 9 | extra-source-files: README.md 10 | , misc/version-compatibility-macros.h 11 | author: Daan Leijen, David Raymond Christiansen, David Luposchainsky 12 | maintainer: David Luposchainsky 13 | bug-reports: http://github.com/quchen/prettyprinter/issues 14 | homepage: http://github.com/quchen/prettyprinter 15 | build-type: Simple 16 | tested-with: GHC==9.4.1, GHC==9.2.4, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 17 | 18 | source-repository head 19 | type: git 20 | location: git://github.com/quchen/prettyprinter.git 21 | 22 | library 23 | exposed-modules: Text.PrettyPrint.Annotated.Leijen 24 | ghc-options: -Wall 25 | hs-source-dirs: src 26 | include-dirs: misc 27 | default-language: Haskell2010 28 | other-extensions: CPP 29 | 30 | build-depends: 31 | base >= 4.5 && < 5 32 | , text >= 1.2 33 | , prettyprinter >= 1.7 34 | -------------------------------------------------------------------------------- /prettyprinter-compat-annotated-wl-pprint/src/Text/PrettyPrint/Annotated/Leijen.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | #include "version-compatibility-macros.h" 4 | 5 | module Text.PrettyPrint.Annotated.Leijen {-# DEPRECATED "Compatibility module for users of annotated-wl-pprint - use \"Prettyprinter\" instead" #-} ( 6 | 7 | Doc, SimpleDoc, SpanList, putDoc, hPutDoc, empty, char, text, (<>), nest, 8 | line, linebreak, group, softline, softbreak, align, hang, indent, 9 | encloseSep, list, tupled, semiBraces, (<+>), (<$>), (), (<$$>), (), 10 | hsep, vsep, fillSep, sep, hcat, vcat, fillCat, cat, punctuate, fill, 11 | fillBreak, enclose, squotes, dquotes, parens, angles, braces, brackets, 12 | lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket, squote, 13 | dquote, semi, colon, comma, space, dot, backslash, equals, pipe, string, 14 | int, integer, float, double, rational, bool, annotate, noAnnotate, 15 | renderPretty, renderCompact, displayDecorated, displayDecoratedA, display, 16 | displayS, displayIO, displaySpans, column, nesting, width 17 | 18 | ) where 19 | 20 | #if MIN_VERSION_base(4,8,0) 21 | import Prelude hiding ((<$>)) 22 | #else 23 | import Prelude 24 | #endif 25 | 26 | #if !(MONOID_IN_PRELUDE) 27 | import Data.Monoid hiding ((<>)) 28 | #endif 29 | 30 | import Control.Applicative hiding (empty, (<$>)) 31 | import qualified Data.Text as T 32 | import qualified Data.Text.IO as T 33 | import System.IO 34 | 35 | import Prettyprinter 36 | import qualified Prettyprinter.Render.String as New 37 | import qualified Prettyprinter.Render.Text as New 38 | import Prettyprinter.Render.Util.Panic 39 | 40 | 41 | 42 | type SimpleDoc = SimpleDocStream 43 | 44 | putDoc :: Doc () -> IO () 45 | putDoc = New.putDoc 46 | 47 | hPutDoc :: Handle -> Doc () -> IO () 48 | hPutDoc = New.hPutDoc 49 | 50 | displayS :: SimpleDoc ann -> ShowS 51 | displayS = New.renderShowS 52 | 53 | renderPretty :: Float -> Int -> Doc ann -> SimpleDoc ann 54 | renderPretty ribbonFraction pWidth 55 | = layoutPretty LayoutOptions 56 | { layoutPageWidth = AvailablePerLine pWidth (realToFrac ribbonFraction) } 57 | 58 | renderCompact :: Doc ann -> SimpleDoc ann 59 | renderCompact = layoutCompact 60 | 61 | display :: SimpleDoc ann -> String 62 | display = flip displayS "" 63 | 64 | noAnnotate :: Doc ann -> Doc xxx 65 | noAnnotate = unAnnotate 66 | 67 | linebreak :: Doc ann 68 | linebreak = line' 69 | 70 | softbreak :: Doc ann 71 | softbreak = softline' 72 | 73 | semiBraces :: [Doc ann] -> Doc ann 74 | semiBraces = encloseSep lbrace rbrace semi 75 | 76 | (<$>), (), (<$$>), () :: Doc ann -> Doc ann -> Doc ann 77 | (<$>) = \x y -> x <> line <> y 78 | () = \x y -> x <> softline <> y 79 | (<$$>) = \x y -> x <> line' <> y 80 | () = \x y -> x <> softline' <> y 81 | 82 | empty :: Doc ann 83 | empty = emptyDoc 84 | 85 | char :: Char -> Doc ann 86 | char = pretty 87 | 88 | bool :: Bool -> Doc ann 89 | bool = pretty 90 | 91 | text, string :: String -> Doc ann 92 | text = pretty 93 | string = pretty 94 | 95 | int :: Int -> Doc ann 96 | int = pretty 97 | 98 | integer :: Integer -> Doc ann 99 | integer = pretty 100 | 101 | float :: Float -> Doc ann 102 | float = pretty 103 | 104 | double :: Double -> Doc ann 105 | double = pretty 106 | 107 | rational :: Rational -> Doc ann 108 | rational = pretty . show 109 | 110 | displayDecorated :: (a -> String -> String) -> SimpleDoc a -> String 111 | displayDecorated decor sd = go id id [] sd "" 112 | where 113 | go s d [] SEmpty = d . s 114 | go s d stk (SChar c x) = go (s . showChar c) d stk x 115 | go s d stk (SText _ str x) = go (s . showString (T.unpack str)) d stk x 116 | go s d stk (SLine ind x) = go (s . showString ('\n':replicate ind ' ')) d stk x 117 | go s d stk (SAnnPush ann x) = go id (decor ann) ((s, d):stk) x 118 | go s d ((sf', d'):stk) (SAnnPop x) = let formatted = d (s "") 119 | in go (sf' . showString formatted) d' stk x 120 | go _ _ [] (SAnnPop _) = error "stack underflow" 121 | go _ _ _ SEmpty = error "stack not consumed by rendering" 122 | go _ _ _ SFail = panicUncaughtFail 123 | 124 | displayDecoratedA :: (Applicative f, Monoid b) 125 | => (String -> f b) -> (a -> f b) -> (a -> f b) 126 | -> SimpleDoc a -> f b 127 | displayDecoratedA str start end sd = go [] sd 128 | where 129 | go [] SEmpty = pure mempty 130 | go stk (SChar c x) = str [c] <++> go stk x 131 | go stk (SText _ s x) = str (T.unpack s) <++> go stk x 132 | go stk (SLine ind x) = str ('\n' : replicate ind ' ') <++> go stk x 133 | go stk (SAnnPush ann x) = start ann <++> go (ann:stk) x 134 | go (ann:stk) (SAnnPop x) = end ann <++> go stk x 135 | 136 | -- malformed documents 137 | go [] (SAnnPop _) = error "stack underflow" 138 | go _ SEmpty = error "stack not consumed by rendering" 139 | go _ SFail = panicUncaughtFail 140 | 141 | (<++>) = liftA2 mappend 142 | 143 | type SpanList a = [(Int, Int, a)] 144 | 145 | displaySpans :: SimpleDoc a -> (String, SpanList a) 146 | displaySpans sd = go 0 [] sd 147 | where 148 | go :: Int -> [(Int, a)] -> SimpleDoc a -> (String, SpanList a) 149 | go _ [] SEmpty = ("", []) 150 | go i stk (SChar c x) = let (str, spans) = go (i+1) stk x 151 | in (c:str, spans) 152 | go i stk (SText l s x) = mapFst (T.unpack s ++) (go (i + l) stk x) 153 | go i stk (SLine ind x) = mapFst (('\n':replicate ind ' ') ++) (go (1+i+ind) stk x) 154 | go i stk (SAnnPush ann x) = go i ((i, ann):stk) x 155 | go i ((start, ann):stk) (SAnnPop x) = mapSnd ((start, i-start, ann) :) (go i stk x) 156 | 157 | -- malformed documents 158 | go _ [] (SAnnPop _) = error "stack underflow" 159 | go _ _ SEmpty = error "Stack not consumed by rendering" 160 | go _ _ SFail = panicUncaughtFail 161 | 162 | mapFst :: (a -> b) -> (a, c) -> (b, c) 163 | mapFst f (x, y) = (f x, y) 164 | 165 | mapSnd :: (a -> b) -> (c, a) -> (c, b) 166 | mapSnd f (x, y) = (x, f y) 167 | 168 | displayIO :: Handle -> SimpleDoc a -> IO () 169 | displayIO h simpleDoc = go simpleDoc 170 | where 171 | go SFail = panicUncaughtFail 172 | go SEmpty = pure () 173 | go (SChar c x) = hPutChar h c >> go x 174 | go (SText _ s x) = T.hPutStr h s >> go x 175 | go (SLine i x) = hPutStr h ('\n':replicate i ' ') >> go x 176 | go (SAnnPush _ x) = go x 177 | go (SAnnPop x) = go x 178 | -------------------------------------------------------------------------------- /prettyprinter-compat-ansi-wl-pprint/LICENSE.md: -------------------------------------------------------------------------------- 1 | ../LICENSE.md -------------------------------------------------------------------------------- /prettyprinter-compat-ansi-wl-pprint/README.md: -------------------------------------------------------------------------------- 1 | ansi-wl-pprint compatibility package 2 | ==================================== 3 | 4 | This package defines a compatibility layer between the old `ansi-wl-pprint` 5 | package, and the new `prettyprinter`/`prettyprinter-ansi-terminal` ones. 6 | 7 | This allows easily transitioning dependent packages from the old to the new 8 | package, by simply replacing `ansi-wl-pprint` with `prettyprinter-ansi-terminal` 9 | in the `.cabal` file. For adapting third party plugins that output 10 | `ansi-wl-pprint` data, use the proper converter from the 11 | `prettyprinter-convert-ansi-wl-pprint` module. 12 | 13 | Note that this package is **only for transitional purposes**, and therefore 14 | deprecated and wholly undocumented. For new development, use the current version 15 | of `prettyprinter`, and the ANSI terminal backend provided in 16 | `prettyprinter-ansi-terminal`. 17 | -------------------------------------------------------------------------------- /prettyprinter-compat-ansi-wl-pprint/Setup.lhs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | > import Distribution.Simple 3 | > main = defaultMain 4 | -------------------------------------------------------------------------------- /prettyprinter-compat-ansi-wl-pprint/prettyprinter-compat-ansi-wl-pprint.cabal: -------------------------------------------------------------------------------- 1 | name: prettyprinter-compat-ansi-wl-pprint 2 | version: 1.0.2 3 | cabal-version: >= 1.10 4 | category: User Interfaces, Text 5 | synopsis: Drop-in compatibility package to migrate from »ansi-wl-pprint« to »prettyprinter«. 6 | description: See README.md 7 | license: BSD2 8 | license-file: LICENSE.md 9 | extra-source-files: README.md 10 | author: David Luposchainsky 11 | maintainer: David Luposchainsky 12 | bug-reports: http://github.com/quchen/prettyprinter/issues 13 | homepage: http://github.com/quchen/prettyprinter 14 | build-type: Simple 15 | tested-with: GHC==9.4.1, GHC==9.2.4, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 16 | 17 | source-repository head 18 | type: git 19 | location: git://github.com/quchen/prettyprinter.git 20 | 21 | library 22 | exposed-modules: Text.PrettyPrint.ANSI.Leijen 23 | ghc-options: -Wall 24 | hs-source-dirs: src 25 | default-language: Haskell2010 26 | other-extensions: 27 | CPP 28 | , OverloadedStrings 29 | 30 | build-depends: 31 | base >= 4.5 && < 5 && < 5 32 | , text >= 1.2 33 | , prettyprinter >= 1.7.0 34 | , prettyprinter-ansi-terminal >= 1.1 35 | 36 | if !impl(ghc >= 8.0) 37 | build-depends: semigroups >= 0.1 38 | -------------------------------------------------------------------------------- /prettyprinter-compat-ansi-wl-pprint/src/Text/PrettyPrint/ANSI/Leijen.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module Text.PrettyPrint.ANSI.Leijen {-# DEPRECATED "Compatibility module for users of ansi-wl-pprint - use \"Prettyprinter\" instead" #-} ( 4 | 5 | Doc, putDoc, hPutDoc, empty, char, text, (<>), nest, line, linebreak, group, 6 | softline, softbreak, hardline, flatAlt, renderSmart, align, hang, indent, 7 | encloseSep, list, tupled, semiBraces, (<+>), (<$>), (), (<$$>), (), 8 | hsep, vsep, fillSep, sep, hcat, vcat, fillCat, cat, punctuate, fill, 9 | fillBreak, enclose, squotes, dquotes, parens, angles, braces, brackets, 10 | lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket, squote, 11 | dquote, semi, colon, comma, space, dot, backslash, equals, black, red, 12 | green, yellow, blue, magenta, cyan, white, dullblack, dullred, dullgreen, 13 | dullyellow, dullblue, dullmagenta, dullcyan, dullwhite, onblack, onred, 14 | ongreen, onyellow, onblue, onmagenta, oncyan, onwhite, ondullblack, 15 | ondullred, ondullgreen, ondullyellow, ondullblue, ondullmagenta, ondullcyan, 16 | ondullwhite, bold, debold, underline, deunderline, plain, string, int, 17 | integer, float, double, rational, Pretty(..), SimpleDoc, renderPretty, 18 | renderCompact, displayS, displayIO, bool, column, columns, nesting, width 19 | 20 | ) where 21 | 22 | #if MIN_VERSION_base(4,8,0) 23 | import Prelude hiding ((<$>)) 24 | #else 25 | import Prelude 26 | #endif 27 | 28 | import qualified Data.Text.Lazy as TL 29 | import System.IO 30 | 31 | import Prettyprinter (Pretty (..)) 32 | import qualified Prettyprinter as New 33 | import qualified Prettyprinter.Render.Terminal as NewT 34 | 35 | #if !(MIN_VERSION_base(4,11,0)) 36 | import Data.Semigroup 37 | #endif 38 | 39 | type Doc = New.Doc NewT.AnsiStyle 40 | type SimpleDoc = New.SimpleDocStream NewT.AnsiStyle 41 | 42 | 43 | 44 | putDoc :: Doc -> IO () 45 | putDoc = NewT.putDoc 46 | 47 | hPutDoc :: Handle -> Doc -> IO () 48 | hPutDoc = NewT.hPutDoc 49 | 50 | empty :: Doc 51 | empty = New.emptyDoc 52 | 53 | char :: Char -> Doc 54 | char = New.pretty 55 | 56 | text :: String -> Doc 57 | text = New.pretty 58 | 59 | nest :: Int -> Doc -> Doc 60 | nest = New.nest 61 | 62 | line :: Doc 63 | line = New.line 64 | 65 | linebreak :: Doc 66 | linebreak = New.flatAlt New.line mempty 67 | 68 | group :: Doc -> Doc 69 | group = New.group 70 | 71 | softline :: Doc 72 | softline = New.softline 73 | 74 | softbreak :: Doc 75 | softbreak = New.group linebreak 76 | 77 | hardline :: Doc 78 | hardline = New.hardline 79 | 80 | flatAlt :: Doc -> Doc -> Doc 81 | flatAlt = New.flatAlt 82 | 83 | renderSmart :: Float -> Int -> Doc -> SimpleDoc 84 | renderSmart ribbonFraction pageWidth 85 | = New.layoutSmart New.LayoutOptions 86 | { New.layoutPageWidth = New.AvailablePerLine pageWidth (realToFrac ribbonFraction) } 87 | 88 | align :: Doc -> Doc 89 | align = New.align 90 | 91 | hang :: Int -> Doc -> Doc 92 | hang = New.hang 93 | 94 | indent :: Int -> Doc -> Doc 95 | indent = New.indent 96 | 97 | encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc 98 | encloseSep = New.encloseSep 99 | 100 | list :: [Doc] -> Doc 101 | list = New.list 102 | 103 | tupled :: [Doc] -> Doc 104 | tupled = New.tupled 105 | 106 | semiBraces :: [Doc] -> Doc 107 | semiBraces = New.encloseSep New.lbrace New.rbrace New.semi 108 | 109 | (<+>), (<$>), (), (<$$>), () :: Doc -> Doc -> Doc 110 | (<+>) = (New.<+>) 111 | (<$>) = \x y -> x <> New.line <> y 112 | () = \x y -> x <> softline <> y 113 | (<$$>) = \x y -> x <> linebreak <> y 114 | () = \x y -> x <> softbreak <> y 115 | 116 | hsep, vsep, fillSep, sep, hcat, vcat, fillCat, cat :: [Doc] -> Doc 117 | hsep = New.hsep 118 | vsep = New.vsep 119 | fillSep = New.fillSep 120 | sep = New.sep 121 | hcat = New.hcat 122 | vcat = New.vcat 123 | fillCat = New.fillCat 124 | cat = New.cat 125 | 126 | punctuate :: Doc -> [Doc] -> [Doc] 127 | punctuate = New.punctuate 128 | 129 | fill :: Int -> Doc -> Doc 130 | fill = New.fill 131 | 132 | fillBreak :: Int -> Doc -> Doc 133 | fillBreak = New.fillBreak 134 | 135 | enclose :: Doc -> Doc -> Doc -> Doc 136 | enclose = New.enclose 137 | 138 | squotes, dquotes, parens, angles, braces, brackets :: Doc -> Doc 139 | squotes = New.squotes 140 | dquotes = New.dquotes 141 | parens = New.parens 142 | angles = New.angles 143 | braces = New.braces 144 | brackets = New.brackets 145 | 146 | lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket, squote, 147 | dquote, semi, colon, comma, space, dot, backslash, equals :: Doc 148 | lparen = New.lparen 149 | rparen = New.rparen 150 | langle = New.langle 151 | rangle = New.rangle 152 | lbrace = New.lbrace 153 | rbrace = New.rbrace 154 | lbracket = New.lbracket 155 | rbracket = New.rbracket 156 | squote = New.squote 157 | dquote = New.dquote 158 | semi = New.semi 159 | colon = New.colon 160 | comma = New.comma 161 | space = New.space 162 | dot = New.dot 163 | backslash = New.backslash 164 | equals = New.equals 165 | 166 | black, red, green, yellow, blue, magenta, cyan, white, dullblack, dullred, 167 | dullgreen, dullyellow, dullblue, dullmagenta, dullcyan, dullwhite, onblack, 168 | onred, ongreen, onyellow, onblue, onmagenta, oncyan, onwhite, ondullblack, 169 | ondullred, ondullgreen, ondullyellow, ondullblue, ondullmagenta, ondullcyan, 170 | ondullwhite, bold, debold, underline, deunderline :: Doc -> Doc 171 | black = New.annotate (NewT.color NewT.Black) 172 | red = New.annotate (NewT.color NewT.Red) 173 | green = New.annotate (NewT.color NewT.Green) 174 | yellow = New.annotate (NewT.color NewT.Yellow) 175 | blue = New.annotate (NewT.color NewT.Blue) 176 | magenta = New.annotate (NewT.color NewT.Magenta) 177 | cyan = New.annotate (NewT.color NewT.Cyan) 178 | white = New.annotate (NewT.color NewT.White) 179 | dullblack = New.annotate (NewT.colorDull NewT.Black) 180 | dullred = New.annotate (NewT.colorDull NewT.Red) 181 | dullgreen = New.annotate (NewT.colorDull NewT.Green) 182 | dullyellow = New.annotate (NewT.colorDull NewT.Yellow) 183 | dullblue = New.annotate (NewT.colorDull NewT.Blue) 184 | dullmagenta = New.annotate (NewT.colorDull NewT.Magenta) 185 | dullcyan = New.annotate (NewT.colorDull NewT.Cyan) 186 | dullwhite = New.annotate (NewT.colorDull NewT.White) 187 | onblack = New.annotate (NewT.bgColor NewT.Black) 188 | onred = New.annotate (NewT.bgColor NewT.Red) 189 | ongreen = New.annotate (NewT.bgColor NewT.Green) 190 | onyellow = New.annotate (NewT.bgColor NewT.Yellow) 191 | onblue = New.annotate (NewT.bgColor NewT.Blue) 192 | onmagenta = New.annotate (NewT.bgColor NewT.Magenta) 193 | oncyan = New.annotate (NewT.bgColor NewT.Cyan) 194 | onwhite = New.annotate (NewT.bgColor NewT.White) 195 | ondullblack = New.annotate (NewT.bgColorDull NewT.Black) 196 | ondullred = New.annotate (NewT.bgColorDull NewT.Red) 197 | ondullgreen = New.annotate (NewT.bgColorDull NewT.Green) 198 | ondullyellow = New.annotate (NewT.bgColorDull NewT.Yellow) 199 | ondullblue = New.annotate (NewT.bgColorDull NewT.Blue) 200 | ondullmagenta = New.annotate (NewT.bgColorDull NewT.Magenta) 201 | ondullcyan = New.annotate (NewT.bgColorDull NewT.Cyan) 202 | ondullwhite = New.annotate (NewT.bgColorDull NewT.White) 203 | bold = New.annotate NewT.bold 204 | debold = id 205 | {-# WARNING debold "Debold does not do anything" #-} 206 | underline = New.annotate NewT.underlined 207 | deunderline = id 208 | {-# WARNING deunderline "Debold does not do anything" #-} 209 | 210 | plain :: Doc -> Doc 211 | plain = New.unAnnotate 212 | 213 | string :: String -> Doc 214 | string = New.pretty 215 | 216 | int :: Int -> Doc 217 | int = New.pretty 218 | 219 | integer :: Integer -> Doc 220 | integer = New.pretty 221 | 222 | float :: Float -> Doc 223 | float = New.pretty 224 | 225 | double :: Double -> Doc 226 | double = New.pretty 227 | 228 | rational :: Rational -> Doc 229 | rational = New.pretty . show 230 | 231 | renderPretty :: Float -> Int -> Doc -> SimpleDoc 232 | renderPretty ribbonFraction pageWidth 233 | = New.layoutSmart New.LayoutOptions 234 | { New.layoutPageWidth = New.AvailablePerLine pageWidth (realToFrac ribbonFraction) } 235 | 236 | 237 | renderCompact :: Doc -> SimpleDoc 238 | renderCompact = New.layoutCompact 239 | 240 | displayS :: SimpleDoc -> ShowS 241 | displayS sdoc = 242 | let rendered = NewT.renderLazy sdoc 243 | in (TL.unpack rendered ++) 244 | 245 | displayIO :: Handle -> SimpleDoc -> IO () 246 | displayIO = NewT.renderIO 247 | 248 | bool :: Bool -> Doc 249 | bool = New.pretty 250 | 251 | column :: (Int -> Doc) -> Doc 252 | column = New.column 253 | 254 | columns :: (Maybe Int -> Doc) -> Doc 255 | columns f = New.pageWidth (f . toMaybeInt) 256 | where 257 | toMaybeInt :: New.PageWidth -> Maybe Int 258 | toMaybeInt (New.AvailablePerLine cpl _) = Just cpl 259 | toMaybeInt New.Unbounded = Nothing 260 | 261 | nesting :: (Int -> Doc) -> Doc 262 | nesting = New.nesting 263 | 264 | width :: Doc -> (Int -> Doc) -> Doc 265 | width = New.width 266 | -------------------------------------------------------------------------------- /prettyprinter-compat-wl-pprint/LICENSE.md: -------------------------------------------------------------------------------- 1 | ../LICENSE.md -------------------------------------------------------------------------------- /prettyprinter-compat-wl-pprint/README.md: -------------------------------------------------------------------------------- 1 | wl-pprint compatibility package 2 | =============================== 3 | 4 | This package defines a compatibility layer between the old `wl-pprint` package, 5 | and the new `prettyprinter` package. 6 | 7 | This allows easily transitioning dependent packages from the old to the new 8 | package, by simply replacing `wl-pprint` with `prettyprinter-compat-wl-pprint` 9 | in the `.cabal` file. 10 | 11 | Note that this package is **only for transitional purposes**, and therefore 12 | deprecated and wholly undocumented. For new development, use the current version 13 | of `prettyprinter`. 14 | -------------------------------------------------------------------------------- /prettyprinter-compat-wl-pprint/Setup.lhs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | > import Distribution.Simple 3 | > main = defaultMain 4 | -------------------------------------------------------------------------------- /prettyprinter-compat-wl-pprint/prettyprinter-compat-wl-pprint.cabal: -------------------------------------------------------------------------------- 1 | name: prettyprinter-compat-wl-pprint 2 | version: 1.0.1 3 | cabal-version: >= 1.10 4 | category: User Interfaces, Text 5 | synopsis: Drop-in compatibility package to migrate from »wl-pprint« to »prettyprinter«. 6 | description: See README.md 7 | license: BSD2 8 | license-file: LICENSE.md 9 | extra-source-files: README.md 10 | author: Daan Leijen, Noam Lewis, David Luposchainsky 11 | maintainer: David Luposchainsky 12 | bug-reports: http://github.com/quchen/prettyprinter/issues 13 | homepage: http://github.com/quchen/prettyprinter 14 | build-type: Simple 15 | tested-with: GHC==9.4.1, GHC==9.2.4, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 16 | 17 | source-repository head 18 | type: git 19 | location: git://github.com/quchen/prettyprinter.git 20 | 21 | library 22 | exposed-modules: Text.PrettyPrint.Leijen 23 | ghc-options: -Wall 24 | hs-source-dirs: src 25 | default-language: Haskell2010 26 | other-extensions: 27 | CPP 28 | , OverloadedStrings 29 | 30 | build-depends: 31 | base >= 4.5 && < 5 32 | , text >= 1.2 33 | , prettyprinter >= 1.7.0 34 | 35 | if !impl(ghc >= 8.0) 36 | build-depends: semigroups >= 0.1 37 | -------------------------------------------------------------------------------- /prettyprinter-compat-wl-pprint/src/Text/PrettyPrint/Leijen.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | module Text.PrettyPrint.Leijen {-# DEPRECATED "Compatibility module for users of wl-pprint - use \"Prettyprinter\" instead" #-} ( 4 | 5 | Doc, putDoc, hPutDoc, empty, char, text, (<>), nest, line, linebreak, group, 6 | softline, softbreak, align, hang, indent, encloseSep, list, tupled, 7 | semiBraces, (<+>), (<$>), (), (<$$>), (), hsep, vsep, fillSep, sep, 8 | hcat, vcat, fillCat, cat, punctuate, fill, fillBreak, enclose, squotes, 9 | dquotes, parens, angles, braces, brackets, lparen, rparen, langle, rangle, 10 | lbrace, rbrace, lbracket, rbracket, squote, dquote, semi, colon, comma, 11 | space, dot, backslash, equals, string, int, integer, float, double, 12 | rational, Pretty(..), SimpleDoc, renderPretty, renderCompact, displayS, 13 | displayIO, bool, column, nesting, width 14 | 15 | ) where 16 | 17 | 18 | 19 | #if MIN_VERSION_base(4,8,0) 20 | import Prelude hiding ((<$>)) 21 | #else 22 | import Prelude 23 | #endif 24 | 25 | import qualified Data.Text.Lazy as TL 26 | import System.IO 27 | 28 | import Prettyprinter (Pretty (..)) 29 | import qualified Prettyprinter as New 30 | import qualified Prettyprinter.Render.Text as NewT 31 | 32 | #if !(MIN_VERSION_base(4,11,0)) 33 | import Data.Semigroup 34 | #endif 35 | 36 | 37 | type Doc = New.Doc () 38 | type SimpleDoc = New.SimpleDocStream () 39 | 40 | 41 | 42 | putDoc :: Doc -> IO () 43 | putDoc = NewT.putDoc 44 | 45 | hPutDoc :: Handle -> Doc -> IO () 46 | hPutDoc = NewT.hPutDoc 47 | 48 | empty :: Doc 49 | empty = New.emptyDoc 50 | 51 | char :: Char -> Doc 52 | char = New.pretty 53 | 54 | text :: String -> Doc 55 | text = New.pretty 56 | 57 | nest :: Int -> Doc -> Doc 58 | nest = New.nest 59 | 60 | line :: Doc 61 | line = New.line 62 | 63 | linebreak :: Doc 64 | linebreak = New.flatAlt New.line mempty 65 | 66 | group :: Doc -> Doc 67 | group = New.group 68 | 69 | softline :: Doc 70 | softline = New.softline 71 | 72 | softbreak :: Doc 73 | softbreak = New.group linebreak 74 | 75 | align :: Doc -> Doc 76 | align = New.align 77 | 78 | hang :: Int -> Doc -> Doc 79 | hang = New.hang 80 | 81 | indent :: Int -> Doc -> Doc 82 | indent = New.indent 83 | 84 | encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc 85 | encloseSep = New.encloseSep 86 | 87 | list :: [Doc] -> Doc 88 | list = New.list 89 | 90 | tupled :: [Doc] -> Doc 91 | tupled = New.tupled 92 | 93 | semiBraces :: [Doc] -> Doc 94 | semiBraces = New.encloseSep New.lbrace New.rbrace New.semi 95 | 96 | (<+>), (<$>), (), (<$$>), () :: Doc -> Doc -> Doc 97 | (<+>) = (New.<+>) 98 | (<$>) = \x y -> x <> New.line <> y 99 | () = \x y -> x <> softline <> y 100 | (<$$>) = \x y -> x <> linebreak <> y 101 | () = \x y -> x <> softbreak <> y 102 | 103 | hsep, vsep, fillSep, sep, hcat, vcat, fillCat, cat :: [Doc] -> Doc 104 | hsep = New.hsep 105 | vsep = New.vsep 106 | fillSep = New.fillSep 107 | sep = New.sep 108 | hcat = New.hcat 109 | vcat = New.vcat 110 | fillCat = New.fillCat 111 | cat = New.cat 112 | 113 | punctuate :: Doc -> [Doc] -> [Doc] 114 | punctuate = New.punctuate 115 | 116 | fill :: Int -> Doc -> Doc 117 | fill = New.fill 118 | 119 | fillBreak :: Int -> Doc -> Doc 120 | fillBreak = New.fillBreak 121 | 122 | enclose :: Doc -> Doc -> Doc -> Doc 123 | enclose = New.enclose 124 | 125 | squotes, dquotes, parens, angles, braces, brackets :: Doc -> Doc 126 | squotes = New.squotes 127 | dquotes = New.dquotes 128 | parens = New.parens 129 | angles = New.angles 130 | braces = New.braces 131 | brackets = New.brackets 132 | 133 | lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket, squote, 134 | dquote, semi, colon, comma, space, dot, backslash, equals :: Doc 135 | lparen = New.lparen 136 | rparen = New.rparen 137 | langle = New.langle 138 | rangle = New.rangle 139 | lbrace = New.lbrace 140 | rbrace = New.rbrace 141 | lbracket = New.lbracket 142 | rbracket = New.rbracket 143 | squote = New.squote 144 | dquote = New.dquote 145 | semi = New.semi 146 | colon = New.colon 147 | comma = New.comma 148 | space = New.space 149 | dot = New.dot 150 | backslash = New.backslash 151 | equals = New.equals 152 | 153 | string :: String -> Doc 154 | string = New.pretty 155 | 156 | int :: Int -> Doc 157 | int = New.pretty 158 | 159 | integer :: Integer -> Doc 160 | integer = New.pretty 161 | 162 | float :: Float -> Doc 163 | float = New.pretty 164 | 165 | double :: Double -> Doc 166 | double = New.pretty 167 | 168 | rational :: Rational -> Doc 169 | rational = New.pretty . show 170 | 171 | renderPretty :: Float -> Int -> Doc -> SimpleDoc 172 | renderPretty ribbonFraction pageWidth 173 | = New.layoutPretty New.LayoutOptions 174 | { New.layoutPageWidth = New.AvailablePerLine pageWidth (realToFrac ribbonFraction) } 175 | 176 | renderCompact :: Doc -> SimpleDoc 177 | renderCompact = New.layoutCompact 178 | 179 | displayS :: SimpleDoc -> ShowS 180 | displayS sdoc = 181 | let rendered = NewT.renderLazy sdoc 182 | in (TL.unpack rendered ++) 183 | 184 | displayIO :: Handle -> SimpleDoc -> IO () 185 | displayIO = NewT.renderIO 186 | 187 | bool :: Bool -> Doc 188 | bool = New.pretty 189 | 190 | column :: (Int -> Doc) -> Doc 191 | column = New.column 192 | 193 | nesting :: (Int -> Doc) -> Doc 194 | nesting = New.nesting 195 | 196 | width :: Doc -> (Int -> Doc) -> Doc 197 | width = New.width 198 | -------------------------------------------------------------------------------- /prettyprinter-convert-ansi-wl-pprint/LICENSE.md: -------------------------------------------------------------------------------- 1 | ../LICENSE.md -------------------------------------------------------------------------------- /prettyprinter-convert-ansi-wl-pprint/README.md: -------------------------------------------------------------------------------- 1 | ansi-wl-pprint conversion package 2 | ================================= 3 | 4 | This package defines a converter from the old `ansi-wl-pprint` document type to 5 | the new `prettyprinter` one. Its purpose is making packages that only generate 6 | `ansi-wl-pprint` data available to the `prettyprinter` ecosystem. 7 | 8 | Note the difference to the `prettyprinter-compat-ansi-wl-pprint` module, which 9 | does *not* convert any data, and instead provides an API that mimicks 10 | `ansi-wl-pprint`, while secretly being `prettyprinter`-based behind the 11 | curtains. This package on the other hand does a proper conversion. 12 | 13 | ``` 14 | ╭────────────────────╮ fromAnsiWlPprint ╭────────────────────╮ 15 | │ Doc ├───────────────────────▷│ Doc AnsiStyle │ 16 | │ (ansi-wl-pprint) │◁───────────────────────┤ (prettyprinter) │ 17 | ╰────────────────────╯ toAnsiWlPprint ╰────────────────────╯ 18 | ``` 19 | -------------------------------------------------------------------------------- /prettyprinter-convert-ansi-wl-pprint/Setup.lhs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | > import Distribution.Simple 3 | > main = defaultMain 4 | -------------------------------------------------------------------------------- /prettyprinter-convert-ansi-wl-pprint/prettyprinter-convert-ansi-wl-pprint.cabal: -------------------------------------------------------------------------------- 1 | name: prettyprinter-convert-ansi-wl-pprint 2 | version: 1.1.2 3 | cabal-version: >= 1.10 4 | category: User Interfaces, Text 5 | synopsis: Converter from »ansi-wl-pprint« documents to »prettyprinter«-based ones. 6 | description: See README.md 7 | license: BSD2 8 | license-file: LICENSE.md 9 | extra-source-files: README.md 10 | author: David Luposchainsky 11 | maintainer: Simon Jakobi , David Luposchainsky 12 | bug-reports: http://github.com/quchen/prettyprinter/issues 13 | homepage: http://github.com/quchen/prettyprinter 14 | build-type: Simple 15 | tested-with: GHC==9.4.1, GHC==9.2.4, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 16 | 17 | source-repository head 18 | type: git 19 | location: git://github.com/quchen/prettyprinter.git 20 | 21 | library 22 | exposed-modules: Data.Text.Prettyprint.Convert.AnsiWlPprint 23 | , Prettyprinter.Convert.AnsiWlPprint 24 | ghc-options: -Wall 25 | hs-source-dirs: src 26 | default-language: Haskell2010 27 | other-extensions: 28 | CPP 29 | , OverloadedStrings 30 | 31 | build-depends: 32 | base >= 4.5 && < 5 33 | , text >= 1.2 34 | , prettyprinter >= 1.7.0 35 | , prettyprinter-ansi-terminal >= 1.1.1 36 | , ansi-wl-pprint >= 0.6.8 37 | , ansi-terminal 38 | 39 | test-suite doctest 40 | type: exitcode-stdio-1.0 41 | hs-source-dirs: test/Doctest 42 | main-is: Main.hs 43 | build-depends: 44 | base >= 4.7 && < 5 45 | , doctest >= 0.9 46 | ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N 47 | default-language: Haskell2010 48 | if impl (ghc < 7.10) 49 | buildable: False 50 | -- Doctest does not support searching through directories in old versions 51 | -------------------------------------------------------------------------------- /prettyprinter-convert-ansi-wl-pprint/src/Data/Text/Prettyprint/Convert/AnsiWlPprint.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Convert.AnsiWlPprint {-# DEPRECATED "Use \"Prettyprinter.Convert.AnsiWlPprint\" instead." #-} ( 2 | module Prettyprinter.Convert.AnsiWlPprint 3 | ) where 4 | 5 | import Prettyprinter.Convert.AnsiWlPprint 6 | -------------------------------------------------------------------------------- /prettyprinter-convert-ansi-wl-pprint/src/Prettyprinter/Convert/AnsiWlPprint.hs: -------------------------------------------------------------------------------- 1 | -- | Convert back and forth between the 'Old.Doc' type of the @ansi-wl-pprint@ 2 | -- and the 'New.Doc' of the prettyprinter package. Useful in order to use the 3 | -- @prettyprinter@ library together with another library that produces 4 | -- @ansi-wl-pprint@ output, and vice versa. 5 | -- 6 | -- @ 7 | -- ╭────────────────────╮ 'fromAnsiWlPprint' ╭────────────────────╮ 8 | -- │ 'Old.Doc' ├───────────────────────▷│ 'New.Doc' 'NewTerm.AnsiStyle' │ 9 | -- │ (ansi-wl-pprint) │◁───────────────────────┤ (prettyprinter) │ 10 | -- ╰────────────────────╯ 'toAnsiWlPprint' ╰────────────────────╯ 11 | -- @ 12 | -- 13 | -- These conversion functions work well, but strictly speaking they are __not__ 14 | -- inverses of each other. @ansi-wl-pprint@ supports slightly less features than 15 | -- @prettyprinter@ – the latter has italics, and allows reacting on the 16 | -- configured ribbon width via 'New.withPageWidth'. 17 | module Prettyprinter.Convert.AnsiWlPprint ( 18 | fromAnsiWlPprint, 19 | toAnsiWlPprint, 20 | ) where 21 | 22 | 23 | 24 | import qualified Data.Text as T 25 | 26 | import qualified Prettyprinter.Internal as New 27 | import qualified Prettyprinter.Render.Terminal.Internal as NewTerm 28 | import qualified System.Console.ANSI as Ansi 29 | import qualified Text.PrettyPrint.ANSI.Leijen.Internal as Old 30 | 31 | 32 | 33 | -- | @ansi-wl-pprint ───▷ prettyprinter@ 34 | fromAnsiWlPprint :: Old.Doc -> New.Doc NewTerm.AnsiStyle 35 | fromAnsiWlPprint = \doc -> case doc of 36 | Old.Fail -> New.Fail 37 | Old.Empty -> New.Empty 38 | Old.Char c -> New.Char c 39 | Old.Text l t -> New.Text l (T.pack t) 40 | Old.Line -> New.Line 41 | 42 | Old.FlatAlt x y -> New.FlatAlt (go x) (go y) 43 | Old.Cat x y -> New.Cat (go x) (go y) 44 | Old.Nest i x -> New.Nest i (go x) 45 | Old.Union x y -> New.Union (go x) (go y) 46 | 47 | Old.Column f -> New.Column (go . f) 48 | Old.Columns f -> New.WithPageWidth (go . f . convert) 49 | where 50 | convert :: New.PageWidth -> Maybe Int 51 | convert (New.AvailablePerLine width _ribbon) = Just width 52 | convert New.Unbounded = Nothing 53 | Old.Nesting f -> New.Nesting (go . f) 54 | 55 | Old.Color layer intensity color x -> 56 | let convertLayerIntensity :: Ansi.ConsoleLayer -> Ansi.ColorIntensity -> NewTerm.Color -> NewTerm.AnsiStyle 57 | convertLayerIntensity Ansi.Foreground Ansi.Dull = NewTerm.colorDull 58 | convertLayerIntensity Ansi.Background Ansi.Dull = NewTerm.bgColorDull 59 | convertLayerIntensity Ansi.Foreground Ansi.Vivid = NewTerm.color 60 | convertLayerIntensity Ansi.Background Ansi.Vivid = NewTerm.bgColor 61 | 62 | convertColor :: Ansi.Color -> NewTerm.AnsiStyle 63 | convertColor c = convertLayerIntensity layer intensity (case c of 64 | Ansi.Black -> NewTerm.Black 65 | Ansi.Red -> NewTerm.Red 66 | Ansi.Green -> NewTerm.Green 67 | Ansi.Yellow -> NewTerm.Yellow 68 | Ansi.Blue -> NewTerm.Blue 69 | Ansi.Magenta -> NewTerm.Magenta 70 | Ansi.Cyan -> NewTerm.Cyan 71 | Ansi.White -> NewTerm.White ) 72 | 73 | in New.annotate (convertColor color) (go x) 74 | Old.Intensify intensity x -> case intensity of 75 | Ansi.BoldIntensity -> New.annotate NewTerm.bold (go x) 76 | Ansi.FaintIntensity -> go x 77 | Ansi.NormalIntensity -> go x 78 | Old.Italicize i x -> case i of 79 | False -> go x 80 | True -> New.annotate NewTerm.italicized (go x) 81 | Old.Underline _ x -> New.annotate NewTerm.underlined (go x) 82 | Old.RestoreFormat{} -> error "Malformed input: RestoreFormat mayb only be used during rendering. Please report this as a bug." 83 | where 84 | go = fromAnsiWlPprint 85 | 86 | -- | @prettyprinter ───▷ ansi-wl-pprint@ 87 | toAnsiWlPprint :: New.Doc NewTerm.AnsiStyle -> Old.Doc 88 | toAnsiWlPprint = \doc -> case doc of 89 | New.Fail -> Old.Fail 90 | New.Empty -> Old.Empty 91 | New.Char c -> Old.Char c 92 | New.Text l t -> Old.Text l (T.unpack t) 93 | New.Line -> Old.Line 94 | 95 | New.FlatAlt x y -> Old.FlatAlt (go x) (go y) 96 | New.Cat x y -> Old.Cat (go x) (go y) 97 | New.Nest i x -> Old.Nest i (go x) 98 | New.Union x y -> Old.Union (go x) (go y) 99 | 100 | New.Column f -> Old.Column (go . f) 101 | New.WithPageWidth f -> Old.Columns (go . f . convert) 102 | where 103 | convert :: Maybe Int -> New.PageWidth 104 | convert Nothing = New.Unbounded 105 | convert (Just width) = New.AvailablePerLine width 1.0 106 | New.Nesting f -> Old.Nesting (go . f) 107 | 108 | New.Annotated style x -> (convertFg . convertBg . convertBold . convertUnderlining) (go x) 109 | -- Italics are unsupported by ansi-wl-pprint so we skip them 110 | where 111 | convertFg, convertBg, convertBold, convertUnderlining :: Old.Doc -> Old.Doc 112 | convertFg = case NewTerm.ansiForeground style of 113 | Nothing -> id 114 | Just (intensity, color) -> convertColor True intensity color 115 | convertBg = case NewTerm.ansiBackground style of 116 | Nothing -> id 117 | Just (intensity, color) -> convertColor False intensity color 118 | convertBold = case NewTerm.ansiBold style of 119 | Nothing -> id 120 | Just NewTerm.Bold -> Old.bold 121 | convertUnderlining = case NewTerm.ansiUnderlining style of 122 | Nothing -> id 123 | Just NewTerm.Underlined -> Old.underline 124 | 125 | convertColor 126 | :: Bool -- True = foreground, False = background 127 | -> NewTerm.Intensity 128 | -> NewTerm.Color 129 | -> Old.Doc 130 | -> Old.Doc 131 | convertColor True NewTerm.Vivid NewTerm.Black = Old.black 132 | convertColor True NewTerm.Vivid NewTerm.Red = Old.red 133 | convertColor True NewTerm.Vivid NewTerm.Green = Old.green 134 | convertColor True NewTerm.Vivid NewTerm.Yellow = Old.yellow 135 | convertColor True NewTerm.Vivid NewTerm.Blue = Old.blue 136 | convertColor True NewTerm.Vivid NewTerm.Magenta = Old.magenta 137 | convertColor True NewTerm.Vivid NewTerm.Cyan = Old.cyan 138 | convertColor True NewTerm.Vivid NewTerm.White = Old.white 139 | 140 | convertColor True NewTerm.Dull NewTerm.Black = Old.dullblack 141 | convertColor True NewTerm.Dull NewTerm.Red = Old.dullred 142 | convertColor True NewTerm.Dull NewTerm.Green = Old.dullgreen 143 | convertColor True NewTerm.Dull NewTerm.Yellow = Old.dullyellow 144 | convertColor True NewTerm.Dull NewTerm.Blue = Old.dullblue 145 | convertColor True NewTerm.Dull NewTerm.Magenta = Old.dullmagenta 146 | convertColor True NewTerm.Dull NewTerm.Cyan = Old.dullcyan 147 | convertColor True NewTerm.Dull NewTerm.White = Old.dullwhite 148 | 149 | convertColor False NewTerm.Vivid NewTerm.Black = Old.onblack 150 | convertColor False NewTerm.Vivid NewTerm.Red = Old.onred 151 | convertColor False NewTerm.Vivid NewTerm.Green = Old.ongreen 152 | convertColor False NewTerm.Vivid NewTerm.Yellow = Old.onyellow 153 | convertColor False NewTerm.Vivid NewTerm.Blue = Old.onblue 154 | convertColor False NewTerm.Vivid NewTerm.Magenta = Old.onmagenta 155 | convertColor False NewTerm.Vivid NewTerm.Cyan = Old.oncyan 156 | convertColor False NewTerm.Vivid NewTerm.White = Old.onwhite 157 | 158 | convertColor False NewTerm.Dull NewTerm.Black = Old.ondullblack 159 | convertColor False NewTerm.Dull NewTerm.Red = Old.ondullred 160 | convertColor False NewTerm.Dull NewTerm.Green = Old.ondullgreen 161 | convertColor False NewTerm.Dull NewTerm.Yellow = Old.ondullyellow 162 | convertColor False NewTerm.Dull NewTerm.Blue = Old.ondullblue 163 | convertColor False NewTerm.Dull NewTerm.Magenta = Old.ondullmagenta 164 | convertColor False NewTerm.Dull NewTerm.Cyan = Old.ondullcyan 165 | convertColor False NewTerm.Dull NewTerm.White = Old.ondullwhite 166 | 167 | where 168 | go = toAnsiWlPprint 169 | -------------------------------------------------------------------------------- /prettyprinter-convert-ansi-wl-pprint/test/Doctest/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Test.DocTest 4 | 5 | main :: IO () 6 | main = doctest ["src"] 7 | -------------------------------------------------------------------------------- /prettyprinter/CHANGELOG.md: -------------------------------------------------------------------------------- 1 | # [1.7.1] 2 | 3 | - [Deprecate the `Data.Text.Prettyprint.*` modules](https://github.com/quchen/prettyprinter/pull/203) 4 | * Users should migrate to the new `Prettyprinter` module hierarchy. 5 | * The old modules will be removed no sooner than September 2022. 6 | - [Make `text` an optional dependency:](https://github.com/quchen/prettyprinter/pull/202) 7 | * When built with `-f-text`, any `text`-based APIs will operate on `String`s instead. 8 | - Documentation improvements: 9 | * [#194](https://github.com/quchen/prettyprinter/pull/194) 10 | * [`1f0bffe`](https://github.com/quchen/prettyprinter/commit/1f0bffe5eb53874d1ba46b0a80bda67c02365f1b) 11 | 12 | [1.7.1]: https://github.com/quchen/prettyprinter/compare/v1.7.0...v1.7.1 13 | 14 | # [1.7.0] 15 | 16 | ## Breaking changes 17 | 18 | - [Fix `layoutPretty` and `layoutSmart` so they don't produce trailing whitespace as a result of indenting empty lines.](https://github.com/quchen/prettyprinter/pull/139) 19 | * Users of `removeTrailingWhitespace` should check whether it is still needed. 20 | - [Use `floor` instead of `round` to compute ribbon width.](https://github.com/quchen/prettyprinter/pull/160) 21 | - [Remove deprecated `Data.Text.Prettyprint.Doc.Render.ShowS` module.](https://github.com/quchen/prettyprinter/pull/173) 22 | - [Add optimized implementation of `stimes` for `Doc`.](https://github.com/quchen/prettyprinter/pull/135) 23 | - [Generalize the type of `layoutCompact` to clarify that it doesn't preserve annotations.](https://github.com/quchen/prettyprinter/pull/183) 24 | - [Add strictness annotations in `SimpleDocStream` and `PageWidth`.](https://github.com/quchen/prettyprinter/pull/129) 25 | 26 | ## Non-breaking changes 27 | 28 | - [Add shallower `Prettyprinter` module hierarchy exposing the same API.](https://github.com/quchen/prettyprinter/pull/174) 29 | * The current plan for the existing `Data.Text.Prettyprint.Doc*` modules is: 30 | * Start deprecation in early 2021. 31 | * Remove the modules after a deprecation period of at least one year. 32 | - [Fix build with GHC 7.4.](https://github.com/quchen/prettyprinter/pull/187) 33 | - Various documentation improvements. 34 | 35 | [1.7.0]: https://github.com/quchen/prettyprinter/compare/v1.6.2...v1.7.0 36 | 37 | # 1.6.2 38 | 39 | - Speed up rendering to lazy and strict `Text`. 40 | - Documentation improvements for `group` and `flatAlt`. 41 | - Internal refactoring of the `layoutWadlerLeijen`-based layouters. 42 | 43 | # 1.6.1 44 | 45 | - Slightly reduce the scope of the fitting predicates for some edge cases. 46 | - Use an export list in `Data.Text.Prettyprint.Doc.Internal`. 47 | - Improve `group` for `Union` and `FlatAlt`. 48 | - Speed up `removeTrailingWhitespace`. 49 | - Improve generating spaces for indentation and `spaces`. 50 | - Simplify some `Doc` constants by defining them as `Doc` literals. 51 | - Enable `-O2`. 52 | - Various documentation fixes and improvements. 53 | 54 | # 1.6.0 55 | 56 | ## Breaking changes 57 | 58 | - Fix `fuse`'s handling of annotated documents: 59 | - Don't remove annotations on empty documents. 60 | - Apply fusion within annotations. 61 | - Fix layouting of hard linebreaks with `Unbounded` page widths. 62 | 63 | ## Non-breaking changes 64 | 65 | - Speed up `group` for documents containing linebreaks and previously 66 | `group`ed documents. 67 | - Add debugging helpers in `Data.Text.Prettyprint.Doc.Internal.Debug` 68 | - Documentation improvements and fixes 69 | 70 | # 1.5.1 71 | 72 | - Removing trailing whitespace sometimes restored necessary whitespace in the 73 | wrong spot 74 | 75 | # 1.5 76 | 77 | - Fix inconsistent formatting within align and wide sub-docs on narrow layouts 78 | 79 | # 1.4 80 | 81 | - Add fixity declaration to `<+>`, matching `<>` 82 | - Fix removal of trailing whitespace 83 | 84 | # 1.3.0.1 85 | 86 | - Support Stack 2 87 | 88 | # 1.3.0 89 | 90 | - Add alignment to Pretty [a] instance 91 | - Fix removal of blank lines in `removeTrailingWhitespace` 92 | - Widened support for GHC versions 7.4–8.8 93 | 94 | # 1.2.1.1 95 | 96 | - Fix dependency of doctest suite 97 | 98 | # 1.2.1 99 | 100 | - Add function to trim trailing space in layouted `SimpleDocStream`, 101 | `removeTrailingWhitespace` 102 | - Add `Pretty` instances for `Identity` and `Const` 103 | 104 | # 1.2.0.1 105 | 106 | - Fix `alterAnnotationsS` (and thus `unAnnotateS`), which removed pushing, but 107 | not popping, style frames. This led to them throwing errors in pretty much all 108 | use cases. 109 | 110 | # 1.2 111 | 112 | - `encloseSep` does no longer include an `align` wrapper; in other words, 113 | 114 | ```haskell 115 | encloseSep_old … = align (encloseSep_new …) 116 | ``` 117 | - Change the default ribbon fraction to 1 (was 0.4) 118 | - Expose `viaShow` and `unsafeViaShow` from the public module 119 | - Fix `layoutSmart` behaving as if there was no space left for unbounded pages 120 | 121 | # 1.1.1 122 | 123 | - Add `panicPeekedEmpty` and `panicPoppedEmpty` to the panic module 124 | 125 | # 1.1.0.1 126 | 127 | - Rendering directly to a handle is now more efficient in the `Text` renderer, 128 | since no intermediate `Text` is generated anymore. 129 | - Remove upper version bounds from `.cabal` files 130 | 131 | # 1.1 132 | 133 | - Allow `alterAnnotations` to convert one annotation to multiple ones, to 134 | support e.g. `Keyword ---> Green+Bold` 135 | - Remove `Pretty` instance for `Doc`: the implicit un-annotation done by it did 136 | more harm than good. 137 | 138 | # 1.0.1 139 | 140 | - Add `alterAnnotations`, which allows changing or removing annotations. 141 | `reAnnotate` and `unAnnotate` are now special cases of this. 142 | - Fix »group« potentially taking exponential time, by making the (internal) 143 | `flatten` function detect whether it is going to have any effect inside 144 | `group`. 145 | - Add proper version bounds for all dependencies and backport them to version 1 146 | - Haddock: example for `Pretty Void` 147 | 148 | # 1 149 | 150 | - Add Foldable/Traversable instances for `SimpleDocTree`, `SimpleDocStream` 151 | - Add Functor instances for `Doc`, `SimpleDocTree`, `SimpleDocStream` 152 | - Add the simplified renderers `renderSimplyDecorated` and 153 | `renderSimplyDecoratedA` to the tree and stack renderer modules 154 | - Lots of typo fixes and doc tweaks 155 | - Add a changelog :-) 156 | 157 | # 0.1 158 | 159 | Initial release. 160 | -------------------------------------------------------------------------------- /prettyprinter/LICENSE.md: -------------------------------------------------------------------------------- 1 | ../LICENSE.md -------------------------------------------------------------------------------- /prettyprinter/README.md: -------------------------------------------------------------------------------- 1 | ../README.md -------------------------------------------------------------------------------- /prettyprinter/Setup.lhs: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env runhaskell 2 | > import Distribution.Simple 3 | > main = defaultMain 4 | -------------------------------------------------------------------------------- /prettyprinter/app/GenerateReadme.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | {-# LANGUAGE QuasiQuotes #-} 3 | 4 | module Main (main) where 5 | 6 | 7 | 8 | import Prelude hiding (words) 9 | 10 | import qualified Data.List as L 11 | import Data.Text (Text) 12 | import qualified Data.Text as T 13 | import qualified Data.Text.IO as T 14 | import Prettyprinter 15 | import Prettyprinter.Render.Text 16 | 17 | import MultilineTh 18 | 19 | 20 | 21 | main :: IO () 22 | main = (T.putStrLn . renderStrict . layoutPretty layoutOptions) readmeContents 23 | where 24 | layoutOptions = LayoutOptions { layoutPageWidth = AvailablePerLine 80 1 } 25 | 26 | readmeContents :: Doc ann 27 | readmeContents = (mconcat . L.intersperse vspace) 28 | [ htmlComment "This file was auto-generated by the 'scripts/generate_readme' program." 29 | 30 | , h1 "A modern Wadler/Leijen Prettyprinter" 31 | 32 | , vcat 33 | [ "[![](https://img.shields.io/travis/quchen/prettyprinter/master.svg?style=flat-square&label=Master%20build)](https://travis-ci.org/quchen/prettyprinter)" 34 | , "[![](https://img.shields.io/hackage/v/prettyprinter.svg?style=flat-square&label=Hackage&colorB=0a7bbb)](https://hackage.haskell.org/package/prettyprinter)" 35 | , "[![](https://www.stackage.org/package/prettyprinter/badge/lts?style=flat-square&colorB=0a7bbb)](https://www.stackage.org/package/prettyprinter)" 36 | , "[![](https://www.stackage.org/package/prettyprinter/badge/nightly?style=flat-square&label=stackage%20nightly&colorB=0a7bbb)](https://www.stackage.org/package/prettyprinter)" ] 37 | 38 | , h2 "tl;dr" 39 | , paragraph [multiline| A prettyprinter/text rendering engine. Easy to 40 | use, well-documented, ANSI terminal backend exists, HTML backend is 41 | trivial to implement, no name clashes, `Text`-based, extensible. |] 42 | , (pretty . T.unlines) 43 | [ "```haskell" 44 | , "let prettyType = align . sep . zipWith (<+>) (\"::\" : repeat \"->\")" 45 | , " prettySig name ty = pretty name <+> prettyType ty" 46 | , "in prettySig \"example\" [\"Int\", \"Bool\", \"Char\", \"IO ()\"]" 47 | , "```" 48 | , "" 49 | , "```haskell" 50 | , "-- Output for wide enough formats:" 51 | , "example :: Int -> Bool -> Char -> IO ()" 52 | , "" 53 | , "-- Output for narrow formats:" 54 | , "example :: Int" 55 | , " -> Bool" 56 | , " -> Char" 57 | , " -> IO ()" 58 | , "```" ] 59 | 60 | 61 | , h2 "Longer; want to read" 62 | , paragraph [multiline| This package defines a prettyprinter to format 63 | text in a flexible and convenient way. The idea is to combine a document 64 | out of many small components, then using a layouter to convert it to an 65 | easily renderable simple document, which can then be rendered to a 66 | variety of formats, for example plain `Text`, or Markdown. *What you are 67 | reading right now was generated by this library (see 68 | `GenerateReadme.hs`).* |] 69 | 70 | , h2 "Why another prettyprinter?" 71 | , paragraph [multiline| Haskell, more specifically Hackage, has a zoo of 72 | Wadler/Leijen based prettyprinters already. Each of them addresses a 73 | different concern with the classic `wl-pprint` package. This package 74 | solves *all* these issues, and then some. |] 75 | 76 | , h3 "`Text` instead of `String`" 77 | , paragraph [multiline| `String` has exactly one use, and that’s showing 78 | Hello World in tutorials. For all other uses, `Text` is what people 79 | should be using. The prettyprinter uses no `String` definitions 80 | anywhere; using a `String` means an immediate conversion to the internal 81 | `Text`-based format. |] 82 | 83 | , h3 "Extensive documentation" 84 | , paragraph [multiline| The library is stuffed with runnable examples, 85 | showing use cases for the vast majority of exported values. Many things 86 | reference related definitions, *everything* comes with at least a 87 | sentence explaining its purpose. |] 88 | 89 | , h3 "No name clashes" 90 | , paragraph [multiline| Many prettyprinters use the legacy API of the 91 | first Wadler/Leijen prettyprinter, which used e.g. `(<$>)` to separate 92 | lines, which clashes with the ubiquitous synonym for `fmap` that’s been 93 | in Base for ages. These definitions were either removed or renamed, so 94 | there are no name clashes with standard libraries anymore. |] 95 | 96 | , h3 "Annotation support" 97 | , paragraph [multiline| Text is not all letters and newlines. Often, we 98 | want to add more information, the simplest kind being some form of 99 | styling. An ANSI terminal supports coloring, a web browser a plethora of 100 | different formattings. |] 101 | 102 | , paragraph [multiline| More complex uses of annotations include e.g. 103 | adding type annotations for mouse-over hovers when printing a syntax 104 | tree, adding URLs to documentation, or adding source locations to show 105 | where a certain piece of output comes from. 106 | [Idris](https://github.com/idris-lang/Idris-dev) is a project that makes 107 | extensive use of such a feature. |] 108 | 109 | , paragraph [multiline| Special care has been applied to make 110 | annotations unobtrusive, so that if you don’t need or care about them 111 | there is no overhead, neither in terms of usability nor performance. |] 112 | 113 | , h3 "Extensible backends" 114 | , paragraph [multiline| A document can be rendered in many different 115 | ways, for many different clients. There is plain text, there is the ANSI 116 | terminal, there is the browser. Each of these speak different languages, 117 | and the backend is responsible for the translation to those languages. 118 | Backends should be readily available, or easy to implement if a custom 119 | solution is desired. |] 120 | 121 | , paragraph [multiline| As a result, each backend requires only minimal 122 | dependencies; if you don’t want to print to an ANSI terminal for 123 | example, there is no need to have a dependency on a terminal library. |] 124 | 125 | , h3 "Performance" 126 | , paragraph [multiline| Rendering large documents should be done 127 | efficiently, and the library should make it easy to optimize common use 128 | cases for the programmer. |] 129 | 130 | , h3 "Open implementation" 131 | 132 | , paragraph [multiline| The type of documents is abstract in most of the 133 | other Wadler/Leijen prettyprinters, making it hard to impossible to 134 | write adaptors from one library to another. The type should be exposed 135 | for such purposes so it is possible to write adaptors from library to 136 | library, or each of them is doomed to live on its own small island of 137 | incompatibility. For this reason, the `Doc` type is fully exposed in a 138 | semi-internal module for this specific use case. |] 139 | 140 | , h2 "The prettyprinter family" 141 | , paragraph "The `prettyprinter` family of packages consists of:" 142 | , (indent 2 . unorderedList . map paragraph) 143 | [ [multiline| `prettyprinter` is the core package. It defines the 144 | language to generate nicely laid out documents, which can then be 145 | given to renderers to display them in various ways, e.g. HTML, or 146 | plain text.|] 147 | , [multiline| `prettyprinter-ansi-terminal` provides a renderer suitable 148 | for ANSI terminal output including colors (at the cost of a 149 | dependency more).|] 150 | , [multiline| `prettyprinter-compat-wl-pprint` provides a drop-in 151 | compatibility layer for previous users of the `wl-pprint` package. Use 152 | it for easy adaption of the new `prettyprinter`, but don't develop 153 | anything new with it.|] 154 | , [multiline| `prettyprinter-compat-ansi-wl-pprint` is the same, but for 155 | previous users of `ansi-wl-pprint`.|] 156 | , [multiline| `prettyprinter-compat-annotated-wl-pprint` is the same, 157 | but for previous users of `annotated-wl-pprint`.|] 158 | , [multiline| `prettyprinter-convert-ansi-wl-pprint` is a *converter*, 159 | not a drop-in replacement, for documents generated by `ansi-wl-pprint`. 160 | Useful for interfacing with other libraries that use the other format, 161 | like Trifecta and Optparse-Applicative. |] 162 | ] 163 | 164 | , h2 "Differences to the old Wadler/Leijen prettyprinters" 165 | 166 | , paragraph [multiline| The library originally started as a fork of 167 | `ansi-wl-pprint` until every line had been touched. The result is still in 168 | the same spirit as its predecessors, but modernized to match the current 169 | ecosystem and needs. |] 170 | 171 | , paragraph "The most significant changes are:" 172 | , (indent 2 . orderedList . map paragraph) 173 | [ [multiline| `(<$>)` is removed as an operator, since it clashes with 174 | the common alias for `fmap`. |] 175 | , [multiline| All but the essential `<>` and `<+>` operators were 176 | removed or replaced by ordinary names. |] 177 | , [multiline| Everything extensively documented, with references to 178 | other functions and runnable code examples. |] 179 | , [multiline| Use of `Text` instead of `String`. |] 180 | , [multiline| A `fuse` function to optimize often-used documents before 181 | rendering for efficiency. |] 182 | , [multiline| SimpleDoc was renamed `SimpleDocStream`, to contrast the 183 | new `SimpleDocTree`. |] 184 | , [multiline| In the ANSI backend, instead of providing an own 185 | colorization function for each color/intensity/layer combination, they 186 | have been combined in `color`, `colorDull`, `bgColor`, and 187 | `bgColorDull` functions, which can be found in the ANSI terminal 188 | specific `prettyprinter-ansi-terminal` package. |] 189 | ] 190 | 191 | , h2 "Historical notes" 192 | 193 | , paragraph [multiline| This module is based on previous work by Daan 194 | Leijen and Max Bolingbroke, who implemented and significantly extended 195 | the prettyprinter given by a [paper by Phil Wadler in his 1997 paper »A 196 | Prettier 197 | Printer«](https://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf), 198 | by adding lots of convenience functions, styling, and new functionality. 199 | Their package, ansi-wl-pprint is widely used in the Haskell ecosystem, 200 | and is at the time of writing maintained by Edward Kmett.|] 201 | 202 | ] 203 | 204 | paragraph :: Text -> Doc ann 205 | paragraph = align . fillSep . map pretty . T.words 206 | 207 | vspace :: Doc ann 208 | vspace = hardline <> hardline 209 | 210 | h1 :: Doc ann -> Doc ann 211 | h1 x = vspace <> underlineWith "=" x 212 | 213 | h2 :: Doc ann -> Doc ann 214 | h2 x = vspace <> underlineWith "-" x 215 | 216 | h3 :: Doc ann -> Doc ann 217 | h3 x = vspace <> "###" <+> x 218 | 219 | underlineWith :: Text -> Doc ann -> Doc ann 220 | underlineWith symbol x = align (width x (\w -> 221 | hardline <> pretty (T.take w (T.replicate w symbol)))) 222 | 223 | orderedList :: [Doc ann] -> Doc ann 224 | orderedList = align . vsep . zipWith (\i x -> pretty i <> dot <+> align x) [1::Int ..] 225 | 226 | unorderedList :: [Doc ann] -> Doc ann 227 | unorderedList = align . vsep . map ("-" <+>) 228 | 229 | htmlComment :: Doc ann -> Doc ann 230 | htmlComment = enclose "" 231 | -------------------------------------------------------------------------------- /prettyprinter/app/MultilineTh.hs: -------------------------------------------------------------------------------- 1 | module MultilineTh (multiline) where 2 | 3 | 4 | 5 | import qualified Data.Text as T 6 | import Language.Haskell.TH 7 | import Language.Haskell.TH.Quote 8 | import Language.Haskell.TH.Syntax 9 | import Prelude 10 | 11 | 12 | 13 | multiline :: QuasiQuoter 14 | multiline = QuasiQuoter 15 | { quoteExp = quoteUnlines 16 | , quotePat = const badUse 17 | , quoteType = const badUse 18 | , quoteDec = const badUse 19 | } 20 | where 21 | badUse = fail "multiline quasiquoter can only be used as an expression" 22 | 23 | quoteUnlines :: String -> Q Exp 24 | quoteUnlines = 25 | liftString 26 | . T.unpack 27 | . T.unwords 28 | . filter (not . T.null) 29 | . T.words 30 | . T.pack 31 | -------------------------------------------------------------------------------- /prettyprinter/bench/FasterUnsafeText.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | 3 | module Main (main) where 4 | 5 | 6 | 7 | import Data.Char 8 | import Data.Text (Text) 9 | import qualified Data.Text as T 10 | import Prettyprinter.Internal 11 | import Test.Tasty.Bench 12 | 13 | 14 | 15 | -- The old implementation. Performance isn’t much worse to be honest, mostly 16 | -- well within a σ. 17 | alternative :: Text -> Doc ann 18 | alternative t = case T.length t of 19 | 0 -> Empty 20 | 1 -> Char (T.head t) 21 | n -> Text n t 22 | 23 | current :: Text -> Doc ann 24 | current = unsafeTextWithoutNewlines 25 | 26 | main :: IO () 27 | main = defaultMain [ benchText (letters n) | n <- [0,1,2,3,5,10,50,100] ] 28 | 29 | letters :: Int -> Text 30 | letters n = T.pack (take n (filter isAlpha [minBound ..])) 31 | 32 | benchText :: Text -> Benchmark 33 | benchText input = bgroup (show (pretty (T.length input) <+> plural "letter" "letters" (T.length input))) 34 | [ bench "alternative" (whnf alternative input) 35 | , bench "current" (whnf current input) ] 36 | -------------------------------------------------------------------------------- /prettyprinter/bench/Fusion.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | #include "version-compatibility-macros.h" 5 | 6 | module Main (main) where 7 | 8 | 9 | 10 | import Control.Monad 11 | import Control.Monad.State 12 | import Data.Text (Text) 13 | import qualified Data.Text as T 14 | import System.Random 15 | import Test.Tasty.Bench 16 | 17 | import Prettyprinter 18 | import Prettyprinter.Render.Text 19 | import qualified Text.PrettyPrint.ANSI.Leijen as WL 20 | 21 | #if !(APPLICATIVE_MONAD) 22 | import Control.Applicative 23 | #endif 24 | 25 | 26 | 27 | main :: IO () 28 | main = defaultMain 29 | [ benchOptimize 30 | , benchWLComparison 31 | ] 32 | 33 | benchOptimize :: Benchmark 34 | benchOptimize = env randomShortWords benchmark_ 35 | where 36 | benchmark_ = \shortWords -> 37 | let doc = hsep (map pretty shortWords) 38 | in bgroup "Many small words" 39 | [ bench "Unoptimized" (nf renderLazy (layoutPretty defaultLayoutOptions doc)) 40 | , bench "Shallowly fused" (nf renderLazy (layoutPretty defaultLayoutOptions (fuse Shallow doc))) 41 | , bench "Deeply fused" (nf renderLazy (layoutPretty defaultLayoutOptions (fuse Deep doc))) 42 | ] 43 | 44 | randomShortWords :: Applicative m => m [Text] 45 | randomShortWords = pure (evalState (randomShortWords' 100) (mkStdGen 0)) 46 | 47 | randomShortWords' :: Int -> State StdGen [Text] 48 | randomShortWords' n = replicateM n randomShortWord 49 | 50 | randomShortWord :: State StdGen Text 51 | randomShortWord = do 52 | g <- get 53 | let (l, g') = randomR (0, 5) g 54 | (gNew, gFree) = split g' 55 | xs = take l (randoms gFree) 56 | put gNew 57 | pure (T.pack xs) 58 | 59 | benchWLComparison :: Benchmark 60 | benchWLComparison = bgroup "vs. other libs" 61 | [ bgroup "renderPretty" 62 | [ bench "this, unoptimized" (nf (renderLazy . layoutPretty defaultLayoutOptions) doc) 63 | , bench "this, shallowly fused" (nf (renderLazy . layoutPretty defaultLayoutOptions) (fuse Shallow doc)) 64 | , bench "this, deeply fused" (nf (renderLazy . layoutPretty defaultLayoutOptions) (fuse Deep doc)) 65 | , bench "ansi-wl-pprint" (nf (\d -> WL.displayS (WL.renderPretty 0.4 80 d) "") wlDoc) 66 | ] 67 | , bgroup "renderSmart" 68 | [ bench "this, unoptimized" (nf (renderLazy . layoutSmart defaultLayoutOptions) doc) 69 | , bench "this, shallowly fused" (nf (renderLazy . layoutSmart defaultLayoutOptions) (fuse Shallow doc)) 70 | , bench "this, deeply fused" (nf (renderLazy . layoutSmart defaultLayoutOptions) (fuse Deep doc)) 71 | , bench "ansi-wl-pprint" (nf (\d -> WL.displayS (WL.renderSmart 0.4 80 d) "") wlDoc) 72 | ] 73 | , bgroup "renderCompact" 74 | [ bench "this, unoptimized" (nf (renderLazy . layoutCompact) doc) 75 | , bench "this, shallowly fused" (nf (renderLazy . layoutCompact) (fuse Shallow doc)) 76 | , bench "this, deeply fused" (nf (renderLazy . layoutCompact) (fuse Deep doc)) 77 | , bench "ansi-wl-pprint" (nf (\d -> WL.displayS (WL.renderCompact d) "") wlDoc) 78 | ] 79 | ] 80 | where 81 | doc :: Doc ann 82 | doc = let fun x = "fun" <> parens (softline <> x) 83 | funnn = chain 10 fun 84 | in funnn (sep (take 48 (cycle ["hello", "world"]))) 85 | 86 | wlDoc :: WL.Doc 87 | wlDoc = let fun x = "fun" WL.<> WL.parens (WL.softline WL.<> x) 88 | funnn = chain 10 fun 89 | in funnn (WL.sep (take 48 (cycle ["hello", "world"]))) 90 | 91 | chain n f = foldr (.) id (replicate n f) 92 | -------------------------------------------------------------------------------- /prettyprinter/bench/LargeOutput.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveGeneric #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | {-# OPTIONS_GHC -fno-warn-orphans #-} 5 | 6 | module Main (main) where 7 | 8 | import Prelude () 9 | import Prelude.Compat 10 | 11 | import Control.DeepSeq 12 | import Control.Monad.Compat 13 | import Data.Char 14 | import Data.Map (Map) 15 | import qualified Data.Map as M 16 | import Data.Text (Text) 17 | import qualified Data.Text as T 18 | import qualified Data.Text.IO as T 19 | import qualified Data.Text.Lazy as TL 20 | import Prettyprinter 21 | import Prettyprinter.Render.Text 22 | import GHC.Generics 23 | import Test.QuickCheck 24 | import Test.QuickCheck.Gen 25 | import Test.QuickCheck.Random 26 | import Test.Tasty.Bench 27 | import qualified Text.PrettyPrint.ANSI.Leijen as WL 28 | 29 | 30 | 31 | newtype Program = Program Binds deriving (Show, Generic) 32 | newtype Binds = Binds (Map Text LambdaForm) deriving (Show, Generic) 33 | data LambdaForm = LambdaForm ![Text] ![Text] !Expr deriving (Show, Generic) 34 | data Expr 35 | = Let Binds Expr 36 | | Case Expr [Alt] 37 | | AppF Text [Text] 38 | | AppC Text [Text] 39 | | AppP Text Text Text 40 | | LitE Int 41 | deriving (Show, Generic) 42 | data Alt = Alt Text [Text] Expr deriving (Show, Generic) 43 | 44 | instance NFData Program 45 | instance NFData Binds 46 | instance NFData LambdaForm 47 | instance NFData Expr 48 | instance NFData Alt 49 | 50 | instance Arbitrary Program where arbitrary = fmap Program arbitrary 51 | instance Arbitrary Binds where 52 | arbitrary = do 53 | NonEmpty xs <- arbitrary 54 | pure (Binds (M.fromList xs)) 55 | instance Arbitrary LambdaForm where 56 | arbitrary = LambdaForm <$> fromTo 0 2 arbitrary <*> fromTo 0 2 arbitrary <*> arbitrary 57 | 58 | instance Arbitrary Expr where 59 | arbitrary = (oneof . map scaled) 60 | [ Let <$> arbitrary <*> arbitrary 61 | , Case <$> arbitrary <*> (do NonEmpty xs <- arbitrary; pure xs) 62 | , AppF <$> arbitrary <*> fromTo 0 3 arbitrary 63 | , AppC <$> ucFirst arbitrary <*> fromTo 0 3 arbitrary 64 | , AppP <$> arbitrary <*> arbitrary <*> arbitrary 65 | , LitE <$> arbitrary ] 66 | instance Arbitrary Alt where arbitrary = Alt <$> ucFirst arbitrary <*> fromTo 0 3 arbitrary <*> arbitrary 67 | instance Arbitrary Text where 68 | arbitrary = do 69 | n <- choose (3,6) 70 | str <- replicateM n (elements ['a'..'z']) 71 | if str `elem` ["let", "in", "case", "of"] 72 | then arbitrary 73 | else pure (T.pack str) 74 | 75 | ucFirst :: Gen Text -> Gen Text 76 | ucFirst gen = do 77 | x <- gen 78 | case T.uncons x of 79 | Nothing -> pure x 80 | Just (t,ext) -> pure (T.cons (toUpper t) ext) 81 | 82 | instance Pretty Program where pretty (Program binds) = pretty binds 83 | instance Pretty Binds where 84 | pretty (Binds bs) = align (vsep (map prettyBinding (M.assocs bs))) 85 | where 86 | prettyBinding (var, lambda) = pretty var <+> "=" <+> pretty lambda 87 | 88 | instance Pretty LambdaForm where 89 | pretty (LambdaForm free bound body) = (prettyExp . (<+> "->") . prettyBound . prettyFree) "\\" 90 | where 91 | prettyFree | null free = id 92 | | otherwise = (<> lparen <> hsep (map pretty free) <> rparen) 93 | prettyBound | null bound = id 94 | | null free = (<> hsep (map pretty bound)) 95 | | otherwise = (<+> hsep (map pretty bound)) 96 | prettyExp = (<+> pretty body) 97 | 98 | instance Pretty Expr where 99 | pretty = \expr -> case expr of 100 | Let binds body -> 101 | align (vsep [ "let" <+> align (pretty binds) 102 | , "in" <+> pretty body ]) 103 | 104 | Case scrutinee alts -> vsep 105 | [ "case" <+> pretty scrutinee <+> "of" 106 | , indent 4 (align (vsep (map pretty alts))) ] 107 | 108 | AppF f [] -> pretty f 109 | AppF f args -> pretty f <+> hsep (map pretty args) 110 | 111 | AppC c [] -> pretty c 112 | AppC c args -> pretty c <+> hsep (map pretty args) 113 | 114 | AppP op x y -> pretty op <+> pretty x <+> pretty y 115 | 116 | LitE lit -> pretty lit 117 | 118 | instance Pretty Alt where 119 | pretty (Alt con [] body) = pretty con <+> "->" <+> pretty body 120 | pretty (Alt con args body) = pretty con <+> hsep (map pretty args) <+> "->" <+> pretty body 121 | 122 | instance WL.Pretty Program where pretty (Program binds) = WL.pretty binds 123 | instance WL.Pretty Binds where 124 | pretty (Binds bs) = WL.align (WL.vsep (map prettyBinding (M.assocs bs))) 125 | where 126 | prettyBinding (var, lambda) = WL.pretty var WL.<+> "=" WL.<+> WL.pretty lambda 127 | 128 | instance WL.Pretty Text where 129 | pretty = WL.string . T.unpack 130 | 131 | instance WL.Pretty LambdaForm where 132 | pretty (LambdaForm free bound body) = (prettyExp . (WL.<+> "->") . prettyBound . prettyFree) "\\" 133 | where 134 | prettyFree | null free = id 135 | | otherwise = (<> WL.lparen <> WL.hsep (map WL.pretty free) <> WL.rparen) 136 | prettyBound | null bound = id 137 | | null free = (<> WL.hsep (map WL.pretty bound)) 138 | | otherwise = (WL.<+> WL.hsep (map WL.pretty bound)) 139 | prettyExp = (WL.<+> WL.pretty body) 140 | 141 | instance WL.Pretty Expr where 142 | pretty = \expr -> case expr of 143 | Let binds body -> 144 | WL.align (WL.vsep [ "let" WL.<+> WL.align (WL.pretty binds) 145 | , "in" WL.<+> WL.pretty body ]) 146 | 147 | Case scrutinee alts -> WL.vsep 148 | [ "case" WL.<+> WL.pretty scrutinee WL.<+> "of" 149 | , WL.indent 4 (WL.align (WL.vsep (map WL.pretty alts))) ] 150 | 151 | AppF f [] -> WL.pretty f 152 | AppF f args -> WL.pretty f WL.<+> WL.hsep (map WL.pretty args) 153 | 154 | AppC c [] -> WL.pretty c 155 | AppC c args -> WL.pretty c WL.<+> WL.hsep (map WL.pretty args) 156 | 157 | AppP op x y -> WL.pretty op WL.<+> WL.pretty x WL.<+> WL.pretty y 158 | 159 | LitE lit -> WL.pretty lit 160 | 161 | instance WL.Pretty Alt where 162 | pretty (Alt con [] body) = WL.text (T.unpack con) WL.<+> "->" WL.<+> WL.pretty body 163 | pretty (Alt con args body) = WL.text (T.unpack con) WL.<+> WL.hsep (map WL.pretty args) WL.<+> "->" WL.<+> WL.pretty body 164 | 165 | scaled :: Gen a -> Gen a 166 | scaled = scale (\n -> n * 2 `quot` 3) 167 | 168 | fromTo :: Int -> Int -> Gen b -> Gen b 169 | fromTo a b gen = do 170 | n <- choose (min a b, max a b) 171 | resize n gen 172 | 173 | randomProgram 174 | :: Int -- ^ Seed 175 | -> Int -- ^ Generator size 176 | -> Program 177 | randomProgram seed size = let MkGen gen = arbitrary in gen (mkQCGen seed) size 178 | 179 | main :: IO () 180 | main = do 181 | let prog = randomProgram 1 60 182 | renderedProg = (renderLazy . layoutPretty defaultLayoutOptions { layoutPageWidth = Unbounded } . pretty) prog 183 | (progLines, progWidth) = let l = TL.lines renderedProg in (length l, maximum (map TL.length l)) 184 | putDoc ("Program size:" <+> pretty progLines <+> "lines, maximum width:" <+> pretty progWidth) 185 | 186 | let renderWith :: (Doc ann -> SimpleDocStream ann) -> Program -> TL.Text 187 | renderWith f = renderLazy . f . pretty 188 | 189 | let _80ColumnsLayoutOptions = defaultLayoutOptions { layoutPageWidth = AvailablePerLine 80 0.5 } 190 | unboundedLayoutOptions = defaultLayoutOptions { layoutPageWidth = Unbounded } 191 | 192 | rnf prog `seq` T.putStrLn "Starting benchmark…" 193 | 194 | defaultMain 195 | [ bgroup "80 characters, 50% ribbon" 196 | [ bgroup "prettyprinter" 197 | [ bench "layoutPretty" (nf (renderWith (layoutPretty _80ColumnsLayoutOptions)) prog) 198 | , bench "layoutSmart" (nf (renderWith (layoutSmart _80ColumnsLayoutOptions)) prog) 199 | , bench "layoutCompact" (nf (renderWith layoutCompact ) prog) 200 | ] 201 | , bench "ansi-wl-pprint" (nf (($ "") . WL.displayS . WL.renderPretty 0.5 80 . WL.pretty) prog) ] 202 | , bgroup "Infinite/large page width" 203 | [ bgroup "prettyprinter" 204 | [ bench "layoutPretty" (nf (renderWith (layoutPretty unboundedLayoutOptions)) prog) 205 | , bench "layoutSmart" (nf (renderWith (layoutSmart unboundedLayoutOptions)) prog) 206 | , bench "layoutCompact" (nf (renderWith layoutCompact ) prog) 207 | ] 208 | , bench "ansi-wl-pprint" (nf (($ "") . WL.displayS . WL.renderPretty 1 (fromIntegral progWidth + 10) . WL.pretty) prog) ] 209 | ] 210 | -------------------------------------------------------------------------------- /prettyprinter/misc/version-compatibility-macros.h: -------------------------------------------------------------------------------- 1 | ../../aux/version-compatibility-macros.h -------------------------------------------------------------------------------- /prettyprinter/prettyprinter.cabal: -------------------------------------------------------------------------------- 1 | name: prettyprinter 2 | version: 1.7.1 3 | cabal-version: >= 1.10 4 | category: User Interfaces, Text 5 | synopsis: A modern, easy to use, well-documented, extensible pretty-printer. 6 | description: A modern, easy to use, well-documented, extensible pretty-printer. For more see README.md 7 | license: BSD2 8 | license-file: LICENSE.md 9 | extra-source-files: README.md 10 | , CHANGELOG.md 11 | , misc/version-compatibility-macros.h 12 | author: Phil Wadler, Daan Leijen, Max Bolingbroke, Edward Kmett, David Luposchainsky, Simon Jakobi 13 | maintainer: Simon Jakobi , David Luposchainsky 14 | bug-reports: http://github.com/quchen/prettyprinter/issues 15 | homepage: http://github.com/quchen/prettyprinter 16 | build-type: Simple 17 | tested-with: GHC==9.4.1, GHC==9.2.4, GHC==9.0.2, GHC==8.10.7, GHC==8.8.4, GHC==8.6.5, GHC==8.4.4, GHC==8.2.2, GHC==8.0.2, GHC==7.10.3, GHC==7.8.4, GHC==7.6.3, GHC==7.4.2 18 | 19 | source-repository head 20 | type: git 21 | location: git://github.com/quchen/prettyprinter.git 22 | 23 | 24 | 25 | library 26 | exposed-modules: 27 | Prettyprinter 28 | , Prettyprinter.Internal 29 | , Prettyprinter.Internal.Debug 30 | , Prettyprinter.Internal.Type 31 | , Prettyprinter.Render.String 32 | , Prettyprinter.Render.Text 33 | , Prettyprinter.Render.Tutorials.StackMachineTutorial 34 | , Prettyprinter.Render.Tutorials.TreeRenderingTutorial 35 | , Prettyprinter.Render.Util.Panic 36 | , Prettyprinter.Render.Util.SimpleDocTree 37 | , Prettyprinter.Render.Util.StackMachine 38 | , Prettyprinter.Util 39 | 40 | , Prettyprinter.Symbols.Unicode 41 | , Prettyprinter.Symbols.Ascii 42 | 43 | , Data.Text.Prettyprint.Doc 44 | , Data.Text.Prettyprint.Doc.Internal 45 | , Data.Text.Prettyprint.Doc.Internal.Debug 46 | , Data.Text.Prettyprint.Doc.Internal.Type 47 | , Data.Text.Prettyprint.Doc.Render.String 48 | , Data.Text.Prettyprint.Doc.Render.Text 49 | , Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial 50 | , Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial 51 | , Data.Text.Prettyprint.Doc.Render.Util.Panic 52 | , Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree 53 | , Data.Text.Prettyprint.Doc.Render.Util.StackMachine 54 | , Data.Text.Prettyprint.Doc.Util 55 | 56 | , Data.Text.Prettyprint.Doc.Symbols.Unicode 57 | , Data.Text.Prettyprint.Doc.Symbols.Ascii 58 | 59 | ghc-options: -Wall -O2 60 | hs-source-dirs: src 61 | include-dirs: misc 62 | default-language: Haskell2010 63 | other-extensions: 64 | BangPatterns 65 | , CPP 66 | , OverloadedStrings 67 | , DefaultSignatures 68 | , ScopedTypeVariables 69 | 70 | build-depends: 71 | base >= 4.5 && < 5 72 | 73 | if flag(text) 74 | build-depends: text >= 1.2 75 | else 76 | -- A fake text package, emulating the same API, but backed by String 77 | hs-source-dirs: src-text 78 | other-modules: 79 | Data.Text 80 | , Data.Text.IO 81 | , Data.Text.Lazy 82 | , Data.Text.Lazy.Builder 83 | 84 | if !impl(ghc >= 7.6) 85 | build-depends: ghc-prim 86 | 87 | if impl(ghc >= 8.0) 88 | ghc-options: -Wcompat 89 | if !impl(ghc >= 8.0) 90 | build-depends: semigroups >= 0.17 91 | build-depends: fail >= 4.9.0.0 && <4.10 92 | if !impl(ghc >= 7.10) 93 | build-depends: void >=0.4 && <0.8 94 | 95 | 96 | 97 | Flag buildReadme 98 | Description: Build the readme generator 99 | Default: False 100 | 101 | Flag text 102 | Description: While it's a core value of @prettyprinter@ to use @Text@, there are rare 103 | circumstances (mostly when @prettyprinter@ arises as a dependency of 104 | test suites of packages like @bytestring@ or @text@ themselves) when 105 | this is inconvenient. In this case one can disable this flag, so that 106 | @prettyprinter@ fallbacks to @String@. 107 | Default: True 108 | 109 | 110 | executable generate_readme 111 | hs-source-dirs: app 112 | main-is: GenerateReadme.hs 113 | build-depends: 114 | base >= 4.7 && < 5 115 | , prettyprinter 116 | 117 | , text 118 | , template-haskell >= 2.9 119 | default-language: Haskell2010 120 | other-modules: MultilineTh 121 | other-extensions: OverloadedStrings 122 | , TemplateHaskell 123 | , QuasiQuotes 124 | if flag(buildReadme) && flag(text) 125 | buildable: True 126 | else 127 | buildable: False 128 | 129 | 130 | 131 | test-suite doctest 132 | type: exitcode-stdio-1.0 133 | hs-source-dirs: test/Doctest 134 | main-is: Main.hs 135 | build-depends: 136 | base >= 4.7 && < 5 137 | , doctest >= 0.9 138 | , prettyprinter 139 | , QuickCheck >= 2.5 140 | ghc-options: -Wall -threaded -rtsopts -with-rtsopts=-N 141 | default-language: Haskell2010 142 | if impl (ghc < 7.10) 143 | buildable: False 144 | -- Doctest does not support searching through directories in old versions 145 | 146 | test-suite testsuite 147 | type: exitcode-stdio-1.0 148 | hs-source-dirs: test/Testsuite 149 | main-is: Main.hs 150 | other-modules: StripTrailingSpace 151 | build-depends: 152 | base 153 | , prettyprinter 154 | 155 | , pgp-wordlist >= 0.1 156 | , bytestring 157 | , quickcheck-instances >= 0.3 158 | , tasty >= 0.10 159 | , tasty-hunit >= 0.9 160 | , tasty-quickcheck >= 0.8 161 | , text 162 | ghc-options: -threaded -rtsopts -with-rtsopts=-N -Wall 163 | default-language: Haskell2010 164 | 165 | if !impl(ghc >= 8.0) 166 | build-depends: semigroups >= 0.6 167 | 168 | if !flag(text) 169 | buildable: False 170 | 171 | 172 | benchmark fusion 173 | type: exitcode-stdio-1.0 174 | hs-source-dirs: bench 175 | main-is: Fusion.hs 176 | build-depends: 177 | base >= 4.5 && < 5 178 | , prettyprinter 179 | 180 | , tasty-bench >= 0.2 181 | , mtl >= 2.1 182 | , random >= 1.0 183 | , text 184 | , transformers >= 0.3 185 | , ansi-wl-pprint >= 0.6 186 | ghc-options: -Wall -rtsopts 187 | default-language: Haskell2010 188 | other-extensions: OverloadedStrings 189 | 190 | if !flag(text) 191 | buildable: False 192 | 193 | benchmark faster-unsafe-text 194 | build-depends: 195 | base >= 4.5 && < 5 196 | , prettyprinter 197 | 198 | , tasty-bench >= 0.2 199 | , text 200 | 201 | hs-source-dirs: bench 202 | main-is: FasterUnsafeText.hs 203 | ghc-options: -rtsopts -Wall 204 | default-language: Haskell2010 205 | type: exitcode-stdio-1.0 206 | 207 | if !flag(text) 208 | buildable: False 209 | 210 | benchmark large-output 211 | build-depends: 212 | base >= 4.5 && < 5 213 | , base-compat >=0.9.3 && <0.12 214 | , prettyprinter 215 | , ansi-wl-pprint 216 | 217 | , tasty-bench >= 0.2 218 | , QuickCheck >= 2.7 219 | , containers 220 | , text 221 | , deepseq 222 | 223 | hs-source-dirs: bench 224 | main-is: LargeOutput.hs 225 | ghc-options: -rtsopts -Wall 226 | default-language: Haskell2010 227 | type: exitcode-stdio-1.0 228 | 229 | -- For GHC.Generics 230 | if !impl(ghc >= 7.6) 231 | build-depends: ghc-prim 232 | 233 | if !impl(ghc >= 8.0) 234 | build-depends: semigroups 235 | 236 | if !flag(text) 237 | buildable: False 238 | -------------------------------------------------------------------------------- /prettyprinter/src-text/Data/Text.hs: -------------------------------------------------------------------------------- 1 | -- Provide a fake API, mimicking Data.Text from text package, 2 | -- but actually backed by type Text = String. It is used only in rare 3 | -- circumstances, when prettyprinter is built with -text flag. 4 | -- 5 | 6 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-} 7 | 8 | module Data.Text where 9 | 10 | import Prelude hiding (head, length, null, replicate) 11 | import qualified Data.Char 12 | import qualified Data.List 13 | 14 | type Text = String 15 | cons = (:) 16 | dropWhileEnd = Data.List.dropWhileEnd 17 | head = Data.List.head 18 | intercalate = Data.List.intercalate 19 | length = Data.List.length :: [Char] -> Int 20 | lines = Data.List.lines 21 | map = Data.List.map 22 | null = Data.List.null :: [Char] -> Bool 23 | pack = id 24 | replicate = (Data.List.concat .) . Data.List.replicate 25 | singleton = (:[]) 26 | snoc xs x = xs ++ [x] 27 | stripEnd = dropWhileEnd Data.Char.isSpace 28 | unlines = Data.List.unlines 29 | unpack = id 30 | words = Data.List.words 31 | 32 | uncons :: Text -> Maybe (Char, Text) 33 | uncons [] = Nothing 34 | uncons (x : xs) = Just (x, xs) 35 | 36 | splitOn :: Text -> Text -> [Text] 37 | splitOn pat src 38 | | null pat = error "splitOn: empty pattern" 39 | | otherwise = go [] src 40 | where 41 | go acc [] = [reverse acc] 42 | go acc xs@(y : ys) 43 | | pat `Data.List.isPrefixOf` xs 44 | = reverse acc : go [] (drop (length pat) xs) 45 | | otherwise 46 | = go (y : acc) ys 47 | -------------------------------------------------------------------------------- /prettyprinter/src-text/Data/Text/IO.hs: -------------------------------------------------------------------------------- 1 | -- Provide a fake API, mimicking Data.Text.IO from text package, 2 | -- but actually backed by type Text = String. It is used only in rare 3 | -- circumstances, when prettyprinter is built with -text flag. 4 | -- 5 | 6 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-} 7 | 8 | module Data.Text.IO where 9 | 10 | import qualified System.IO 11 | 12 | hPutStr = System.IO.hPutStr 13 | putStrLn = System.IO.putStrLn 14 | -------------------------------------------------------------------------------- /prettyprinter/src-text/Data/Text/Lazy.hs: -------------------------------------------------------------------------------- 1 | -- Provide a fake API, mimicking Data.Text.Lazy from text package, 2 | -- but actually backed by type Text = String. It is used only in rare 3 | -- circumstances, when prettyprinter is built with -text flag. 4 | -- 5 | 6 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-} 7 | 8 | module Data.Text.Lazy where 9 | 10 | import Data.Text as T 11 | 12 | type Text = T.Text 13 | length = T.length 14 | lines = T.lines 15 | toStrict = id 16 | -------------------------------------------------------------------------------- /prettyprinter/src-text/Data/Text/Lazy/Builder.hs: -------------------------------------------------------------------------------- 1 | -- Provide a fake API, mimicking Data.Text.Lazy.Builder from text package, 2 | -- but actually backed by type Builder = String. It is used only in rare 3 | -- circumstances, when prettyprinter is built with -text flag. 4 | -- 5 | 6 | {-# OPTIONS_GHC -fno-warn-missing-signatures #-} 7 | 8 | module Data.Text.Lazy.Builder where 9 | 10 | type Builder = String 11 | fromText = id 12 | singleton = (:[]) 13 | toLazyText = id 14 | -------------------------------------------------------------------------------- /prettyprinter/src/Data/Text/Prettyprint/Doc.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc {-# DEPRECATED "Use \"Prettyprinter\" instead." #-} ( 2 | module Prettyprinter 3 | ) where 4 | 5 | import Prettyprinter 6 | -------------------------------------------------------------------------------- /prettyprinter/src/Data/Text/Prettyprint/Doc/Internal.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Internal {-# DEPRECATED "Use \"Prettyprinter.Internal\" instead." #-} ( 2 | module Prettyprinter.Internal 3 | ) where 4 | 5 | import Prettyprinter.Internal 6 | -------------------------------------------------------------------------------- /prettyprinter/src/Data/Text/Prettyprint/Doc/Internal/Debug.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Internal.Debug {-# DEPRECATED "Use \"Prettyprinter.Internal.Debug\" instead." #-} ( 2 | module Prettyprinter.Internal.Debug 3 | ) where 4 | 5 | import Prettyprinter.Internal.Debug 6 | -------------------------------------------------------------------------------- /prettyprinter/src/Data/Text/Prettyprint/Doc/Internal/Type.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Internal.Type {-# DEPRECATED "Use \"Prettyprinter.Internal.Type\" instead." #-} ( 2 | module Prettyprinter.Internal.Type 3 | ) where 4 | 5 | import Prettyprinter.Internal.Type 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /prettyprinter/src/Data/Text/Prettyprint/Doc/Render/String.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Render.String {-# DEPRECATED "Use \"Prettyprinter.Render.String\" instead." #-} ( 2 | module Prettyprinter.Render.String 3 | ) where 4 | 5 | import Prettyprinter.Render.String 6 | -------------------------------------------------------------------------------- /prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Text.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Render.Text {-# DEPRECATED "Use \"Prettyprinter.Render.Text\" instead." #-} ( 2 | module Prettyprinter.Render.Text 3 | ) where 4 | 5 | import Prettyprinter.Render.Text 6 | -------------------------------------------------------------------------------- /prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/StackMachineTutorial.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Render.Tutorials.StackMachineTutorial {-# DEPRECATED "Use \"Prettyprinter.Render.Tutorials.StackMachineTutorial\" instead." #-} ( 2 | module Prettyprinter.Render.Tutorials.StackMachineTutorial 3 | ) where 4 | 5 | -- Yeah, this produces a deprecation warning. It's hard to disable it while 6 | -- staying compatible with GHC < 8.0 though. Don't waste your time. 7 | import Prettyprinter.Render.Tutorials.StackMachineTutorial 8 | -------------------------------------------------------------------------------- /prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Tutorials/TreeRenderingTutorial.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Render.Tutorials.TreeRenderingTutorial {-# DEPRECATED "Use \"Prettyprinter.Render.Tutorials.TreeRenderingTutorial\" instead." #-} ( 2 | module Prettyprinter.Render.Tutorials.TreeRenderingTutorial 3 | ) where 4 | 5 | import Prettyprinter.Render.Tutorials.TreeRenderingTutorial 6 | -------------------------------------------------------------------------------- /prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/Panic.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Render.Util.Panic {-# DEPRECATED "Use \"Prettyprinter.Render.Util.Panic\" instead." #-} ( 2 | module Prettyprinter.Render.Util.Panic 3 | ) where 4 | 5 | import Prettyprinter.Render.Util.Panic 6 | -------------------------------------------------------------------------------- /prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/SimpleDocTree.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Render.Util.SimpleDocTree {-# DEPRECATED "Use \"Prettyprinter.Render.Util.SimpleDocTree\" instead." #-} ( 2 | module Prettyprinter.Render.Util.SimpleDocTree 3 | ) where 4 | 5 | import Prettyprinter.Render.Util.SimpleDocTree 6 | -------------------------------------------------------------------------------- /prettyprinter/src/Data/Text/Prettyprint/Doc/Render/Util/StackMachine.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Render.Util.StackMachine {-# DEPRECATED "Use \"Prettyprinter.Render.Util.StackMachine\" instead." #-} ( 2 | module Prettyprinter.Render.Util.StackMachine 3 | ) where 4 | 5 | import Prettyprinter.Render.Util.StackMachine 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /prettyprinter/src/Data/Text/Prettyprint/Doc/Symbols/Ascii.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Symbols.Ascii {-# DEPRECATED "Use \"Prettyprinter.Symbols.Ascii\" instead." #-} ( 2 | module Prettyprinter.Symbols.Ascii 3 | ) where 4 | 5 | import Prettyprinter.Symbols.Ascii 6 | -------------------------------------------------------------------------------- /prettyprinter/src/Data/Text/Prettyprint/Doc/Symbols/Unicode.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Symbols.Unicode {-# DEPRECATED "Use \"Prettyprinter.Symbols.Unicode\" instead." #-} ( 2 | module Prettyprinter.Symbols.Unicode 3 | ) where 4 | 5 | import Prettyprinter.Symbols.Unicode 6 | -------------------------------------------------------------------------------- /prettyprinter/src/Data/Text/Prettyprint/Doc/Util.hs: -------------------------------------------------------------------------------- 1 | module Data.Text.Prettyprint.Doc.Util {-# DEPRECATED "Use \"Prettyprinter.Util\" instead." #-} ( 2 | module Prettyprinter.Util 3 | ) where 4 | 5 | import Prettyprinter.Util 6 | 7 | 8 | 9 | -------------------------------------------------------------------------------- /prettyprinter/src/Prettyprinter.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | #include "version-compatibility-macros.h" 4 | 5 | -- | 6 | -- Module : Prettyprinter 7 | -- Copyright : Daan Leijen (c) 2000, http://www.cs.uu.nl/~daan 8 | -- Max Bolingbroke (c) 2008, http://blog.omega-prime.co.uk 9 | -- David Luposchainsky (c) 2016, http://github.com/quchen 10 | -- License : BSD-style (see the file LICENSE.md) 11 | -- Maintainer : David Luposchainsky 12 | -- Stability : experimental 13 | -- Portability : portable 14 | -- 15 | -- = Overview 16 | -- 17 | -- This module defines a prettyprinter to format text in a flexible and 18 | -- convenient way. The idea is to combine a 'Doc'ument out of many small 19 | -- components, then using a layouter to convert it to an easily renderable 20 | -- 'SimpleDocStream', which can then be rendered to a variety of formats, for 21 | -- example plain 'Text'. 22 | -- 23 | -- The documentation consists of several parts: 24 | -- 25 | -- 1. Just below is some general information about the library. 26 | -- 2. The actual library with extensive documentation and examples 27 | -- 3. Migration guide for users familiar with (ansi-)wl-pprint 28 | -- 29 | -- == Starting out 30 | -- 31 | -- As a reading list for starters, some of the most commonly used functions in 32 | -- this module include '<>', 'hsep', '<+>', 'vsep', 'align', 'hang'. These cover 33 | -- many use cases already, and many other functions are variations or 34 | -- combinations of these. 35 | -- 36 | -- = Simple example 37 | -- 38 | -- Let’s prettyprint a simple Haskell type definition. First, intersperse @->@ 39 | -- and add a leading @::@, 40 | -- 41 | -- >>> :{ 42 | -- >>> prettyprintType :: [Doc x] -> Doc x 43 | -- >>> prettyprintType = align . sep . zipWith (<+>) ("::" : repeat "->") 44 | -- >>> :} 45 | -- 46 | -- The 'sep' function is one way of concatenating documents, there are multiple 47 | -- others, e.g. 'vsep', 'cat' and 'fillSep'. In our case, 'sep' space-separates 48 | -- all entries if there is space, and newlines if the remaining line is too 49 | -- short. 50 | -- 51 | -- Second, prepend the name to the type, 52 | -- 53 | -- >>> let prettyprintDeclaration n tys = pretty n <+> prettyprintType tys 54 | -- 55 | -- Now we can define a document that contains some type signature: 56 | -- 57 | -- >>> let doc = prettyprintDeclaration "example" ["Int", "Bool", "Char", "IO ()"] 58 | -- 59 | -- This document can now be printed, and it automatically adapts to available 60 | -- space. If the page is wide enough (80 characters in this case), the 61 | -- definitions are space-separated, 62 | -- 63 | -- >>> putDocW 80 doc 64 | -- example :: Int -> Bool -> Char -> IO () 65 | -- 66 | -- If we narrow the page width to only 20 characters, the /same document/ 67 | -- renders vertically aligned: 68 | -- 69 | -- >>> putDocW 20 doc 70 | -- example :: Int 71 | -- -> Bool 72 | -- -> Char 73 | -- -> IO () 74 | -- 75 | -- Speaking of alignment, had we not used 'align', the @->@ would be at the 76 | -- beginning of each line, and not beneath the @::@. 77 | -- 78 | -- The 'Prettyprinter.Util.putDocW' renderer used here is from 79 | -- "Prettyprinter.Util". 80 | -- 81 | -- = General workflow 82 | -- 83 | -- @ 84 | -- ╔══════════╗ 85 | -- ║ ║ ╭────────────────────╮ 86 | -- ║ ║ │ 'vsep', 'pretty', '<+>', │ 87 | -- ║ ║ │ 'nest', 'align', … │ 88 | -- ║ ║ ╰─────────┬──────────╯ 89 | -- ║ ║ │ 90 | -- ║ Create ║ │ 91 | -- ║ ║ │ 92 | -- ║ ║ ▽ 93 | -- ║ ║ ╭───────────────────╮ 94 | -- ║ ║ │ 'Doc' │ 95 | -- ╠══════════╣ │ (rich document) │ 96 | -- ║ ║ ╰─────────┬─────────╯ 97 | -- ║ ║ │ 98 | -- ║ ║ │ Layout algorithms 99 | -- ║ Layout ║ │ e.g. 'layoutPretty' 100 | -- ║ ║ ▽ 101 | -- ║ ║ ╭───────────────────╮ 102 | -- ║ ║ │ 'SimpleDocStream' │ 103 | -- ╠══════════╣ │ (simple document) │ 104 | -- ║ ║ ╰─────────┬─────────╯ 105 | -- ║ ║ │ 106 | -- ║ ║ ├─────────────────────────────╮ 107 | -- ║ ║ │ │ 'Prettyprinter.Render.Util.SimpleDocTree.treeForm' 108 | -- ║ ║ │ ▽ 109 | -- ║ ║ │ ╭───────────────╮ 110 | -- ║ ║ │ │ 'Prettyprinter.Render.Util.SimpleDocTree.SimpleDocTree' │ 111 | -- ║ Render ║ │ ╰───────┬───────╯ 112 | -- ║ ║ │ │ 113 | -- ║ ║ ╭───────────────────┼─────────────────╮ ╭────────┴────────╮ 114 | -- ║ ║ │ │ │ │ │ 115 | -- ║ ║ ▽ ▽ ▽ ▽ ▽ 116 | -- ║ ║ ╭───────────────╮ ╭───────────────╮ ╭───────────────╮ ╭───────────────╮ 117 | -- ║ ║ │ ANSI terminal │ │ Plain 'Text' │ │ other/custom │ │ HTML │ 118 | -- ║ ║ ╰───────────────╯ ╰───────────────╯ ╰───────────────╯ ╰───────────────╯ 119 | -- ║ ║ 120 | -- ╚══════════╝ 121 | -- @ 122 | -- 123 | -- = How the layout works 124 | -- 125 | -- There are two key concepts to laying a document out: the available width, and 126 | -- 'group'ing. 127 | -- 128 | -- == Available width 129 | -- 130 | -- The page has a certain maximum width, which the layouter tries to not exceed, 131 | -- by inserting line breaks where possible. The functions given in this module 132 | -- make it fairly straightforward to specify where, and under what 133 | -- circumstances, such a line break may be inserted by the layouter, for example 134 | -- via the 'sep' function. 135 | -- 136 | -- There is also the concept of /ribbon width/. The ribbon is the part of a line 137 | -- that is printed, i.e. the line length without the leading indentation. The 138 | -- layouters take a ribbon fraction argument, which specifies how much of a line 139 | -- should be filled before trying to break it up. A ribbon width of 0.5 in a 140 | -- document of width 80 will result in the layouter to try to not exceed @0.5*80 = 141 | -- 40@ (ignoring current indentation depth). 142 | -- 143 | -- == Grouping 144 | -- 145 | -- A document can be 'group'ed, which tells the layouter that it should attempt 146 | -- to collapse it to a single line. If the result does not fit within the 147 | -- constraints (given by page and ribbon widths), the document is rendered 148 | -- unaltered. This allows fallback definitions, so that we get nice results even 149 | -- when the original document would exceed the layout constraints. 150 | -- 151 | -- = Things the prettyprinter /cannot/ do 152 | -- 153 | -- Due to how the Wadler/Leijen algorithm is designed, a couple of things are 154 | -- unsupported right now, with a high possibility of having no sensible 155 | -- implementation without significantly changing the layout algorithm. In 156 | -- particular, this includes 157 | -- 158 | -- * Leading symbols instead of just spaces for indentation, as used by the 159 | -- Linux @tree@ tool for example 160 | -- * Multi-column layouts, in particular tables with multiple cells of equal 161 | -- width adjacent to each other 162 | -- 163 | -- = Some helpful tips 164 | -- 165 | -- == Which kind of annotation should I use? 166 | -- 167 | -- __Summary:__ Use semantic annotations for @'Doc'@, and after layouting map to 168 | -- backend-specific ones. 169 | -- 170 | -- For example, suppose you want to prettyprint some programming language code. 171 | -- If you want keywords to be red, you should annotate the @'Doc'@ with a type 172 | -- that has a 'Keyword' field (without any notion of color), and then after 173 | -- layouting convert the annotations to map @'Keyword'@ to e.g. @'Red'@ (using 174 | -- @'reAnnotateS'@). The alternative that I /do not/ recommend is directly 175 | -- annotating the @'Doc'@ with 'Red'. 176 | -- 177 | -- While both versions would superficially work equally well and would create 178 | -- identical output, the recommended way has two significant advantages: 179 | -- modularity and extensibility. 180 | -- 181 | -- /Modularity:/ To change the color of keywords later, you have to touch one 182 | -- point, namely the mapping in @'reAnnotateS'@, where @'Keyword'@ is mapped to 183 | -- 'Red'. If you have @'annotate Red …'@ everywher, you’ll have to do a full 184 | -- text replacement, producing a large diff and touching lots of places for a 185 | -- very small change. 186 | -- 187 | -- /Extensibility:/ Adding a different backend in the recommended version is 188 | -- simply adding another @'reAnnotateS'@ to convert the @'Doc'@ annotation to 189 | -- something else. On the other hand, if you have @'Red'@ as an annotation in 190 | -- the @'Doc'@ already and the other backend does not support anything red 191 | -- (think of plain text or a website where red doesn’t work well with the rest 192 | -- of the style), you’ll have to worry about what to map »redness« to, which has 193 | -- no canonical answer. Should it be omitted? What does »red« mean anyway – 194 | -- maybe keywords and variables are red, and you want to change only the color 195 | -- of variables? 196 | module Prettyprinter ( 197 | -- * Documents 198 | Doc, 199 | 200 | -- * Basic functionality 201 | Pretty(..), 202 | viaShow, unsafeViaShow, 203 | emptyDoc, nest, line, line', softline, softline', hardline, 204 | 205 | -- ** Primitives for alternative layouts 206 | group, flatAlt, 207 | 208 | -- * Alignment functions 209 | -- 210 | -- | The functions in this section cannot be described by Wadler's original 211 | -- functions. They align their output relative to the current output 212 | -- position - in contrast to @'nest'@ which always aligns to the current 213 | -- nesting level. This deprives these functions from being \'optimal\'. In 214 | -- practice however they prove to be very useful. The functions in this 215 | -- section should be used with care, since they are more expensive than the 216 | -- other functions. For example, @'align'@ shouldn't be used to pretty print 217 | -- all top-level declarations of a language, but using @'hang'@ for let 218 | -- expressions is fine. 219 | align, hang, indent, encloseSep, list, tupled, 220 | 221 | -- * Binary functions 222 | (<>), (<+>), 223 | 224 | -- * List functions 225 | 226 | -- | The 'sep' and 'cat' functions differ in one detail: when 'group'ed, the 227 | -- 'sep's replace newlines wich 'space's, while the 'cat's simply remove 228 | -- them. If you're not sure what you want, start with the 'sep's. 229 | 230 | concatWith, 231 | 232 | -- ** 'sep' family 233 | -- 234 | -- | When 'group'ed, these will replace newlines with spaces. 235 | hsep, vsep, fillSep, sep, 236 | -- ** 'cat' family 237 | -- 238 | -- | When 'group'ed, these will remove newlines. 239 | hcat, vcat, fillCat, cat, 240 | -- ** Others 241 | punctuate, 242 | 243 | -- * Reactive/conditional layouts 244 | -- 245 | -- | Lay documents out differently based on current position and the page 246 | -- layout. 247 | column, nesting, width, pageWidth, 248 | 249 | -- * Filler functions 250 | -- 251 | -- | Fill up available space 252 | fill, fillBreak, 253 | 254 | -- * General convenience 255 | -- 256 | -- | Useful helper functions. 257 | plural, enclose, surround, 258 | 259 | -- * Bracketing functions 260 | -- 261 | -- | Enclose documents in common ways. 262 | squotes, dquotes, parens, angles, brackets, braces, 263 | 264 | -- * Named characters 265 | -- 266 | -- | Convenience definitions for common characters 267 | lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket, squote, 268 | dquote, semi, colon, comma, space, dot, slash, backslash, equals, pipe, 269 | 270 | -- ** Annotations 271 | annotate, 272 | unAnnotate, 273 | reAnnotate, 274 | alterAnnotations, 275 | unAnnotateS, 276 | reAnnotateS, 277 | alterAnnotationsS, 278 | 279 | -- * Optimization 280 | -- 281 | -- Render documents faster 282 | fuse, FusionDepth(..), 283 | 284 | -- * Layout 285 | -- 286 | -- | Laying a 'Doc'ument out produces a straightforward 'SimpleDocStream' 287 | -- based on parameters such as page width and ribbon size, by evaluating how 288 | -- a 'Doc' fits these constraints the best. There are various ways to render 289 | -- a 'SimpleDocStream'. For the common case of rendering a 'SimpleDocStream' 290 | -- as plain 'Text' take a look at "Prettyprinter.Render.Text". 291 | SimpleDocStream(..), 292 | PageWidth(..), LayoutOptions(..), defaultLayoutOptions, 293 | layoutPretty, layoutCompact, layoutSmart, 294 | removeTrailingWhitespace, 295 | 296 | -- * Migration guide 297 | -- 298 | -- $migration 299 | ) where 300 | 301 | 302 | 303 | #if !(SEMIGROUP_MONOID_SUPERCLASS) 304 | import Data.Semigroup 305 | #endif 306 | import Prettyprinter.Internal 307 | import Prettyprinter.Symbols.Ascii 308 | 309 | -- $setup 310 | -- 311 | -- (Definitions for the doctests) 312 | -- 313 | -- >>> :set -XOverloadedStrings 314 | -- >>> import Prettyprinter.Render.Text 315 | -- >>> import Prettyprinter.Util 316 | 317 | 318 | 319 | -- $migration 320 | -- 321 | -- There are 3 main ways to migrate: 322 | -- 323 | -- 1. Direct: just replace the previous package and fix the errors 324 | -- 2. Using a drop-in replacement mimicking the API of the former module, see 325 | -- the @prettyprinter-compat-@ packages 326 | -- 3. Using a converter from the old @Doc@ type to the new one, see the 327 | -- @prettyprinter-convert-@ packages 328 | -- 329 | -- If you're already familiar with (ansi-)wl-pprint, you'll recognize many 330 | -- functions in this module, and they work just the same way. However, a couple 331 | -- of definitions are missing: 332 | -- 333 | -- - @char@, @string@, @double@, … – these are all special cases of the 334 | -- overloaded @'pretty'@ function. 335 | -- - @\<$>@, @\<$$>@, @\@, @\@ are special cases of 336 | -- @'vsep'@, @'vcat'@, @'fillSep'@, @'fillCat'@ with only two documents. 337 | -- - If you need 'String' output, use the backends in the 338 | -- "Prettyprinter.Render.String" module. 339 | -- - The /display/ functions are moved to the rendering submodules, for 340 | -- example conversion to plain 'Text' is in the 341 | -- "Prettyprinter.Render.Text" module. 342 | -- - The /render/ functions are called /layout/ functions. 343 | -- - @SimpleDoc@ was renamed to @'SimpleDocStream'@, in order to make it 344 | -- clearer in the presence of @SimpleDocTree@. 345 | -- - Instead of providing an own colorization function for each 346 | -- color\/intensity\/layer combination, they have been combined in 'color', 347 | -- 'colorDull', 'bgColor', and 'bgColorDull' functions, which can be found 348 | -- in the ANSI terminal specific @prettyprinter-ansi-terminal@ package. 349 | -------------------------------------------------------------------------------- /prettyprinter/src/Prettyprinter/Internal/Debug.hs: -------------------------------------------------------------------------------- 1 | -- | __Warning: internal module!__ This means that the API may change 2 | -- arbitrarily between versions without notice. Depending on this module may 3 | -- lead to unexpected breakages, so proceed with caution! 4 | -- 5 | -- This module provides debugging helpers for inspecting 'Doc's. 6 | -- 7 | -- Use the @pretty-simple@ package to get a nicer layout for 'show'n 8 | -- 'Diag's: 9 | -- 10 | -- > > Text.Pretty.Simple.pPrintNoColor . diag $ align (vcat ["foo", "bar"]) 11 | -- > Column 12 | -- > [ 13 | -- > ( 10 14 | -- > , Nesting 15 | -- > [ 16 | -- > ( 10 17 | -- > , Cat ( Text 3 "foo" ) 18 | -- > ( Cat ( FlatAlt Line Empty ) ( Text 3 "bar" ) ) 19 | -- > ) 20 | -- > ] 21 | -- > ) 22 | -- > ] 23 | 24 | 25 | module Prettyprinter.Internal.Debug where 26 | 27 | import Data.Text (Text) 28 | import Prettyprinter.Internal (PageWidth, Doc) 29 | import qualified Prettyprinter.Internal as Doc 30 | 31 | -- | A variant of 'Doc' for debugging. 32 | -- 33 | -- Unlike in the 'Doc' type, the 'Column', 'WithPageWidth' and 'Nesting' 34 | -- constructors don't contain functions but are \"sampled\" to allow 35 | -- simple inspection with 'show'. 36 | data Diag ann = 37 | Fail 38 | | Empty 39 | | Char !Char 40 | | Text !Int !Text 41 | | Line 42 | | FlatAlt (Diag ann) (Diag ann) 43 | | Cat (Diag ann) (Diag ann) 44 | | Nest !Int (Diag ann) 45 | | Union (Diag ann) (Diag ann) 46 | | Column [(Int, Diag ann)] 47 | -- ^ 'Doc': @(Int -> Diag ann)@ 48 | | WithPageWidth [(PageWidth, Diag ann)] 49 | -- ^ 'Doc': @(PageWidth -> Diag ann)@ 50 | | Nesting [(Int, Diag ann)] 51 | -- ^ 'Doc': @(Int -> Diag ann)@ 52 | | Annotated ann (Diag ann) 53 | deriving Show 54 | 55 | -- | Convert a 'Doc' to its diagnostic representation. 56 | -- 57 | -- The functions in the 'Column', 'WithPageWidth' and 'Nesting' constructors are 58 | -- sampled with some default values. 59 | -- 60 | -- Use `diag'` to control the function inputs yourself. 61 | -- 62 | -- >>> diag $ Doc.align (Doc.vcat ["foo", "bar"]) 63 | -- Column [(10,Nesting [(10,Cat (Text 3 "foo") (Cat (FlatAlt Line Empty) (Text 3 "bar")))])] 64 | diag :: Doc ann -> Diag ann 65 | diag = diag' [10] [Doc.defaultPageWidth] [10] 66 | 67 | diag' 68 | :: [Int] 69 | -- ^ Cursor positions for the 'Column' constructor 70 | -> [PageWidth] 71 | -- ^ For 'WithPageWidth' 72 | -> [Int] 73 | -- ^ Nesting levels for 'Nesting' 74 | -> Doc ann 75 | -> Diag ann 76 | diag' columns pageWidths nestings = go 77 | where 78 | go doc = case doc of 79 | Doc.Fail -> Fail 80 | Doc.Empty -> Empty 81 | Doc.Char c -> Char c 82 | Doc.Text l t -> Text l t 83 | Doc.Line -> Line 84 | Doc.FlatAlt a b -> FlatAlt (go a) (go b) 85 | Doc.Cat a b -> Cat (go a) (go b) 86 | Doc.Nest i d -> Nest i (go d) 87 | Doc.Union a b -> Union (go a) (go b) 88 | Doc.Column f -> Column (apply f columns) 89 | Doc.WithPageWidth f -> WithPageWidth (apply f pageWidths) 90 | Doc.Nesting f -> Nesting (apply f nestings) 91 | Doc.Annotated ann d -> Annotated ann (go d) 92 | 93 | apply :: (a -> Doc ann) -> [a] -> [(a, Diag ann)] 94 | apply f = map (\x -> (x, go (f x))) 95 | 96 | -------------------------------------------------------------------------------- /prettyprinter/src/Prettyprinter/Internal/Type.hs: -------------------------------------------------------------------------------- 1 | {-# OPTIONS_HADDOCK not-home #-} 2 | 3 | -- | __Internal module with stability guarantees__ 4 | -- 5 | -- This module exposes the internals of the @'Doc'@ type so other libraries can 6 | -- write adaptors to/from it. For all other uses, please use only the API 7 | -- provided by non-internal modules. 8 | -- 9 | -- Although this module is internal, it follows the usual package versioning 10 | -- policy, AKA Haskell’s version of semantic versioning. In other words, this 11 | -- module is as stable as the public API. 12 | module Prettyprinter.Internal.Type (Doc(..)) where 13 | 14 | import Prettyprinter.Internal 15 | -------------------------------------------------------------------------------- /prettyprinter/src/Prettyprinter/Render/String.hs: -------------------------------------------------------------------------------- 1 | module Prettyprinter.Render.String ( 2 | renderString, 3 | renderShowS, 4 | ) where 5 | 6 | import Prettyprinter.Internal (SimpleDocStream, renderShowS) 7 | 8 | -- | Render a 'SimpleDocStream' to a 'String'. 9 | renderString :: SimpleDocStream ann -> String 10 | renderString s = renderShowS s "" 11 | -------------------------------------------------------------------------------- /prettyprinter/src/Prettyprinter/Render/Text.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | 3 | #include "version-compatibility-macros.h" 4 | 5 | -- | Render an unannotated 'SimpleDocStream' as plain 'Text'. 6 | module Prettyprinter.Render.Text ( 7 | #ifdef MIN_VERSION_text 8 | -- * Conversion to plain 'Text' 9 | renderLazy, renderStrict, 10 | #endif 11 | 12 | -- * Render to a 'Handle' 13 | renderIO, 14 | 15 | -- ** Convenience functions 16 | putDoc, hPutDoc 17 | ) where 18 | 19 | 20 | 21 | import Data.Text (Text) 22 | import qualified Data.Text.IO as T 23 | import qualified Data.Text.Lazy as TL 24 | import qualified Data.Text.Lazy.Builder as TLB 25 | import System.IO 26 | 27 | import Prettyprinter 28 | import Prettyprinter.Internal 29 | import Prettyprinter.Render.Util.Panic 30 | 31 | #if !(SEMIGROUP_IN_BASE) 32 | import Data.Semigroup 33 | #endif 34 | 35 | #if !(APPLICATIVE_MONAD) 36 | import Control.Applicative 37 | #endif 38 | 39 | -- $setup 40 | -- 41 | -- (Definitions for the doctests) 42 | -- 43 | -- >>> :set -XOverloadedStrings 44 | -- >>> import qualified Data.Text.IO as T 45 | -- >>> import qualified Data.Text.Lazy.IO as TL 46 | 47 | 48 | 49 | -- | @('renderLazy' sdoc)@ takes the output @sdoc@ from a rendering function 50 | -- and transforms it to lazy text. 51 | -- 52 | -- >>> let render = TL.putStrLn . renderLazy . layoutPretty defaultLayoutOptions 53 | -- >>> let doc = "lorem" <+> align (vsep ["ipsum dolor", parens "foo bar", "sit amet"]) 54 | -- >>> render doc 55 | -- lorem ipsum dolor 56 | -- (foo bar) 57 | -- sit amet 58 | renderLazy :: SimpleDocStream ann -> TL.Text 59 | renderLazy = TLB.toLazyText . go 60 | where 61 | go x = case x of 62 | SFail -> panicUncaughtFail 63 | SEmpty -> mempty 64 | SChar c rest -> TLB.singleton c <> go rest 65 | SText _l t rest -> TLB.fromText t <> go rest 66 | SLine i rest -> TLB.singleton '\n' <> (TLB.fromText (textSpaces i) <> go rest) 67 | SAnnPush _ann rest -> go rest 68 | SAnnPop rest -> go rest 69 | 70 | -- | @('renderStrict' sdoc)@ takes the output @sdoc@ from a rendering function 71 | -- and transforms it to strict text. 72 | renderStrict :: SimpleDocStream ann -> Text 73 | renderStrict = TL.toStrict . renderLazy 74 | 75 | 76 | 77 | -- | @('renderIO' h sdoc)@ writes @sdoc@ to the file @h@. 78 | -- 79 | -- >>> renderIO System.IO.stdout (layoutPretty defaultLayoutOptions "hello\nworld") 80 | -- hello 81 | -- world 82 | -- 83 | -- This function is more efficient than @'T.hPutStr' h ('renderStrict' sdoc)@, 84 | -- since it writes to the handle directly, skipping the intermediate 'Text' 85 | -- representation. 86 | renderIO :: Handle -> SimpleDocStream ann -> IO () 87 | renderIO h = go 88 | where 89 | go :: SimpleDocStream ann -> IO () 90 | go = \sds -> case sds of 91 | SFail -> panicUncaughtFail 92 | SEmpty -> pure () 93 | SChar c rest -> do hPutChar h c 94 | go rest 95 | SText _ t rest -> do T.hPutStr h t 96 | go rest 97 | SLine n rest -> do hPutChar h '\n' 98 | T.hPutStr h (textSpaces n) 99 | go rest 100 | SAnnPush _ann rest -> go rest 101 | SAnnPop rest -> go rest 102 | 103 | -- | @('putDoc' doc)@ prettyprints document @doc@ to standard output. Uses the 104 | -- 'defaultLayoutOptions'. 105 | -- 106 | -- >>> putDoc ("hello" <+> "world") 107 | -- hello world 108 | -- 109 | -- @ 110 | -- 'putDoc' = 'hPutDoc' 'stdout' 111 | -- @ 112 | putDoc :: Doc ann -> IO () 113 | putDoc = hPutDoc stdout 114 | 115 | -- | Like 'putDoc', but instead of using 'stdout', print to a user-provided 116 | -- handle, e.g. a file or a socket. Uses the 'defaultLayoutOptions'. 117 | -- 118 | -- @ 119 | -- main = 'withFile' filename (\h -> 'hPutDoc' h doc) 120 | -- where 121 | -- doc = 'vcat' ["vertical", "text"] 122 | -- filename = "someFile.txt" 123 | -- @ 124 | -- 125 | -- @ 126 | -- 'hPutDoc' h doc = 'renderIO' h ('layoutPretty' 'defaultLayoutOptions' doc) 127 | -- @ 128 | hPutDoc :: Handle -> Doc ann -> IO () 129 | hPutDoc h doc = renderIO h (layoutPretty defaultLayoutOptions doc) 130 | -------------------------------------------------------------------------------- /prettyprinter/src/Prettyprinter/Render/Tutorials/StackMachineTutorial.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | {-# OPTIONS_GHC -fno-warn-deprecations #-} 5 | 6 | #include "version-compatibility-macros.h" 7 | 8 | -- | This module shows how to write a custom prettyprinter backend, based on 9 | -- directly converting a 'SimpleDocStream' to an output format using a stack 10 | -- machine. For a tree serialization approach, which may be more suitable for 11 | -- certain output formats, see 12 | -- "Prettyprinter.Render.Tutorials.TreeRenderingTutorial". 13 | -- 14 | -- Rendering to ANSI terminal with colors is an important use case for stack 15 | -- machine based rendering. 16 | -- 17 | -- The module is written to be readable top-to-bottom in both Haddock and raw 18 | -- source form. 19 | module Prettyprinter.Render.Tutorials.StackMachineTutorial 20 | {-# DEPRECATED "Writing your own stack machine is probably more efficient and customizable; also consider using »renderSimplyDecorated(A)« instead" #-} 21 | where 22 | 23 | import qualified Data.Text.Lazy as TL 24 | import qualified Data.Text.Lazy.Builder as TLB 25 | 26 | import Prettyprinter 27 | import Prettyprinter.Internal 28 | import Prettyprinter.Render.Util.Panic 29 | import Prettyprinter.Render.Util.StackMachine 30 | 31 | #if !(APPLICATIVE_MONAD) 32 | import Control.Applicative 33 | #endif 34 | 35 | -- * The type of available markup 36 | -- 37 | -- $standalone-text 38 | -- 39 | -- First, we define a set of valid annotations must be defined, with the goal of 40 | -- defining a @'Doc' 'SimpleHtml'@. We will later define how to convert this to 41 | -- the output format ('TL.Text'). 42 | 43 | data SimpleHtml = Bold | Italics | Color Color | Paragraph | Headline 44 | data Color = Red | Green | Blue 45 | 46 | -- ** Convenience definitions 47 | 48 | bold, italics, paragraph, headline :: Doc SimpleHtml -> Doc SimpleHtml 49 | bold = annotate Bold 50 | italics = annotate Italics 51 | paragraph = annotate Paragraph 52 | headline = annotate Headline 53 | 54 | color :: Color -> Doc SimpleHtml -> Doc SimpleHtml 55 | color c = annotate (Color c) 56 | 57 | -- * The rendering algorithm 58 | -- 59 | -- $standalone-text 60 | -- 61 | -- With the annotation definitions out of the way, we can now define a 62 | -- conversion function from 'SimpleDocStream' annotated with our 'SimpleHtml' to the 63 | -- final 'TL.Text' representation. 64 | -- 65 | -- There are two ways to render this; the simpler one is just using 66 | -- 'renderSimplyDecorated'. However, some output formats require more 67 | -- complicated functionality, so we explore this explicitly with a simple 68 | -- example below. An example for something more complicated is ANSI terminal 69 | -- rendering, where on popping we need to regenerate the previous style, 70 | -- requiring a pop (discard current style) followed by a peek (regenerate 71 | -- previous style). 72 | 73 | -- | The 'StackMachine' type defines a stack machine suitable for many rendering 74 | -- needs. It has two auxiliary parameters: the type of the end result, and the 75 | -- type of the document’s annotations. 76 | -- 77 | -- Most 'StackMachine' creations will look like this definition: a recursive 78 | -- walk through the 'SimpleDocStream', pushing styles on the stack and popping 79 | -- them off again, and writing raw output. 80 | -- 81 | -- The equivalent to this in the tree based rendering approach is 82 | -- 'Prettyprinter.Render.Tutorials.TreeRenderingTutorial.renderTree'. 83 | renderStackMachine :: SimpleDocStream SimpleHtml -> StackMachine TLB.Builder SimpleHtml () 84 | renderStackMachine = \sds -> case sds of 85 | SFail -> panicUncaughtFail 86 | SEmpty -> pure () 87 | SChar c x -> do 88 | writeOutput (TLB.singleton c) 89 | renderStackMachine x 90 | SText _l t x -> do 91 | writeOutput (TLB.fromText t) 92 | renderStackMachine x 93 | SLine i x -> do 94 | writeOutput (TLB.singleton '\n') 95 | writeOutput (TLB.fromText (textSpaces i)) 96 | renderStackMachine x 97 | SAnnPush s x -> do 98 | pushStyle s 99 | writeOutput (fst (htmlTag s)) 100 | renderStackMachine x 101 | SAnnPop x -> do 102 | s <- unsafePopStyle 103 | writeOutput (snd (htmlTag s)) 104 | renderStackMachine x 105 | 106 | -- | Convert a 'SimpleHtml' annotation to a pair of opening and closing tags. 107 | -- This is where the translation of style to raw output happens. 108 | htmlTag :: SimpleHtml -> (TLB.Builder, TLB.Builder) 109 | htmlTag = \sh -> case sh of 110 | Bold -> ("", "") 111 | Italics -> ("", "") 112 | Color c -> (" hexCode c <> "\">", "") 113 | Paragraph -> ("

", "

") 114 | Headline -> ("

", "

") 115 | where 116 | hexCode :: Color -> TLB.Builder 117 | hexCode = \c -> case c of 118 | Red -> "#f00" 119 | Green -> "#0f0" 120 | Blue -> "#00f" 121 | 122 | -- | We can now wrap our stack machine definition from 'renderStackMachine' in a 123 | -- nicer interface; on successful conversion, we run the builder to give us the 124 | -- final 'TL.Text', and before we do that we check that the style stack is empty 125 | -- (i.e. there are no unmatched style applications) after the machine is run. 126 | -- 127 | -- This function does only a bit of plumbing around 'renderStackMachine', and is 128 | -- the main API function of a stack machine renderer. The tree renderer 129 | -- equivalent to this is 130 | -- 'Prettyprinter.Render.Tutorials.TreeRenderingTutorial.render'. 131 | render :: SimpleDocStream SimpleHtml -> TL.Text 132 | render doc 133 | = let (resultBuilder, remainingStyles) = execStackMachine [] (renderStackMachine doc) 134 | in if null remainingStyles 135 | then TLB.toLazyText resultBuilder 136 | else error ("There are " 137 | <> show (length remainingStyles) 138 | <> " unpaired styles! Please report this as a bug.") 139 | 140 | -- * Example invocation 141 | -- 142 | -- $standalone-text 143 | -- 144 | -- We can now render an example document using our definitions: 145 | -- 146 | -- >>> :set -XOverloadedStrings 147 | -- >>> import qualified Data.Text.Lazy.IO as TL 148 | -- >>> :{ 149 | -- >>> let go = TL.putStrLn . render . layoutPretty defaultLayoutOptions 150 | -- >>> in go (vsep 151 | -- >>> [ headline "Example document" 152 | -- >>> , paragraph ("This is a" <+> color Red "paragraph" <> comma) 153 | -- >>> , paragraph ("and" <+> bold "this text is bold.") 154 | -- >>> ]) 155 | -- >>> :} 156 | --

Example document

157 | --

This is a paragraph,

158 | --

and this text is bold.

159 | -------------------------------------------------------------------------------- /prettyprinter/src/Prettyprinter/Render/Tutorials/TreeRenderingTutorial.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | #include "version-compatibility-macros.h" 5 | 6 | -- | This module shows how to write a custom prettyprinter backend, based on a 7 | -- tree representation of a 'SimpleDocStream'. For a stack machine approach, which 8 | -- may be more suitable for certain output formats, see 9 | -- "Prettyprinter.Render.Tutorials.StackMachineTutorial". 10 | -- 11 | -- Rendering to HTML, particularly using libraries such as blaze-html or lucid, 12 | -- is one important use case of tree-based rendering. 13 | -- 14 | -- The module is written to be readable top-to-bottom in both Haddock and raw 15 | -- source form. 16 | module Prettyprinter.Render.Tutorials.TreeRenderingTutorial where 17 | 18 | import qualified Data.Text.Lazy as TL 19 | import qualified Data.Text.Lazy.Builder as TLB 20 | 21 | import Prettyprinter 22 | import Prettyprinter.Internal 23 | import Prettyprinter.Render.Util.SimpleDocTree 24 | 25 | #if !(FOLDABLE_TRAVERSABLE_IN_PRELUDE) 26 | import Data.Foldable (foldMap) 27 | #endif 28 | #if !(SEMIGROUP_MONOID_SUPERCLASS) 29 | import Data.Semigroup 30 | #endif 31 | 32 | -- * The type of available markup 33 | -- 34 | -- $standalone-text 35 | -- 36 | -- First, we define a set of valid annotations must be defined, with the goal of 37 | -- defining a @'Doc' 'SimpleHtml'@. We will later define how to convert this to 38 | -- the output format ('TL.Text'). 39 | 40 | data SimpleHtml = Bold | Italics | Color Color | Paragraph | Headline 41 | data Color = Red | Green | Blue 42 | 43 | -- ** Convenience definitions 44 | 45 | bold, italics, paragraph, headline :: Doc SimpleHtml -> Doc SimpleHtml 46 | bold = annotate Bold 47 | italics = annotate Italics 48 | paragraph = annotate Paragraph 49 | headline = annotate Headline 50 | 51 | color :: Color -> Doc SimpleHtml -> Doc SimpleHtml 52 | color c = annotate (Color c) 53 | 54 | -- * The rendering algorithm 55 | -- 56 | -- $standalone-text 57 | -- 58 | -- With the annotation definitions out of the way, we can now define a 59 | -- conversion function from 'SimpleDocStream' (annotated with our 'SimpleHtml') 60 | -- to the tree-shaped 'SimpleDocTree', which is easily convertible to a 61 | -- HTML/'Text' representation. 62 | -- 63 | -- There are two ways to render this; the simpler one is just using 64 | -- 'renderSimplyDecorated'. However, some output formats require more 65 | -- complicated functionality, so we explore this explicitly with a simple 66 | -- example below. An example for something more complicated is e.g. an XHTML 67 | -- renderer, where a newline may not simply be a newline character followed by a 68 | -- certain number of spaces, but e.g. involve adding a @
@ tag. 69 | 70 | -- | To render the HTML, we first convert the 'SimpleDocStream' to the 71 | -- 'SimpleDocTree' format, which makes enveloping sub-documents in markup 72 | -- easier. 73 | -- 74 | -- This function is the entry main API function of the renderer; as such, it is 75 | -- only glue for the internal functions. This is similar to 76 | -- 'Prettyprinter.Render.Tutorials.StackMachineTutorial.render' from 77 | -- the stack machine tutorial in its purpose. 78 | render :: SimpleDocStream SimpleHtml -> TL.Text 79 | render = TLB.toLazyText . renderTree . treeForm 80 | 81 | -- | Render a 'SimpleDocTree' to a 'TLB.Builder'; this is the workhorse of the 82 | -- tree-based rendering approach, and equivalent to 83 | -- 'Prettyprinter.Render.Tutorials.StackMachineTutorial.renderStackMachine' 84 | -- in the stack machine rendering tutorial. 85 | renderTree :: SimpleDocTree SimpleHtml -> TLB.Builder 86 | renderTree sds = case sds of 87 | STEmpty -> mempty 88 | STChar c -> TLB.singleton c 89 | STText _ t -> TLB.fromText t 90 | STLine i -> "\n" <> TLB.fromText (textSpaces i) 91 | STAnn ann content -> encloseInTagFor ann (renderTree content) 92 | STConcat contents -> foldMap renderTree contents 93 | 94 | -- | Convert a 'SimpleHtml' to a function that encloses a 'TLB.Builder' in HTML 95 | -- tags. This is where the translation of style to raw output happens. 96 | encloseInTagFor :: SimpleHtml -> TLB.Builder -> TLB.Builder 97 | encloseInTagFor sh = case sh of 98 | Bold -> \x -> "" <> x <> "" 99 | Italics -> \x -> "" <> x <> "" 100 | Color c -> \x -> " hexCode c <> "\">" <> x <> "" 101 | Paragraph -> \x -> "

" <> x <> "

" 102 | Headline -> \x -> "

" <> x <> "

" 103 | where 104 | hexCode :: Color -> TLB.Builder 105 | hexCode c = case c of 106 | Red -> "#f00" 107 | Green -> "#0f0" 108 | Blue -> "#00f" 109 | 110 | -- * Example invocation 111 | -- 112 | -- $standalone-text 113 | -- 114 | -- We can now render an example document using our definitions: 115 | -- 116 | -- >>> :set -XOverloadedStrings 117 | -- >>> import qualified Data.Text.Lazy.IO as TL 118 | -- >>> :{ 119 | -- >>> let go = TL.putStrLn . render . layoutPretty defaultLayoutOptions 120 | -- >>> in go (vsep 121 | -- >>> [ headline "Example document" 122 | -- >>> , paragraph ("This is a" <+> color Red "paragraph" <> comma) 123 | -- >>> , paragraph ("and" <+> bold "this text is bold.") 124 | -- >>> ]) 125 | -- >>> :} 126 | --

Example document

127 | --

This is a paragraph,

128 | --

and this text is bold.

129 | -------------------------------------------------------------------------------- /prettyprinter/src/Prettyprinter/Render/Util/Panic.hs: -------------------------------------------------------------------------------- 1 | module Prettyprinter.Render.Util.Panic ( 2 | panicUncaughtFail, 3 | panicUnpairedPop, 4 | panicSimpleDocTreeConversionFailed, 5 | panicInputNotFullyConsumed, 6 | panicPeekedEmpty, 7 | panicPoppedEmpty, 8 | ) where 9 | 10 | -- | Raise a hard 'error' if there is a 'Prettyprinter.SFail' in a 11 | -- 'Prettyprinter.SimpleDocStream'. 12 | panicUncaughtFail :: void 13 | panicUncaughtFail = error ("»SFail« must not appear in a rendered »SimpleDocStream«. This is a bug in the layout algorithm! " ++ report) 14 | 15 | -- | Raise a hard 'error' when an annotation terminator is encountered in an 16 | -- unannotated region. 17 | panicUnpairedPop :: void 18 | panicUnpairedPop = error ("An unpaired style terminator was encountered. This is a bug in the layout algorithm! " ++ report) 19 | 20 | -- | Raise a hard generic 'error' when the 21 | -- 'Prettyprinter.SimpleDocStream' to 22 | -- 'Prettyprinter.Render.Util.SimpleDocTree.SimpleDocTree' conversion fails. 23 | panicSimpleDocTreeConversionFailed :: void 24 | panicSimpleDocTreeConversionFailed = error ("Conversion from SimpleDocStream to SimpleDocTree failed! " ++ report) 25 | 26 | -- | Raise a hard 'error' when the »to 27 | -- 'Prettyprinter.Render.Util.SimpleDocTree.SimpleDocTree'« parser finishes 28 | -- without consuming the full input. 29 | panicInputNotFullyConsumed :: void 30 | panicInputNotFullyConsumed = error ("Conversion from SimpleDocStream to SimpleDocTree left unconsumed input! " ++ report) 31 | 32 | report :: String 33 | report = "Please report this as a bug" 34 | 35 | panicPeekedEmpty, panicPoppedEmpty :: void 36 | (panicPeekedEmpty, panicPoppedEmpty) = (mkErr "Peeked", mkErr "Popped") 37 | where 38 | mkErr x = error (x ++ " an empty style stack! Please report this as a bug.") 39 | -------------------------------------------------------------------------------- /prettyprinter/src/Prettyprinter/Render/Util/SimpleDocTree.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE DeriveDataTypeable #-} 3 | {-# LANGUAGE DeriveGeneric #-} 4 | 5 | #include "version-compatibility-macros.h" 6 | 7 | -- | Conversion of the linked-list-like 'SimpleDocStream' to a tree-like 8 | -- 'SimpleDocTree'. 9 | module Prettyprinter.Render.Util.SimpleDocTree ( 10 | 11 | -- * Type and conversion 12 | SimpleDocTree(..), 13 | treeForm, 14 | 15 | -- * Manipulating annotations 16 | unAnnotateST, 17 | reAnnotateST, 18 | alterAnnotationsST, 19 | 20 | -- * Common use case shortcut definitions 21 | renderSimplyDecorated, 22 | renderSimplyDecoratedA, 23 | ) where 24 | 25 | 26 | 27 | import Control.Applicative 28 | import Data.Text (Text) 29 | import qualified Data.Text as T 30 | import Data.Typeable (Typeable) 31 | import GHC.Generics 32 | 33 | import Prettyprinter 34 | import Prettyprinter.Internal 35 | import Prettyprinter.Render.Util.Panic 36 | 37 | import qualified Control.Monad.Fail as Fail 38 | 39 | #if !(MONOID_IN_PRELUDE) 40 | import Data.Monoid (Monoid (..)) 41 | #endif 42 | 43 | #if !(FOLDABLE_TRAVERSABLE_IN_PRELUDE) 44 | import Data.Foldable (Foldable (..)) 45 | import Data.Traversable (Traversable (..)) 46 | #endif 47 | 48 | -- $setup 49 | -- 50 | -- (Definitions for the doctests) 51 | -- 52 | -- >>> import Prettyprinter hiding ((<>)) 53 | -- >>> import qualified Data.Text.IO as T 54 | 55 | 56 | 57 | -- | Simplest possible tree-based renderer. 58 | -- 59 | -- For example, here is a document annotated with @()@, and the behaviour is to 60 | -- surround annotated regions with »>>>« and »<<<«: 61 | -- 62 | -- >>> let doc = "hello" <+> annotate () "world" <> "!" 63 | -- >>> let stdoc = treeForm (layoutPretty defaultLayoutOptions doc) 64 | -- >>> T.putStrLn (renderSimplyDecorated id (\() x -> ">>>" <> x <> "<<<") stdoc) 65 | -- hello >>>world<< (Text -> out) -- ^ Render plain 'Text' 69 | -> (ann -> out -> out) -- ^ How to modify an element with an annotation 70 | -> SimpleDocTree ann 71 | -> out 72 | renderSimplyDecorated text renderAnn = go 73 | where 74 | go = \sdt -> case sdt of 75 | STEmpty -> mempty 76 | STChar c -> text (T.singleton c) 77 | STText _ t -> text t 78 | STLine i -> text (T.singleton '\n') `mappend` text (textSpaces i) 79 | STAnn ann rest -> renderAnn ann (go rest) 80 | STConcat xs -> foldMap go xs 81 | {-# INLINE renderSimplyDecorated #-} 82 | 83 | -- | Version of 'renderSimplyDecoratedA' that allows for 'Applicative' effects. 84 | renderSimplyDecoratedA 85 | :: (Applicative f, Monoid out) 86 | => (Text -> f out) -- ^ Render plain 'Text' 87 | -> (ann -> f out -> f out) -- ^ How to modify an element with an annotation 88 | -> SimpleDocTree ann 89 | -> f out 90 | renderSimplyDecoratedA text renderAnn = go 91 | where 92 | go = \sdt -> case sdt of 93 | STEmpty -> pure mempty 94 | STChar c -> text (T.singleton c) 95 | STText _ t -> text t 96 | STLine i -> text (T.cons '\n' (textSpaces i)) 97 | STAnn ann rest -> renderAnn ann (go rest) 98 | STConcat xs -> fmap mconcat (traverse go xs) 99 | {-# INLINE renderSimplyDecoratedA #-} 100 | 101 | 102 | 103 | -- | A type for parsers of unique results. Token stream »s«, results »a«. 104 | -- 105 | -- Hand-written to avoid a dependency on a parser lib. 106 | newtype UniqueParser s a = UniqueParser { runParser :: s -> Maybe (a, s) } 107 | deriving Typeable 108 | 109 | instance Functor (UniqueParser s) where 110 | fmap f (UniqueParser mx) = UniqueParser (\s -> 111 | fmap (\(x,s') -> (f x, s')) (mx s)) 112 | 113 | instance Applicative (UniqueParser s) where 114 | pure x = UniqueParser (\rest -> Just (x, rest)) 115 | UniqueParser mf <*> UniqueParser mx = UniqueParser (\s -> do 116 | (f, s') <- mf s 117 | (x, s'') <- mx s' 118 | pure (f x, s'') ) 119 | 120 | instance Monad (UniqueParser s) where 121 | UniqueParser p >>= f = UniqueParser (\s -> do 122 | (a', s') <- p s 123 | let UniqueParser p' = f a' 124 | p' s' ) 125 | 126 | #if !(APPLICATIVE_MONAD) 127 | return = pure 128 | #endif 129 | #if FAIL_IN_MONAD 130 | fail = Fail.fail 131 | #endif 132 | 133 | instance Fail.MonadFail (UniqueParser s) where 134 | fail _err = empty 135 | 136 | instance Alternative (UniqueParser s) where 137 | empty = UniqueParser (const empty) 138 | UniqueParser p <|> UniqueParser q = UniqueParser (\s -> p s <|> q s) 139 | 140 | data SimpleDocTok ann 141 | = TokEmpty 142 | | TokChar Char 143 | | TokText !Int Text 144 | | TokLine Int 145 | | TokAnnPush ann 146 | | TokAnnPop 147 | deriving (Eq, Ord, Show, Typeable) 148 | 149 | -- | A 'SimpleDocStream' is a linked list of different annotated cons cells 150 | -- ('SText' and then some further 'SimpleDocStream', 'SLine' and then some 151 | -- further 'SimpleDocStream', …). This format is very suitable as a target for a 152 | -- layout engine, but not very useful for rendering to a structured format such 153 | -- as HTML, where we don’t want to do a lookahead until the end of some markup. 154 | -- These formats benefit from a tree-like structure that explicitly marks its 155 | -- contents as annotated. 'SimpleDocTree' is that format. 156 | data SimpleDocTree ann 157 | = STEmpty 158 | | STChar Char 159 | 160 | -- | 'Data.Text.length' is /O(n)/, so we cache it in the 'Int' field. 161 | | STText !Int Text 162 | 163 | -- | @Int@ = indentation level for the (next) line 164 | | STLine !Int 165 | 166 | -- | Annotate the contained document. 167 | | STAnn ann (SimpleDocTree ann) 168 | 169 | -- | Horizontal concatenation of multiple documents. 170 | | STConcat [SimpleDocTree ann] 171 | deriving (Eq, Ord, Show, Generic, Typeable) 172 | 173 | -- | Alter the document’s annotations. 174 | -- 175 | -- This instance makes 'SimpleDocTree' more flexible (because it can be used in 176 | -- 'Functor'-polymorphic values), but @'fmap'@ is much less readable compared to 177 | -- using @'reAnnotateST'@ in code that only works for @'SimpleDocTree'@ anyway. 178 | -- Consider using the latter when the type does not matter. 179 | instance Functor SimpleDocTree where 180 | fmap = reAnnotateST 181 | 182 | -- | Get the next token, consuming it in the process. 183 | nextToken :: UniqueParser (SimpleDocStream ann) (SimpleDocTok ann) 184 | nextToken = UniqueParser (\sds -> case sds of 185 | SFail -> panicUncaughtFail 186 | SEmpty -> empty 187 | SChar c rest -> Just (TokChar c , rest) 188 | SText l t rest -> Just (TokText l t , rest) 189 | SLine i rest -> Just (TokLine i , rest) 190 | SAnnPush ann rest -> Just (TokAnnPush ann , rest) 191 | SAnnPop rest -> Just (TokAnnPop , rest) ) 192 | 193 | sdocToTreeParser :: UniqueParser (SimpleDocStream ann) (SimpleDocTree ann) 194 | sdocToTreeParser = fmap wrap (many contentPiece) 195 | 196 | where 197 | 198 | wrap :: [SimpleDocTree ann] -> SimpleDocTree ann 199 | wrap = \sdts -> case sdts of 200 | [] -> STEmpty 201 | [x] -> x 202 | xs -> STConcat xs 203 | 204 | contentPiece = nextToken >>= \tok -> case tok of 205 | TokEmpty -> pure STEmpty 206 | TokChar c -> pure (STChar c) 207 | TokText l t -> pure (STText l t) 208 | TokLine i -> pure (STLine i) 209 | TokAnnPop -> empty 210 | TokAnnPush ann -> do annotatedContents <- sdocToTreeParser 211 | TokAnnPop <- nextToken 212 | pure (STAnn ann annotatedContents) 213 | 214 | -- | Convert a 'SimpleDocStream' to its 'SimpleDocTree' representation. 215 | treeForm :: SimpleDocStream ann -> SimpleDocTree ann 216 | treeForm sdoc = case runParser sdocToTreeParser sdoc of 217 | Nothing -> panicSimpleDocTreeConversionFailed 218 | Just (sdoct, SEmpty) -> sdoct 219 | Just (_, _unconsumed) -> panicInputNotFullyConsumed 220 | 221 | -- $ 222 | -- 223 | -- >>> :set -XOverloadedStrings 224 | -- >>> treeForm (layoutPretty defaultLayoutOptions ("lorem" <+> "ipsum" <+> annotate True ("TRUE" <+> annotate False "FALSE") <+> "dolor")) 225 | -- 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"] 226 | 227 | -- | Remove all annotations. 'unAnnotate' for 'SimpleDocTree'. 228 | unAnnotateST :: SimpleDocTree ann -> SimpleDocTree xxx 229 | unAnnotateST = alterAnnotationsST (const []) 230 | 231 | -- | Change the annotation of a document. 'reAnnotate' for 'SimpleDocTree'. 232 | reAnnotateST :: (ann -> ann') -> SimpleDocTree ann -> SimpleDocTree ann' 233 | reAnnotateST f = alterAnnotationsST (pure . f) 234 | 235 | -- | Change the annotation of a document to a different annotation, or none at 236 | -- all. 'alterAnnotations' for 'SimpleDocTree'. 237 | -- 238 | -- Note that this is as powerful as 'alterAnnotations', allowing one annotation 239 | -- to become multiple ones, contrary to 'alterAnnotationsS', which cannot do 240 | -- this. 241 | alterAnnotationsST :: (ann -> [ann']) -> SimpleDocTree ann -> SimpleDocTree ann' 242 | alterAnnotationsST re = go 243 | where 244 | go = \sdt -> case sdt of 245 | STEmpty -> STEmpty 246 | STChar c -> STChar c 247 | STText l t -> STText l t 248 | STLine i -> STLine i 249 | STConcat xs -> STConcat (map go xs) 250 | STAnn ann rest -> Prelude.foldr STAnn (go rest) (re ann) 251 | 252 | -- | Collect all annotations from a document. 253 | instance Foldable SimpleDocTree where 254 | foldMap f = go 255 | where 256 | go = \sdt -> case sdt of 257 | STEmpty -> mempty 258 | STChar _ -> mempty 259 | STText _ _ -> mempty 260 | STLine _ -> mempty 261 | STAnn ann rest -> f ann `mappend` go rest 262 | STConcat xs -> mconcat (map go xs) 263 | 264 | -- | Transform a document based on its annotations, possibly leveraging 265 | -- 'Applicative' effects. 266 | instance Traversable SimpleDocTree where 267 | traverse f = go 268 | where 269 | go = \sdt -> case sdt of 270 | STEmpty -> pure STEmpty 271 | STChar c -> pure (STChar c) 272 | STText l t -> pure (STText l t) 273 | STLine i -> pure (STLine i) 274 | STAnn ann rest -> STAnn <$> f ann <*> go rest 275 | STConcat xs -> STConcat <$> traverse go xs 276 | -------------------------------------------------------------------------------- /prettyprinter/src/Prettyprinter/Render/Util/StackMachine.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE BangPatterns #-} 2 | {-# LANGUAGE CPP #-} 3 | 4 | #include "version-compatibility-macros.h" 5 | 6 | -- | Definitions to write renderers based on looking at a 'SimpleDocStream' as 7 | -- an instruction tape for a stack machine: text is written, annotations are 8 | -- added (pushed) and later removed (popped). 9 | module Prettyprinter.Render.Util.StackMachine ( 10 | 11 | -- * Simple, pre-defined stack machines 12 | -- 13 | -- | These cover most basic use cases where there is not too much special 14 | -- logic, and all that’s important is how to render text, and how to 15 | -- add/remove an annotation. 16 | renderSimplyDecorated, 17 | renderSimplyDecoratedA, 18 | 19 | -- * General stack machine 20 | -- 21 | -- | These definitions allow defining a full-blown stack machine renderer, 22 | -- allowing for arbitrary peeking, popping and what not. 23 | StackMachine, 24 | execStackMachine, 25 | 26 | pushStyle, 27 | unsafePopStyle, 28 | unsafePeekStyle, 29 | writeOutput, 30 | ) where 31 | 32 | 33 | 34 | import Control.Applicative 35 | import Data.Text (Text) 36 | import qualified Data.Text as T 37 | 38 | import Prettyprinter.Internal 39 | import Prettyprinter.Render.Util.Panic 40 | 41 | #if !(SEMIGROUP_MONOID_SUPERCLASS) 42 | import Data.Monoid 43 | #endif 44 | 45 | 46 | -- $setup 47 | -- 48 | -- (Definitions for the doctests) 49 | -- 50 | -- >>> import Prettyprinter hiding ((<>)) 51 | -- >>> import qualified Data.Text.IO as T 52 | 53 | 54 | 55 | -- | Simplest possible stack-based renderer. 56 | -- 57 | -- For example, here is a document annotated with @()@, and the behaviour is to 58 | -- write »>>>« at the beginning, and »<<<« at the end of the annotated region: 59 | -- 60 | -- >>> let doc = "hello" <+> annotate () "world" <> "!" 61 | -- >>> let sdoc = layoutPretty defaultLayoutOptions doc 62 | -- >>> T.putStrLn (renderSimplyDecorated id (\() -> ">>>") (\() -> "<<<") sdoc) 63 | -- hello >>>world<< (Text -> out) -- ^ Render plain 'Text' 69 | -> (ann -> out) -- ^ How to render an annotation 70 | -> (ann -> out) -- ^ How to render the removed annotation 71 | -> SimpleDocStream ann 72 | -> out 73 | renderSimplyDecorated text push pop = go [] 74 | where 75 | go _ SFail = panicUncaughtFail 76 | go [] SEmpty = mempty 77 | go (_:_) SEmpty = panicInputNotFullyConsumed 78 | go stack (SChar c rest) = text (T.singleton c) <> go stack rest 79 | go stack (SText _l t rest) = text t <> go stack rest 80 | go stack (SLine i rest) = text (T.singleton '\n') <> text (textSpaces i) <> go stack rest 81 | go stack (SAnnPush ann rest) = push ann <> go (ann : stack) rest 82 | go (ann:stack) (SAnnPop rest) = pop ann <> go stack rest 83 | go [] SAnnPop{} = panicUnpairedPop 84 | {-# INLINE renderSimplyDecorated #-} 85 | 86 | -- | Version of 'renderSimplyDecoratedA' that allows for 'Applicative' effects. 87 | renderSimplyDecoratedA 88 | :: (Applicative f, Monoid out) 89 | => (Text -> f out) -- ^ Render plain 'Text' 90 | -> (ann -> f out) -- ^ How to render an annotation 91 | -> (ann -> f out) -- ^ How to render the removed annotation 92 | -> SimpleDocStream ann 93 | -> f out 94 | renderSimplyDecoratedA text push pop = go [] 95 | where 96 | go _ SFail = panicUncaughtFail 97 | go [] SEmpty = pure mempty 98 | go (_:_) SEmpty = panicInputNotFullyConsumed 99 | go stack (SChar c rest) = text (T.singleton c) <++> go stack rest 100 | go stack (SText _l t rest) = text t <++> go stack rest 101 | go stack (SLine i rest) = text (T.singleton '\n') <++> text (textSpaces i) <++> go stack rest 102 | go stack (SAnnPush ann rest) = push ann <++> go (ann : stack) rest 103 | go (ann:stack) (SAnnPop rest) = pop ann <++> go stack rest 104 | go [] SAnnPop{} = panicUnpairedPop 105 | 106 | (<++>) = liftA2 mappend 107 | {-# INLINE renderSimplyDecoratedA #-} 108 | 109 | 110 | 111 | -- | @WriterT output StateT [style] a@, but with a strict Writer value. 112 | -- 113 | -- The @output@ type is used to append data chunks to, the @style@ is the member 114 | -- of a stack of styles to model nested styles with. 115 | newtype StackMachine output style a = StackMachine ([style] -> (a, output, [style])) 116 | {-# DEPRECATED StackMachine "Writing your own stack machine is probably more efficient and customizable; also consider using »renderSimplyDecorated(A)« instead" #-} 117 | 118 | instance Functor (StackMachine output style) where 119 | fmap f (StackMachine r) = StackMachine (\s -> 120 | let (x1, w1, s1) = r s 121 | in (f x1, w1, s1)) 122 | 123 | instance Monoid output => Applicative (StackMachine output style) where 124 | pure x = StackMachine (\s -> (x, mempty, s)) 125 | StackMachine f <*> StackMachine x = StackMachine (\s -> 126 | let (f1, w1, s1) = f s 127 | (x2, w2, s2) = x s1 128 | !w12 = w1 <> w2 129 | in (f1 x2, w12, s2)) 130 | 131 | instance Monoid output => Monad (StackMachine output style) where 132 | #if !(APPLICATIVE_MONAD) 133 | return = pure 134 | #endif 135 | StackMachine r >>= f = StackMachine (\s -> 136 | let (x1, w1, s1) = r s 137 | StackMachine r1 = f x1 138 | (x2, w2, s2) = r1 s1 139 | !w12 = w1 <> w2 140 | in (x2, w12, s2)) 141 | 142 | -- | Add a new style to the style stack. 143 | pushStyle :: Monoid output => style -> StackMachine output style () 144 | pushStyle style = StackMachine (\styles -> ((), mempty, style : styles)) 145 | 146 | -- | Get the topmost style. 147 | -- 148 | -- If the stack is empty, this raises an 'error'. 149 | unsafePopStyle :: Monoid output => StackMachine output style style 150 | unsafePopStyle = StackMachine (\stack -> case stack of 151 | x:xs -> (x, mempty, xs) 152 | [] -> panicPoppedEmpty ) 153 | 154 | -- | View the topmost style, but do not modify the stack. 155 | -- 156 | -- If the stack is empty, this raises an 'error'. 157 | unsafePeekStyle :: Monoid output => StackMachine output style style 158 | unsafePeekStyle = StackMachine (\styles -> case styles of 159 | x:_ -> (x, mempty, styles) 160 | [] -> panicPeekedEmpty ) 161 | 162 | -- | Append a value to the output end. 163 | writeOutput :: output -> StackMachine output style () 164 | writeOutput w = StackMachine (\styles -> ((), w, styles)) 165 | 166 | -- | Run the renderer and retrive the writing end 167 | execStackMachine :: [styles] -> StackMachine output styles a -> (output, [styles]) 168 | execStackMachine styles (StackMachine r) = let (_, w, s) = r styles in (w, s) 169 | -------------------------------------------------------------------------------- /prettyprinter/src/Prettyprinter/Symbols/Ascii.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | #include "version-compatibility-macros.h" 5 | 6 | -- | Common symbols composed out of the ASCII subset of Unicode. For non-ASCII 7 | -- symbols, see "Prettyprinter.Symbols.Unicode". 8 | module Prettyprinter.Symbols.Ascii where 9 | 10 | 11 | 12 | import Prettyprinter.Internal 13 | 14 | 15 | 16 | -- | >>> squotes "·" 17 | -- '·' 18 | squotes :: Doc ann -> Doc ann 19 | squotes = enclose squote squote 20 | 21 | -- | >>> dquotes "·" 22 | -- "·" 23 | dquotes :: Doc ann -> Doc ann 24 | dquotes = enclose dquote dquote 25 | 26 | -- | >>> parens "·" 27 | -- (·) 28 | parens :: Doc ann -> Doc ann 29 | parens = enclose lparen rparen 30 | 31 | -- | >>> angles "·" 32 | -- <·> 33 | angles :: Doc ann -> Doc ann 34 | angles = enclose langle rangle 35 | 36 | -- | >>> brackets "·" 37 | -- [·] 38 | brackets :: Doc ann -> Doc ann 39 | brackets = enclose lbracket rbracket 40 | 41 | -- | >>> braces "·" 42 | -- {·} 43 | braces :: Doc ann -> Doc ann 44 | braces = enclose lbrace rbrace 45 | 46 | -- | >>> squote 47 | -- ' 48 | squote :: Doc ann 49 | squote = Char '\'' 50 | 51 | -- | >>> dquote 52 | -- " 53 | dquote :: Doc ann 54 | dquote = Char '"' 55 | 56 | -- | >>> lparen 57 | -- ( 58 | lparen :: Doc ann 59 | lparen = Char '(' 60 | 61 | -- | >>> rparen 62 | -- ) 63 | rparen :: Doc ann 64 | rparen = Char ')' 65 | 66 | -- | >>> langle 67 | -- < 68 | langle :: Doc ann 69 | langle = Char '<' 70 | 71 | -- | >>> rangle 72 | -- > 73 | rangle :: Doc ann 74 | rangle = Char '>' 75 | 76 | -- | >>> lbracket 77 | -- [ 78 | lbracket :: Doc ann 79 | lbracket = Char '[' 80 | -- | >>> rbracket 81 | -- ] 82 | rbracket :: Doc ann 83 | rbracket = Char ']' 84 | 85 | -- | >>> lbrace 86 | -- { 87 | lbrace :: Doc ann 88 | lbrace = Char '{' 89 | -- | >>> rbrace 90 | -- } 91 | rbrace :: Doc ann 92 | rbrace = Char '}' 93 | 94 | -- | >>> semi 95 | -- ; 96 | semi :: Doc ann 97 | semi = Char ';' 98 | 99 | -- | >>> colon 100 | -- : 101 | colon :: Doc ann 102 | colon = Char ':' 103 | 104 | -- | >>> comma 105 | -- , 106 | comma :: Doc ann 107 | comma = Char ',' 108 | 109 | -- | >>> "a" <> space <> "b" 110 | -- a b 111 | -- 112 | -- This is mostly used via @'<+>'@, 113 | -- 114 | -- >>> "a" <+> "b" 115 | -- a b 116 | space :: Doc ann 117 | space = Char ' ' 118 | 119 | -- | >>> dot 120 | -- . 121 | dot :: Doc ann 122 | dot = Char '.' 123 | 124 | -- | >>> slash 125 | -- / 126 | slash :: Doc ann 127 | slash = Char '/' 128 | 129 | -- | >>> backslash 130 | -- \\ 131 | 132 | backslash :: Doc ann 133 | backslash = "\\" 134 | 135 | -- | >>> equals 136 | -- = 137 | equals :: Doc ann 138 | equals = Char '=' 139 | 140 | -- | >>> pipe 141 | -- | 142 | pipe :: Doc ann 143 | pipe = Char '|' 144 | 145 | 146 | 147 | -- $setup 148 | -- 149 | -- (Definitions for the doctests) 150 | -- 151 | -- >>> :set -XOverloadedStrings 152 | -- >>> import Data.Semigroup 153 | -- >>> import Prettyprinter.Render.Text 154 | -- >>> import Prettyprinter.Util 155 | -------------------------------------------------------------------------------- /prettyprinter/src/Prettyprinter/Symbols/Unicode.hs: -------------------------------------------------------------------------------- 1 | -- | A collection of predefined Unicode values outside of ASCII range. For 2 | -- ASCII, see "Prettyprinter.Symbols.Ascii". 3 | module Prettyprinter.Symbols.Unicode ( 4 | -- * Quotes 5 | 6 | -- ** Enclosing 7 | d9966quotes, 8 | d6699quotes, 9 | s96quotes, 10 | s69quotes, 11 | dGuillemetsOut, 12 | dGuillemetsIn, 13 | sGuillemetsOut, 14 | sGuillemetsIn, 15 | 16 | -- ** Standalone 17 | b99dquote, 18 | t66dquote, 19 | t99dquote, 20 | b9quote, 21 | t6quote, 22 | t9quote, 23 | 24 | rdGuillemet, 25 | ldGuillemet, 26 | rsGuillemet, 27 | lsGuillemet, 28 | 29 | -- * Various typographical symbols 30 | bullet, 31 | endash, 32 | 33 | -- * Currencies 34 | euro, 35 | cent, 36 | yen, 37 | pound, 38 | ) where 39 | 40 | 41 | 42 | import Prettyprinter.Internal 43 | 44 | 45 | 46 | -- | Double „99-66“ quotes, as used in German typography. 47 | -- 48 | -- >>> putDoc (d9966quotes "·") 49 | -- „·“ 50 | d9966quotes :: Doc ann -> Doc ann 51 | d9966quotes = enclose b99dquote t66dquote 52 | 53 | -- | Double “66-99” quotes, as used in English typography. 54 | -- 55 | -- >>> putDoc (d6699quotes "·") 56 | -- “·” 57 | d6699quotes :: Doc ann -> Doc ann 58 | d6699quotes = enclose t66dquote t99dquote 59 | 60 | -- | Single ‚9-6‘ quotes, as used in German typography. 61 | -- 62 | -- >>> putDoc (s96quotes "·") 63 | -- ‚·‘ 64 | s96quotes :: Doc ann -> Doc ann 65 | s96quotes = enclose b9quote t6quote 66 | 67 | -- | Single ‘6-9’ quotes, as used in English typography. 68 | -- 69 | -- >>> putDoc (s69quotes "·") 70 | -- ‘·’ 71 | s69quotes :: Doc ann -> Doc ann 72 | s69quotes = enclose t6quote t9quote 73 | 74 | -- | Double «guillemets», pointing outwards (without adding any spacing). 75 | -- 76 | -- >>> putDoc (dGuillemetsOut "·") 77 | -- «·» 78 | dGuillemetsOut :: Doc ann -> Doc ann 79 | dGuillemetsOut = enclose ldGuillemet rdGuillemet 80 | 81 | -- | Double »guillemets«, pointing inwards (without adding any spacing). 82 | -- 83 | -- >>> putDoc (dGuillemetsIn "·") 84 | -- »·« 85 | dGuillemetsIn :: Doc ann -> Doc ann 86 | dGuillemetsIn = enclose rdGuillemet ldGuillemet 87 | 88 | -- | Single ‹guillemets›, pointing outwards (without adding any spacing). 89 | -- 90 | -- >>> putDoc (sGuillemetsOut "·") 91 | -- ‹·› 92 | sGuillemetsOut :: Doc ann -> Doc ann 93 | sGuillemetsOut = enclose lsGuillemet rsGuillemet 94 | 95 | -- | Single ›guillemets‹, pointing inwards (without adding any spacing). 96 | -- 97 | -- >>> putDoc (sGuillemetsIn "·") 98 | -- ›·‹ 99 | sGuillemetsIn :: Doc ann -> Doc ann 100 | sGuillemetsIn = enclose rsGuillemet lsGuillemet 101 | 102 | -- | Bottom „99“ style double quotes. 103 | -- 104 | -- >>> putDoc b99dquote 105 | -- „ 106 | b99dquote :: Doc ann 107 | b99dquote = Char '„' 108 | 109 | -- | Top “66” style double quotes. 110 | -- 111 | -- >>> putDoc t66dquote 112 | -- “ 113 | t66dquote :: Doc ann 114 | t66dquote = Char '“' 115 | 116 | -- | Top “99” style double quotes. 117 | -- 118 | -- >>> putDoc t99dquote 119 | -- ” 120 | t99dquote :: Doc ann 121 | t99dquote = Char '”' 122 | 123 | -- | Bottom ‚9‘ style single quote. 124 | -- 125 | -- >>> putDoc b9quote 126 | -- ‚ 127 | b9quote :: Doc ann 128 | b9quote = Char '‚' 129 | 130 | -- | Top ‘66’ style single quote. 131 | -- 132 | -- >>> putDoc t6quote 133 | -- ‘ 134 | t6quote :: Doc ann 135 | t6quote = Char '‘' 136 | 137 | -- | Top ‘9’ style single quote. 138 | -- 139 | -- >>> putDoc t9quote 140 | -- ’ 141 | t9quote :: Doc ann 142 | t9quote = Char '’' 143 | 144 | -- | Right-pointing double guillemets 145 | -- 146 | -- >>> putDoc rdGuillemet 147 | -- » 148 | rdGuillemet :: Doc ann 149 | rdGuillemet = Char '»' 150 | 151 | -- | Left-pointing double guillemets 152 | -- 153 | -- >>> putDoc ldGuillemet 154 | -- « 155 | ldGuillemet :: Doc ann 156 | ldGuillemet = Char '«' 157 | 158 | -- | Right-pointing single guillemets 159 | -- 160 | -- >>> putDoc rsGuillemet 161 | -- › 162 | rsGuillemet :: Doc ann 163 | rsGuillemet = Char '›' 164 | 165 | -- | Left-pointing single guillemets 166 | -- 167 | -- >>> putDoc lsGuillemet 168 | -- ‹ 169 | lsGuillemet :: Doc ann 170 | lsGuillemet = Char '‹' 171 | 172 | -- | >>> putDoc bullet 173 | -- • 174 | bullet :: Doc ann 175 | bullet = Char '•' 176 | 177 | -- | >>> putDoc endash 178 | -- – 179 | endash :: Doc ann 180 | endash = Char '–' 181 | 182 | -- | >>> putDoc euro 183 | -- € 184 | euro :: Doc ann 185 | euro = Char '€' 186 | 187 | -- | >>> putDoc cent 188 | -- ¢ 189 | cent :: Doc ann 190 | cent = Char '¢' 191 | 192 | -- | >>> putDoc yen 193 | -- ¥ 194 | yen :: Doc ann 195 | yen = Char '¥' 196 | 197 | -- | >>> putDoc pound 198 | -- £ 199 | pound :: Doc ann 200 | pound = Char '£' 201 | 202 | 203 | 204 | -- $setup 205 | -- 206 | -- (Definitions for the doctests) 207 | -- 208 | -- >>> :set -XOverloadedStrings 209 | -- >>> import Prettyprinter.Render.Text 210 | -- >>> import Prettyprinter.Util 211 | -------------------------------------------------------------------------------- /prettyprinter/src/Prettyprinter/Util.hs: -------------------------------------------------------------------------------- 1 | -- | Frequently useful definitions for working with general prettyprinters. 2 | module Prettyprinter.Util ( 3 | module Prettyprinter.Util 4 | ) where 5 | 6 | 7 | 8 | import Data.Text (Text) 9 | import qualified Data.Text as T 10 | import Prettyprinter.Render.Text 11 | import Prelude hiding (words) 12 | import System.IO 13 | 14 | import Prettyprinter 15 | 16 | 17 | 18 | -- | Split an input into word-sized 'Doc's. 19 | -- 20 | -- >>> putDoc (tupled (words "Lorem ipsum dolor")) 21 | -- (Lorem, ipsum, dolor) 22 | words :: Text -> [Doc ann] 23 | words = map pretty . T.words 24 | 25 | -- | Insert soft linebreaks between words, so that text is broken into multiple 26 | -- lines when it exceeds the available width. 27 | -- 28 | -- >>> putDocW 32 (reflow "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.") 29 | -- Lorem ipsum dolor sit amet, 30 | -- consectetur adipisicing elit, 31 | -- sed do eiusmod tempor incididunt 32 | -- ut labore et dolore magna 33 | -- aliqua. 34 | -- 35 | -- @ 36 | -- 'reflow' = 'fillSep' . 'words' 37 | -- @ 38 | reflow :: Text -> Doc ann 39 | reflow = fillSep . words 40 | 41 | -- | Render a document with a certain width. Useful for quick-and-dirty testing 42 | -- of layout behaviour. Used heavily in the doctests of this package, for 43 | -- example. 44 | -- 45 | -- >>> let doc = reflow "Lorem ipsum dolor sit amet, consectetur adipisicing elit" 46 | -- >>> putDocW 20 doc 47 | -- Lorem ipsum dolor 48 | -- sit amet, 49 | -- consectetur 50 | -- adipisicing elit 51 | -- >>> putDocW 30 doc 52 | -- Lorem ipsum dolor sit amet, 53 | -- consectetur adipisicing elit 54 | putDocW :: Int -> Doc ann -> IO () 55 | putDocW w doc = renderIO System.IO.stdout (layoutPretty layoutOptions (unAnnotate doc)) 56 | where 57 | layoutOptions = LayoutOptions { layoutPageWidth = AvailablePerLine w 1 } 58 | 59 | 60 | 61 | -- $setup 62 | -- 63 | -- (Definitions for the doctests) 64 | -- 65 | -- >>> :set -XOverloadedStrings 66 | -------------------------------------------------------------------------------- /prettyprinter/test/Doctest/Main.hs: -------------------------------------------------------------------------------- 1 | module Main (main) where 2 | 3 | import Test.DocTest 4 | 5 | main :: IO () 6 | main = doctest [ "src" , "-Imisc"] 7 | -------------------------------------------------------------------------------- /prettyprinter/test/Testsuite/StripTrailingSpace.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE CPP #-} 2 | {-# LANGUAGE OverloadedStrings #-} 3 | 4 | #include "version-compatibility-macros.h" 5 | 6 | module StripTrailingSpace (testStripTrailingSpace) where 7 | 8 | 9 | 10 | import Data.Text (Text) 11 | import qualified Data.Text as T 12 | 13 | import Prettyprinter 14 | import Prettyprinter.Render.Util.StackMachine 15 | 16 | import Test.Tasty 17 | import Test.Tasty.HUnit 18 | 19 | #if !(APPLICATIVE_MONAD) 20 | import Control.Applicative 21 | #endif 22 | 23 | 24 | 25 | box :: Text -> Text 26 | box singleLine = unlines' 27 | [ "┌─" <> T.replicate (T.length singleLine) "─" <> "─┐" 28 | , "│ " <> singleLine <> " │" 29 | , "└─" <> T.replicate (T.length singleLine) "─" <> "─┘" 30 | ] 31 | 32 | bbox :: Text -> Text 33 | bbox singleLine = unlines' 34 | [ "╔═" <> T.replicate (T.length singleLine) "═" <> "═╗" 35 | , "║ " <> singleLine <> " ║" 36 | , "╚═" <> T.replicate (T.length singleLine) "═" <> "═╝" 37 | ] 38 | 39 | testStripTrailingSpace :: TestTree 40 | testStripTrailingSpace = testGroup "Stripping trailing space" 41 | [ testCase "No trailing space" 42 | (testStripping "No trailing space at all") 43 | , testCase "Single trailing space character" 44 | (testStripping ("Single trailing character" <> " ")) 45 | , testCase "Space character inside" 46 | (testStripping ("Space character" <> " " <> "inside")) 47 | , testCase "Obvious trailing spaces" 48 | (testStripping ("Obvious trailing space" <> " ")) 49 | , testCase "Multiple spaces inside" 50 | (testStripping ("Multiple spaces" <> " " <> "inside")) 51 | , testCase "Whitespace inside text" 52 | (testStripping "Whitespace inside text ") 53 | , testCase "Indented blank line" 54 | (testStripping (nest 4 (vcat ["Indented blank line", "", ""]))) 55 | , testCase "Multiple indented blank lines" 56 | (testStripping (nest 4 (vcat ["Indented blank lines", "", "", "", ""]))) 57 | , testCase "Annotation" 58 | (testStripping (annotate () "Annotation with trailing space ")) 59 | , testCase "Document with annotation" 60 | (testStripping ("Here comes an" <> annotate () "annotation " <> "and some trailing space again " <> " ")) 61 | , testCase "Nested annotations" 62 | (testStripping ("A " <> annotate () ("nested " <> annotate () "annotation ") <> "and some trailing space again " <> " ")) 63 | , testCase "Stress test" 64 | (testStripping (nest 4 (vcat ["Stress test", "", "" <> annotate () "hello ", "", "world " <> " ", annotate () "", "", "end"]))) 65 | ] 66 | 67 | testStripping :: Doc ann -> Assertion 68 | testStripping doc = case hasTrailingWhitespace (render removeTrailingWhitespace doc) of 69 | False -> pure () 70 | True -> (assertFailure . T.unpack . T.unlines) 71 | [ bbox "Input is not stripped correctly!" 72 | , "" 73 | , box "Rendered/stripped:" 74 | , (revealSpaces . render removeTrailingWhitespace) doc 75 | , "" 76 | , box "Rendered/unstripped:" 77 | , (revealSpaces . render id) doc 78 | , "" 79 | , box "Rendered/unstripped, later stripped via Text API:" 80 | , (revealSpaces . removeTrailingSpaceText . render id) doc ] 81 | where 82 | 83 | render :: (SimpleDocStream ann -> SimpleDocStream ann) -> Doc ann -> Text 84 | render f = renderSimplyDecorated id (const "") (const "") . f . layoutPretty defaultLayoutOptions 85 | 86 | removeTrailingSpaceText :: Text -> Text 87 | removeTrailingSpaceText = unlines' . map T.stripEnd . T.lines 88 | 89 | hasTrailingWhitespace :: Text -> Bool 90 | hasTrailingWhitespace x = removeTrailingSpaceText x /= x 91 | 92 | revealSpaces :: Text -> Text 93 | revealSpaces = T.map (\x -> if x == ' ' then '␣' else x) 94 | 95 | -- Text.unlines appends a trailing whitespace, so T.unlines . T.lines /= id 96 | unlines' :: [Text] -> Text 97 | unlines' = T.intercalate (T.singleton '\n') 98 | -------------------------------------------------------------------------------- /scripts/benchmark: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -euo pipefail 4 | 5 | PROJECT_ROOT="$(stack path --project-root)" 6 | cd "$PROJECT_ROOT" 7 | pwd 8 | 9 | stack build prettyprinter --bench --no-run-benchmarks 10 | 11 | OUTDIR="${PROJECT_ROOT}/generated/benchmarks" 12 | mkdir -p "$OUTDIR" 13 | stack bench prettyprinter:bench:fusion \ 14 | --benchmark-arguments "--output \"$OUTDIR/fusion.html\"" 15 | stack bench prettyprinter:bench:faster-unsafe-text \ 16 | --benchmark-arguments "--output \"$OUTDIR/faster-unsafe-text.html\"" 17 | stack bench prettyprinter:bench:large-output \ 18 | --benchmark-arguments "--output \"$OUTDIR/large-output.html\"" 19 | -------------------------------------------------------------------------------- /scripts/ci/checks/negated-cpp-macro-syntax: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -euo pipefail 4 | 5 | cd "$(stack path --project-root)" 6 | 7 | function find_bad_macro() { 8 | git grep -I --extended-regexp --line-number --break "$@" '#if\s+![^(]' | cat 9 | } 10 | 11 | if find_bad_macro -q; then 12 | echo "╭──────────────────────────────────────────────────────────────╮" 13 | echo "│ Please use explicit parentheses to emphasize negated macros. │" 14 | echo "│ #if !(MIN_VERSION_base(4,8,0)) │" 15 | echo "│ instead of │" 16 | echo "│ !MIN_VERSION_base(4,8,0) │" 17 | echo "╰──────────────────────────────────────────────────────────────╯" 18 | echo "" 19 | echo "The following offenders were found:" 20 | find_bad_macro 21 | exit 1 22 | else 23 | echo "Macro check passed" 24 | fi 25 | -------------------------------------------------------------------------------- /scripts/ci/checks/readme-was-generated: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -euo pipefail 4 | 5 | cd "$(stack path --project-root)" 6 | git stash 7 | ./scripts/generate_readme 8 | 9 | cd "$(git rev-parse --show-toplevel)" 10 | set +e 11 | git diff --exit-code -U0 --word-diff README.md 12 | EXIT=$? 13 | set -e 14 | 15 | if [[ $EXIT -ne 0 ]]; then 16 | echo '╭─────────────────────────────────────────────────────────────╮' 17 | echo '│ The generated README differs from the tracked one! │' 18 | echo '│ Please regenerate it by running ./scripts/generate_readme." |' 19 | echo '╰─────────────────────────────────────────────────────────────╯' 20 | fi 21 | exit $EXIT 22 | -------------------------------------------------------------------------------- /scripts/ci/install/hlint: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -euo pipefail 4 | 5 | curl -sSL https://raw.github.com/ndmitchell/hlint/master/misc/run.sh | sh -s . 6 | -------------------------------------------------------------------------------- /scripts/ci/install/stack: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -euo pipefail 4 | 5 | mkdir -p ~/.local/bin 6 | 7 | stack_download_url=https://www.stackage.org/stack/linux-x86_64 8 | if [[ ! -z ${STACK_VERSION+x} ]]; then 9 | if [[ $STACK_VERSION = "1.9.1" ]]; then 10 | stack_download_url="https://github.com/commercialhaskell/stack/releases/download/v1.9.1/stack-1.9.1-linux-x86_64-static.tar.gz" 11 | else 12 | echo "Stack version $STACK_VERSION unsupported by this Travis CI downloader script" >&2 13 | exit 1 14 | fi 15 | fi 16 | 17 | curl -L "$stack_download_url" | tar xz --wildcards --strip-components=1 -C ~/.local/bin '*/stack' 18 | -------------------------------------------------------------------------------- /scripts/find-language-extensions: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -euo pipefail 4 | 5 | cd "$(stack path --project-root)" 6 | 7 | function find-language-extensions() { 8 | find "$1" -name "*.hs" -type f -exec grep -Ehro '\{-# LANGUAGE [a-zA-Z]+' '{}' \; |\ 9 | sed -re 's/.*LANGUAGE\s+//' |\ 10 | sort -u 11 | } 12 | 13 | function separator() { 14 | echo "==========================================================" 15 | echo 16 | } 17 | 18 | for dir in prettyprinter*; do 19 | separator 20 | echo "Language extensions used in $dir:" 21 | for extension in $(find-language-extensions "$dir"); do 22 | echo " - $extension" 23 | done 24 | echo 25 | done 26 | separator 27 | -------------------------------------------------------------------------------- /scripts/generate_readme: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | set -euo pipefail 4 | 5 | cd "$(stack path --project-root)" 6 | stack build prettyprinter:exe:generate_readme --flag prettyprinter:buildReadme 7 | stack exec generate_readme > README.md 8 | -------------------------------------------------------------------------------- /scripts/haddock: -------------------------------------------------------------------------------- 1 | #!/usr/bin/env bash 2 | 3 | stack haddock --open prettyprinter 4 | -------------------------------------------------------------------------------- /stack.yaml: -------------------------------------------------------------------------------- 1 | resolver: lts-17.1 2 | packages: 3 | - 'prettyprinter' 4 | - 'prettyprinter-ansi-terminal' 5 | - 'prettyprinter-compat-wl-pprint' 6 | - 'prettyprinter-compat-ansi-wl-pprint' 7 | - 'prettyprinter-convert-ansi-wl-pprint' 8 | - 'prettyprinter-compat-annotated-wl-pprint' 9 | extra-deps: 10 | flags: {} 11 | extra-package-dbs: [] 12 | -------------------------------------------------------------------------------- /stack.yaml.lock: -------------------------------------------------------------------------------- 1 | # This file was autogenerated by Stack. 2 | # You should not edit this file by hand. 3 | # For more information, please see the documentation at: 4 | # https://docs.haskellstack.org/en/stable/lock_files 5 | 6 | packages: [] 7 | snapshots: 8 | - completed: 9 | size: 563098 10 | url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/17/1.yaml 11 | sha256: 395775c03e66a4286f134d50346b0b6f1432131cf542886252984b4cfa5fef69 12 | original: lts-17.1 13 | --------------------------------------------------------------------------------