2 -----------------------------------------------------------------------------
4 -- Module : Hcompta.Format.Text
5 -- Copyright : Julien Moutinho <julm+hcompta@autogeree.net> (c) 2015,
6 -- Ivan Lazar Miljenovic <Ivan.Miljenovic@gmail.com> (c) 2010,
7 -- Daan Leijen (c) 2000, http://www.cs.uu.nl/~daan
10 -- Stability : provisional
11 -- Portability : portable
13 -- This module is a merge between /wl-pprint-text/ and /ansi-wl-pprint/ packages
14 -- to use 'Text' values rather than 'String's and ANSI formatting.
16 -- Pretty print module based on Philip Wadler's \"prettier printer\"
19 -- \"A prettier printer\"
20 -- Draft paper, April 1997, revised March 1998.
21 -- <http://cm.bell-labs.com/cm/cs/who/wadler/papers/prettier/prettier.ps>
24 -- PPrint is an implementation of the pretty printing combinators
25 -- described by Philip Wadler (1997). In their bare essence, the
26 -- combinators of Wadler are not expressive enough to describe some
27 -- commonly occurring layouts. The PPrint library adds new primitives
28 -- to describe these layouts and works well in practice.
30 -- The library is based on a single way to concatenate documents,
31 -- which is associative and has both a left and right unit. This
32 -- simple design leads to an efficient and short implementation. The
33 -- simplicity is reflected in the predictable behaviour of the
34 -- combinators which make them easy to use in practice.
36 -- A thorough description of the primitive combinators and their
37 -- implementation can be found in Philip Wadler's paper
38 -- (1997). Additions and the main differences with his original paper
41 -- * The nil document is called empty.
43 -- * The above combinator is called '<$>'. The operator '</>' is used
44 -- for soft line breaks.
46 -- * There are three new primitives: 'align', 'fill' and
47 -- 'fillBreak'. These are very useful in practice.
49 -- * Lots of other useful combinators, like 'fillSep' and 'list'.
51 -- * There are two renderers, 'renderPretty' for pretty printing and
52 -- 'renderCompact' for compact output. The pretty printing algorithm
53 -- also uses a ribbon-width now for even prettier output.
55 -- * There are two displayers, 'displayT' for 'Text' values and 'displayIO'
56 -- for file based output.
58 -- * There is a 'Pretty' class.
60 -- * The implementation uses optimised representations and strictness
63 -- Ways that this library differs from /wl-pprint/ (apart from using
64 -- 'Text' rather than 'String'):
66 -- * Smarter treatment of 'empty' sub-documents (partially copied over
67 -- from the /pretty/ library).
68 -----------------------------------------------------------
69 module Hcompta.Format.Text (
73 -- * Basic combinators
74 empty, char, text, (<>), nest, line, linebreak, group, softline,
75 softbreak, spacebreak, renderSmart,
84 -- | The combinators in this section can not be described by Wadler's
85 -- original combinators. They align their output relative to the
86 -- current output position - in contrast to @nest@ which always
87 -- aligns to the current nesting level. This deprives these
88 -- combinators from being \`optimal\'. In practice however they
89 -- prove to be very useful. The combinators in this section should
90 -- be used with care, since they are more expensive than the other
91 -- combinators. For example, @align@ shouldn't be used to pretty
92 -- print all top-level declarations of a language, but using @hang@
93 -- for let expressions is fine.
94 align, hang, indent, encloseSep, list, tupled, semiBraces,
97 (<+>), (<++>), (<$>), (</>), (<$$>), (<//>),
100 hsep, vsep, fillSep, sep, hcat, vcat, fillCat, cat, punctuate,
105 -- * Bracketing combinators
106 enclose, squotes, dquotes, parens, angles, braces, brackets,
108 -- * Character documents
109 lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket,
110 squote, dquote, semi, colon, comma, space, dot, backslash, equals,
112 -- * Colorisation combinators
113 black, red, green, yellow, blue, magenta, cyan, white,
114 dullblack, dullred, dullgreen, dullyellow, dullblue, dullmagenta, dullcyan, dullwhite,
115 onblack, onred, ongreen, onyellow, onblue, onmagenta, oncyan, onwhite,
116 ondullblack, ondullred, ondullgreen, ondullyellow, ondullblue, ondullmagenta, ondullcyan, ondullwhite,
118 -- * Emboldening combinators
121 -- * Underlining combinators
122 underline, deunderline,
124 -- * Removing formatting
127 -- * Primitive type documents
128 string, int, integer, float, double, rational, bool,
130 -- * Position-based combinators
131 column, nesting, width,
137 SimpleDoc(..), renderPretty, renderCompact, renderOneLine,
138 displayB, displayT, displayIO, putDoc, hPutDoc
142 #if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ >= 710
143 import Prelude hiding ((<$>))
146 import Data.String (IsString (..))
147 import System.IO (Handle, hPutChar, stdout)
148 import System.Console.ANSI (Color(..), ColorIntensity(..), ConsoleLayer(..),
149 Underlining(..), ConsoleIntensity(..),
150 SGR(..), hSetSGR, setSGRCode)
152 import Data.Int (Int64)
153 import Data.Maybe (catMaybes)
154 import Data.Monoid (Monoid (..), (<>))
155 import Data.Text.Lazy (Text)
156 import qualified Data.Text.Lazy as T
157 import Data.Text.Lazy.Builder (Builder)
158 import qualified Data.Text.Lazy.Builder as B
159 import qualified Data.Text.Lazy.IO as T
162 infixr 5 </>,<//>,<$>,<$$>
166 -----------------------------------------------------------
167 -- list, tupled and semiBraces pretty print a list of
168 -- documents either horizontally or vertically aligned.
169 -----------------------------------------------------------
172 -- | The document @(list xs)@ comma separates the documents @xs@ and
173 -- encloses them in square brackets. The documents are rendered
174 -- horizontally if that fits the page. Otherwise they are aligned
175 -- vertically. All comma separators are put in front of the
178 list = encloseSep lbracket rbracket comma
180 -- | The document @(tupled xs)@ comma separates the documents @xs@ and
181 -- encloses them in parenthesis. The documents are rendered
182 -- horizontally if that fits the page. Otherwise they are aligned
183 -- vertically. All comma separators are put in front of the
185 tupled :: [Doc] -> Doc
186 tupled = encloseSep lparen rparen comma
188 -- | The document @(semiBraces xs)@ separates the documents @xs@ with
189 -- semi colons and encloses them in braces. The documents are
190 -- rendered horizontally if that fits the page. Otherwise they are
191 -- aligned vertically. All semi colons are put in front of the
193 semiBraces :: [Doc] -> Doc
194 semiBraces = encloseSep lbrace rbrace semi
196 -- | The document @(encloseSep l r sep xs)@ concatenates the documents
197 -- @xs@ separated by @sep@ and encloses the resulting document by
198 -- @l@ and @r@. The documents are rendered horizontally if that fits
199 -- the page. Otherwise they are aligned vertically. All separators
200 -- are put in front of the elements. For example, the combinator
201 -- 'list' can be defined with @encloseSep@:
203 -- > list xs = encloseSep lbracket rbracket comma xs
204 -- > test = text "list" <+> (list (map int [10,200,3000]))
206 -- Which is laid out with a page width of 20 as:
209 -- list [10,200,3000]
212 -- But when the page width is 15, it is laid out as:
219 encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc
220 encloseSep left right sp ds
223 [d] -> left <> d <> right
224 _ -> align (cat (zipWith (<>) (left : repeat sp) ds) <> right)
226 -----------------------------------------------------------
227 -- punctuate p [d1,d2,...,dn] => [d1 <> p,d2 <> p, ... ,dn]
228 -----------------------------------------------------------
231 -- | @(punctuate p xs)@ concatenates all documents in @xs@ with
232 -- document @p@ except for the last document.
234 -- > someText = map text ["words","in","a","tuple"]
235 -- > test = parens (align (cat (punctuate comma someText)))
237 -- This is laid out on a page width of 20 as:
240 -- (words,in,a,tuple)
243 -- But when the page width is 15, it is laid out as:
252 -- (If you want put the commas in front of their elements instead of
253 -- at the end, you should use 'tupled' or, in general, 'encloseSep'.)
254 punctuate :: Doc -> [Doc] -> [Doc]
256 punctuate _ [d] = [d]
257 punctuate p (d:ds) = (d <> p) : punctuate p ds
260 -----------------------------------------------------------
261 -- high-level combinators
262 -----------------------------------------------------------
265 -- | The document @(sep xs)@ concatenates all documents @xs@ either
266 -- horizontally with @(\<+\>)@, if it fits the page, or vertically
269 -- > sep xs = group (vsep xs)
273 -- | The document @(fillSep xs)@ concatenates documents @xs@
274 -- horizontally with @(\<+\>)@ as long as its fits the page, then
275 -- inserts a @line@ and continues doing that for all documents in
278 -- > fillSep xs = foldr (</>) empty xs
279 fillSep :: [Doc] -> Doc
282 -- | The document @(hsep xs)@ concatenates all documents @xs@
283 -- horizontally with @(\<+\>)@.
287 -- | The document @(vsep xs)@ concatenates all documents @xs@
288 -- vertically with @(\<$\>)@. If a 'group' undoes the line breaks
289 -- inserted by @vsep@, all documents are separated with a space.
291 -- > someText = map text (words ("text to lay out"))
293 -- > test = text "some" <+> vsep someText
295 -- This is laid out as:
304 -- The 'align' combinator can be used to align the documents under
305 -- their first element
307 -- > test = text "some" <+> align (vsep someText)
309 -- Which is printed as:
320 -- | The document @(cat xs)@ concatenates all documents @xs@ either
321 -- horizontally with @(\<\>)@, if it fits the page, or vertically
324 -- > cat xs = group (vcat xs)
328 -- | The document @(fillCat xs)@ concatenates documents @xs@
329 -- horizontally with @(\<\>)@ as long as its fits the page, then
330 -- inserts a @linebreak@ and continues doing that for all documents
333 -- > fillCat xs = foldr (<//>) empty xs
334 fillCat :: [Doc] -> Doc
335 fillCat = fold (<//>)
337 -- | The document @(hcat xs)@ concatenates all documents @xs@
338 -- horizontally with @(\<\>)@.
342 -- | The document @(vcat xs)@ concatenates all documents @xs@
343 -- vertically with @(\<$$\>)@. If a 'group' undoes the line breaks
344 -- inserted by @vcat@, all documents are directly concatenated.
348 fold :: (Doc -> Doc -> Doc) -> [Doc] -> Doc
350 fold f ds = foldr1 f ds
352 -- | The document @(x \<+\> y)@ concatenates document @x@ and @y@ with
353 -- a 'space' in between. (infixr 6)
354 (<+>) :: Doc -> Doc -> Doc
357 x <+> y = x <> space <> y
359 -- | The document @(x \<++\> y)@ concatenates document @x@ and @y@ with
360 -- a 'spacebreak' in between. (infixr 6)
361 (<++>) :: Doc -> Doc -> Doc
364 x <++> y = x <> spacebreak <> y
367 -- | The document @(x \<\/\> y)@ concatenates document @x@ and @y@
368 -- with a 'softline' in between. This effectively puts @x@ and @y@
369 -- either next to each other (with a @space@ in between) or
370 -- underneath each other. (infixr 5)
371 (</>) :: Doc -> Doc -> Doc
372 (</>) = splitWithBreak False
374 -- | The document @(x \<\/\/\> y)@ concatenates document @x@ and @y@
375 -- with a 'softbreak' in between. This effectively puts @x@ and @y@
376 -- either right next to each other or underneath each other. (infixr
378 (<//>) :: Doc -> Doc -> Doc
379 (<//>) = splitWithBreak True
381 splitWithBreak :: Bool -> Doc -> Doc -> Doc
382 splitWithBreak _ Empty b = b
383 splitWithBreak _ a Empty = a
384 splitWithBreak f a b = a <> group (Line f) <> b
386 -- | The document @(x \<$\> y)@ concatenates document @x@ and @y@ with
387 -- a 'line' in between. (infixr 5)
388 (<$>) :: Doc -> Doc -> Doc
389 (<$>) = splitWithLine False
391 -- | The document @(x \<$$\> y)@ concatenates document @x@ and @y@
392 -- with a 'linebreak' in between. (infixr 5)
393 (<$$>) :: Doc -> Doc -> Doc
394 (<$$>) = splitWithLine True
396 splitWithLine :: Bool -> Doc -> Doc -> Doc
397 splitWithLine _ Empty b = b
398 splitWithLine _ a Empty = a
399 splitWithLine f a b = a <> Line f <> b
401 -- | The document @softline@ behaves like 'space' if the resulting
402 -- output fits the page, otherwise it behaves like 'line'.
404 -- > softline = group line
406 softline = group line
408 -- | The document @softbreak@ behaves like 'empty' if the resulting
409 -- output fits the page, otherwise it behaves like 'line'.
411 -- > softbreak = group linebreak
413 softbreak = group linebreak
415 -- | The document @spacebreak@ behaves like 'space' when rendered normally
416 -- but like 'empty' when using 'renderCompact' or 'renderOneLine'.
418 spacebreak = Spaces 1
420 -- | Document @(squotes x)@ encloses document @x@ with single quotes
422 squotes :: Doc -> Doc
423 squotes = enclose squote squote
425 -- | Document @(dquotes x)@ encloses document @x@ with double quotes
427 dquotes :: Doc -> Doc
428 dquotes = enclose dquote dquote
430 -- | Document @(braces x)@ encloses document @x@ in braces, \"{\" and
433 braces = enclose lbrace rbrace
435 -- | Document @(parens x)@ encloses document @x@ in parenthesis, \"(\"
438 parens = enclose lparen rparen
440 -- | Document @(angles x)@ encloses document @x@ in angles, \"\<\" and
443 angles = enclose langle rangle
445 -- | Document @(brackets x)@ encloses document @x@ in square brackets,
447 brackets :: Doc -> Doc
448 brackets = enclose lbracket rbracket
450 -- | The document @(enclose l r x)@ encloses document @x@ between
451 -- documents @l@ and @r@ using @(\<\>)@.
453 -- > enclose l r x = l <> x <> r
454 enclose :: Doc -> Doc -> Doc -> Doc
455 enclose l r x = l <> x <> r
457 -- | The document @lparen@ contains a left parenthesis, \"(\".
461 -- | The document @rparen@ contains a right parenthesis, \")\".
465 -- | The document @langle@ contains a left angle, \"\<\".
469 -- | The document @rangle@ contains a right angle, \">\".
473 -- | The document @lbrace@ contains a left brace, \"{\".
477 -- | The document @rbrace@ contains a right brace, \"}\".
481 -- | The document @lbracket@ contains a left square bracket, \"[\".
485 -- | The document @rbracket@ contains a right square bracket, \"]\".
489 -- | The document @squote@ contains a single quote, \"'\".
493 -- | The document @dquote@ contains a double quote, '\"'.
497 -- | The document @semi@ contains a semi colon, \";\".
501 -- | The document @colon@ contains a colon, \":\".
505 -- | The document @comma@ contains a comma, \",\".
509 -- | The document @space@ contains a single space, \" \".
511 -- > x <+> y = x <> space <> y
515 -- | The document @dot@ contains a single dot, \".\".
519 -- | The document @backslash@ contains a back slash, \"\\\".
521 backslash = char '\\'
523 -- | The document @equals@ contains an equal sign, \"=\".
527 -----------------------------------------------------------
528 -- Combinators for prelude types
529 -----------------------------------------------------------
531 -- string is like "text" but replaces '\n' by "line"
533 -- | The document @(string s)@ concatenates all characters in @s@
534 -- using @line@ for newline characters and @char@ for all other
535 -- characters. It is used instead of 'text' whenever the text
536 -- contains newline characters.
537 string :: Text -> Doc
538 string str = case T.uncons str of
540 Just ('\n',str') -> line <> string str'
541 _ -> case (T.span (/='\n') str) of
542 (xs,ys) -> text xs <> string ys
544 -- | The document @(bool b)@ shows the literal boolean @b@ using
549 -- | The document @(int i)@ shows the literal integer @i@ using
554 -- | The document @(integer i)@ shows the literal integer @i@ using
556 integer :: Integer -> Doc
559 -- | The document @(float f)@ shows the literal float @f@ using
561 float :: Float -> Doc
564 -- | The document @(double d)@ shows the literal double @d@ using
566 double :: Double -> Doc
569 -- | The document @(rational r)@ shows the literal rational @r@ using
571 rational :: Rational -> Doc
574 text' :: (Show a) => a -> Doc
575 text' = text . T.pack . show
577 -----------------------------------------------------------
578 -- overloading "pretty"
579 -----------------------------------------------------------
581 -- | The member @prettyList@ is only used to define the @instance
582 -- Pretty a => Pretty [a]@. In normal circumstances only the
583 -- @pretty@ function is used.
587 prettyList :: [a] -> Doc
588 prettyList = list . map pretty
590 instance Pretty a => Pretty [a] where
593 instance Pretty Doc where
596 instance Pretty Text where
599 instance Pretty () where
602 instance Pretty Bool where
605 instance Pretty Char where
608 prettyList s = string $ T.pack s
610 instance Pretty Int where
613 instance Pretty Integer where
616 instance Pretty Float where
619 instance Pretty Double where
622 --instance Pretty Rational where
623 -- pretty r = rational r
625 instance (Pretty a,Pretty b) => Pretty (a,b) where
626 pretty (x,y) = tupled [pretty x, pretty y]
628 instance (Pretty a,Pretty b,Pretty c) => Pretty (a,b,c) where
629 pretty (x,y,z)= tupled [pretty x, pretty y, pretty z]
631 instance Pretty a => Pretty (Maybe a) where
632 pretty Nothing = empty
634 pretty (Just x) = pretty x
636 -----------------------------------------------------------
637 -- semi primitive: fill and fillBreak
638 -----------------------------------------------------------
640 -- | The document @(fillBreak i x)@ first renders document @x@. It
641 -- then appends @space@s until the width is equal to @i@. If the
642 -- width of @x@ is already larger than @i@, the nesting level is
643 -- increased by @i@ and a @line@ is appended. When we redefine
644 -- @ptype@ in the previous example to use @fillBreak@, we get a
645 -- useful variation of the previous output:
648 -- > = fillBreak 6 (text name) <+> text "::" <+> text tp
650 -- The output will now be:
654 -- nest :: Int -> Doc -> Doc
658 fillBreak :: Int -> Doc -> Doc
659 fillBreak f x = width x (\w ->
661 then nest f linebreak
666 -- | The document @(fill i x)@ renders document @x@. It then appends
667 -- @space@s until the width is equal to @i@. If the width of @x@ is
668 -- already larger, nothing is appended. This combinator is quite
669 -- useful in practice to output a list of bindings. The following
670 -- example demonstrates this.
672 -- > types = [("empty","Doc")
673 -- > ,("nest","Int -> Doc -> Doc")
674 -- > ,("linebreak","Doc")]
677 -- > = fill 6 (text name) <+> text "::" <+> text tp
679 -- > test = text "let" <+> align (vcat (map ptype types))
681 -- Which is laid out as:
685 -- nest :: Int -> Doc -> Doc
688 fill :: Int -> Doc -> Doc
689 fill f d = width d (\w ->
696 width :: Doc -> (Int -> Doc) -> Doc
697 width d f = column (\k1 -> d <> column (\k2 -> f (k2 - k1)))
699 -----------------------------------------------------------
700 -- semi primitive: Alignment and indentation
701 -----------------------------------------------------------
703 -- | The document @(indent i x)@ indents document @x@ with @i@ spaces.
705 -- > test = indent 4 (fillSep (map text
706 -- > (words "the indent combinator indents these words !")))
708 -- Which lays out with a page width of 20 as:
716 indent :: Int -> Doc -> Doc
717 indent _ Empty = Empty
718 indent i d = hang i (spaced i <> d)
720 -- | The hang combinator implements hanging indentation. The document
721 -- @(hang i x)@ renders document @x@ with a nesting level set to the
722 -- current column plus @i@. The following example uses hanging
723 -- indentation for some text:
725 -- > test = hang 4 (fillSep (map text
726 -- > (words "the hang combinator indents these words !")))
728 -- Which lays out on a page with a width of 20 characters as:
731 -- the hang combinator
736 -- The @hang@ combinator is implemented as:
738 -- > hang i x = align (nest i x)
739 hang :: Int -> Doc -> Doc
740 hang i d = align (nest i d)
742 -- | The document @(align x)@ renders document @x@ with the nesting
743 -- level set to the current column. It is used for example to
746 -- As an example, we will put a document right above another one,
747 -- regardless of the current nesting level:
749 -- > x $$ y = align (x <$> y)
751 -- > test = text "hi" <+> (text "nice" $$ text "world")
753 -- which will be laid out as:
760 align d = column (\k ->
761 nesting (\i -> nest (k - i) d)) --nesting might be negative :-)
763 -----------------------------------------------------------
765 -----------------------------------------------------------
767 -- | The abstract data type @Doc@ represents pretty documents.
769 -- @Doc@ is an instance of the 'Show' class. @(show doc)@ pretty
770 -- prints document @doc@ with a page width of 100 characters and a
771 -- ribbon width of 40 characters.
773 -- > show (text "hello" <$> text "world")
775 -- Which would return the string \"hello\\nworld\", i.e.
782 | Char Char -- invariant: char is not '\n'
783 | Text !Int64 Builder -- invariant: text doesn't contain '\n'
784 | Line !Bool -- True <=> when undone by group, do not insert a space
785 -- | FlatAlt Doc Doc -- Render the first doc, but when
786 -- flattened, render the second.
789 | Union Doc Doc -- invariant: first lines of first doc longer than the first lines of the second doc
790 | Column (Int64 -> Doc)
791 | Nesting (Int64 -> Doc)
793 | Color ConsoleLayer ColorIntensity -- Introduces coloring /around/ the embedded document
796 | Intensify ConsoleIntensity Doc
798 | Underline Underlining Doc
799 | RestoreFormat (Maybe (ColorIntensity, Color)) -- Only used during the rendered phase, to signal a SGR should be issued to restore the terminal formatting.
800 (Maybe (ColorIntensity, Color)) -- These are the colors to revert the current forecolor/backcolor to (i.e. those from before the start of the Color block).
801 (Maybe ConsoleIntensity) -- Intensity to revert to.
802 (Maybe Bool) -- Italicization to revert to.
803 (Maybe Underlining) -- Underlining to revert to.
805 instance IsString Doc where
806 fromString = string . T.pack
808 -- | In particular, note that the document @(x '<>' y)@ concatenates
809 -- document @x@ and document @y@. It is an associative operation
810 -- having 'empty' as a left and right unit. (infixr 6)
811 instance Monoid Doc where
815 -- | The data type @SimpleDoc@ represents rendered documents and is
816 -- used by the display functions.
818 -- The @Int@ in @SText@ contains the length of the string. The @Int@
819 -- in @SLine@ contains the indentation for that line. The library
820 -- provides two default display functions 'displayS' and
821 -- 'displayIO'. You can provide your own display function by writing
822 -- a function from a @SimpleDoc@ to your own output format.
823 data SimpleDoc = SEmpty
824 | SChar Char SimpleDoc
825 | SText !Int64 Builder SimpleDoc
826 | SLine !Int64 SimpleDoc
827 | SSGR [SGR] SimpleDoc
829 -- | The empty document is, indeed, empty. Although @empty@ has no
830 -- content, it does have a \'height\' of 1 and behaves exactly like
831 -- @(text \"\")@ (and is therefore not a unit of @\<$\>@).
835 is_empty :: Doc -> Bool
836 is_empty doc = case doc of
840 if_color :: Doc -> Doc -> Doc
843 -- | The document @(char c)@ contains the literal character @c@. The
844 -- character shouldn't be a newline (@'\n'@), the function 'line'
845 -- should be used for line breaks.
850 -- | The document @(text s)@ contains the literal string @s@. The
851 -- string shouldn't contain any newline (@'\n'@) characters. If the
852 -- string contains newline characters, the function 'string' should
857 | otherwise = Text (T.length s) (B.fromLazyText s)
859 -- | The @line@ document advances to the next line and indents to the
860 -- current nesting level. Document @line@ behaves like @(text \"
861 -- \")@ if the line break is undone by 'group' or if rendered with
865 --line = FlatAlt Line space
867 -- | The @linebreak@ document advances to the next line and indents to
868 -- the current nesting level. Document @linebreak@ behaves like
869 -- 'empty' if the line break is undone by 'group'.
871 linebreak = Line True
872 --linebreak = FlatAlt Line empty
874 beside :: Doc -> Doc -> Doc
879 -- | The document @(nest i x)@ renders document @x@ with the current
880 -- indentation level increased by @i@ (See also 'hang', 'align' and
883 -- > nest 2 (text "hello" <$> text "world") <$> text "!"
892 nest :: Int -> Doc -> Doc
894 nest i x = Nest (fromIntegral i) x
896 -- | Specifies how to create the document based upon which column it is in.
897 column :: (Int -> Doc) -> Doc
898 column f = Column (f . fromIntegral)
900 -- | Specifies how to nest the document based upon which column it is
902 nesting :: (Int -> Doc) -> Doc
903 nesting f = Nesting (f . fromIntegral)
905 -- | The @group@ combinator is used to specify alternative
906 -- layouts. The document @(group x)@ undoes all line breaks in
907 -- document @x@. The resulting line is added to the current line if
908 -- that fits the page. Otherwise, the document @x@ is rendered
909 -- without any changes.
911 group x = Union (flatten x) x
913 flatten :: Doc -> Doc
914 flatten (Cat x y) = Cat (flatten x) (flatten y)
915 flatten (Nest i x) = Nest i (flatten x)
916 flatten (Line brk) = if brk then Empty else Text 1 (B.singleton ' ')
917 flatten (Union x _) = flatten x
918 flatten (Column f) = Column (flatten . f)
919 flatten (Nesting f) = Nesting (flatten . f)
920 flatten (Color l i c x) = Color l i c (flatten x)
921 flatten (IfColor t f) = IfColor (flatten t) (flatten f)
922 flatten (Intensify i x) = Intensify i (flatten x)
923 flatten (Italicize b x) = Italicize b (flatten x)
924 flatten (Underline u x) = Underline u (flatten x)
925 -- flatten (FlatAlt x y) = y
926 flatten other = other --Empty,Char,Text,RestoreFormat
929 -----------------------------------------------------------
931 -----------------------------------------------------------
933 -- | Displays a document with the black forecolor
935 -- | Displays a document with the red forecolor
937 -- | Displays a document with the green forecolor
939 -- | Displays a document with the yellow forecolor
941 -- | Displays a document with the blue forecolor
943 -- | Displays a document with the magenta forecolor
944 magenta :: Doc -> Doc
945 -- | Displays a document with the cyan forecolor
947 -- | Displays a document with the white forecolor
949 -- | Displays a document with the dull black forecolor
950 dullblack :: Doc -> Doc
951 -- | Displays a document with the dull red forecolor
952 dullred :: Doc -> Doc
953 -- | Displays a document with the dull green forecolor
954 dullgreen :: Doc -> Doc
955 -- | Displays a document with the dull yellow forecolor
956 dullyellow :: Doc -> Doc
957 -- | Displays a document with the dull blue forecolor
958 dullblue :: Doc -> Doc
959 -- | Displays a document with the dull magenta forecolor
960 dullmagenta :: Doc -> Doc
961 -- | Displays a document with the dull cyan forecolor
962 dullcyan :: Doc -> Doc
963 -- | Displays a document with the dull white forecolor
964 dullwhite :: Doc -> Doc
965 (black, dullblack) = colorFunctions Black
966 (red, dullred) = colorFunctions Red
967 (green, dullgreen) = colorFunctions Green
968 (yellow, dullyellow) = colorFunctions Yellow
969 (blue, dullblue) = colorFunctions Blue
970 (magenta, dullmagenta) = colorFunctions Magenta
971 (cyan, dullcyan) = colorFunctions Cyan
972 (white, dullwhite) = colorFunctions White
974 -- | Displays a document with a forecolor given in the first parameter
975 color :: Color -> Doc -> Doc
976 -- | Displays a document with a dull forecolor given in the first parameter
977 dullcolor :: Color -> Doc -> Doc
978 color = Color Foreground Vivid
979 dullcolor = Color Foreground Dull
981 colorFunctions :: Color -> (Doc -> Doc, Doc -> Doc)
982 colorFunctions what = (color what, dullcolor what)
984 -- | Displays a document with the black backcolor
985 onblack :: Doc -> Doc
986 -- | Displays a document with the red backcolor
988 -- | Displays a document with the green backcolor
989 ongreen :: Doc -> Doc
990 -- | Displays a document with the yellow backcolor
991 onyellow :: Doc -> Doc
992 -- | Displays a document with the blue backcolor
994 -- | Displays a document with the magenta backcolor
995 onmagenta :: Doc -> Doc
996 -- | Displays a document with the cyan backcolor
998 -- | Displays a document with the white backcolor
999 onwhite :: Doc -> Doc
1000 -- | Displays a document with the dull block backcolor
1001 ondullblack :: Doc -> Doc
1002 -- | Displays a document with the dull red backcolor
1003 ondullred :: Doc -> Doc
1004 -- | Displays a document with the dull green backcolor
1005 ondullgreen :: Doc -> Doc
1006 -- | Displays a document with the dull yellow backcolor
1007 ondullyellow :: Doc -> Doc
1008 -- | Displays a document with the dull blue backcolor
1009 ondullblue :: Doc -> Doc
1010 -- | Displays a document with the dull magenta backcolor
1011 ondullmagenta :: Doc -> Doc
1012 -- | Displays a document with the dull cyan backcolor
1013 ondullcyan :: Doc -> Doc
1014 -- | Displays a document with the dull white backcolor
1015 ondullwhite :: Doc -> Doc
1016 (onblack, ondullblack) = oncolorFunctions Black
1017 (onred, ondullred) = oncolorFunctions Red
1018 (ongreen, ondullgreen) = oncolorFunctions Green
1019 (onyellow, ondullyellow) = oncolorFunctions Yellow
1020 (onblue, ondullblue) = oncolorFunctions Blue
1021 (onmagenta, ondullmagenta) = oncolorFunctions Magenta
1022 (oncyan, ondullcyan) = oncolorFunctions Cyan
1023 (onwhite, ondullwhite) = oncolorFunctions White
1025 -- | Displays a document with a backcolor given in the first parameter
1026 oncolor :: Color -> Doc -> Doc
1027 -- | Displays a document with a dull backcolor given in the first parameter
1028 ondullcolor :: Color -> Doc -> Doc
1029 oncolor = Color Background Vivid
1030 ondullcolor = Color Background Dull
1032 oncolorFunctions :: Color -> (Doc -> Doc, Doc -> Doc)
1033 oncolorFunctions what = (oncolor what, ondullcolor what)
1036 -----------------------------------------------------------
1037 -- Console Intensity
1038 -----------------------------------------------------------
1040 -- | Displays a document in a heavier font weight
1042 bold = Intensify BoldIntensity
1044 -- | Displays a document in the normal font weight
1045 debold :: Doc -> Doc
1046 debold = Intensify NormalIntensity
1048 -- NB: I don't support FaintIntensity here because it is not widely supported by terminals.
1051 -----------------------------------------------------------
1053 -----------------------------------------------------------
1057 I'm in two minds about providing these functions, since italicization is so rarely implemented.
1058 It is especially bad because "italicization" may cause the meaning of colors to flip, which will
1059 look a bit weird, to say the least...
1062 -- | Displays a document in italics. This is not widely supported, and it's use is not recommended
1063 italicize :: Doc -> Doc
1064 italicize = Italicize True
1066 -- | Displays a document with no italics
1067 deitalicize :: Doc -> Doc
1068 deitalicize = Italicize False
1072 -----------------------------------------------------------
1074 -----------------------------------------------------------
1076 -- | Displays a document with underlining
1077 underline :: Doc -> Doc
1078 underline = Underline SingleUnderline
1080 -- | Displays a document with no underlining
1081 deunderline :: Doc -> Doc
1082 deunderline = Underline NoUnderline
1084 -- NB: I don't support DoubleUnderline here because it is not widely supported by terminals.
1086 -----------------------------------------------------------
1087 -- Removing formatting
1088 -----------------------------------------------------------
1090 -- | Removes all colorisation, emboldening and underlining from a document
1092 -- plain Fail = Fail
1094 plain c@(Char _) = c
1095 plain t@(Text _ _) = t
1096 plain l@(Line _) = l
1097 -- plain (FlatAlt x y) = FlatAlt (plain x) (plain y)
1098 plain (Cat x y) = Cat (plain x) (plain y)
1099 plain (Nest i x) = Nest i (plain x)
1100 plain (Union x y) = Union (plain x) (plain y)
1101 plain (Column f) = Column (plain . f)
1102 -- plain (Columns f) = Columns (plain . f)
1103 plain (Nesting f) = Nesting (plain . f)
1104 plain (Spaces l) = Spaces l
1105 plain (Color _ _ _ x) = plain x
1106 plain (Intensify _ x) = plain x
1107 plain (IfColor _ x) = plain x
1108 plain (Italicize _ x) = plain x
1109 plain (Underline _ x) = plain x
1110 plain (RestoreFormat _ _ _ _ _) = Empty
1112 -----------------------------------------------------------
1114 -----------------------------------------------------------
1116 -----------------------------------------------------------
1117 -- renderPretty: the default pretty printing algorithm
1118 -----------------------------------------------------------
1120 -- list of indentation/document pairs; saves an indirection over [(Int,Doc)]
1122 | Cons !Int64 Doc Docs
1124 -- | This is the default pretty printer which is used by 'show',
1125 -- 'putDoc' and 'hPutDoc'. @(renderPretty ribbonfrac width x)@
1126 -- renders document @x@ with a page width of @width@ and a ribbon
1127 -- width of @(ribbonfrac * width)@ characters. The ribbon width is
1128 -- the maximal amount of non-indentation characters on a line. The
1129 -- parameter @ribbonfrac@ should be between @0.0@ and @1.0@. If it
1130 -- is lower or higher, the ribbon width will be 0 or @width@
1132 renderPretty :: Bool -> Float -> Int -> Doc -> SimpleDoc
1133 renderPretty = renderFits fits1
1135 -- | A slightly smarter rendering algorithm with more lookahead. It provides
1136 -- provide earlier breaking on deeply nested structures
1137 -- For example, consider this python-ish pseudocode:
1138 -- @fun(fun(fun(fun(fun([abcdefg, abcdefg])))))@
1139 -- If we put a softbreak (+ nesting 2) after each open parenthesis, and align
1140 -- the elements of the list to match the opening brackets, this will render with
1141 -- @renderPretty@ and a page width of 20 as:
1143 -- fun(fun(fun(fun(fun([
1149 -- Where the 20c. boundary has been marked with |.
1150 -- Because @renderPretty@ only uses one-line lookahead, it sees that the first
1151 -- line fits, and is stuck putting the second and third lines after the 20-c
1152 -- mark. In contrast, @renderSmart@ will continue to check that the potential
1153 -- document up to the end of the indentation level. Thus, it will format the
1167 -- Which fits within the 20c. boundary.
1168 renderSmart :: Bool -> Float -> Int -> Doc -> SimpleDoc
1169 renderSmart = renderFits fitsR
1171 renderFits :: (Int64 -> Int64 -> Int64 -> SimpleDoc -> Bool)
1172 -> Bool -> Float -> Int -> Doc -> SimpleDoc
1173 renderFits fits with_color rfrac w doc
1174 -- I used to do a @SSGR [Reset]@ here, but if you do that it will result
1175 -- in any rendered @Doc@ containing at least some ANSI control codes. This
1176 -- may be undesirable if you want to render to non-ANSI devices by simply
1177 -- not making use of the ANSI color combinators I provide.
1179 -- What I "really" want to do here is do an initial Reset iff there is some
1180 -- ANSI color within the Doc, but that's a bit fiddly. I'll fix it if someone
1182 = best 0 0 Nothing Nothing Nothing Nothing Nothing (Cons 0 doc Nil)
1184 -- r :: the ribbon width in characters
1185 r = max 0 (min w64 (round (fromIntegral w * rfrac)))
1187 w64 = fromIntegral w
1189 -- best :: n = indentation of current line
1190 -- k = current column
1191 -- (ie. (k >= n) && (k - n == count of inserted characters)
1192 best _n _k _mb_fc _mb_bc _mb_in _mb_it _mb_un Nil = SEmpty
1193 best n k mb_fc mb_bc mb_in mb_it mb_un (Cons i d ds)
1196 Empty -> best_typical n k ds
1197 Char c -> let k' = k+1 in seq k' (SChar c (best_typical n k' ds))
1198 Text l s -> let k' = k+l in seq k' (SText l s (best_typical n k' ds))
1199 Line _ -> SLine i (best_typical i i ds)
1200 -- FlatAlt x _ -> best_typical n k (Cons i x ds)
1201 Cat x y -> best_typical n k (Cons i x (Cons i y ds))
1202 Nest j x -> let i' = i+j in seq i' (best_typical n k (Cons i' x ds))
1203 Union x y -> nicest n k (best_typical n k (Cons i x ds))
1204 (best_typical n k (Cons i y ds))
1205 Column f -> best_typical n k (Cons i (f k) ds)
1206 -- Columns f -> best_typical n k (Cons i (f (Just w)) ds)
1207 Nesting f -> best_typical n k (Cons i (f i) ds)
1208 Spaces l -> let k' = k+l in seq k' $ SText l (spaces l) (best_typical n k' ds)
1209 Color _ _ _ x | not with_color -> best_typical n k (Cons i x ds)
1210 Color l t c x -> SSGR [SetColor l t c] (best n k mb_fc' mb_bc' mb_in mb_it mb_un (Cons i x ds_restore))
1212 mb_fc' = case l of { Background -> mb_fc; Foreground -> Just (t, c) }
1213 mb_bc' = case l of { Background -> Just (t, c); Foreground -> mb_bc }
1214 IfColor xt xf -> best_typical n k (if with_color then Cons i xt ds else Cons i xf ds)
1215 Intensify _ x | not with_color -> best_typical n k (Cons i x ds)
1216 Intensify t x -> SSGR [SetConsoleIntensity t] (best n k mb_fc mb_bc (Just t) mb_it mb_un (Cons i x ds_restore))
1217 Italicize _ x | not with_color -> best_typical n k (Cons i x ds)
1218 Italicize t x -> SSGR [SetItalicized t] (best n k mb_fc mb_bc mb_in (Just t) mb_un (Cons i x ds_restore))
1219 Underline _ x | not with_color -> best_typical n k (Cons i x ds)
1220 Underline u x -> SSGR [SetUnderlining u] (best n k mb_fc mb_bc mb_in mb_it (Just u) (Cons i x ds_restore))
1221 RestoreFormat _ _ _ _ _ | not with_color -> best_typical n k ds
1222 RestoreFormat mb_fc' mb_bc' mb_in' mb_it' mb_un' -> SSGR sgrs (best n k mb_fc' mb_bc' mb_in' mb_it' mb_un' ds)
1224 -- We need to be able to restore the entire SGR state, hence we carry around what we believe
1225 -- that state should be in all the arguments to this function. Note that in some cases we could
1226 -- avoid the Reset of the entire state, but not in general.
1227 sgrs = Reset : catMaybes [
1228 fmap (uncurry (SetColor Foreground)) mb_fc',
1229 fmap (uncurry (SetColor Background)) mb_bc',
1230 fmap SetConsoleIntensity mb_in',
1231 fmap SetItalicized mb_it',
1232 fmap SetUnderlining mb_un'
1235 best_typical n' k' ds' = best n' k' mb_fc mb_bc mb_in mb_it mb_un ds'
1236 ds_restore = Cons i (RestoreFormat mb_fc mb_bc mb_in mb_it mb_un) ds
1238 --nicest :: r = ribbon width, w = page width,
1239 -- n = indentation of current line, k = current column
1240 -- x and y, the (simple) documents to chose from.
1241 -- precondition: first lines of x are longer than the first lines of y.
1242 nicest n k x y | fits w64 (min n k) width_ x = x
1245 width_ = min (w64 - k) (r - k + n)
1247 -- @fits1@ does 1 line lookahead.
1248 fits1 :: Int64 -> Int64 -> Int64 -> SimpleDoc -> Bool
1249 fits1 _ _ w _x | w < 0 = False
1250 --fits1 _ _ w SFail = False
1251 fits1 _ _ _w SEmpty = True
1252 fits1 p m w (SChar _c x) = fits1 p m (w - 1) x
1253 fits1 p m w (SText l _s x) = fits1 p m (w - l) x
1254 fits1 _ _ _w (SLine _i _x) = True
1255 fits1 p m w (SSGR _ x) = fits1 p m w x
1257 -- @fitsR@ has a little more lookahead: assuming that nesting roughly
1258 -- corresponds to syntactic depth, @fitsR@ checks that not only the current line
1259 -- fits, but the entire syntactic structure being formatted at this level of
1260 -- indentation fits. If we were to remove the second case for @SLine@, we would
1261 -- check that not only the current structure fits, but also the rest of the
1262 -- document, which would be slightly more intelligent but would have exponential
1263 -- runtime (and is prohibitively expensive in practice).
1265 -- m = minimum nesting level to fit in
1266 -- w = the width in which to fit the first line
1267 fitsR :: Int64 -> Int64 -> Int64 -> SimpleDoc -> Bool
1268 fitsR _p _m w _x | w < 0 = False
1269 --fitsR p m w SFail = False
1270 fitsR _p _m _w SEmpty = True
1271 fitsR p m w (SChar _c x) = fitsR p m (w - 1) x
1272 fitsR p m w (SText l _s x) = fitsR p m (w - l) x
1273 fitsR p m _w (SLine i x) | m < i = fitsR p m (p - i) x
1275 fitsR p m w (SSGR _ x) = fitsR p m w x
1277 -----------------------------------------------------------
1278 -- renderCompact: renders documents without indentation
1279 -- fast and fewer characters output, good for machines
1280 -----------------------------------------------------------
1283 -- | @(renderCompact x)@ renders document @x@ without adding any
1284 -- indentation. Since no \'pretty\' printing is involved, this
1285 -- renderer is very fast. The resulting output contains fewer
1286 -- characters than a pretty printed version and can be used for
1287 -- output that is read by other programs.
1288 renderCompact :: Bool -> Doc -> SimpleDoc
1289 renderCompact with_color dc
1290 = scan 0 Nothing Nothing Nothing Nothing Nothing [dc]
1292 scan _ _mb_fc _mb_bc _mb_in _mb_it _mb_un [] = SEmpty
1293 scan k mb_fc mb_bc mb_in mb_it mb_un (d:ds)
1296 Char c -> let k' = k+1 in seq k' (SChar c (scan' k' ds))
1297 Text l s -> let k' = k+l in seq k' (SText l s (scan' k' ds))
1298 Line _ -> SLine 0 (scan' 0 ds)
1299 -- FlatAlt x _ -> scan' k (x:ds)
1300 Cat x y -> scan' k (x:y:ds)
1301 Nest _ x -> scan' k (x:ds)
1302 Union _ y -> scan' k (y:ds)
1303 Column f -> scan' k (f k:ds)
1304 -- Columns f -> scan' k (f Nothing:ds)
1305 Nesting f -> scan' k (f 0:ds)
1306 Spaces _ -> scan' k ds
1307 Color _ _ _ x | not with_color -> scan' k (x:ds)
1308 Color l t c x -> SSGR [SetColor l t c] (scan k mb_fc' mb_bc' mb_in mb_it mb_un (x:ds_restore))
1310 mb_fc' = case l of { Background -> mb_fc; Foreground -> Just (t, c) }
1311 mb_bc' = case l of { Background -> Just (t, c); Foreground -> mb_bc }
1312 IfColor x _ | not with_color -> scan' k (x:ds)
1313 IfColor _ x -> scan' k (x:ds)
1314 Intensify _ x | not with_color -> scan' k (x:ds)
1315 Intensify t x -> SSGR [SetConsoleIntensity t] (scan k mb_fc mb_bc (Just t) mb_it mb_un (x:ds_restore))
1316 Italicize _ x | not with_color -> scan' k (x:ds)
1317 Italicize t x -> SSGR [SetItalicized t] (scan k mb_fc mb_bc mb_in (Just t) mb_un (x:ds_restore))
1318 Underline _ x | not with_color -> scan' k (x:ds)
1319 Underline u x -> SSGR [SetUnderlining u] (scan k mb_fc mb_bc mb_in mb_it (Just u) (x:ds_restore))
1320 RestoreFormat _ _ _ _ _ | not with_color -> scan' k ds
1321 RestoreFormat mb_fc' mb_bc' mb_in' mb_it' mb_un' -> SSGR sgrs (scan k mb_fc' mb_bc' mb_in' mb_it' mb_un' ds)
1323 sgrs = Reset : catMaybes [
1324 fmap (uncurry (SetColor Foreground)) mb_fc',
1325 fmap (uncurry (SetColor Background)) mb_bc',
1326 fmap SetConsoleIntensity mb_in',
1327 fmap SetItalicized mb_it',
1328 fmap SetUnderlining mb_un'
1331 scan' k' ds' = scan k' mb_fc mb_bc mb_in mb_it mb_un ds'
1332 ds_restore = RestoreFormat mb_fc mb_bc mb_in mb_it mb_un:ds
1334 -- | @(renderOneLine x)@ renders document @x@ without adding any
1335 -- indentation or newlines.
1336 renderOneLine :: Bool -> Doc -> SimpleDoc
1337 renderOneLine with_color dc
1338 = scan 0 Nothing Nothing Nothing Nothing Nothing [dc]
1340 scan _ _mb_fc _mb_bc _mb_in _mb_it _mb_un [] = SEmpty
1341 scan k mb_fc mb_bc mb_in mb_it mb_un (d:ds)
1344 Char c -> let k' = k+1 in seq k' (SChar c (scan' k' ds))
1345 Text l s -> let k' = k+l in seq k' (SText l s (scan' k' ds))
1346 Line False -> let k' = k+1 in seq k' (SChar ' ' (scan' k' ds))
1347 Line _ -> scan' k ds
1348 Cat x y -> scan' k (x:y:ds)
1349 Nest _ x -> scan' k (x:ds)
1350 Union _ y -> scan' k (y:ds)
1351 Column f -> scan' k (f k:ds)
1352 Nesting f -> scan' k (f 0:ds)
1353 Spaces _ -> scan' k ds
1354 Color _ _ _ x | not with_color -> scan' k (x:ds)
1355 Color l t c x -> SSGR [SetColor l t c] (scan k mb_fc' mb_bc' mb_in mb_it mb_un (x:ds_restore))
1357 mb_fc' = case l of { Background -> mb_fc; Foreground -> Just (t, c) }
1358 mb_bc' = case l of { Background -> Just (t, c); Foreground -> mb_bc }
1359 IfColor x _ | with_color -> scan' k (x:ds)
1360 IfColor _ x -> scan' k (x:ds)
1361 Intensify _ x | with_color -> scan' k (x:ds)
1362 Intensify t x -> SSGR [SetConsoleIntensity t] (scan k mb_fc mb_bc (Just t) mb_it mb_un (x:ds_restore))
1363 Italicize _ x | with_color -> scan' k (x:ds)
1364 Italicize t x -> SSGR [SetItalicized t] (scan k mb_fc mb_bc mb_in (Just t) mb_un (x:ds_restore))
1365 Underline _ x | with_color -> scan' k (x:ds)
1366 Underline u x -> SSGR [SetUnderlining u] (scan k mb_fc mb_bc mb_in mb_it (Just u) (x:ds_restore))
1367 RestoreFormat _ _ _ _ _ | with_color -> scan' k ds
1368 RestoreFormat mb_fc' mb_bc' mb_in' mb_it' mb_un' -> SSGR sgrs (scan k mb_fc' mb_bc' mb_in' mb_it' mb_un' ds)
1370 sgrs = Reset : catMaybes [
1371 fmap (uncurry (SetColor Foreground)) mb_fc',
1372 fmap (uncurry (SetColor Background)) mb_bc',
1373 fmap SetConsoleIntensity mb_in',
1374 fmap SetItalicized mb_it',
1375 fmap SetUnderlining mb_un'
1378 scan' k' ds' = scan k' mb_fc mb_bc mb_in mb_it mb_un ds'
1379 ds_restore = RestoreFormat mb_fc mb_bc mb_in mb_it mb_un:ds
1381 -----------------------------------------------------------
1382 -- Displayers: displayS and displayIO
1383 -----------------------------------------------------------
1386 -- | @(displayB simpleDoc)@ takes the output @simpleDoc@ from a
1387 -- rendering function and transforms it to a 'Builder' type (for
1388 -- further manipulation before converting to a lazy 'Text').
1389 displayB :: SimpleDoc -> Builder
1390 displayB SEmpty = mempty
1391 displayB (SChar c x) = c `consB` displayB x
1392 displayB (SText _ s x) = s `mappend` displayB x
1393 displayB (SLine i x) = '\n' `consB` (indentation i `mappend` displayB x)
1394 displayB (SSGR s x) = B.fromLazyText (T.pack (setSGRCode s)) `mappend` displayB x
1396 consB :: Char -> Builder -> Builder
1397 c `consB` b = B.singleton c `mappend` b
1399 -- | @(displayT simpleDoc)@ takes the output @simpleDoc@ from a
1400 -- rendering function and transforms it to a lazy 'Text' value.
1402 -- > showWidth :: Int -> Doc -> Text
1403 -- > showWidth w x = displayT (renderPretty 0.4 w x)
1404 displayT :: SimpleDoc -> Text
1405 displayT = B.toLazyText . displayB
1407 -- | @(displayIO handle simpleDoc)@ writes @simpleDoc@ to the
1408 -- file handle @handle@. This function is used for example by
1411 -- > hPutDoc handle doc = displayIO handle (renderPretty 0.4 100 doc)
1412 displayIO :: Handle -> SimpleDoc -> IO ()
1413 displayIO handle simpleDoc
1416 display SEmpty = return ()
1417 display (SChar c x) = hPutChar handle c >> display x
1418 display (SText _ s x) = T.hPutStr handle (B.toLazyText s) >> display x
1419 display (SLine i x) = T.hPutStr handle newLine >> display x
1421 newLine = B.toLazyText $ '\n' `consB` indentation i
1422 display (SSGR s x) = hSetSGR handle s >> display x
1424 -----------------------------------------------------------
1425 -- default pretty printers: show, putDoc and hPutDoc
1426 -----------------------------------------------------------
1428 instance Show Doc where
1429 showsPrec d doc = showsPrec d (displayT $ renderPretty True 0.4 80 doc)
1430 show doc = T.unpack (displayT $ renderPretty True 0.4 80 doc)
1432 instance Show SimpleDoc where
1433 show simpleDoc = T.unpack (displayT simpleDoc)
1435 -- | The action @(putDoc doc)@ pretty prints document @doc@ to the
1436 -- standard output, with a page width of 100 characters and a ribbon
1437 -- width of 40 characters.
1440 -- > main = do{ putDoc (text "hello" <+> text "world") }
1442 -- Which would output
1447 putDoc :: Doc -> IO ()
1448 putDoc doc = hPutDoc stdout doc
1450 -- | @(hPutDoc handle doc)@ pretty prints document @doc@ to the file
1451 -- handle @handle@ with a page width of 100 characters and a ribbon
1452 -- width of 40 characters.
1454 -- > main = do handle <- 'openFile' "MyFile" 'WriteMode'
1455 -- > 'hPutDoc' handle ('vcat' ('map' 'text'
1456 -- > ['T.pack' "vertical", 'T.pack' "text"]))
1457 -- > 'hClose' handle
1458 hPutDoc :: Handle -> Doc -> IO ()
1459 hPutDoc handle doc = displayIO handle (renderPretty True 0.4 80 doc)
1461 -----------------------------------------------------------
1463 -- "indentation" used to insert tabs but tabs seem to cause
1464 -- more trouble than they solve :-)
1465 -----------------------------------------------------------
1466 spaces :: Int64 -> Builder
1469 | otherwise = B.fromLazyText $ T.replicate n (T.singleton ' ')
1471 spaced :: Int -> Doc
1472 spaced l = Spaces l'
1476 -- An alias for readability purposes
1477 indentation :: Int64 -> Builder
1478 indentation = spaces
1480 -- LocalWords: PPrint combinators Wadler Wadler's encloseSep