1{-# LANGUAGE CPP #-}
2-----------------------------------------------------------------------------
3-- |
4-- Module      :  Text.PrettyPrint.ANSI.Leijen
5-- Copyright   :  Daan Leijen (c) 2000, http://www.cs.uu.nl/~daan
6--                Max Bolingbroke (c) 2008, http://blog.omega-prime.co.uk
7-- License     :  BSD-style (see the file LICENSE)
8--
9-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
10-- Stability   :  provisional
11-- Portability :  portable
12--
13--
14-- This module is an extended implementation of the functional pretty printer
15-- given by Philip Wadler (1997):
16--
17-- @
18--      \"A prettier printer\"
19--      Draft paper, April 1997, revised March 1998.
20--      <https://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf>
21-- @
22--
23-- In their bare essence, the combinators given by Wadler are
24-- not expressive enough to describe some commonly occurring layouts.
25-- This library adds new primitives to describe these layouts and
26-- works well in practice.
27--
28-- The library is based on a single way to concatenate documents,
29-- which is associative and has both a left and right unit.  This
30-- simple design leads to an efficient and short implementation. The
31-- simplicity is reflected in the predictable behaviour of the
32-- combinators which make them easy to use in practice.
33--
34-- A thorough description of the primitive combinators and their
35-- implementation can be found in Philip Wadler's paper.
36-- The main differences with his original paper are:
37--
38-- * The nil document is called 'empty'.
39--
40-- * The above combinator is called '<$>'. The operator '</>' is used
41-- for soft line breaks.
42--
43-- * There are three new primitives: 'align', 'fill' and
44-- 'fillBreak'. These are very useful in practice.
45--
46-- * There are many additional useful combinators, like 'fillSep' and 'list'.
47--
48-- * There are two renderers: 'renderPretty' for pretty printing, and
49-- 'renderCompact' for quickly rendered, compact output more suitable
50-- for generating input to other programs.
51--
52-- * The pretty printing algorithm used by 'renderPretty' extends the algorithm
53-- given by Wadler to take into account a \"ribbon width\", i.e., a desired
54-- maximum number of non-indentation characters to output on any one line.
55--
56-- * There are two displayers, 'displayS' for strings and 'displayIO' for
57-- file-based output.
58--
59-- * There is a 'Pretty' class.
60--
61-- * The implementation uses optimised representations and strictness
62-- annotations.
63--
64-- * The library has been extended to allow formatting text for output
65-- to ANSI style consoles. New combinators allow control of foreground and
66-- background color and the ability to make parts of the text bold or
67-- underlined.
68-----------------------------------------------------------
69module Text.PrettyPrint.ANSI.Leijen (
70   -- * The algebra of pretty-printing
71   -- $DocumentAlgebra
72
73   -- * Documents
74   Doc,
75
76   -- * Basic combinators
77   empty, char, text, string, int, integer, float, double, rational, bool,
78   (<>), nest, line, linebreak,
79   group, softline, softbreak, hardline, flatAlt,
80
81   -- * Alignment combinators
82   --
83   -- | The combinators in this section cannot be described by Wadler's
84   -- original combinators. They align their output relative to the
85   -- current output position — in contrast to @nest@ which always
86   -- aligns to the current nesting level. This deprives these
87   -- combinators from being \`optimal\'. In practice however they
88   -- prove to be very useful. The combinators in this section should
89   -- be used with care, since they are more expensive than the other
90   -- combinators. For example, @align@ shouldn't be used to pretty
91   -- print all top-level declarations of a language, but using @hang@
92   -- for let expressions is fine.
93   align, hang, indent, encloseSep, list, tupled, semiBraces,
94
95   -- * Operators
96   (<+>), (Text.PrettyPrint.ANSI.Leijen.Internal.<$>), (</>), (<$$>), (<//>),
97
98   -- * List combinators
99   hsep, vsep, fillSep, sep, hcat, vcat, fillCat, cat, punctuate,
100
101   -- * Filler combinators
102   fill, fillBreak,
103
104   -- * Bracketing combinators
105   enclose, squotes, dquotes, parens, angles, braces, brackets,
106
107   -- * Named character combinators
108   lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket,
109   squote, dquote, semi, colon, comma, space, dot, backslash, equals,
110
111
112   -- * ANSI formatting combinators
113   --
114   -- | This terminal formatting functionality is, as far as possible,
115   -- portable across platforms with their varying terminals. However,
116   -- note that to display ANSI colors and formatting will only be displayed
117   -- on Windows consoles if the 'Doc' value is output using the 'putDoc'
118   -- function or one of its friends.  Rendering the 'Doc' to a 'String'
119   -- and then outputing /that/ will only work on Unix-style operating systems.
120
121   -- ** Forecolor combinators
122   black, red, green, yellow, blue, magenta, cyan, white,
123   dullblack, dullred, dullgreen, dullyellow, dullblue, dullmagenta,
124   dullcyan, dullwhite,
125
126   -- ** Backcolor combinators
127   onblack, onred, ongreen, onyellow, onblue, onmagenta, oncyan, onwhite,
128   ondullblack, ondullred, ondullgreen, ondullyellow, ondullblue, ondullmagenta,
129   ondullcyan, ondullwhite,
130
131   -- ** Emboldening combinators
132   bold, debold,
133
134   -- ** Underlining combinators
135   underline, deunderline,
136
137   -- ** Formatting elimination combinators
138   plain,
139
140
141   -- * Pretty class
142   Pretty(..),
143
144
145   -- * Rendering and displaying documents
146
147   -- ** Simple (i.e., rendered) documents
148   SimpleDoc(..),
149   renderPretty, renderCompact, renderSmart,
150   displayS,
151   displayIO,
152
153   -- ** Simultaneous rendering and displaying of documents
154   putDoc, hPutDoc,
155
156
157   -- * Undocumented
158   column, columns, nesting, width
159   ) where
160
161import Text.PrettyPrint.ANSI.Leijen.Internal
162
163#if __GLASGOW_HASKELL__ >= 710
164import Data.Monoid ((<>))
165#elif __GLASGOW_HASKELL__ >= 704
166import Data.Monoid (Monoid, mappend, mconcat, mempty, (<>))
167#else
168import Data.Monoid (Monoid, mappend, mconcat, mempty)
169#endif
170
171-- $DocumentAlgebra
172-- The combinators in this library satisfy many algebraic laws.
173--
174-- The concatenation operator '<>' is associative and has 'empty' as a left
175-- and right unit:
176--
177--     > x <> (y <> z)           = (x <> y) <> z
178--     > x <> empty              = x
179--     > empty <> x              = x
180--
181-- The 'text' combinator is a homomorphism from string concatenation to
182-- document concatenation:
183--
184--     > text (s ++ t)           = text s <> text t
185--     > text ""                 = empty
186--
187-- The 'char' combinator behaves like one-element text:
188--
189--     > char c                  = text [c]
190--
191-- The 'nest' combinator is a homomorphism from addition to document
192-- composition.  'nest' also distributes through document concatenation and is
193-- absorbed by 'text' and 'align':
194--
195--     > nest (i + j) x          = nest i (nest j x)
196--     > nest 0 x                = x
197--     > nest i (x <> y)         = nest i x <> nest i y
198--     > nest i empty            = empty
199--     > nest i (text s)         = text s
200--     > nest i (align x)        = align x
201--
202-- The 'group' combinator is absorbed by 'empty'.  'group' is commutative with
203-- 'nest' and 'align':
204--
205--     > group empty             = empty
206--     > group (text s <> x)     = text s <> group x
207--     > group (nest i x)        = nest i (group x)
208--     > group (align x)         = align (group x)
209--
210-- The 'align' combinator is absorbed by 'empty' and 'text'.
211-- 'align' is idempotent:
212--
213--     > align empty             = empty
214--     > align (text s)          = text s
215--     > align (align x)         = align x
216--
217-- From the laws of the primitive combinators, we can derive many other laws
218-- for the derived combinators.  For example, the /above/ operator '<$>' is
219-- defined as:
220--
221--     > x <$> y                 = x <> line <> y
222--
223-- It follows that '<$>' is associative and that '<$>' and '<>' associate
224-- with each other:
225--
226--     > x <$> (y <$> z)         = (x <$> y) <$> z
227--     > x <> (y <$> z)          = (x <> y) <$> z
228--     > x <$> (y <> z)          = (x <$> y) <> z
229--
230-- Similar laws also hold for the other line break operators '</>', '<$$>',
231-- and '<//>'.
232