Improve documentation (fixes #33).
[packages/pretty.git] / src / Text / PrettyPrint / HughesPJ.hs
1 {-# OPTIONS_HADDOCK not-home #-}
2 #if __GLASGOW_HASKELL__ >= 701
3 {-# LANGUAGE Safe #-}
4 {-# LANGUAGE DeriveGeneric #-}
5 #endif
6
7 -----------------------------------------------------------------------------
8 -- |
9 -- Module : Text.PrettyPrint.HughesPJ
10 -- Copyright : (c) The University of Glasgow 2001
11 -- License : BSD-style (see the file LICENSE)
12 --
13 -- Maintainer : David Terei <code@davidterei.com>
14 -- Stability : stable
15 -- Portability : portable
16 --
17 -- Provides a collection of pretty printer combinators, a set of API's that
18 -- provides a way to easily print out text in a consistent format of your
19 -- choosing.
20 --
21 -- Originally designed by John Hughes's and Simon Peyton Jones's.
22 --
23 -- For more information you can refer to the
24 -- <http://belle.sourceforge.net/doc/hughes95design.pdf original paper> that
25 -- serves as the basis for this libraries design: /The Design -- of a
26 -- Pretty-printing Library/ by John Hughes, in Advanced Functional Programming,
27 -- 1995.
28 --
29 -----------------------------------------------------------------------------
30
31 #ifndef TESTING
32 module Text.PrettyPrint.HughesPJ (
33
34 -- * The document type
35 Doc, TextDetails(..),
36
37 -- * Constructing documents
38
39 -- ** Converting values into documents
40 char, text, ptext, sizedText, zeroWidthText,
41 int, integer, float, double, rational,
42
43 -- ** Simple derived documents
44 semi, comma, colon, space, equals,
45 lparen, rparen, lbrack, rbrack, lbrace, rbrace,
46
47 -- ** Wrapping documents in delimiters
48 parens, brackets, braces, quotes, doubleQuotes,
49 maybeParens, maybeBrackets, maybeBraces, maybeQuotes, maybeDoubleQuotes,
50
51 -- ** Combining documents
52 empty,
53 (<>), (<+>), hcat, hsep,
54 ($$), ($+$), vcat,
55 sep, cat,
56 fsep, fcat,
57 nest,
58 hang, punctuate,
59
60 -- * Predicates on documents
61 isEmpty,
62
63 -- * Utility functions for documents
64 first, reduceDoc,
65
66 -- * Rendering documents
67
68 -- ** Default rendering
69 render,
70
71 -- ** Rendering with a particular style
72 Style(..),
73 style,
74 renderStyle,
75 Mode(..),
76
77 -- ** General rendering
78 fullRender
79
80 ) where
81 #endif
82
83 import Text.PrettyPrint.Annotated.HughesPJ
84 ( TextDetails(..), Mode(..), Style(..), style )
85 import qualified Text.PrettyPrint.Annotated.HughesPJ as Ann
86
87 import Control.DeepSeq ( NFData(rnf) )
88 import Data.Function ( on )
89 #if __GLASGOW_HASKELL__ >= 800
90 import qualified Data.Semigroup as Semi ( Semigroup((<>)) )
91 #elif __GLASGOW_HASKELL__ < 709
92 import Data.Monoid ( Monoid(mempty, mappend) )
93 #endif
94 import Data.String ( IsString(fromString) )
95
96 import GHC.Generics
97
98
99 -- ---------------------------------------------------------------------------
100 -- Operator fixity
101
102 infixl 6 <>
103 infixl 6 <+>
104 infixl 5 $$, $+$
105
106 -- ---------------------------------------------------------------------------
107 -- The Doc data type
108
109 -- | The abstract type of documents. A Doc represents a /set/ of layouts. A
110 -- Doc with no occurrences of Union or NoDoc represents just one layout.
111 newtype Doc = Doc (Ann.Doc ())
112 #if __GLASGOW_HASKELL__ >= 701
113 deriving (Generic)
114 #endif
115
116 liftList :: ([Ann.Doc ()] -> Ann.Doc ()) -> ([Doc] -> Doc)
117 liftList f ds = Doc (f [ d | Doc d <- ds ])
118 {-# INLINE liftList #-}
119
120 liftBinary :: (Ann.Doc () -> Ann.Doc () -> Ann.Doc ())
121 -> ( Doc -> Doc -> Doc )
122 liftBinary f (Doc a) (Doc b) = Doc (f a b)
123 {-# INLINE liftBinary #-}
124
125 -- | RDoc is a "reduced GDoc", guaranteed not to have a top-level Above or
126 -- Beside.
127 type RDoc = Doc
128
129 -- Combining @Doc@ values
130 #if __GLASGOW_HASKELL__ >= 800
131 instance Semi.Semigroup Doc where
132 (<>) = (Text.PrettyPrint.HughesPJ.<>)
133
134 instance Monoid Doc where
135 mempty = empty
136 mappend = (Semi.<>)
137 #else
138 instance Monoid Doc where
139 mempty = empty
140 mappend = (<>)
141 #endif
142
143 instance IsString Doc where
144 fromString = text
145
146 instance Show Doc where
147 showsPrec _ doc cont = fullRender (mode style) (lineLength style)
148 (ribbonsPerLine style)
149 txtPrinter cont doc
150
151 instance Eq Doc where
152 (==) = (==) `on` render
153
154 instance NFData Doc where
155 rnf (Doc a) = rnf a
156
157 -- ---------------------------------------------------------------------------
158 -- Values and Predicates on GDocs and TextDetails
159
160 -- | A document of height and width 1, containing a literal character.
161 char :: Char -> Doc
162 char c = Doc (Ann.char c)
163 {-# INLINE char #-}
164
165 -- | A document of height 1 containing a literal string.
166 -- 'text' satisfies the following laws:
167 --
168 -- * @'text' s '<>' 'text' t = 'text' (s'++'t)@
169 --
170 -- * @'text' \"\" '<>' x = x@, if @x@ non-empty
171 --
172 -- The side condition on the last law is necessary because @'text' \"\"@
173 -- has height 1, while 'empty' has no height.
174 text :: String -> Doc
175 text s = Doc (Ann.text s)
176 {-# INLINE text #-}
177
178 -- | Same as @text@. Used to be used for Bytestrings.
179 ptext :: String -> Doc
180 ptext s = Doc (Ann.ptext s)
181 {-# INLINE ptext #-}
182
183 -- | Some text with any width. (@text s = sizedText (length s) s@)
184 sizedText :: Int -> String -> Doc
185 sizedText l s = Doc (Ann.sizedText l s)
186
187 -- | Some text, but without any width. Use for non-printing text
188 -- such as a HTML or Latex tags
189 zeroWidthText :: String -> Doc
190 zeroWidthText = sizedText 0
191
192 -- | The empty document, with no height and no width.
193 -- 'empty' is the identity for '<>', '<+>', '$$' and '$+$', and anywhere
194 -- in the argument list for 'sep', 'hcat', 'hsep', 'vcat', 'fcat' etc.
195 empty :: Doc
196 empty = Doc Ann.empty
197
198 -- | Returns 'True' if the document is empty
199 isEmpty :: Doc -> Bool
200 isEmpty (Doc d) = Ann.isEmpty d
201
202 semi :: Doc -- ^ A ';' character
203 comma :: Doc -- ^ A ',' character
204 colon :: Doc -- ^ A ':' character
205 space :: Doc -- ^ A space character
206 equals :: Doc -- ^ A '=' character
207 lparen :: Doc -- ^ A '(' character
208 rparen :: Doc -- ^ A ')' character
209 lbrack :: Doc -- ^ A '[' character
210 rbrack :: Doc -- ^ A ']' character
211 lbrace :: Doc -- ^ A '{' character
212 rbrace :: Doc -- ^ A '}' character
213 semi = char ';'
214 comma = char ','
215 colon = char ':'
216 space = char ' '
217 equals = char '='
218 lparen = char '('
219 rparen = char ')'
220 lbrack = char '['
221 rbrack = char ']'
222 lbrace = char '{'
223 rbrace = char '}'
224
225 int :: Int -> Doc -- ^ @int n = text (show n)@
226 integer :: Integer -> Doc -- ^ @integer n = text (show n)@
227 float :: Float -> Doc -- ^ @float n = text (show n)@
228 double :: Double -> Doc -- ^ @double n = text (show n)@
229 rational :: Rational -> Doc -- ^ @rational n = text (show n)@
230 int n = text (show n)
231 integer n = text (show n)
232 float n = text (show n)
233 double n = text (show n)
234 rational n = text (show n)
235
236 parens :: Doc -> Doc -- ^ Wrap document in @(...)@
237 brackets :: Doc -> Doc -- ^ Wrap document in @[...]@
238 braces :: Doc -> Doc -- ^ Wrap document in @{...}@
239 quotes :: Doc -> Doc -- ^ Wrap document in @\'...\'@
240 doubleQuotes :: Doc -> Doc -- ^ Wrap document in @\"...\"@
241 quotes p = char '\'' <> p <> char '\''
242 doubleQuotes p = char '"' <> p <> char '"'
243 parens p = char '(' <> p <> char ')'
244 brackets p = char '[' <> p <> char ']'
245 braces p = char '{' <> p <> char '}'
246
247 -- | Apply 'parens' to 'Doc' if boolean is true.
248 maybeParens :: Bool -> Doc -> Doc
249 maybeParens False = id
250 maybeParens True = parens
251
252 -- | Apply 'brackets' to 'Doc' if boolean is true.
253 maybeBrackets :: Bool -> Doc -> Doc
254 maybeBrackets False = id
255 maybeBrackets True = brackets
256
257 -- | Apply 'braces' to 'Doc' if boolean is true.
258 maybeBraces :: Bool -> Doc -> Doc
259 maybeBraces False = id
260 maybeBraces True = braces
261
262 -- | Apply 'quotes' to 'Doc' if boolean is true.
263 maybeQuotes :: Bool -> Doc -> Doc
264 maybeQuotes False = id
265 maybeQuotes True = quotes
266
267 -- | Apply 'doubleQuotes' to 'Doc' if boolean is true.
268 maybeDoubleQuotes :: Bool -> Doc -> Doc
269 maybeDoubleQuotes False = id
270 maybeDoubleQuotes True = doubleQuotes
271
272 -- ---------------------------------------------------------------------------
273 -- Structural operations on GDocs
274
275 -- | Perform some simplification of a built up @GDoc@.
276 reduceDoc :: Doc -> RDoc
277 reduceDoc (Doc d) = Doc (Ann.reduceDoc d)
278 {-# INLINE reduceDoc #-}
279
280 -- | List version of '<>'.
281 hcat :: [Doc] -> Doc
282 hcat = liftList Ann.hcat
283 {-# INLINE hcat #-}
284
285 -- | List version of '<+>'.
286 hsep :: [Doc] -> Doc
287 hsep = liftList Ann.hsep
288 {-# INLINE hsep #-}
289
290 -- | List version of '$$'.
291 vcat :: [Doc] -> Doc
292 vcat = liftList Ann.vcat
293 {-# INLINE vcat #-}
294
295 -- | Nest (or indent) a document by a given number of positions
296 -- (which may also be negative). 'nest' satisfies the laws:
297 --
298 -- * @'nest' 0 x = x@
299 --
300 -- * @'nest' k ('nest' k' x) = 'nest' (k+k') x@
301 --
302 -- * @'nest' k (x '<>' y) = 'nest' k z '<>' 'nest' k y@
303 --
304 -- * @'nest' k (x '$$' y) = 'nest' k x '$$' 'nest' k y@
305 --
306 -- * @'nest' k 'empty' = 'empty'@
307 --
308 -- * @x '<>' 'nest' k y = x '<>' y@, if @x@ non-empty
309 --
310 -- The side condition on the last law is needed because
311 -- 'empty' is a left identity for '<>'.
312 nest :: Int -> Doc -> Doc
313 nest k (Doc p) = Doc (Ann.nest k p)
314 {-# INLINE nest #-}
315
316 -- | @hang d1 n d2 = sep [d1, nest n d2]@
317 hang :: Doc -> Int -> Doc -> Doc
318 hang (Doc d1) n (Doc d2) = Doc (Ann.hang d1 n d2)
319 {-# INLINE hang #-}
320
321 -- | @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@
322 punctuate :: Doc -> [Doc] -> [Doc]
323 punctuate (Doc p) ds = [ Doc d | d <- Ann.punctuate p [ d | Doc d <- ds ] ]
324 {-# INLINE punctuate #-}
325
326
327 -- ---------------------------------------------------------------------------
328 -- Vertical composition @$$@
329
330 -- | Above, except that if the last line of the first argument stops
331 -- at least one position before the first line of the second begins,
332 -- these two lines are overlapped. For example:
333 --
334 -- > text "hi" $$ nest 5 (text "there")
335 --
336 -- lays out as
337 --
338 -- > hi there
339 --
340 -- rather than
341 --
342 -- > hi
343 -- > there
344 --
345 -- '$$' is associative, with identity 'empty', and also satisfies
346 --
347 -- * @(x '$$' y) '<>' z = x '$$' (y '<>' z)@, if @y@ non-empty.
348 --
349 ($$) :: Doc -> Doc -> Doc
350 ($$) = liftBinary (Ann.$$)
351 {-# INLINE ($$) #-}
352
353 -- | Above, with no overlapping.
354 -- '$+$' is associative, with identity 'empty'.
355 ($+$) :: Doc -> Doc -> Doc
356 ($+$) = liftBinary (Ann.$+$)
357 {-# INLINE ($+$) #-}
358
359
360 -- ---------------------------------------------------------------------------
361 -- Horizontal composition @<>@
362
363 -- We intentionally avoid Data.Monoid.(<>) here due to interactions of
364 -- Data.Monoid.(<>) and (<+>). See
365 -- http://www.haskell.org/pipermail/libraries/2011-November/017066.html
366
367 -- | Beside.
368 -- '<>' is associative, with identity 'empty'.
369 (<>) :: Doc -> Doc -> Doc
370 (<>) = liftBinary (Ann.<>)
371 {-# INLINE (<>) #-}
372
373 -- | Beside, separated by space, unless one of the arguments is 'empty'.
374 -- '<+>' is associative, with identity 'empty'.
375 (<+>) :: Doc -> Doc -> Doc
376 (<+>) = liftBinary (Ann.<+>)
377 {-# INLINE (<+>) #-}
378
379
380 -- ---------------------------------------------------------------------------
381 -- Separate, @sep@
382
383 -- Specification: sep ps = oneLiner (hsep ps)
384 -- `union`
385 -- vcat ps
386
387 -- | Either 'hsep' or 'vcat'.
388 sep :: [Doc] -> Doc
389 sep = liftList Ann.sep
390 {-# INLINE sep #-}
391
392 -- | Either 'hcat' or 'vcat'.
393 cat :: [Doc] -> Doc
394 cat = liftList Ann.cat
395 {-# INLINE cat #-}
396
397
398 -- ---------------------------------------------------------------------------
399 -- @fill@
400
401 -- | \"Paragraph fill\" version of 'cat'.
402 fcat :: [Doc] -> Doc
403 fcat = liftList Ann.fcat
404 {-# INLINE fcat #-}
405
406 -- | \"Paragraph fill\" version of 'sep'.
407 fsep :: [Doc] -> Doc
408 fsep = liftList Ann.fsep
409 {-# INLINE fsep #-}
410
411
412 -- ---------------------------------------------------------------------------
413 -- Selecting the best layout
414
415 -- | @first@ returns its first argument if it is non-empty, otherwise its second.
416 first :: Doc -> Doc -> Doc
417 first = liftBinary Ann.first
418 {-# INLINE first #-}
419
420
421 -- ---------------------------------------------------------------------------
422 -- Rendering
423
424 -- | Render the @Doc@ to a String using the default @Style@ (see 'style').
425 render :: Doc -> String
426 render = fullRender (mode style) (lineLength style) (ribbonsPerLine style)
427 txtPrinter ""
428 {-# INLINE render #-}
429
430 -- | Render the @Doc@ to a String using the given @Style@.
431 renderStyle :: Style -> Doc -> String
432 renderStyle s = fullRender (mode s) (lineLength s) (ribbonsPerLine s)
433 txtPrinter ""
434 {-# INLINE renderStyle #-}
435
436 -- | Default TextDetails printer.
437 txtPrinter :: TextDetails -> String -> String
438 txtPrinter (Chr c) s = c:s
439 txtPrinter (Str s1) s2 = s1 ++ s2
440 txtPrinter (PStr s1) s2 = s1 ++ s2
441
442 -- | The general rendering interface. Please refer to the @Style@ and @Mode@
443 -- types for a description of rendering mode, line length and ribbons.
444 fullRender :: Mode -- ^ Rendering mode.
445 -> Int -- ^ Line length.
446 -> Float -- ^ Ribbons per line.
447 -> (TextDetails -> a -> a) -- ^ What to do with text.
448 -> a -- ^ What to do at the end.
449 -> Doc -- ^ The document.
450 -> a -- ^ Result.
451 fullRender m lineLen ribbons txt rest (Doc doc)
452 = Ann.fullRender m lineLen ribbons txt rest doc
453 {-# INLINE fullRender #-}
454