lib/Hcompta/Format/Text.hs

   1 {-# LANGUAGE CPP #-}
   2 -----------------------------------------------------------------------------
   3 -- |
   4 -- Module      :  Text.PrettyPrint.Leijen.Text
   5 -- Copyright   :  Ivan Lazar Miljenovic (c) 2010,
   6 --                Daan Leijen (c) 2000, http://www.cs.uu.nl/~daan
   7 -- License     :  BSD-style (see the file LICENSE)
   8 --
   9 -- Maintainer  :  Ivan.Miljenovic@gmail.com
  10 -- Stability   :  provisional
  11 -- Portability :  portable
  12 --
  13 -- This library is a port of the /wl-pprint/ package to use 'Text' values rather than 'String's.
  14 --
  15 -- Pretty print module based on Philip Wadler's \"prettier printer\"
  16 --
  17 -- @
  18 --      \"A prettier printer\"
  19 --      Draft paper, April 1997, revised March 1998.
  20 --      <http://cm.bell-labs.com/cm/cs/who/wadler/papers/prettier/prettier.ps>
  21 -- @
  22 --
  23 -- PPrint is an implementation of the pretty printing combinators
  24 -- described by Philip Wadler (1997). In their bare essence, the
  25 -- combinators of Wadler are not expressive enough to describe some
  26 -- commonly occurring layouts. The PPrint library adds new primitives
  27 -- to describe these layouts and works well in practice.
  28 --
  29 -- The library is based on a single way to concatenate documents,
  30 -- which is associative and has both a left and right unit.  This
  31 -- simple design leads to an efficient and short implementation. The
  32 -- simplicity is reflected in the predictable behaviour of the
  33 -- combinators which make them easy to use in practice.
  34 --
  35 -- A thorough description of the primitive combinators and their
  36 -- implementation can be found in Philip Wadler's paper
  37 -- (1997). Additions and the main differences with his original paper
  38 -- are:
  39 --
  40 -- * The nil document is called empty.
  41 --
  42 -- * The above combinator is called '<$>'. The operator '</>' is used
  43 --   for soft line breaks.
  44 --
  45 -- * There are three new primitives: 'align', 'fill' and
  46 --   'fillBreak'. These are very useful in practice.
  47 --
  48 -- * Lots of other useful combinators, like 'fillSep' and 'list'.
  49 --
  50 -- * There are two renderers, 'renderPretty' for pretty printing and
  51 --   'renderCompact' for compact output. The pretty printing algorithm
  52 --   also uses a ribbon-width now for even prettier output.
  53 --
  54 -- * There are two displayers, 'displayT' for 'Text' values and 'displayIO'
  55 --   for file based output.
  56 --
  57 -- * There is a 'Pretty' class.
  58 --
  59 -- * The implementation uses optimised representations and strictness
  60 --   annotations.
  61 --
  62 -- Ways that this library differs from /wl-pprint/ (apart from using
  63 -- 'Text' rather than 'String'):
  64 --
  65 -- * Smarter treatment of 'empty' sub-documents (partially copied over
  66 --   from the /pretty/ library).
  67 -----------------------------------------------------------
  68 module Hcompta.Format.Text (
  69    -- * Documents
  70    Doc,
  71
  72    -- * Basic combinators
  73    empty, char, text, (<>), nest, line, linebreak, group, softline,
  74    softbreak, spacebreak,
  75
  76    -- * Alignment
  77    --
  78    -- | The combinators in this section can not be described by Wadler's
  79    --   original combinators. They align their output relative to the
  80    --   current output position - in contrast to @nest@ which always
  81    --   aligns to the current nesting level. This deprives these
  82    --   combinators from being \`optimal\'. In practice however they
  83    --   prove to be very useful. The combinators in this section should
  84    --   be used with care, since they are more expensive than the other
  85    --   combinators. For example, @align@ shouldn't be used to pretty
  86    --   print all top-level declarations of a language, but using @hang@
  87    --   for let expressions is fine.
  88    align, hang, indent, encloseSep, list, tupled, semiBraces,
  89
  90    -- * Operators
  91    (<+>), (<++>), (<$>), (</>), (<$$>), (<//>),
  92
  93    -- * List combinators
  94    hsep, vsep, fillSep, sep, hcat, vcat, fillCat, cat, punctuate,
  95
  96    -- * Fillers
  97    fill, fillBreak,
  98
  99    -- * Bracketing combinators
 100    enclose, squotes, dquotes, parens, angles, braces, brackets,
 101
 102    -- * Character documents
 103    lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket,
 104    squote, dquote, semi, colon, comma, space, dot, backslash, equals,
 105
 106    -- * Primitive type documents
 107    string, int, integer, float, double, rational, bool,
 108
 109    -- * Position-based combinators
 110    column, nesting, width,
 111
 112    -- * Pretty class
 113    Pretty(..),
 114
 115    -- * Rendering
 116    SimpleDoc(..), renderPretty, renderCompact, renderOneLine,
 117    displayB, displayT, displayIO, putDoc, hPutDoc
 118
 119    ) where
 120
 121 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 710
 122 import Prelude hiding ((<$>))
 123 #endif
 124
 125 import Data.String (IsString (..))
 126 import System.IO   (Handle, hPutChar, stdout)
 127
 128 import           Data.Int               (Int64)
 129 import           Data.Monoid            (Monoid (..), (<>))
 130 import           Data.Text.Lazy         (Text)
 131 import qualified Data.Text.Lazy         as T
 132 import           Data.Text.Lazy.Builder (Builder)
 133 import qualified Data.Text.Lazy.Builder as B
 134 import qualified Data.Text.Lazy.IO      as T
 135
 136
 137 infixr 5 </>,<//>,<$>,<$$>
 138 infixr 6 <+>,<++>
 139
 140
 141 -----------------------------------------------------------
 142 -- list, tupled and semiBraces pretty print a list of
 143 -- documents either horizontally or vertically aligned.
 144 -----------------------------------------------------------
 145
 146
 147 -- | The document @(list xs)@ comma separates the documents @xs@ and
 148 --   encloses them in square brackets. The documents are rendered
 149 --   horizontally if that fits the page. Otherwise they are aligned
 150 --   vertically. All comma separators are put in front of the
 151 --   elements.
 152 list :: [Doc] -> Doc
 153 list = encloseSep lbracket rbracket comma
 154
 155 -- | The document @(tupled xs)@ comma separates the documents @xs@ and
 156 --   encloses them in parenthesis. The documents are rendered
 157 --   horizontally if that fits the page. Otherwise they are aligned
 158 --   vertically. All comma separators are put in front of the
 159 --   elements.
 160 tupled :: [Doc] -> Doc
 161 tupled = encloseSep lparen rparen comma
 162
 163 -- | The document @(semiBraces xs)@ separates the documents @xs@ with
 164 --   semi colons and encloses them in braces. The documents are
 165 --   rendered horizontally if that fits the page. Otherwise they are
 166 --   aligned vertically. All semi colons are put in front of the
 167 --   elements.
 168 semiBraces :: [Doc] -> Doc
 169 semiBraces = encloseSep lbrace rbrace semi
 170
 171 -- | The document @(encloseSep l r sep xs)@ concatenates the documents
 172 --   @xs@ separated by @sep@ and encloses the resulting document by
 173 --   @l@ and @r@. The documents are rendered horizontally if that fits
 174 --   the page. Otherwise they are aligned vertically. All separators
 175 --   are put in front of the elements. For example, the combinator
 176 --   'list' can be defined with @encloseSep@:
 177 --
 178 --   > list xs = encloseSep lbracket rbracket comma xs
 179 --   > test = text "list" <+> (list (map int [10,200,3000]))
 180 --
 181 --   Which is laid out with a page width of 20 as:
 182 --
 183 --   @
 184 --   list [10,200,3000]
 185 --   @
 186 --
 187 --   But when the page width is 15, it is laid out as:
 188 --
 189 --   @
 190 --   list [10
 191 --        ,200
 192 --        ,3000]
 193 --   @
 194 encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc
 195 encloseSep left right sp ds
 196   = case ds of
 197       []  -> left <> right
 198       [d] -> left <> d <> right
 199       _   -> align (cat (zipWith (<>) (left : repeat sp) ds) <> right)
 200
 201 -----------------------------------------------------------
 202 -- punctuate p [d1,d2,...,dn] => [d1 <> p,d2 <> p, ... ,dn]
 203 -----------------------------------------------------------
 204
 205
 206 -- | @(punctuate p xs)@ concatenates all documents in @xs@ with
 207 --   document @p@ except for the last document.
 208 --
 209 --   > someText = map text ["words","in","a","tuple"]
 210 --   > test = parens (align (cat (punctuate comma someText)))
 211 --
 212 --   This is laid out on a page width of 20 as:
 213 --
 214 --   @
 215 --   (words,in,a,tuple)
 216 --   @
 217 --
 218 --   But when the page width is 15, it is laid out as:
 219 --
 220 --   @
 221 --   (words,
 222 --    in,
 223 --    a,
 224 --    tuple)
 225 --   @
 226 --
 227 --   (If you want put the commas in front of their elements instead of
 228 --   at the end, you should use 'tupled' or, in general, 'encloseSep'.)
 229 punctuate :: Doc -> [Doc] -> [Doc]
 230 punctuate _ [] = []
 231 punctuate _ [d] = [d]
 232 punctuate p (d:ds) = (d <> p) : punctuate p ds
 233
 234
 235 -----------------------------------------------------------
 236 -- high-level combinators
 237 -----------------------------------------------------------
 238
 239
 240 -- | The document @(sep xs)@ concatenates all documents @xs@ either
 241 --   horizontally with @(\<+\>)@, if it fits the page, or vertically
 242 --   with @(\<$\>)@.
 243 --
 244 --   > sep xs = group (vsep xs)
 245 sep :: [Doc] -> Doc
 246 sep = group . vsep
 247
 248 -- | The document @(fillSep xs)@ concatenates documents @xs@
 249 --   horizontally with @(\<+\>)@ as long as its fits the page, then
 250 --   inserts a @line@ and continues doing that for all documents in
 251 --   @xs@.
 252 --
 253 --   > fillSep xs = foldr (</>) empty xs
 254 fillSep :: [Doc] -> Doc
 255 fillSep = fold (</>)
 256
 257 -- | The document @(hsep xs)@ concatenates all documents @xs@
 258 --   horizontally with @(\<+\>)@.
 259 hsep :: [Doc] -> Doc
 260 hsep = fold (<+>)
 261
 262 -- | The document @(vsep xs)@ concatenates all documents @xs@
 263 --   vertically with @(\<$\>)@. If a 'group' undoes the line breaks
 264 --   inserted by @vsep@, all documents are separated with a space.
 265 --
 266 --   > someText = map text (words ("text to lay out"))
 267 --   >
 268 --   > test = text "some" <+> vsep someText
 269 --
 270 --   This is laid out as:
 271 --
 272 --   @
 273 --   some text
 274 --   to
 275 --   lay
 276 --   out
 277 --   @
 278 --
 279 --   The 'align' combinator can be used to align the documents under
 280 --   their first element
 281 --
 282 --   > test = text "some" <+> align (vsep someText)
 283 --
 284 --   Which is printed as:
 285 --
 286 --   @
 287 --   some text
 288 --        to
 289 --        lay
 290 --        out
 291 --   @
 292 vsep :: [Doc] -> Doc
 293 vsep = fold (<$>)
 294
 295 -- | The document @(cat xs)@ concatenates all documents @xs@ either
 296 --   horizontally with @(\<\>)@, if it fits the page, or vertically
 297 --   with @(\<$$\>)@.
 298 --
 299 --   > cat xs = group (vcat xs)
 300 cat :: [Doc] -> Doc
 301 cat = group . vcat
 302
 303 -- | The document @(fillCat xs)@ concatenates documents @xs@
 304 --   horizontally with @(\<\>)@ as long as its fits the page, then
 305 --   inserts a @linebreak@ and continues doing that for all documents
 306 --   in @xs@.
 307 --
 308 --   > fillCat xs = foldr (<//>) empty xs
 309 fillCat :: [Doc] -> Doc
 310 fillCat = fold (<//>)
 311
 312 -- | The document @(hcat xs)@ concatenates all documents @xs@
 313 --   horizontally with @(\<\>)@.
 314 hcat :: [Doc] -> Doc
 315 hcat = fold (<>)
 316
 317 -- | The document @(vcat xs)@ concatenates all documents @xs@
 318 --   vertically with @(\<$$\>)@. If a 'group' undoes the line breaks
 319 --   inserted by @vcat@, all documents are directly concatenated.
 320 vcat :: [Doc] -> Doc
 321 vcat = fold (<$$>)
 322
 323 fold      :: (Doc -> Doc -> Doc) -> [Doc] -> Doc
 324 fold _ [] = empty
 325 fold f ds = foldr1 f ds
 326
 327 -- | The document @(x \<+\> y)@ concatenates document @x@ and @y@ with
 328 --   a 'space' in between.  (infixr 6)
 329 (<+>) :: Doc -> Doc -> Doc
 330 Empty <+> y     = y
 331 x     <+> Empty = x
 332 x     <+> y     = x <> space <> y
 333
 334 -- | The document @(x \<++\> y)@ concatenates document @x@ and @y@ with
 335 --   a 'spacebreak' in between.  (infixr 6)
 336 (<++>) :: Doc -> Doc -> Doc
 337 Empty <++> y     = y
 338 x     <++> Empty = x
 339 x     <++> y     = x <> spacebreak <> y
 340
 341
 342 -- | The document @(x \<\/\> y)@ concatenates document @x@ and @y@
 343 --   with a 'softline' in between. This effectively puts @x@ and @y@
 344 --   either next to each other (with a @space@ in between) or
 345 --   underneath each other. (infixr 5)
 346 (</>) :: Doc -> Doc -> Doc
 347 (</>) = splitWithBreak False
 348
 349 -- | The document @(x \<\/\/\> y)@ concatenates document @x@ and @y@
 350 --   with a 'softbreak' in between. This effectively puts @x@ and @y@
 351 --   either right next to each other or underneath each other. (infixr
 352 --   5)
 353 (<//>) :: Doc -> Doc -> Doc
 354 (<//>) = splitWithBreak True
 355
 356 splitWithBreak               :: Bool -> Doc -> Doc -> Doc
 357 splitWithBreak _ Empty b     = b
 358 splitWithBreak _ a     Empty = a
 359 splitWithBreak f a     b     = a <> group (Line f) <> b
 360
 361 -- | The document @(x \<$\> y)@ concatenates document @x@ and @y@ with
 362 --   a 'line' in between. (infixr 5)
 363 (<$>) :: Doc -> Doc -> Doc
 364 (<$>) = splitWithLine False
 365
 366 -- | The document @(x \<$$\> y)@ concatenates document @x@ and @y@
 367 --   with a 'linebreak' in between. (infixr 5)
 368 (<$$>) :: Doc -> Doc -> Doc
 369 (<$$>) = splitWithLine True
 370
 371 splitWithLine               :: Bool -> Doc -> Doc -> Doc
 372 splitWithLine _ Empty b     = b
 373 splitWithLine _ a     Empty = a
 374 splitWithLine f a     b     = a <> Line f <> b
 375
 376 -- | The document @softline@ behaves like 'space' if the resulting
 377 --   output fits the page, otherwise it behaves like 'line'.
 378 --
 379 --   > softline = group line
 380 softline :: Doc
 381 softline = group line
 382
 383 -- | The document @softbreak@ behaves like 'empty' if the resulting
 384 --   output fits the page, otherwise it behaves like 'line'.
 385 --
 386 --   > softbreak = group linebreak
 387 softbreak :: Doc
 388 softbreak = group linebreak
 389
 390 -- | The document @spacebreak@ behaves like 'space' when rendered normally
 391 -- but like 'empty' when using 'renderCompact' or 'renderOneLine'.
 392 spacebreak :: Doc
 393 spacebreak = Spaces 1
 394
 395 -- | Document @(squotes x)@ encloses document @x@ with single quotes
 396 --   \"'\".
 397 squotes :: Doc -> Doc
 398 squotes = enclose squote squote
 399
 400 -- | Document @(dquotes x)@ encloses document @x@ with double quotes
 401 --   '\"'.
 402 dquotes :: Doc -> Doc
 403 dquotes = enclose dquote dquote
 404
 405 -- | Document @(braces x)@ encloses document @x@ in braces, \"{\" and
 406 --   \"}\".
 407 braces :: Doc -> Doc
 408 braces = enclose lbrace rbrace
 409
 410 -- | Document @(parens x)@ encloses document @x@ in parenthesis, \"(\"
 411 --   and \")\".
 412 parens :: Doc -> Doc
 413 parens = enclose lparen rparen
 414
 415 -- | Document @(angles x)@ encloses document @x@ in angles, \"\<\" and
 416 --   \"\>\".
 417 angles :: Doc -> Doc
 418 angles = enclose langle rangle
 419
 420 -- | Document @(brackets x)@ encloses document @x@ in square brackets,
 421 --   \"[\" and \"]\".
 422 brackets :: Doc -> Doc
 423 brackets = enclose lbracket rbracket
 424
 425 -- | The document @(enclose l r x)@ encloses document @x@ between
 426 --   documents @l@ and @r@ using @(\<\>)@.
 427 --
 428 --   > enclose l r x = l <> x <> r
 429 enclose       :: Doc -> Doc -> Doc -> Doc
 430 enclose l r x = l <> x <> r
 431
 432 -- | The document @lparen@ contains a left parenthesis, \"(\".
 433 lparen :: Doc
 434 lparen = char '('
 435
 436 -- | The document @rparen@ contains a right parenthesis, \")\".
 437 rparen :: Doc
 438 rparen = char ')'
 439
 440 -- | The document @langle@ contains a left angle, \"\<\".
 441 langle :: Doc
 442 langle = char '<'
 443
 444 -- | The document @rangle@ contains a right angle, \">\".
 445 rangle :: Doc
 446 rangle = char '>'
 447
 448 -- | The document @lbrace@ contains a left brace, \"{\".
 449 lbrace :: Doc
 450 lbrace = char '{'
 451
 452 -- | The document @rbrace@ contains a right brace, \"}\".
 453 rbrace :: Doc
 454 rbrace = char '}'
 455
 456 -- | The document @lbracket@ contains a left square bracket, \"[\".
 457 lbracket :: Doc
 458 lbracket = char '['
 459
 460 -- | The document @rbracket@ contains a right square bracket, \"]\".
 461 rbracket :: Doc
 462 rbracket = char ']'
 463
 464 -- | The document @squote@ contains a single quote, \"'\".
 465 squote :: Doc
 466 squote = char '\''
 467
 468 -- | The document @dquote@ contains a double quote, '\"'.
 469 dquote :: Doc
 470 dquote = char '"'
 471
 472 -- | The document @semi@ contains a semi colon, \";\".
 473 semi :: Doc
 474 semi = char ';'
 475
 476 -- | The document @colon@ contains a colon, \":\".
 477 colon :: Doc
 478 colon = char ':'
 479
 480 -- | The document @comma@ contains a comma, \",\".
 481 comma :: Doc
 482 comma = char ','
 483
 484 -- | The document @space@ contains a single space, \" \".
 485 --
 486 --   > x <+> y = x <> space <> y
 487 space :: Doc
 488 space = char ' '
 489
 490 -- | The document @dot@ contains a single dot, \".\".
 491 dot :: Doc
 492 dot = char '.'
 493
 494 -- | The document @backslash@ contains a back slash, \"\\\".
 495 backslash :: Doc
 496 backslash = char '\\'
 497
 498 -- | The document @equals@ contains an equal sign, \"=\".
 499 equals :: Doc
 500 equals = char '='
 501
 502 -----------------------------------------------------------
 503 -- Combinators for prelude types
 504 -----------------------------------------------------------
 505
 506 -- string is like "text" but replaces '\n' by "line"
 507
 508 -- | The document @(string s)@ concatenates all characters in @s@
 509 --   using @line@ for newline characters and @char@ for all other
 510 --   characters. It is used instead of 'text' whenever the text
 511 --   contains newline characters.
 512 string :: Text -> Doc
 513 string str = case T.uncons str of
 514                Nothing          -> empty
 515                Just ('\n',str') -> line <> string str'
 516                _                -> case (T.span (/='\n') str) of
 517                                      (xs,ys) -> text xs <> string ys
 518
 519 -- | The document @(bool b)@ shows the literal boolean @b@ using
 520 --   'text'.
 521 bool   :: Bool -> Doc
 522 bool b = text' b
 523
 524 -- | The document @(int i)@ shows the literal integer @i@ using
 525 --   'text'.
 526 int   :: Int -> Doc
 527 int i = text' i
 528
 529 -- | The document @(integer i)@ shows the literal integer @i@ using
 530 --   'text'.
 531 integer   :: Integer -> Doc
 532 integer i = text' i
 533
 534 -- | The document @(float f)@ shows the literal float @f@ using
 535 --   'text'.
 536 float   :: Float -> Doc
 537 float f = text' f
 538
 539 -- | The document @(double d)@ shows the literal double @d@ using
 540 --   'text'.
 541 double   :: Double -> Doc
 542 double d = text' d
 543
 544 -- | The document @(rational r)@ shows the literal rational @r@ using
 545 --   'text'.
 546 rational   :: Rational -> Doc
 547 rational r = text' r
 548
 549 text' :: (Show a) => a -> Doc
 550 text' = text . T.pack . show
 551
 552 -----------------------------------------------------------
 553 -- overloading "pretty"
 554 -----------------------------------------------------------
 555
 556 -- | The member @prettyList@ is only used to define the @instance
 557 --   Pretty a => Pretty [a]@. In normal circumstances only the
 558 --   @pretty@ function is used.
 559 class Pretty a where
 560   pretty :: a -> Doc
 561
 562   prettyList :: [a] -> Doc
 563   prettyList = list . map pretty
 564
 565 instance Pretty a => Pretty [a] where
 566   pretty = prettyList
 567
 568 instance Pretty Doc where
 569   pretty = id
 570
 571 instance Pretty Text where
 572   pretty = string
 573
 574 instance Pretty () where
 575   pretty () = text' ()
 576
 577 instance Pretty Bool where
 578   pretty b = bool b
 579
 580 instance Pretty Char where
 581   pretty c = char c
 582
 583   prettyList s = string $ T.pack s
 584
 585 instance Pretty Int where
 586   pretty i = int i
 587
 588 instance Pretty Integer where
 589   pretty i = integer i
 590
 591 instance Pretty Float where
 592   pretty f = float f
 593
 594 instance Pretty Double where
 595   pretty d = double d
 596
 597 --instance Pretty Rational where
 598 --  pretty r = rational r
 599
 600 instance (Pretty a,Pretty b) => Pretty (a,b) where
 601   pretty (x,y) = tupled [pretty x, pretty y]
 602
 603 instance (Pretty a,Pretty b,Pretty c) => Pretty (a,b,c) where
 604   pretty (x,y,z)= tupled [pretty x, pretty y, pretty z]
 605
 606 instance Pretty a => Pretty (Maybe a) where
 607   pretty Nothing = empty
 608
 609   pretty (Just x) = pretty x
 610
 611 -----------------------------------------------------------
 612 -- semi primitive: fill and fillBreak
 613 -----------------------------------------------------------
 614
 615 -- | The document @(fillBreak i x)@ first renders document @x@. It
 616 --   then appends @space@s until the width is equal to @i@. If the
 617 --   width of @x@ is already larger than @i@, the nesting level is
 618 --   increased by @i@ and a @line@ is appended. When we redefine
 619 --   @ptype@ in the previous example to use @fillBreak@, we get a
 620 --   useful variation of the previous output:
 621 --
 622 --   > ptype (name,tp)
 623 --   > = fillBreak 6 (text name) <+> text "::" <+> text tp
 624 --
 625 --   The output will now be:
 626 --
 627 --   @
 628 --   let empty  :: Doc
 629 --       nest   :: Int -> Doc -> Doc
 630 --       linebreak
 631 --              :: Doc
 632 --   @
 633 fillBreak     :: Int -> Doc -> Doc
 634 fillBreak f x = width x (\w ->
 635                           if (w > f)
 636                             then nest f linebreak
 637                             else spaced (f - w)
 638                         )
 639
 640
 641 -- | The document @(fill i x)@ renders document @x@. It then appends
 642 --   @space@s until the width is equal to @i@. If the width of @x@ is
 643 --   already larger, nothing is appended. This combinator is quite
 644 --   useful in practice to output a list of bindings. The following
 645 --   example demonstrates this.
 646 --
 647 --   > types = [("empty","Doc")
 648 --   >          ,("nest","Int -> Doc -> Doc")
 649 --   >          ,("linebreak","Doc")]
 650 --   >
 651 --   > ptype (name,tp)
 652 --   > = fill 6 (text name) <+> text "::" <+> text tp
 653 --   >
 654 --   > test = text "let" <+> align (vcat (map ptype types))
 655 --
 656 --   Which is laid out as:
 657 --
 658 --   @
 659 --   let empty  :: Doc
 660 --       nest   :: Int -> Doc -> Doc
 661 --       linebreak :: Doc
 662 --   @
 663 fill     :: Int -> Doc -> Doc
 664 fill f d = width d (\w ->
 665                      if (w >= f)
 666                        then empty
 667                        else spaced (f - w)
 668                    )
 669
 670
 671 width     :: Doc -> (Int -> Doc) -> Doc
 672 width d f = column (\k1 -> d <> column (\k2 -> f (k2 - k1)))
 673
 674 -----------------------------------------------------------
 675 -- semi primitive: Alignment and indentation
 676 -----------------------------------------------------------
 677
 678 -- | The document @(indent i x)@ indents document @x@ with @i@ spaces.
 679 --
 680 --   > test = indent 4 (fillSep (map text
 681 --   >         (words "the indent combinator indents these words !")))
 682 --
 683 --   Which lays out with a page width of 20 as:
 684 --
 685 --   @
 686 --       the indent
 687 --       combinator
 688 --       indents these
 689 --       words !
 690 --   @
 691 indent         :: Int -> Doc -> Doc
 692 indent _ Empty = Empty
 693 indent i d     = hang i (spaced i <> d)
 694
 695 -- | The hang combinator implements hanging indentation. The document
 696 --   @(hang i x)@ renders document @x@ with a nesting level set to the
 697 --   current column plus @i@. The following example uses hanging
 698 --   indentation for some text:
 699 --
 700 --   > test = hang 4 (fillSep (map text
 701 --   >         (words "the hang combinator indents these words !")))
 702 --
 703 --   Which lays out on a page with a width of 20 characters as:
 704 --
 705 --   @
 706 --   the hang combinator
 707 --       indents these
 708 --       words !
 709 --   @
 710 --
 711 --   The @hang@ combinator is implemented as:
 712 --
 713 --   > hang i x = align (nest i x)
 714 hang     :: Int -> Doc -> Doc
 715 hang i d = align (nest i d)
 716
 717 -- | The document @(align x)@ renders document @x@ with the nesting
 718 --   level set to the current column. It is used for example to
 719 --   implement 'hang'.
 720 --
 721 --   As an example, we will put a document right above another one,
 722 --   regardless of the current nesting level:
 723 --
 724 --   > x $$ y = align (x <$> y)
 725 --
 726 --   > test = text "hi" <+> (text "nice" $$ text "world")
 727 --
 728 --   which will be laid out as:
 729 --
 730 --   @
 731 --   hi nice
 732 --      world
 733 --   @
 734 align   :: Doc -> Doc
 735 align d = column (\k ->
 736                    nesting (\i -> nest (k - i) d))   --nesting might be negative :-)
 737
 738 -----------------------------------------------------------
 739 -- Primitives
 740 -----------------------------------------------------------
 741
 742 -- | The abstract data type @Doc@ represents pretty documents.
 743 --
 744 --   @Doc@ is an instance of the 'Show' class. @(show doc)@ pretty
 745 --   prints document @doc@ with a page width of 100 characters and a
 746 --   ribbon width of 40 characters.
 747 --
 748 --   > show (text "hello" <$> text "world")
 749 --
 750 --   Which would return the string \"hello\\nworld\", i.e.
 751 --
 752 --   @
 753 --   hello
 754 --   world
 755 --   @
 756 data Doc = Empty
 757          | Char Char             -- invariant: char is not '\n'
 758          | Text !Int64 Builder   -- invariant: text doesn't contain '\n'
 759          | Line !Bool            -- True <=> when undone by group, do not insert a space
 760          | Cat Doc Doc
 761          | Nest !Int64 Doc
 762          | Union Doc Doc         -- invariant: first lines of first doc longer than the first lines of the second doc
 763          | Column  (Int64 -> Doc)
 764          | Nesting (Int64 -> Doc)
 765          | Spaces !Int64
 766
 767 instance IsString Doc where
 768   fromString = string . T.pack
 769
 770 -- | In particular, note that the document @(x '<>' y)@ concatenates
 771 --   document @x@ and document @y@. It is an associative operation
 772 --   having 'empty' as a left and right unit.  (infixr 6)
 773 instance Monoid Doc where
 774     mempty  = empty
 775     mappend = beside
 776
 777 -- | The data type @SimpleDoc@ represents rendered documents and is
 778 --   used by the display functions.
 779 --
 780 --   The @Int@ in @SText@ contains the length of the string. The @Int@
 781 --   in @SLine@ contains the indentation for that line. The library
 782 --   provides two default display functions 'displayS' and
 783 --   'displayIO'. You can provide your own display function by writing
 784 --   a function from a @SimpleDoc@ to your own output format.
 785 data SimpleDoc = SEmpty
 786                 | SChar Char SimpleDoc
 787                 | SText !Int64 Builder SimpleDoc
 788                 | SLine !Int64 SimpleDoc
 789
 790 -- | The empty document is, indeed, empty. Although @empty@ has no
 791 --   content, it does have a \'height\' of 1 and behaves exactly like
 792 --   @(text \"\")@ (and is therefore not a unit of @\<$\>@).
 793 empty :: Doc
 794 empty = Empty
 795
 796 -- | The document @(char c)@ contains the literal character @c@. The
 797 --   character shouldn't be a newline (@'\n'@), the function 'line'
 798 --   should be used for line breaks.
 799 char      :: Char -> Doc
 800 char '\n' = line
 801 char  c   = Char c
 802
 803 -- | The document @(text s)@ contains the literal string @s@. The
 804 --   string shouldn't contain any newline (@'\n'@) characters. If the
 805 --   string contains newline characters, the function 'string' should
 806 --   be used.
 807 text :: Text -> Doc
 808 text s
 809   | T.null s  = Empty
 810   | otherwise = Text (T.length s) (B.fromLazyText s)
 811
 812 -- | The @line@ document advances to the next line and indents to the
 813 --   current nesting level. Document @line@ behaves like @(text \"
 814 --   \")@ if the line break is undone by 'group' or if rendered with
 815 --   'renderOneLine'.
 816 line :: Doc
 817 line = Line False
 818
 819 -- | The @linebreak@ document advances to the next line and indents to
 820 --   the current nesting level. Document @linebreak@ behaves like
 821 --   'empty' if the line break is undone by 'group'.
 822 linebreak :: Doc
 823 linebreak = Line True
 824
 825 beside             :: Doc -> Doc -> Doc
 826 beside Empty r     = r
 827 beside l     Empty = l
 828 beside l     r     = Cat l r
 829
 830 -- | The document @(nest i x)@ renders document @x@ with the current
 831 --   indentation level increased by @i@ (See also 'hang', 'align' and
 832 --   'indent').
 833 --
 834 --   > nest 2 (text "hello" <$> text "world") <$> text "!"
 835 --
 836 --   outputs as:
 837 --
 838 --   @
 839 --   hello
 840 --     world
 841 --   !
 842 --   @
 843 nest         :: Int -> Doc -> Doc
 844 nest _ Empty = Empty
 845 nest i x     = Nest (fromIntegral i) x
 846
 847 -- | Specifies how to create the document based upon which column it is in.
 848 column   :: (Int -> Doc) -> Doc
 849 column f = Column (f . fromIntegral)
 850
 851 -- | Specifies how to nest the document based upon which column it is
 852 --   being nested in.
 853 nesting   :: (Int -> Doc) -> Doc
 854 nesting f = Nesting (f . fromIntegral)
 855
 856 -- | The @group@ combinator is used to specify alternative
 857 --   layouts. The document @(group x)@ undoes all line breaks in
 858 --   document @x@. The resulting line is added to the current line if
 859 --   that fits the page. Otherwise, the document @x@ is rendered
 860 --   without any changes.
 861 group   :: Doc -> Doc
 862 group x = Union (flatten x) x
 863
 864 flatten              :: Doc -> Doc
 865 flatten (Cat x y)   = Cat (flatten x) (flatten y)
 866 flatten (Nest i x)  = Nest i (flatten x)
 867 flatten (Line brk)  = if brk then Empty else Text 1 (B.singleton ' ')
 868 flatten (Union x _) = flatten x
 869 flatten (Column f)  = Column (flatten . f)
 870 flatten (Nesting f) = Nesting (flatten . f)
 871 flatten other       = other                     --Empty,Char,Text
 872
 873 -----------------------------------------------------------
 874 -- Renderers
 875 -----------------------------------------------------------
 876
 877 -----------------------------------------------------------
 878 -- renderPretty: the default pretty printing algorithm
 879 -----------------------------------------------------------
 880
 881 -- list of indentation/document pairs; saves an indirection over [(Int,Doc)]
 882 data Docs = Nil
 883           | Cons !Int64 Doc Docs
 884
 885 -- | This is the default pretty printer which is used by 'show',
 886 --   'putDoc' and 'hPutDoc'. @(renderPretty ribbonfrac width x)@
 887 --   renders document @x@ with a page width of @width@ and a ribbon
 888 --   width of @(ribbonfrac * width)@ characters. The ribbon width is
 889 --   the maximal amount of non-indentation characters on a line. The
 890 --   parameter @ribbonfrac@ should be between @0.0@ and @1.0@. If it
 891 --   is lower or higher, the ribbon width will be 0 or @width@
 892 --   respectively.
 893 renderPretty :: Float -> Int -> Doc -> SimpleDoc
 894 renderPretty rfrac w doc
 895  = best 0 0 (Cons 0 doc Nil)
 896     where
 897       -- r :: the ribbon width in characters
 898       r = max 0 (min w64 (round (fromIntegral w * rfrac)))
 899
 900       w64 = fromIntegral w
 901
 902       -- best :: n = indentation of current line
 903       --         k = current column
 904       --        (ie. (k >= n) && (k - n == count of inserted characters)
 905       best _ _ Nil = SEmpty
 906       best n k (Cons i d ds)
 907         = case d of
 908             Empty     -> best n k ds
 909             Char c    -> let k' = k+1 in seq k' $ SChar c (best n k' ds)
 910             Text l s  -> let k' = k+l in seq k' $ SText l s (best n k' ds)
 911             Line _    -> SLine i (best i i ds)
 912             Cat x y   -> best n k (Cons i x (Cons i y ds))
 913             Nest j x  -> let i' = i+j in seq i' (best n k (Cons i' x ds))
 914             Union x y -> nicest n k (best n k $ Cons i x ds)
 915                                     (best n k $ Cons i y ds)
 916             Column f  -> best n k (Cons i (f k) ds)
 917             Nesting f -> best n k (Cons i (f i) ds)
 918             Spaces l  -> let k' = k+l in seq k' $ SText l (spaces l) (best n k' ds)
 919
 920       --nicest :: r = ribbon width, w = page width,
 921       --          n = indentation of current line, k = current column
 922       --          x and y, the (simple) documents to chose from.
 923       --          precondition: first lines of x are longer than the first lines of y.
 924       nicest n k x y
 925         | fits wth x = x
 926         | otherwise    = y
 927           where
 928             wth = min (w64 - k) (r - k + n)
 929
 930 fits                 :: Int64 -> SimpleDoc -> Bool
 931 fits w _ | w < 0     = False
 932 fits _ SEmpty        = True
 933 fits w (SChar _ x)   = fits (w - 1) x
 934 fits w (SText l _ x) = fits (w - l) x
 935 fits _ SLine{}       = True
 936
 937 -----------------------------------------------------------
 938 -- renderCompact: renders documents without indentation
 939 --  fast and fewer characters output, good for machines
 940 -----------------------------------------------------------
 941
 942 -- | @(renderCompact x)@ renders document @x@ without adding any
 943 --   indentation. Since no \'pretty\' printing is involved, this
 944 --   renderer is very fast. The resulting output contains fewer
 945 --   characters than a pretty printed version and can be used for
 946 --   output that is read by other programs.
 947 renderCompact :: Doc -> SimpleDoc
 948 renderCompact dc
 949   = scan 0 [dc]
 950     where
 951       scan _ [] = SEmpty
 952       scan k (d:ds)
 953         = case d of
 954             Empty     -> scan k ds
 955             Char c    -> let k' = k+1 in seq k' (SChar c (scan k' ds))
 956             Text l s  -> let k' = k+l in seq k' (SText l s (scan k' ds))
 957             Line _    -> SLine 0 (scan 0 ds)
 958             Cat x y   -> scan k (x:y:ds)
 959             Nest _ x  -> scan k (x:ds)
 960             Union _ y -> scan k (y:ds)
 961             Column f  -> scan k (f k:ds)
 962             Nesting f -> scan k (f 0:ds)
 963             Spaces _  -> scan k ds
 964
 965 -- | @(renderOneLine x)@ renders document @x@ without adding any
 966 --   indentation or newlines.
 967 renderOneLine :: Doc -> SimpleDoc
 968 renderOneLine dc
 969   = scan 0 [dc]
 970     where
 971       scan _ [] = SEmpty
 972       scan k (d:ds)
 973         = case d of
 974             Empty      -> scan k ds
 975             Char c     -> let k' = k+1 in seq k' (SChar c (scan k' ds))
 976             Text l s   -> let k' = k+l in seq k' (SText l s (scan k' ds))
 977             Line False -> let k' = k+1 in seq k' (SChar ' ' (scan k' ds))
 978             Line _     -> scan k ds
 979             Cat x y    -> scan k (x:y:ds)
 980             Nest _ x   -> scan k (x:ds)
 981             Union _ y  -> scan k (y:ds)
 982             Column f   -> scan k (f k:ds)
 983             Nesting f  -> scan k (f 0:ds)
 984             Spaces _   -> scan k ds
 985
 986 -----------------------------------------------------------
 987 -- Displayers:  displayS and displayIO
 988 -----------------------------------------------------------
 989
 990
 991 -- | @(displayB simpleDoc)@ takes the output @simpleDoc@ from a
 992 --   rendering function and transforms it to a 'Builder' type (for
 993 --   further manipulation before converting to a lazy 'Text').
 994 displayB               :: SimpleDoc -> Builder
 995 displayB SEmpty        = mempty
 996 displayB (SChar c x)   = c `consB` displayB x
 997 displayB (SText _ s x) = s `mappend` displayB x
 998 displayB (SLine i x)   = '\n' `consB` (indentation i `mappend` displayB x)
 999
1000 consB       :: Char -> Builder -> Builder
1001 c `consB` b = B.singleton c `mappend` b
1002
1003 -- | @(displayT simpleDoc)@ takes the output @simpleDoc@ from a
1004 --   rendering function and transforms it to a lazy 'Text' value.
1005 --
1006 --   > showWidth :: Int -> Doc -> Text
1007 --   > showWidth w x = displayT (renderPretty 0.4 w x)
1008 displayT :: SimpleDoc -> Text
1009 displayT = B.toLazyText . displayB
1010
1011 -- | @(displayIO handle simpleDoc)@ writes @simpleDoc@ to the
1012 --   file handle @handle@. This function is used for example by
1013 --   'hPutDoc':
1014 --
1015 --   > hPutDoc handle doc = displayIO handle (renderPretty 0.4 100 doc)
1016 displayIO :: Handle -> SimpleDoc -> IO ()
1017 displayIO handle simpleDoc
1018  = display simpleDoc
1019     where
1020       display SEmpty        = return ()
1021       display (SChar c x)   = hPutChar handle c >> display x
1022       display (SText _ s x) = T.hPutStr handle (B.toLazyText s) >> display x
1023       display (SLine i x)   = T.hPutStr handle newLine >> display x
1024         where
1025           newLine = B.toLazyText $ '\n' `consB` indentation i
1026
1027 -----------------------------------------------------------
1028 -- default pretty printers: show, putDoc and hPutDoc
1029 -----------------------------------------------------------
1030
1031 instance Show Doc where
1032   showsPrec d doc = showsPrec d (displayT $ renderPretty 0.4 80 doc)
1033   show doc = T.unpack (displayT $ renderPretty 0.4 80 doc)
1034
1035 instance Show SimpleDoc where
1036   show simpleDoc = T.unpack (displayT simpleDoc)
1037
1038 -- | The action @(putDoc doc)@ pretty prints document @doc@ to the
1039 -- standard output, with a page width of 100 characters and a ribbon
1040 -- width of 40 characters.
1041 --
1042 -- > main :: IO ()
1043 -- > main = do{ putDoc (text "hello" <+> text "world") }
1044 --
1045 -- Which would output
1046 --
1047 -- @
1048 -- hello world
1049 -- @
1050 putDoc :: Doc -> IO ()
1051 putDoc doc = hPutDoc stdout doc
1052
1053 -- | @(hPutDoc handle doc)@ pretty prints document @doc@ to the file
1054 --   handle @handle@ with a page width of 100 characters and a ribbon
1055 --   width of 40 characters.
1056 --
1057 --   > main = do handle <- 'openFile' "MyFile" 'WriteMode'
1058 --   >           'hPutDoc' handle ('vcat' ('map' 'text'
1059 --   >                           ['T.pack' "vertical", 'T.pack' "text"]))
1060 --   >           'hClose' handle
1061 hPutDoc :: Handle -> Doc -> IO ()
1062 hPutDoc handle doc = displayIO handle (renderPretty 0.4 80 doc)
1063
1064 -----------------------------------------------------------
1065 -- insert spaces
1066 -- "indentation" used to insert tabs but tabs seem to cause
1067 -- more trouble than they solve :-)
1068 -----------------------------------------------------------
1069 spaces :: Int64 -> Builder
1070 spaces n
1071   | n <= 0 = mempty
1072   | otherwise = B.fromLazyText $ T.replicate n (T.singleton ' ')
1073
1074 spaced   :: Int -> Doc
1075 spaced l = Spaces l'
1076   where
1077     l' = fromIntegral l
1078
1079 -- An alias for readability purposes
1080 indentation :: Int64 -> Builder
1081 indentation = spaces
1082
1083 --  LocalWords:  PPrint combinators Wadler Wadler's encloseSep