Ticket #4377: cleaned-up-and-added-sizedText.dpatch

File cleaned-up-and-added-sizedText.dpatch, 32.9 KB (added by maeder, 3 years ago)

proposed darcs patches

Line 
14 patches for repository http://darcs.haskell.org/packages/pretty:
2
3Fri Dec 10 15:14:07 CET 2010  Christian.Maeder@dfki.de
4  * replaced tabs and removed trailing spaces
5
6Fri Dec 10 17:13:02 CET 2010  Christian.Maeder@dfki.de
7  * added sizedText
8
9Fri Dec 10 17:25:13 CET 2010  Christian.Maeder@dfki.de
10  * use replicate for indent, spaces and multi_ch
11
12Fri Dec 10 17:44:47 CET 2010  Christian.Maeder@dfki.de
13  * shortened too long lines and removed redundant brackets
14
15New patches:
16
17[replaced tabs and removed trailing spaces
18Christian.Maeder@dfki.de**20101210141407
19 Ignore-this: c8ec06621e39a759e1a780d54eb34432
20] {
21hunk ./Text/PrettyPrint/HughesPJ.hs 6
22 -- Module      :  Text.PrettyPrint.HughesPJ
23 -- Copyright   :  (c) The University of Glasgow 2001
24 -- License     :  BSD-style (see the file libraries/base/LICENSE)
25---
26+--
27 -- Maintainer  :  libraries@haskell.org
28 -- Stability   :  provisional
29 -- Portability :  portable
30hunk ./Text/PrettyPrint/HughesPJ.hs 12
31 --
32 -- John Hughes's and Simon Peyton Jones's Pretty Printer Combinators
33---
34+--
35 -- Based on /The Design of a Pretty-printing Library/
36 -- in Advanced Functional Programming,
37 -- Johan Jeuring and Erik Meijer (eds), LNCS 925
38hunk ./Text/PrettyPrint/HughesPJ.hs 98
39 ======================================================================
40 Relative to John's original paper, there are the following new features:
41 
42-1.  There's an empty document, "empty".  It's a left and right unit for
43+1.  There's an empty document, "empty".  It's a left and right unit for
44     both <> and $$, and anywhere in the argument list for
45     sep, hcat, hsep, vcat, fcat etc.
46 
47hunk ./Text/PrettyPrint/HughesPJ.hs 107
48 2.  There is a paragraph-fill combinator, fsep, that's much like sep,
49     only it keeps fitting things on one line until it can't fit any more.
50 
51-3.  Some random useful extra combinators are provided. 
52+3.  Some random useful extra combinators are provided.
53         <+> puts its arguments beside each other with a space between them,
54             unless either argument is empty in which case it returns the other
55 
56hunk ./Text/PrettyPrint/HughesPJ.hs 123
57 
58         These new ones do the obvious things:
59                 char, semi, comma, colon, space,
60-                parens, brackets, braces,
61+                parens, brackets, braces,
62                 quotes, doubleQuotes
63 
64 4.  The "above" combinator, $$, now overlaps its two arguments if the
65hunk ./Text/PrettyPrint/HughesPJ.hs 161
66 
67 5.      Several different renderers are provided:
68                 * a standard one
69-                * one that uses cut-marks to avoid deeply-nested documents
70+                * one that uses cut-marks to avoid deeply-nested documents
71                         simply piling up in the right-hand margin
72                 * one that ignores indentation (fewer chars output; good for machines)
73                 * one that ignores indentation and newlines (ditto, only more so)
74hunk ./Text/PrettyPrint/HughesPJ.hs 172
75 
76 module Text.PrettyPrint.HughesPJ (
77 
78-       -- * The document type
79+        -- * The document type
80         Doc,            -- Abstract
81 
82hunk ./Text/PrettyPrint/HughesPJ.hs 175
83-       -- * Constructing documents
84-       -- ** Converting values into documents
85+        -- * Constructing documents
86+        -- ** Converting values into documents
87         char, text, ptext, zeroWidthText,
88         int, integer, float, double, rational,
89 
90hunk ./Text/PrettyPrint/HughesPJ.hs 180
91-       -- ** Simple derived documents
92+        -- ** Simple derived documents
93         semi, comma, colon, space, equals,
94         lparen, rparen, lbrack, rbrack, lbrace, rbrace,
95 
96hunk ./Text/PrettyPrint/HughesPJ.hs 184
97-       -- ** Wrapping documents in delimiters
98+        -- ** Wrapping documents in delimiters
99         parens, brackets, braces, quotes, doubleQuotes,
100 
101hunk ./Text/PrettyPrint/HughesPJ.hs 187
102-       -- ** Combining documents
103+        -- ** Combining documents
104         empty,
105hunk ./Text/PrettyPrint/HughesPJ.hs 189
106-        (<>), (<+>), hcat, hsep,
107-        ($$), ($+$), vcat,
108-        sep, cat,
109-        fsep, fcat,
110-       nest,
111+        (<>), (<+>), hcat, hsep,
112+        ($$), ($+$), vcat,
113+        sep, cat,
114+        fsep, fcat,
115+        nest,
116         hang, punctuate,
117hunk ./Text/PrettyPrint/HughesPJ.hs 195
118-       
119-       -- * Predicates on documents
120-       isEmpty,
121 
122hunk ./Text/PrettyPrint/HughesPJ.hs 196
123-       -- * Rendering documents
124+        -- * Predicates on documents
125+        isEmpty,
126+
127+        -- * Rendering documents
128 
129hunk ./Text/PrettyPrint/HughesPJ.hs 201
130-       -- ** Default rendering
131-       render,
132+        -- ** Default rendering
133+        render,
134 
135hunk ./Text/PrettyPrint/HughesPJ.hs 204
136-       -- ** Rendering with a particular style
137-       Style(..),
138-       style,
139+        -- ** Rendering with a particular style
140+        Style(..),
141+        style,
142         renderStyle,
143 
144hunk ./Text/PrettyPrint/HughesPJ.hs 209
145-       -- ** General rendering
146+        -- ** General rendering
147         fullRender,
148         Mode(..), TextDetails(..),
149 
150hunk ./Text/PrettyPrint/HughesPJ.hs 220
151 import Data.Monoid ( Monoid(mempty, mappend) )
152 import Data.String ( IsString(fromString) )
153 
154-infixl 6 <>
155+infixl 6 <>
156 infixl 6 <+>
157 infixl 5 $$, $+$
158 
159hunk ./Text/PrettyPrint/HughesPJ.hs 236
160 -- in the argument list for 'sep', 'hcat', 'hsep', 'vcat', 'fcat' etc.
161 empty   :: Doc
162 
163-semi   :: Doc;                 -- ^ A ';' character
164-comma  :: Doc;                 -- ^ A ',' character
165-colon  :: Doc;                 -- ^ A ':' character
166-space  :: Doc;                 -- ^ A space character
167-equals :: Doc;                 -- ^ A '=' character
168-lparen :: Doc;                 -- ^ A '(' character
169-rparen :: Doc;                 -- ^ A ')' character
170-lbrack :: Doc;                 -- ^ A '[' character
171-rbrack :: Doc;                 -- ^ A ']' character
172-lbrace :: Doc;                 -- ^ A '{' character
173-rbrace :: Doc;                 -- ^ A '}' character
174+semi    :: Doc;                 -- ^ A ';' character
175+comma   :: Doc;                 -- ^ A ',' character
176+colon   :: Doc;                 -- ^ A ':' character
177+space   :: Doc;                 -- ^ A space character
178+equals  :: Doc;                 -- ^ A '=' character
179+lparen  :: Doc;                 -- ^ A '(' character
180+rparen  :: Doc;                 -- ^ A ')' character
181+lbrack  :: Doc;                 -- ^ A '[' character
182+rbrack  :: Doc;                 -- ^ A ']' character
183+lbrace  :: Doc;                 -- ^ A '{' character
184+rbrace  :: Doc;                 -- ^ A '}' character
185 
186 -- | A document of height and width 1, containing a literal character.
187hunk ./Text/PrettyPrint/HughesPJ.hs 249
188-char    :: Char     -> Doc
189+char     :: Char     -> Doc
190 
191 -- | A document of height 1 containing a literal string.
192 -- 'text' satisfies the following laws:
193hunk ./Text/PrettyPrint/HughesPJ.hs 260
194 --
195 -- The side condition on the last law is necessary because @'text' \"\"@
196 -- has height 1, while 'empty' has no height.
197-text    :: String   -> Doc
198+text     :: String   -> Doc
199 
200 instance IsString Doc where
201     fromString = text
202hunk ./Text/PrettyPrint/HughesPJ.hs 266
203 
204 -- | An obsolete function, now identical to 'text'.
205-ptext   :: String   -> Doc
206+ptext    :: String   -> Doc
207 
208 -- | Some text, but without any width. Use for non-printing text
209 -- such as a HTML or Latex tags
210hunk ./Text/PrettyPrint/HughesPJ.hs 272
211 zeroWidthText :: String   -> Doc
212 
213-int      :: Int      -> Doc;   -- ^ @int n = text (show n)@
214-integer  :: Integer  -> Doc;   -- ^ @integer n = text (show n)@
215-float    :: Float    -> Doc;   -- ^ @float n = text (show n)@
216-double   :: Double   -> Doc;   -- ^ @double n = text (show n)@
217-rational :: Rational -> Doc;   -- ^ @rational n = text (show n)@
218+int      :: Int      -> Doc;    -- ^ @int n = text (show n)@
219+integer  :: Integer  -> Doc;    -- ^ @integer n = text (show n)@
220+float    :: Float    -> Doc;    -- ^ @float n = text (show n)@
221+double   :: Double   -> Doc;    -- ^ @double n = text (show n)@
222+rational :: Rational -> Doc;    -- ^ @rational n = text (show n)@
223 
224hunk ./Text/PrettyPrint/HughesPJ.hs 278
225-parens       :: Doc -> Doc;    -- ^ Wrap document in @(...)@
226-brackets     :: Doc -> Doc;    -- ^ Wrap document in @[...]@
227-braces      :: Doc -> Doc;     -- ^ Wrap document in @{...}@
228-quotes      :: Doc -> Doc;     -- ^ Wrap document in @\'...\'@
229-doubleQuotes :: Doc -> Doc;    -- ^ Wrap document in @\"...\"@
230+parens       :: Doc -> Doc;     -- ^ Wrap document in @(...)@
231+brackets     :: Doc -> Doc;     -- ^ Wrap document in @[...]@
232+braces       :: Doc -> Doc;     -- ^ Wrap document in @{...}@
233+quotes       :: Doc -> Doc;     -- ^ Wrap document in @\'...\'@
234+doubleQuotes :: Doc -> Doc;     -- ^ Wrap document in @\"...\"@
235 
236 -- Combining @Doc@ values
237 
238hunk ./Text/PrettyPrint/HughesPJ.hs 360
239 punctuate :: Doc -> [Doc] -> [Doc]
240 
241 
242--- Displaying @Doc@ values.
243+-- Displaying @Doc@ values.
244 
245 instance Show Doc where
246   showsPrec _ doc cont = showDoc doc cont
247hunk ./Text/PrettyPrint/HughesPJ.hs 369
248 render     :: Doc -> String
249 
250 -- | The general rendering interface.
251-fullRender :: Mode                     -- ^Rendering mode
252+fullRender :: Mode                      -- ^Rendering mode
253            -> Int                       -- ^Line length
254            -> Float                     -- ^Ribbons per line
255            -> (TextDetails -> a -> a)   -- ^What to do with text
256hunk ./Text/PrettyPrint/HughesPJ.hs 374
257            -> a                         -- ^What to do at the end
258-           -> Doc                      -- ^The document
259+           -> Doc                       -- ^The document
260            -> a                         -- ^Result
261 
262 -- | Render the document as a string using a specified style.
263hunk ./Text/PrettyPrint/HughesPJ.hs 383
264 -- | A rendering style.
265 data Style
266  = Style { mode           :: Mode     -- ^ The rendering mode
267-        , lineLength     :: Int      -- ^ Length of line, in chars
268+         , lineLength     :: Int      -- ^ Length of line, in chars
269          , ribbonsPerLine :: Float    -- ^ Ratio of ribbon length to line length
270          }
271 
272hunk ./Text/PrettyPrint/HughesPJ.hs 392
273 style = Style { lineLength = 100, ribbonsPerLine = 1.5, mode = PageMode }
274 
275 -- | Rendering mode.
276-data Mode = PageMode            -- ^Normal
277+data Mode = PageMode            -- ^Normal
278           | ZigZagMode          -- ^With zig-zag cuts
279           | LeftMode            -- ^No indentation, infinitely long lines
280           | OneLineMode         -- ^All on one line
281hunk ./Text/PrettyPrint/HughesPJ.hs 423
282 ~~~~~~~~~~~~~
283 <t1>    text s <> text t        = text (s++t)
284 <t2>    text "" <> x            = x, if x non-empty
285
286+
287 ** because of law n6, t2 only holds if x doesn't
288 ** start with `nest'.
289hunk ./Text/PrettyPrint/HughesPJ.hs 426
290-   
291+
292 
293 Laws for nest
294 ~~~~~~~~~~~~~
295hunk ./Text/PrettyPrint/HughesPJ.hs 443
296 Miscellaneous
297 ~~~~~~~~~~~~~
298 <m1>    (text s <> x) $$ y = text s <> ((text "" <> x) $$
299-                                         nest (-length s) y)
300+                                         nest (-length s) y)
301 
302 <m2>    (x $$ y) <> z = x $$ (y <> z)
303         if y non-empty
304hunk ./Text/PrettyPrint/HughesPJ.hs 460
305 Laws for oneLiner
306 ~~~~~~~~~~~~~~~~~
307 <o1>    oneLiner (nest k p) = nest k (oneLiner p)
308-<o2>    oneLiner (x <> y)   = oneLiner x <> oneLiner y
309+<o2>    oneLiner (x <> y)   = oneLiner x <> oneLiner y
310 
311 You might think that the following verion of <m1> would
312 be neater:
313hunk ./Text/PrettyPrint/HughesPJ.hs 465
314 
315-<3 NO>  (text s <> x) $$ y = text s <> ((empty <> x)) $$
316+<3 NO>  (text s <> x) $$ y = text s <> ((empty <> x)) $$
317                                          nest (-length s) y)
318 
319 But it doesn't work, for if x=empty, we would have
320hunk ./Text/PrettyPrint/HughesPJ.hs 540
321 data Doc
322  = Empty                                -- empty
323  | NilAbove Doc                         -- text "" $$ x
324- | TextBeside TextDetails !Int Doc      -- text s <> x 
325+ | TextBeside TextDetails !Int Doc      -- text s <> x
326  | Nest !Int Doc                        -- nest k x
327  | Union Doc Doc                        -- ul `union` ur
328  | NoDoc                                -- The empty set of documents
329hunk ./Text/PrettyPrint/HughesPJ.hs 565
330 
331 {-
332   Here are the invariants:
333
334+
335   1) The argument of NilAbove is never Empty. Therefore
336      a NilAbove occupies at least two lines.
337hunk ./Text/PrettyPrint/HughesPJ.hs 568
338
339+
340   2) The argument of @TextBeside@ is never @Nest@.
341hunk ./Text/PrettyPrint/HughesPJ.hs 570
342
343
344-  3) The layouts of the two arguments of @Union@ both flatten to the same
345+
346+
347+  3) The layouts of the two arguments of @Union@ both flatten to the same
348      string.
349hunk ./Text/PrettyPrint/HughesPJ.hs 574
350
351+
352   4) The arguments of @Union@ are either @TextBeside@, or @NilAbove@.
353hunk ./Text/PrettyPrint/HughesPJ.hs 576
354
355-  5) A @NoDoc@ may only appear on the first line of the left argument of an
356+
357+  5) A @NoDoc@ may only appear on the first line of the left argument of an
358      union. Therefore, the right argument of an union can never be equivalent
359      to the empty set (@NoDoc@).
360hunk ./Text/PrettyPrint/HughesPJ.hs 580
361
362+
363   6) An empty document is always represented by @Empty@.  It can't be
364      hidden inside a @Nest@, or a @Union@ of two @Empty@s.
365hunk ./Text/PrettyPrint/HughesPJ.hs 583
366
367+
368   7) The first line of every layout in the left argument of @Union@ is
369      longer than the first line of any layout in the right argument.
370      (1) ensures that the left argument has a first line.  In view of
371hunk ./Text/PrettyPrint/HughesPJ.hs 607
372 
373 
374 -- Notice the difference between
375---        * NoDoc (no documents)
376---        * Empty (one empty document; no height and no width)
377---        * text "" (a document containing the empty string;
378---                   one line high, but has no width)
379+--         * NoDoc (no documents)
380+--         * Empty (one empty document; no height and no width)
381+--         * text "" (a document containing the empty string;
382+--                    one line high, but has no width)
383 
384 
385 -- ---------------------------------------------------------------------------
386hunk ./Text/PrettyPrint/HughesPJ.hs 663
387 
388 aboveNest _                   _ k _ | k `seq` False = undefined
389 aboveNest NoDoc               _ _ _ = NoDoc
390-aboveNest (p1 `Union` p2)     g k q = aboveNest p1 g k q `union_`
391+aboveNest (p1 `Union` p2)     g k q = aboveNest p1 g k q `union_`
392                                       aboveNest p2 g k q
393hunk ./Text/PrettyPrint/HughesPJ.hs 665
394-                               
395+
396 aboveNest Empty               _ k q = mkNest k q
397 aboveNest (Nest k1 p)         g k q = nest_ k1 (aboveNest p g (k - k1) q)
398                                   -- p can't be Empty, so no need for mkNest
399hunk ./Text/PrettyPrint/HughesPJ.hs 669
400-                               
401+
402 aboveNest (NilAbove p)        g k q = nilAbove_ (aboveNest p g k q)
403 aboveNest (TextBeside s sl p) g k q = k1 `seq` textBeside_ s sl rest
404                                     where
405hunk ./Text/PrettyPrint/HughesPJ.hs 682
406 
407 
408 nilAboveNest :: Bool -> Int -> RDoc -> RDoc
409--- Specification: text s <> nilaboveNest g k q
410+-- Specification: text s <> nilaboveNest g k q
411 --              = text s <> (text "" $g$ nest k q)
412 
413 nilAboveNest _ k _           | k `seq` False = undefined
414hunk ./Text/PrettyPrint/HughesPJ.hs 707
415 
416 beside :: Doc -> Bool -> RDoc -> RDoc
417 -- Specification: beside g p q = p <g> q
418-
419+
420 beside NoDoc               _ _   = NoDoc
421 beside (p1 `Union` p2)     g q   = (beside p1 g q) `union_` (beside p2 g q)
422 beside Empty               _ q   = q
423hunk ./Text/PrettyPrint/HughesPJ.hs 712
424 beside (Nest k p)          g q   = nest_ k (beside p g q)       -- p non-empty
425-beside p@(Beside p1 g1 q1) g2 q2
426-           {- (A `op1` B) `op2` C == A `op1` (B `op2` C)  iff op1 == op2
427+beside p@(Beside p1 g1 q1) g2 q2
428+           {- (A `op1` B) `op2` C == A `op1` (B `op2` C)  iff op1 == op2
429                                                  [ && (op1 == <> || op1 == <+>) ] -}
430          | g1 == g2              = beside p1 g1 (beside q1 g2 q2)
431          | otherwise             = beside (reduceDoc p) g2 q2
432hunk ./Text/PrettyPrint/HughesPJ.hs 727
433 
434 
435 nilBeside :: Bool -> RDoc -> RDoc
436--- Specification: text "" <> nilBeside g p
437+-- Specification: text "" <> nilBeside g p
438 --              = text "" <g> p
439 
440 nilBeside _ Empty      = Empty  -- Hence the text "" in the spec
441hunk ./Text/PrettyPrint/HughesPJ.hs 778
442 sepNB g (Nest _ p)  k ys  = sepNB g p k ys -- Never triggered, because of invariant (2)
443 
444 sepNB g Empty k ys        = oneLiner (nilBeside g (reduceDoc rest))
445-                                `mkUnion`
446+                                `mkUnion`
447                             nilAboveNest True k (reduceDoc (vcat ys))
448                           where
449                             rest | g         = hsep ys
450hunk ./Text/PrettyPrint/HughesPJ.hs 837
451 
452 fillNBE :: Bool -> Int -> Doc -> [Doc] -> Doc
453 fillNBE g k y ys           = nilBeside g (fill1 g ((elideNest . oneLiner . reduceDoc) y) k1 ys)
454-                             `mkUnion`
455+                             `mkUnion`
456                              nilAboveNest True k (fill g (y:ys))
457                            where
458                              k1 | g         = k - 1
459hunk ./Text/PrettyPrint/HughesPJ.hs 894
460     get1 w sl (NilAbove p)        = nilAbove_ (get (w - sl) p)
461     get1 w sl (TextBeside t tl p) = textBeside_ t tl (get1 w (sl + tl) p)
462     get1 w sl (Nest _ p)          = get1 w sl p
463-    get1 w sl (p `Union` q)       = nicest1 w r sl (get1 w sl p)
464+    get1 w sl (p `Union` q)       = nicest1 w r sl (get1 w sl p)
465                                                    (get1 w sl q)
466     get1 _ _  (Above {})          = error "best get1 Above"
467     get1 _ _  (Beside {})         = error "best get1 Beside"
468hunk ./Text/PrettyPrint/HughesPJ.hs 909
469 fits :: Int     -- Space available
470      -> Doc
471      -> Bool    -- True if *first line* of Doc fits in space available
472-
473+
474 fits n _    | n < 0 = False
475 fits _ NoDoc               = False
476 fits _ Empty               = True
477hunk ./Text/PrettyPrint/HughesPJ.hs 961
478   = fullRender (mode the_style)
479                (lineLength the_style)
480                (ribbonsPerLine the_style)
481-              string_txt
482-              ""
483-              doc
484+               string_txt
485+               ""
486+               doc
487 
488 render doc       = showDoc doc ""
489 
490hunk ./Text/PrettyPrint/HughesPJ.hs 981
491 
492 fullRender the_mode line_length ribbons_per_line txt end doc
493   = display the_mode line_length ribbon_length txt end best_doc
494-  where
495+  where
496     best_doc = best the_mode hacked_line_length ribbon_length (reduceDoc doc)
497 
498     hacked_line_length, ribbon_length :: Int
499hunk ./Text/PrettyPrint/HughesPJ.hs 1002
500         lay _ (Beside {})  = error "display lay Beside"
501         lay _ NoDoc        = error "display lay NoDoc"
502         lay _ (Union {})   = error "display lay Union"
503-   
504+
505         lay k (NilAbove p) = nl_text `txt` lay k p
506hunk ./Text/PrettyPrint/HughesPJ.hs 1004
507-   
508+
509         lay k (TextBeside s sl p)
510             = case the_mode of
511                     ZigZagMode |  k >= gap_width
512hunk ./Text/PrettyPrint/HughesPJ.hs 1020
513                                   lay1 (k + shift) s sl p )))
514 
515                     _ -> lay1 k s sl p
516-   
517+
518         lay1 k _ sl _ | k+sl `seq` False = undefined
519         lay1 k s sl p = Str (indent k) `txt` (s `txt` lay2 (k + sl) p)
520hunk ./Text/PrettyPrint/HughesPJ.hs 1023
521-   
522+
523         lay2 k _ | k `seq` False = undefined
524         lay2 k (NilAbove p)        = nl_text `txt` lay k p
525         lay2 k (TextBeside s sl p) = s `txt` (lay2 (k + sl) p)
526hunk ./Text/PrettyPrint/HughesPJ.hs 1041
527 cant_fail = error "easy_display: NoDoc"
528 
529 easy_display :: TextDetails -> (TextDetails -> a -> a) -> a -> Doc -> a
530-easy_display nl_space_text txt end doc
531+easy_display nl_space_text txt end doc
532   = lay doc cant_fail
533   where
534     lay NoDoc               no_doc = no_doc
535}
536[added sizedText
537Christian.Maeder@dfki.de**20101210161302
538 Ignore-this: 16cc6b484be4edbd2a1683dbd776b065
539] {
540hunk ./Text/PrettyPrint/HughesPJ.hs 176
541         Doc,            -- Abstract
542 
543         -- * Constructing documents
544+
545         -- ** Converting values into documents
546hunk ./Text/PrettyPrint/HughesPJ.hs 178
547-        char, text, ptext, zeroWidthText,
548+        char, text, ptext, sizedText, zeroWidthText,
549         int, integer, float, double, rational,
550 
551         -- ** Simple derived documents
552hunk ./Text/PrettyPrint/HughesPJ.hs 269
553 -- | An obsolete function, now identical to 'text'.
554 ptext    :: String   -> Doc
555 
556+-- | Some text with any width. (@text s = sizedText (length s) s@)
557+sizedText :: Int -> String -> Doc
558+
559 -- | Some text, but without any width. Use for non-printing text
560 -- such as a HTML or Latex tags
561 zeroWidthText :: String   -> Doc
562hunk ./Text/PrettyPrint/HughesPJ.hs 628
563 char  c = textBeside_ (Chr c) 1 Empty
564 text  s = case length s of {sl -> textBeside_ (Str s)  sl Empty}
565 ptext s = case length s of {sl -> textBeside_ (PStr s) sl Empty}
566-zeroWidthText s = textBeside_ (Str s) 0 Empty
567+sizedText l s = textBeside_ (Str s) l Empty
568+zeroWidthText = sizedText 0
569 
570 nest k  p = mkNest k (reduceDoc p)        -- Externally callable version
571 
572hunk ./pretty.cabal 2
573 name:          pretty
574-version:       1.0.1.2
575+version:       1.0.2.0
576 license:       BSD3
577 license-file:  LICENSE
578 maintainer:    libraries@haskell.org
579}
580[use replicate for indent, spaces and multi_ch
581Christian.Maeder@dfki.de**20101210162513
582 Ignore-this: 6b2a6ef82d918fc90b7c8b2cb0bd6c5b
583] {
584hunk ./Text/PrettyPrint/HughesPJ.hs 695
585 nilAboveNest g k (Nest k1 q) = nilAboveNest g (k + k1) q
586 
587 nilAboveNest g k q           | (not g) && (k > 0)        -- No newline if no overlap
588-                             = textBeside_ (Str (spaces k)) k q
589+                             = textBeside_ (Str (indent k)) k q
590                              | otherwise                        -- Put them really above
591                              = nilAbove_ (mkNest k q)
592 
593hunk ./Text/PrettyPrint/HughesPJ.hs 1014
594             = case the_mode of
595                     ZigZagMode |  k >= gap_width
596                                -> nl_text `txt` (
597-                                  Str (multi_ch shift '/') `txt` (
598+                                  Str (replicate shift '/') `txt` (
599                                   nl_text `txt` (
600                                   lay1 (k - shift) s sl p)))
601 
602hunk ./Text/PrettyPrint/HughesPJ.hs 1020
603                                |  k < 0
604                                -> nl_text `txt` (
605-                                  Str (multi_ch shift '\\') `txt` (
606+                                  Str (replicate shift '\\') `txt` (
607                                   nl_text `txt` (
608                                   lay1 (k + shift) s sl p )))
609 
610hunk ./Text/PrettyPrint/HughesPJ.hs 1058
611     lay (Above {}) _ = error "easy_display Above"
612     lay (Beside {}) _ = error "easy_display Beside"
613 
614--- OLD version: we shouldn't rely on tabs being 8 columns apart in the output.
615--- indent n | n >= 8 = '\t' : indent (n - 8)
616---          | otherwise      = spaces n
617+-- an old version inserted tabs being 8 columns apart in the output.
618 indent :: Int -> String
619hunk ./Text/PrettyPrint/HughesPJ.hs 1060
620-indent n = spaces n
621-
622-multi_ch :: Int -> Char -> String
623-multi_ch 0 _ = ""
624-multi_ch n       ch = ch : multi_ch (n - 1) ch
625-
626--- (spaces n) generates a list of n spaces
627---
628--- returns the empty string on negative argument.
629---
630-spaces :: Int -> String
631-spaces n
632- {-
633- | n  < 0    = trace "Warning: negative indentation" ""
634- -}
635- | n <= 0    = ""
636- | otherwise = ' ' : spaces (n - 1)
637+indent n = replicate n ' '
638 
639 {-
640 Q: What is the reason for negative indentation (i.e. argument to indent
641}
642[shortened too long lines and removed redundant brackets
643Christian.Maeder@dfki.de**20101210164447
644 Ignore-this: 12047d94f2184489dc93a553595761b3
645] {
646hunk ./Text/PrettyPrint/HughesPJ.hs 163
647                 * a standard one
648                 * one that uses cut-marks to avoid deeply-nested documents
649                         simply piling up in the right-hand margin
650-                * one that ignores indentation (fewer chars output; good for machines)
651-                * one that ignores indentation and newlines (ditto, only more so)
652+                * one that ignores indentation
653+                        (fewer chars output; good for machines)
654+                * one that ignores indentation and newlines
655+                        (ditto, only more so)
656 
657 6.      Numerous implementation tidy-ups
658         Use of unboxed data types to speed up the implementation
659hunk ./Text/PrettyPrint/HughesPJ.hs 553
660  | Beside Doc Bool Doc                  -- True <=> space between
661  | Above  Doc Bool Doc                  -- True <=> never overlap
662 
663-type RDoc = Doc         -- RDoc is a "reduced Doc", guaranteed not to have a top-level Above or Beside
664+-- RDoc is a "reduced Doc", guaranteed not to have a top-level Above or Beside
665+type RDoc = Doc
666 
667 
668 reduceDoc :: Doc -> RDoc
669hunk ./Text/PrettyPrint/HughesPJ.hs 694
670 --              = text s <> (text "" $g$ nest k q)
671 
672 nilAboveNest _ k _           | k `seq` False = undefined
673-nilAboveNest _ _ Empty       = Empty    -- Here's why the "text s <>" is in the spec!
674+nilAboveNest _ _ Empty       = Empty
675+                               -- Here's why the "text s <>" is in the spec!
676 nilAboveNest g k (Nest k1 q) = nilAboveNest g (k + k1) q
677 
678hunk ./Text/PrettyPrint/HughesPJ.hs 698
679-nilAboveNest g k q           | (not g) && (k > 0)        -- No newline if no overlap
680+nilAboveNest g k q           | not g && k > 0      -- No newline if no overlap
681                              = textBeside_ (Str (indent k)) k q
682hunk ./Text/PrettyPrint/HughesPJ.hs 700
683-                             | otherwise                        -- Put them really above
684+                             | otherwise           -- Put them really above
685                              = nilAbove_ (mkNest k q)
686 
687 -- ---------------------------------------------------------------------------
688hunk ./Text/PrettyPrint/HughesPJ.hs 718
689 -- Specification: beside g p q = p <g> q
690 
691 beside NoDoc               _ _   = NoDoc
692-beside (p1 `Union` p2)     g q   = (beside p1 g q) `union_` (beside p2 g q)
693+beside (p1 `Union` p2)     g q   = beside p1 g q `union_` beside p2 g q
694 beside Empty               _ q   = q
695 beside (Nest k p)          g q   = nest_ k (beside p g q)       -- p non-empty
696 beside p@(Beside p1 g1 q1) g2 q2
697hunk ./Text/PrettyPrint/HughesPJ.hs 723
698            {- (A `op1` B) `op2` C == A `op1` (B `op2` C)  iff op1 == op2
699-                                                 [ && (op1 == <> || op1 == <+>) ] -}
700+                                             [ && (op1 == <> || op1 == <+>) ] -}
701          | g1 == g2              = beside p1 g1 (beside q1 g2 q2)
702          | otherwise             = beside (reduceDoc p) g2 q2
703 beside p@(Above _ _ _)     g q   = beside (reduceDoc p) g q
704hunk ./Text/PrettyPrint/HughesPJ.hs 768
705 sep1 _ NoDoc               _ _  = NoDoc
706 sep1 g (p `Union` q)       k ys = sep1 g p k ys
707                                   `union_`
708-                                  (aboveNest q False k (reduceDoc (vcat ys)))
709+                                  aboveNest q False k (reduceDoc (vcat ys))
710 
711 sep1 g Empty               k ys = mkNest k (sepX g ys)
712 sep1 g (Nest n p)          k ys = nest_ n (sep1 g p (k - n) ys)
713hunk ./Text/PrettyPrint/HughesPJ.hs 773
714 
715-sep1 _ (NilAbove p)        k ys = nilAbove_ (aboveNest p False k (reduceDoc (vcat ys)))
716+sep1 _ (NilAbove p)        k ys = nilAbove_
717+                                  (aboveNest p False k (reduceDoc (vcat ys)))
718 sep1 g (TextBeside s sl p) k ys = textBeside_ s sl (sepNB g p (k - sl) ys)
719 sep1 _ (Above {})          _ _  = error "sep1 Above"
720 sep1 _ (Beside {})         _ _  = error "sep1 Beside"
721hunk ./Text/PrettyPrint/HughesPJ.hs 785
722 
723 sepNB :: Bool -> Doc -> Int -> [Doc] -> Doc
724 
725-sepNB g (Nest _ p)  k ys  = sepNB g p k ys -- Never triggered, because of invariant (2)
726+sepNB g (Nest _ p)  k ys  = sepNB g p k ys
727+                            -- Never triggered, because of invariant (2)
728 
729 sepNB g Empty k ys        = oneLiner (nilBeside g (reduceDoc rest))
730                                 `mkUnion`
731hunk ./Text/PrettyPrint/HughesPJ.hs 810
732 -- fillIndent k [] = []
733 -- fillIndent k [p] = p
734 -- fillIndent k (p1:p2:ps) =
735---    oneLiner p1 <g> fillIndent (k + length p1 + g ? 1 : 0) (remove_nests (oneLiner p2) : ps)
736+--    oneLiner p1 <g> fillIndent (k + length p1 + g ? 1 : 0)
737+--                               (remove_nests (oneLiner p2) : ps)
738 --     `Union`
739 --    (p1 $*$ nest (-k) (fillIndent 0 ps))
740 --
741hunk ./Text/PrettyPrint/HughesPJ.hs 829
742 fill1 _ NoDoc               _ _  = NoDoc
743 fill1 g (p `Union` q)       k ys = fill1 g p k ys
744                                    `union_`
745-                                   (aboveNest q False k (fill g ys))
746+                                   aboveNest q False k (fill g ys)
747 
748 fill1 g Empty               k ys = mkNest k (fill g ys)
749 fill1 g (Nest n p)          k ys = nest_ n (fill1 g p (k - n) ys)
750hunk ./Text/PrettyPrint/HughesPJ.hs 841
751 
752 fillNB :: Bool -> Doc -> Int -> [Doc] -> Doc
753 fillNB _ _           k _  | k `seq` False = undefined
754-fillNB g (Nest _ p)  k ys  = fillNB g p k ys -- Never triggered, because of invariant (2)
755+fillNB g (Nest _ p)  k ys  = fillNB g p k ys
756+                             -- Never triggered, because of invariant (2)
757 fillNB _ Empty _ []        = Empty
758 fillNB g Empty k (Empty:ys)  = fillNB g Empty k ys
759 fillNB g Empty k (y:ys)    = fillNBE g k y ys
760hunk ./Text/PrettyPrint/HughesPJ.hs 849
761 fillNB g p k ys            = fill1 g p k ys
762 
763 fillNBE :: Bool -> Int -> Doc -> [Doc] -> Doc
764-fillNBE g k y ys           = nilBeside g (fill1 g ((elideNest . oneLiner . reduceDoc) y) k1 ys)
765+fillNBE g k y ys           = nilBeside g
766+                             (fill1 g ((elideNest . oneLiner . reduceDoc) y)
767+                                      k1 ys)
768                              `mkUnion`
769                              nilAboveNest True k (fill g (y:ys))
770                            where
771hunk ./Text/PrettyPrint/HughesPJ.hs 991
772 string_txt (PStr s1) s2 = s1 ++ s2
773 
774 
775-fullRender OneLineMode _ _ txt end doc = easy_display space_text txt end (reduceDoc doc)
776-fullRender LeftMode    _ _ txt end doc = easy_display nl_text    txt end (reduceDoc doc)
777+fullRender OneLineMode _ _ txt end doc
778+  = easy_display space_text txt end (reduceDoc doc)
779+fullRender LeftMode    _ _ txt end doc
780+  = easy_display nl_text    txt end (reduceDoc doc)
781 
782 fullRender the_mode line_length ribbons_per_line txt end doc
783   = display the_mode line_length ribbon_length txt end best_doc
784hunk ./Text/PrettyPrint/HughesPJ.hs 1027
785                     ZigZagMode |  k >= gap_width
786                                -> nl_text `txt` (
787                                   Str (replicate shift '/') `txt` (
788-                                  nl_text `txt` (
789-                                  lay1 (k - shift) s sl p)))
790+                                  nl_text `txt`
791+                                  lay1 (k - shift) s sl p ))
792 
793                                |  k < 0
794                                -> nl_text `txt` (
795hunk ./Text/PrettyPrint/HughesPJ.hs 1033
796                                   Str (replicate shift '\\') `txt` (
797-                                  nl_text `txt` (
798-                                  lay1 (k + shift) s sl p )))
799+                                  nl_text `txt`
800+                                  lay1 (k + shift) s sl p ))
801 
802                     _ -> lay1 k s sl p
803 
804hunk ./Text/PrettyPrint/HughesPJ.hs 1043
805 
806         lay2 k _ | k `seq` False = undefined
807         lay2 k (NilAbove p)        = nl_text `txt` lay k p
808-        lay2 k (TextBeside s sl p) = s `txt` (lay2 (k + sl) p)
809+        lay2 k (TextBeside s sl p) = s `txt` lay2 (k + sl) p
810         lay2 k (Nest _ p)          = lay2 k p
811         lay2 _ Empty               = end
812         lay2 _ (Above {})          = error "display lay2 Above"
813hunk ./Text/PrettyPrint/HughesPJ.hs 1062
814   = lay doc cant_fail
815   where
816     lay NoDoc               no_doc = no_doc
817-    lay (Union _p q)        _      = {- lay p -} (lay q cant_fail)              -- Second arg can't be NoDoc
818+    lay (Union _p q)        _      = {- lay p -} lay q cant_fail
819+        -- Second arg can't be NoDoc
820     lay (Nest _ p)          no_doc = lay p no_doc
821     lay Empty               _      = end
822hunk ./Text/PrettyPrint/HughesPJ.hs 1066
823-    lay (NilAbove p)        _      = nl_space_text `txt` lay p cant_fail      -- NoDoc always on first line
824+    lay (NilAbove p)        _      = nl_space_text `txt` lay p cant_fail
825+        -- NoDoc always on first line
826     lay (TextBeside s _ p)  no_doc = s `txt` lay p no_doc
827     lay (Above {}) _ = error "easy_display Above"
828     lay (Beside {}) _ = error "easy_display Beside"
829}
830
831Context:
832
833[Added instance Monoid Doc where mempty = empty; mappend = (<>)
834Bas van Dijk <v.dijk.bas@gmail.com>**20101008072358
835 Ignore-this: d91a4c5c6178aeecffe4352425de0ec1
836]
837[Added instance IsString Doc where fromString = text
838Bas van Dijk <v.dijk.bas@gmail.com>**20101008072041
839 Ignore-this: 4244040de2f7fd38f013ec16b2a76c35
840]
841[Bump version number 1.0.1.1 -> 1.0.1.2
842Ian Lynagh <igloo@earth.li>**20100916162249]
843[Fix doc typo; trac #4298
844Ian Lynagh <igloo@earth.li>**20100912172524]
845[vcat should behave like 'foldr ($$) empty', not 'foldr ($+$) empty', according to the documentation
846Benedikt Huber **20100304102410
847 Ignore-this: 50069337ffc8f0712f8b0e039f40b3b2
848]
849[Bump version to 1.0.1.1
850Ian Lynagh <igloo@earth.li>**20090920141946]
851[Fix "Cabal check" warnings
852Ian Lynagh <igloo@earth.li>**20090811215918]
853[Remove unused imports
854Ian Lynagh <igloo@earth.li>**20090707115854]
855[TAG 2009-06-25
856Ian Lynagh <igloo@earth.li>**20090625160329]
857Patch bundle hash:
858ec0f6e11e8dd5c7c70cb0b84f5862441e67f5925