1 {-# LANGUAGE FlexibleInstances #-}
2 {-# LANGUAGE MultiParamTypeClasses #-}
3 -----------------------------------------------------------------------------
5 -- Module : Hcompta.Lib.Leijen
6 -- Copyright : Julien Moutinho <julm+hcompta@autogeree.net> (c) 2015,
7 -- Ivan Lazar Miljenovic <Ivan.Miljenovic@gmail.com> (c) 2010,
8 -- Daan Leijen (c) 2000, http://www.cs.uu.nl/~daan
11 -- Stability : provisional
12 -- Portability : portable
14 -- This module is a merge between /wl-pprint-text/ and /ansi-wl-pprint/ packages
15 -- to use 'Text' values rather than 'String's and ANSI formatting.
17 -- Pretty print module based on Philip Wadler's \"prettier printer\"
20 -- \"A prettier printer\"
21 -- <http://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf>
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.Lib.Leijen (
73 -- * Basic combinators
74 empty, char, text, strict_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, intercalate,
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,
143 import qualified Data.Foldable (Foldable(..))
144 import Data.Int (Int64)
145 import Data.Bool hiding (bool)
146 import Data.Functor (Functor(..))
147 import Data.Foldable (foldr1)
148 import Data.Maybe (Maybe(..), catMaybes)
149 import Data.Monoid (Monoid(..), (<>))
150 import Data.String (IsString (..))
151 import qualified Data.Text (Text)
152 import Data.Text.Lazy (Text)
153 import qualified Data.Text.Lazy as T
154 import Data.Text.Lazy.Builder (Builder)
155 import qualified Data.Text.Lazy.Builder as B
156 import qualified Data.Text.Lazy.IO as T
157 import Data.Tuple (uncurry)
158 import Prelude ( Eq(..), Show(..), (/=), zipWith, repeat, (.), Int
159 , Float, Double, Rational, Integer, id
160 , ($), (<), (>), (-), (<=), (>=), fromIntegral, min
161 , max, round, Num(..), seq, IO, Monad(..) )
162 import System.IO (Handle, hPutChar, stdout)
163 import System.Console.ANSI ( Color(..), ColorIntensity(..)
164 , ConsoleIntensity(..), ConsoleLayer(..)
165 , hSetSGR, setSGRCode, SGR(..), Underlining(..) )
166 {-# ANN module "HLint: ignore Eta reduce" #-}
169 infixr 5 </>,<//>,<$>,<$$>
173 -----------------------------------------------------------
174 -- list, tupled and semiBraces pretty print a list of
175 -- documents either horizontally or vertically aligned.
176 -----------------------------------------------------------
179 -- | The document @(list xs)@ comma separates the documents @xs@ and
180 -- encloses them in square brackets. The documents are rendered
181 -- horizontally if that fits the page. Otherwise they are aligned
182 -- vertically. All comma separators are put in front of the
185 list = encloseSep lbracket rbracket comma
187 -- | The document @(tupled xs)@ comma separates the documents @xs@ and
188 -- encloses them in parenthesis. The documents are rendered
189 -- horizontally if that fits the page. Otherwise they are aligned
190 -- vertically. All comma separators are put in front of the
192 tupled :: [Doc] -> Doc
193 tupled = encloseSep lparen rparen comma
195 -- | The document @(semiBraces xs)@ separates the documents @xs@ with
196 -- semi colons and encloses them in braces. The documents are
197 -- rendered horizontally if that fits the page. Otherwise they are
198 -- aligned vertically. All semi colons are put in front of the
200 semiBraces :: [Doc] -> Doc
201 semiBraces = encloseSep lbrace rbrace semi
203 -- | The document @(encloseSep l r sep xs)@ concatenates the documents
204 -- @xs@ separated by @sep@ and encloses the resulting document by
205 -- @l@ and @r@. The documents are rendered horizontally if that fits
206 -- the page. Otherwise they are aligned vertically. All separators
207 -- are put in front of the elements. For example, the combinator
208 -- 'list' can be defined with @encloseSep@:
210 -- > list xs = encloseSep lbracket rbracket comma xs
211 -- > test = text "list" <+> (list (map int [10,200,3000]))
213 -- Which is laid out with a page width of 20 as:
216 -- list [10,200,3000]
219 -- But when the page width is 15, it is laid out as:
226 encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc
227 encloseSep left right sp ds
230 [d] -> left <> d <> right
231 _ -> align (cat (zipWith (<>) (left : repeat sp) ds) <> right)
233 -----------------------------------------------------------
234 -- punctuate p [d1,d2,...,dn] => [d1 <> p,d2 <> p, ... ,dn]
235 -----------------------------------------------------------
238 -- | @(punctuate p xs)@ concatenates all documents in @xs@ with
239 -- document @p@ except for the last document.
241 -- > someText = map text ["words","in","a","tuple"]
242 -- > test = parens (align (cat (punctuate comma someText)))
244 -- This is laid out on a page width of 20 as:
247 -- (words,in,a,tuple)
250 -- But when the page width is 15, it is laid out as:
259 -- (If you want put the commas in front of their elements instead of
260 -- at the end, you should use 'tupled' or, in general, 'encloseSep'.)
261 punctuate :: Doc -> [Doc] -> [Doc]
263 punctuate _ [d] = [d]
264 punctuate p (d:ds) = (d <> p) : punctuate p ds
267 -----------------------------------------------------------
268 -- high-level combinators
269 -----------------------------------------------------------
272 -- | The document @(sep xs)@ concatenates all documents @xs@ either
273 -- horizontally with @(\<+\>)@, if it fits the page, or vertically
276 -- > sep xs = group (vsep xs)
280 -- | The document @(fillSep xs)@ concatenates documents @xs@
281 -- horizontally with @(\<+\>)@ as long as its fits the page, then
282 -- inserts a @line@ and continues doing that for all documents in
285 -- > fillSep xs = foldr (</>) empty xs
286 fillSep :: [Doc] -> Doc
289 -- | The document @(hsep xs)@ concatenates all documents @xs@
290 -- horizontally with @(\<+\>)@.
294 -- | The document @(vsep xs)@ concatenates all documents @xs@
295 -- vertically with @(\<$\>)@. If a 'group' undoes the line breaks
296 -- inserted by @vsep@, all documents are separated with a space.
298 -- > someText = map text (words ("text to lay out"))
300 -- > test = text "some" <+> vsep someText
302 -- This is laid out as:
311 -- The 'align' combinator can be used to align the documents under
312 -- their first element
314 -- > test = text "some" <+> align (vsep someText)
316 -- Which is printed as:
327 -- | The document @(cat xs)@ concatenates all documents @xs@ either
328 -- horizontally with @(\<\>)@, if it fits the page, or vertically
331 -- > cat xs = group (vcat xs)
335 -- | The document @(fillCat xs)@ concatenates documents @xs@
336 -- horizontally with @(\<\>)@ as long as its fits the page, then
337 -- inserts a @linebreak@ and continues doing that for all documents
340 -- > fillCat xs = foldr (<//>) empty xs
341 fillCat :: [Doc] -> Doc
342 fillCat = fold (<//>)
344 -- | The document @(hcat xs)@ concatenates all documents @xs@
345 -- horizontally with @(\<\>)@.
349 -- | The document @(vcat xs)@ concatenates all documents @xs@
350 -- vertically with @(\<$$\>)@. If a 'group' undoes the line breaks
351 -- inserted by @vcat@, all documents are directly concatenated.
355 fold :: (Doc -> Doc -> Doc) -> [Doc] -> Doc
357 fold f ds = foldr1 f ds
359 -- | The document @(x \<+\> y)@ concatenates document @x@ and @y@ with
360 -- a 'space' in between. (infixr 6)
361 (<+>) :: Doc -> Doc -> Doc
364 x <+> y = x <> space <> y
366 -- | The document @(x \<++\> y)@ concatenates document @x@ and @y@ with
367 -- a 'spacebreak' in between. (infixr 6)
368 (<++>) :: Doc -> Doc -> Doc
371 x <++> y = x <> spacebreak <> y
374 -- | The document @(x \<\/\> y)@ concatenates document @x@ and @y@
375 -- with a 'softline' in between. This effectively puts @x@ and @y@
376 -- either next to each other (with a @space@ in between) or
377 -- underneath each other. (infixr 5)
378 (</>) :: Doc -> Doc -> Doc
379 (</>) = splitWithBreak False
381 -- | The document @(x \<\/\/\> y)@ concatenates document @x@ and @y@
382 -- with a 'softbreak' in between. This effectively puts @x@ and @y@
383 -- either right next to each other or underneath each other. (infixr
385 (<//>) :: Doc -> Doc -> Doc
386 (<//>) = splitWithBreak True
388 splitWithBreak :: Bool -> Doc -> Doc -> Doc
389 splitWithBreak _ Empty b = b
390 splitWithBreak _ a Empty = a
391 splitWithBreak f a b = a <> group (Line f) <> b
393 -- | The document @(x \<$\> y)@ concatenates document @x@ and @y@ with
394 -- a 'line' in between. (infixr 5)
395 (<$>) :: Doc -> Doc -> Doc
396 (<$>) = splitWithLine False
398 -- | The document @(x \<$$\> y)@ concatenates document @x@ and @y@
399 -- with a 'linebreak' in between. (infixr 5)
400 (<$$>) :: Doc -> Doc -> Doc
401 (<$$>) = splitWithLine True
403 splitWithLine :: Bool -> Doc -> Doc -> Doc
404 splitWithLine _ Empty b = b
405 splitWithLine _ a Empty = a
406 splitWithLine f a b = a <> Line f <> b
408 -- | The document @softline@ behaves like 'space' if the resulting
409 -- output fits the page, otherwise it behaves like 'line'.
411 -- > softline = group line
413 softline = group line
415 -- | The document @softbreak@ behaves like 'empty' if the resulting
416 -- output fits the page, otherwise it behaves like 'line'.
418 -- > softbreak = group linebreak
420 softbreak = group linebreak
422 -- | The document @spacebreak@ behaves like 'space' when rendered normally
423 -- but like 'empty' when using 'renderCompact' or 'renderOneLine'.
425 spacebreak = Spaces 1
427 -- | Document @(squotes x)@ encloses document @x@ with single quotes
429 squotes :: Doc -> Doc
430 squotes = enclose squote squote
432 -- | Document @(dquotes x)@ encloses document @x@ with double quotes
434 dquotes :: Doc -> Doc
435 dquotes = enclose dquote dquote
437 -- | Document @(braces x)@ encloses document @x@ in braces, \"{\" and
440 braces = enclose lbrace rbrace
442 -- | Document @(parens x)@ encloses document @x@ in parenthesis, \"(\"
445 parens = enclose lparen rparen
447 -- | Document @(angles x)@ encloses document @x@ in angles, \"\<\" and
450 angles = enclose langle rangle
452 -- | Document @(brackets x)@ encloses document @x@ in square brackets,
454 brackets :: Doc -> Doc
455 brackets = enclose lbracket rbracket
457 -- | The document @(enclose l r x)@ encloses document @x@ between
458 -- documents @l@ and @r@ using @(\<\>)@.
460 -- > enclose l r x = l <> x <> r
461 enclose :: Doc -> Doc -> Doc -> Doc
462 enclose l r x = l <> x <> r
464 -- | The document @lparen@ contains a left parenthesis, \"(\".
468 -- | The document @rparen@ contains a right parenthesis, \")\".
472 -- | The document @langle@ contains a left angle, \"\<\".
476 -- | The document @rangle@ contains a right angle, \">\".
480 -- | The document @lbrace@ contains a left brace, \"{\".
484 -- | The document @rbrace@ contains a right brace, \"}\".
488 -- | The document @lbracket@ contains a left square bracket, \"[\".
492 -- | The document @rbracket@ contains a right square bracket, \"]\".
496 -- | The document @squote@ contains a single quote, \"'\".
500 -- | The document @dquote@ contains a double quote, '\"'.
504 -- | The document @semi@ contains a semi colon, \";\".
508 -- | The document @colon@ contains a colon, \":\".
512 -- | The document @comma@ contains a comma, \",\".
516 -- | The document @space@ contains a single space, \" \".
518 -- > x <+> y = x <> space <> y
522 -- | The document @dot@ contains a single dot, \".\".
526 -- | The document @backslash@ contains a back slash, \"\\\".
528 backslash = char '\\'
530 -- | The document @equals@ contains an equal sign, \"=\".
534 -----------------------------------------------------------
535 -- Combinators for prelude types
536 -----------------------------------------------------------
538 -- string is like "text" but replaces '\n' by "line"
540 -- | The document @(string s)@ concatenates all characters in @s@
541 -- using @line@ for newline characters and @char@ for all other
542 -- characters. It is used instead of 'text' whenever the text
543 -- contains newline characters.
544 string :: Text -> Doc
545 string str = case T.uncons str of
547 Just ('\n',str') -> line <> string str'
548 _ -> case (T.span (/='\n') str) of
549 (xs,ys) -> text xs <> string ys
551 -- | The document @(bool b)@ shows the literal boolean @b@ using
556 -- | The document @(int i)@ shows the literal integer @i@ using
561 -- | The document @(integer i)@ shows the literal integer @i@ using
563 integer :: Integer -> Doc
566 -- | The document @(float f)@ shows the literal float @f@ using
568 float :: Float -> Doc
571 -- | The document @(double d)@ shows the literal double @d@ using
573 double :: Double -> Doc
576 -- | The document @(rational r)@ shows the literal rational @r@ using
578 rational :: Rational -> Doc
581 text' :: (Show a) => a -> Doc
582 text' = text . T.pack . show
584 -----------------------------------------------------------
585 -- overloading "pretty"
586 -----------------------------------------------------------
588 -- | The member @prettyList@ is only used to define the @instance
589 -- Pretty a => Pretty [a]@. In normal circumstances only the
590 -- @pretty@ function is used.
594 prettyList :: [a] -> Doc
595 prettyList = list . fmap pretty
597 instance Pretty a => Pretty [a] where
600 instance Pretty Doc where
603 instance Pretty Text where
606 instance Pretty () where
609 instance Pretty Bool where
612 instance Pretty Char where
615 prettyList s = string $ T.pack s
617 instance Pretty Int where
620 instance Pretty Integer where
623 instance Pretty Float where
626 instance Pretty Double where
629 --instance Pretty Rational where
630 -- pretty r = rational r
632 instance (Pretty a,Pretty b) => Pretty (a,b) where
633 pretty (x,y) = tupled [pretty x, pretty y]
635 instance (Pretty a,Pretty b,Pretty c) => Pretty (a,b,c) where
636 pretty (x,y,z)= tupled [pretty x, pretty y, pretty z]
638 instance Pretty a => Pretty (Maybe a) where
639 pretty Nothing = empty
641 pretty (Just x) = pretty x
643 -----------------------------------------------------------
644 -- semi primitive: fill and fillBreak
645 -----------------------------------------------------------
647 -- | The document @(fillBreak i x)@ first renders document @x@. It
648 -- then appends @space@s until the width is equal to @i@. If the
649 -- width of @x@ is already larger than @i@, the nesting level is
650 -- increased by @i@ and a @line@ is appended. When we redefine
651 -- @ptype@ in the previous example to use @fillBreak@, we get a
652 -- useful variation of the previous output:
655 -- > = fillBreak 6 (text name) <+> text "::" <+> text tp
657 -- The output will now be:
661 -- nest :: Int -> Doc -> Doc
665 fillBreak :: Int -> Doc -> Doc
666 fillBreak f x = width x (\w ->
668 then nest f linebreak
673 -- | The document @(fill i x)@ renders document @x@. It then appends
674 -- @space@s until the width is equal to @i@. If the width of @x@ is
675 -- already larger, nothing is appended. This combinator is quite
676 -- useful in practice to output a list of bindings. The following
677 -- example demonstrates this.
679 -- > types = [("empty","Doc")
680 -- > ,("nest","Int -> Doc -> Doc")
681 -- > ,("linebreak","Doc")]
684 -- > = fill 6 (text name) <+> text "::" <+> text tp
686 -- > test = text "let" <+> align (vcat (map ptype types))
688 -- Which is laid out as:
692 -- nest :: Int -> Doc -> Doc
695 fill :: Int -> Doc -> Doc
696 fill f d = width d (\w ->
703 width :: Doc -> (Int -> Doc) -> Doc
704 width d f = column (\k1 -> d <> column (\k2 -> f (k2 - k1)))
706 -----------------------------------------------------------
707 -- semi primitive: Alignment and indentation
708 -----------------------------------------------------------
710 -- | The document @(indent i x)@ indents document @x@ with @i@ spaces.
712 -- > test = indent 4 (fillSep (map text
713 -- > (words "the indent combinator indents these words !")))
715 -- Which lays out with a page width of 20 as:
723 indent :: Int -> Doc -> Doc
724 indent _ Empty = Empty
725 indent i d = hang i (spaced i <> d)
727 -- | The hang combinator implements hanging indentation. The document
728 -- @(hang i x)@ renders document @x@ with a nesting level set to the
729 -- current column plus @i@. The following example uses hanging
730 -- indentation for some text:
732 -- > test = hang 4 (fillSep (map text
733 -- > (words "the hang combinator indents these words !")))
735 -- Which lays out on a page with a width of 20 characters as:
738 -- the hang combinator
743 -- The @hang@ combinator is implemented as:
745 -- > hang i x = align (nest i x)
746 hang :: Int -> Doc -> Doc
747 hang i d = align (nest i d)
749 -- | The document @(align x)@ renders document @x@ with the nesting
750 -- level set to the current column. It is used for example to
753 -- As an example, we will put a document right above another one,
754 -- regardless of the current nesting level:
756 -- > x $$ y = align (x <$> y)
758 -- > test = text "hi" <+> (text "nice" $$ text "world")
760 -- which will be laid out as:
767 align d = column (\k ->
768 nesting (\i -> nest (k - i) d)) --nesting might be negative :-)
770 -----------------------------------------------------------
772 -----------------------------------------------------------
774 -- | The abstract data type @Doc@ represents pretty documents.
776 -- @Doc@ is an instance of the 'Show' class. @(show doc)@ pretty
777 -- prints document @doc@ with a page width of 100 characters and a
778 -- ribbon width of 40 characters.
780 -- > show (text "hello" <$> text "world")
782 -- Which would return the string \"hello\\nworld\", i.e.
789 | Char Char -- invariant: char is not '\n'
790 | Text !Int64 Builder -- invariant: text doesn't contain '\n'
791 | Line !Bool -- True <=> when undone by group, do not insert a space
792 -- | FlatAlt Doc Doc -- Render the first doc, but when
793 -- flattened, render the second.
796 | Union Doc Doc -- invariant: first lines of first doc longer than the first lines of the second doc
797 | Column (Int64 -> Doc)
798 | Nesting (Int64 -> Doc)
800 | Color ConsoleLayer ColorIntensity -- Introduces coloring /around/ the embedded document
803 | Intensify ConsoleIntensity Doc
805 | Underline Underlining Doc
806 | RestoreFormat (Maybe (ColorIntensity, Color)) -- Only used during the rendered phase, to signal a SGR should be issued to restore the terminal formatting.
807 (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).
808 (Maybe ConsoleIntensity) -- Intensity to revert to.
809 (Maybe Bool) -- Italicization to revert to.
810 (Maybe Underlining) -- Underlining to revert to.
812 instance IsString Doc where
813 fromString = string . T.pack
815 -- | In particular, note that the document @(x '<>' y)@ concatenates
816 -- document @x@ and document @y@. It is an associative operation
817 -- having 'empty' as a left and right unit. (infixr 6)
818 instance Monoid Doc where
822 -- | The data type @SimpleDoc@ represents rendered documents and is
823 -- used by the display functions.
825 -- The @Int@ in @SText@ contains the length of the string. The @Int@
826 -- in @SLine@ contains the indentation for that line. The library
827 -- provides two default display functions 'displayS' and
828 -- 'displayIO'. You can provide your own display function by writing
829 -- a function from a @SimpleDoc@ to your own output format.
830 data SimpleDoc = SEmpty
831 | SChar Char SimpleDoc
832 | SText !Int64 Builder SimpleDoc
833 | SLine !Int64 SimpleDoc
834 | SSGR [SGR] SimpleDoc
836 -- | The empty document is, indeed, empty. Although @empty@ has no
837 -- content, it does have a \'height\' of 1 and behaves exactly like
838 -- @(text \"\")@ (and is therefore not a unit of @\<$\>@).
842 is_empty :: Doc -> Bool
843 is_empty doc = case doc of
847 if_color :: Doc -> Doc -> Doc
850 -- | The document @(char c)@ contains the literal character @c@. The
851 -- character shouldn't be a newline (@'\n'@), the function 'line'
852 -- should be used for line breaks.
857 -- | The document @(text s)@ contains the literal string @s@. The
858 -- string shouldn't contain any newline (@'\n'@) characters. If the
859 -- string contains newline characters, the function 'string' should
864 | otherwise = Text (T.length s) (B.fromLazyText s)
866 -- | The @line@ document advances to the next line and indents to the
867 -- current nesting level. Document @line@ behaves like @(text \"
868 -- \")@ if the line break is undone by 'group' or if rendered with
872 --line = FlatAlt Line space
874 -- | The @linebreak@ document advances to the next line and indents to
875 -- the current nesting level. Document @linebreak@ behaves like
876 -- 'empty' if the line break is undone by 'group'.
878 linebreak = Line True
879 --linebreak = FlatAlt Line empty
881 beside :: Doc -> Doc -> Doc
886 -- | The document @(nest i x)@ renders document @x@ with the current
887 -- indentation level increased by @i@ (See also 'hang', 'align' and
890 -- > nest 2 (text "hello" <$> text "world") <$> text "!"
899 nest :: Int -> Doc -> Doc
901 nest i x = Nest (fromIntegral i) x
903 -- | Specifies how to create the document based upon which column it is in.
904 column :: (Int -> Doc) -> Doc
905 column f = Column (f . fromIntegral)
907 -- | Specifies how to nest the document based upon which column it is
909 nesting :: (Int -> Doc) -> Doc
910 nesting f = Nesting (f . fromIntegral)
912 -- | The @group@ combinator is used to specify alternative
913 -- layouts. The document @(group x)@ undoes all line breaks in
914 -- document @x@. The resulting line is added to the current line if
915 -- that fits the page. Otherwise, the document @x@ is rendered
916 -- without any changes.
918 group x = Union (flatten x) x
920 flatten :: Doc -> Doc
921 flatten (Cat x y) = Cat (flatten x) (flatten y)
922 flatten (Nest i x) = Nest i (flatten x)
923 flatten (Line brk) = if brk then Empty else Text 1 (B.singleton ' ')
924 flatten (Union x _) = flatten x
925 flatten (Column f) = Column (flatten . f)
926 flatten (Nesting f) = Nesting (flatten . f)
927 flatten (Color l i c x) = Color l i c (flatten x)
928 flatten (IfColor t f) = IfColor (flatten t) (flatten f)
929 flatten (Intensify i x) = Intensify i (flatten x)
930 flatten (Italicize b x) = Italicize b (flatten x)
931 flatten (Underline u x) = Underline u (flatten x)
932 -- flatten (FlatAlt x y) = y
933 flatten other = other --Empty,Char,Text,RestoreFormat
936 -----------------------------------------------------------
938 -----------------------------------------------------------
940 -- | Displays a document with the black forecolor
942 -- | Displays a document with the red forecolor
944 -- | Displays a document with the green forecolor
946 -- | Displays a document with the yellow forecolor
948 -- | Displays a document with the blue forecolor
950 -- | Displays a document with the magenta forecolor
951 magenta :: Doc -> Doc
952 -- | Displays a document with the cyan forecolor
954 -- | Displays a document with the white forecolor
956 -- | Displays a document with the dull black forecolor
957 dullblack :: Doc -> Doc
958 -- | Displays a document with the dull red forecolor
959 dullred :: Doc -> Doc
960 -- | Displays a document with the dull green forecolor
961 dullgreen :: Doc -> Doc
962 -- | Displays a document with the dull yellow forecolor
963 dullyellow :: Doc -> Doc
964 -- | Displays a document with the dull blue forecolor
965 dullblue :: Doc -> Doc
966 -- | Displays a document with the dull magenta forecolor
967 dullmagenta :: Doc -> Doc
968 -- | Displays a document with the dull cyan forecolor
969 dullcyan :: Doc -> Doc
970 -- | Displays a document with the dull white forecolor
971 dullwhite :: Doc -> Doc
972 (black, dullblack) = colorFunctions Black
973 (red, dullred) = colorFunctions Red
974 (green, dullgreen) = colorFunctions Green
975 (yellow, dullyellow) = colorFunctions Yellow
976 (blue, dullblue) = colorFunctions Blue
977 (magenta, dullmagenta) = colorFunctions Magenta
978 (cyan, dullcyan) = colorFunctions Cyan
979 (white, dullwhite) = colorFunctions White
981 -- | Displays a document with a forecolor given in the first parameter
982 color :: Color -> Doc -> Doc
983 -- | Displays a document with a dull forecolor given in the first parameter
984 dullcolor :: Color -> Doc -> Doc
985 color = Color Foreground Vivid
986 dullcolor = Color Foreground Dull
988 colorFunctions :: Color -> (Doc -> Doc, Doc -> Doc)
989 colorFunctions what = (color what, dullcolor what)
991 -- | Displays a document with the black backcolor
992 onblack :: Doc -> Doc
993 -- | Displays a document with the red backcolor
995 -- | Displays a document with the green backcolor
996 ongreen :: Doc -> Doc
997 -- | Displays a document with the yellow backcolor
998 onyellow :: Doc -> Doc
999 -- | Displays a document with the blue backcolor
1000 onblue :: Doc -> Doc
1001 -- | Displays a document with the magenta backcolor
1002 onmagenta :: Doc -> Doc
1003 -- | Displays a document with the cyan backcolor
1004 oncyan :: Doc -> Doc
1005 -- | Displays a document with the white backcolor
1006 onwhite :: Doc -> Doc
1007 -- | Displays a document with the dull block backcolor
1008 ondullblack :: Doc -> Doc
1009 -- | Displays a document with the dull red backcolor
1010 ondullred :: Doc -> Doc
1011 -- | Displays a document with the dull green backcolor
1012 ondullgreen :: Doc -> Doc
1013 -- | Displays a document with the dull yellow backcolor
1014 ondullyellow :: Doc -> Doc
1015 -- | Displays a document with the dull blue backcolor
1016 ondullblue :: Doc -> Doc
1017 -- | Displays a document with the dull magenta backcolor
1018 ondullmagenta :: Doc -> Doc
1019 -- | Displays a document with the dull cyan backcolor
1020 ondullcyan :: Doc -> Doc
1021 -- | Displays a document with the dull white backcolor
1022 ondullwhite :: Doc -> Doc
1023 (onblack, ondullblack) = oncolorFunctions Black
1024 (onred, ondullred) = oncolorFunctions Red
1025 (ongreen, ondullgreen) = oncolorFunctions Green
1026 (onyellow, ondullyellow) = oncolorFunctions Yellow
1027 (onblue, ondullblue) = oncolorFunctions Blue
1028 (onmagenta, ondullmagenta) = oncolorFunctions Magenta
1029 (oncyan, ondullcyan) = oncolorFunctions Cyan
1030 (onwhite, ondullwhite) = oncolorFunctions White
1032 -- | Displays a document with a backcolor given in the first parameter
1033 oncolor :: Color -> Doc -> Doc
1034 -- | Displays a document with a dull backcolor given in the first parameter
1035 ondullcolor :: Color -> Doc -> Doc
1036 oncolor = Color Background Vivid
1037 ondullcolor = Color Background Dull
1039 oncolorFunctions :: Color -> (Doc -> Doc, Doc -> Doc)
1040 oncolorFunctions what = (oncolor what, ondullcolor what)
1043 -----------------------------------------------------------
1044 -- Console Intensity
1045 -----------------------------------------------------------
1047 -- | Displays a document in a heavier font weight
1049 bold = Intensify BoldIntensity
1051 -- | Displays a document in the normal font weight
1052 debold :: Doc -> Doc
1053 debold = Intensify NormalIntensity
1055 -- NB: I don't support FaintIntensity here because it is not widely supported by terminals.
1058 -----------------------------------------------------------
1060 -----------------------------------------------------------
1064 I'm in two minds about providing these functions, since italicization is so rarely implemented.
1065 It is especially bad because "italicization" may cause the meaning of colors to flip, which will
1066 look a bit weird, to say the least...
1069 -- | Displays a document in italics. This is not widely supported, and it's use is not recommended
1070 italicize :: Doc -> Doc
1071 italicize = Italicize True
1073 -- | Displays a document with no italics
1074 deitalicize :: Doc -> Doc
1075 deitalicize = Italicize False
1079 -----------------------------------------------------------
1081 -----------------------------------------------------------
1083 -- | Displays a document with underlining
1084 underline :: Doc -> Doc
1085 underline = Underline SingleUnderline
1087 -- | Displays a document with no underlining
1088 deunderline :: Doc -> Doc
1089 deunderline = Underline NoUnderline
1091 -- NB: I don't support DoubleUnderline here because it is not widely supported by terminals.
1093 -----------------------------------------------------------
1094 -- Removing formatting
1095 -----------------------------------------------------------
1097 -- | Removes all colorisation, emboldening and underlining from a document
1099 -- plain Fail = Fail
1101 plain c@(Char _) = c
1102 plain t@(Text _ _) = t
1103 plain l@(Line _) = l
1104 -- plain (FlatAlt x y) = FlatAlt (plain x) (plain y)
1105 plain (Cat x y) = Cat (plain x) (plain y)
1106 plain (Nest i x) = Nest i (plain x)
1107 plain (Union x y) = Union (plain x) (plain y)
1108 plain (Column f) = Column (plain . f)
1109 -- plain (Columns f) = Columns (plain . f)
1110 plain (Nesting f) = Nesting (plain . f)
1111 plain (Spaces l) = Spaces l
1112 plain (Color _ _ _ x) = plain x
1113 plain (Intensify _ x) = plain x
1114 plain (IfColor t f) = IfColor (plain t) (plain f)
1115 plain (Italicize _ x) = plain x
1116 plain (Underline _ x) = plain x
1117 plain (RestoreFormat{}) = Empty
1119 -----------------------------------------------------------
1121 -----------------------------------------------------------
1123 -----------------------------------------------------------
1124 -- renderPretty: the default pretty printing algorithm
1125 -----------------------------------------------------------
1127 -- list of indentation/document pairs; saves an indirection over [(Int,Doc)]
1129 | Cons !Int64 Doc Docs
1131 -- | This is the default pretty printer which is used by 'show',
1132 -- 'putDoc' and 'hPutDoc'. @(renderPretty ribbonfrac width x)@
1133 -- renders document @x@ with a page width of @width@ and a ribbon
1134 -- width of @(ribbonfrac * width)@ characters. The ribbon width is
1135 -- the maximal amount of non-indentation characters on a line. The
1136 -- parameter @ribbonfrac@ should be between @0.0@ and @1.0@. If it
1137 -- is lower or higher, the ribbon width will be 0 or @width@
1139 renderPretty :: Bool -> Float -> Int -> Doc -> SimpleDoc
1140 renderPretty = renderFits fits1
1142 -- | A slightly smarter rendering algorithm with more lookahead. It provides
1143 -- provide earlier breaking on deeply nested structures
1144 -- For example, consider this python-ish pseudocode:
1145 -- @fun(fun(fun(fun(fun([abcdefg, abcdefg])))))@
1146 -- If we put a softbreak (+ nesting 2) after each open parenthesis, and align
1147 -- the elements of the list to match the opening brackets, this will render with
1148 -- @renderPretty@ and a page width of 20 as:
1150 -- fun(fun(fun(fun(fun([
1156 -- Where the 20c. boundary has been marked with |.
1157 -- Because @renderPretty@ only uses one-line lookahead, it sees that the first
1158 -- line fits, and is stuck putting the second and third lines after the 20-c
1159 -- mark. In contrast, @renderSmart@ will continue to check that the potential
1160 -- document up to the end of the indentation level. Thus, it will format the
1174 -- Which fits within the 20c. boundary.
1175 renderSmart :: Bool -> Float -> Int -> Doc -> SimpleDoc
1176 renderSmart = renderFits fitsR
1178 renderFits :: (Int64 -> Int64 -> Int64 -> SimpleDoc -> Bool)
1179 -> Bool -> Float -> Int -> Doc -> SimpleDoc
1180 renderFits fits with_color rfrac w doc
1181 -- I used to do a @SSGR [Reset]@ here, but if you do that it will result
1182 -- in any rendered @Doc@ containing at least some ANSI control codes. This
1183 -- may be undesirable if you want to render to non-ANSI devices by simply
1184 -- not making use of the ANSI color combinators I provide.
1186 -- What I "really" want to do here is do an initial Reset iff there is some
1187 -- ANSI color within the Doc, but that's a bit fiddly. I'll fix it if someone
1189 = best 0 0 Nothing Nothing Nothing Nothing Nothing (Cons 0 doc Nil)
1191 -- r :: the ribbon width in characters
1192 r = max 0 (min w64 (round (fromIntegral w * rfrac)))
1194 w64 = fromIntegral w
1196 -- best :: n = indentation of current line
1197 -- k = current column
1198 -- (ie. (k >= n) && (k - n == count of inserted characters)
1199 best _n _k _mb_fc _mb_bc _mb_in _mb_it _mb_un Nil = SEmpty
1200 best n k mb_fc mb_bc mb_in mb_it mb_un (Cons i d ds)
1203 Empty -> best_typical n k ds
1204 Char c -> let k' = k+1 in seq k' (SChar c (best_typical n k' ds))
1205 Text l s -> let k' = k+l in seq k' (SText l s (best_typical n k' ds))
1206 Line _ -> SLine i (best_typical i i ds)
1207 -- FlatAlt x _ -> best_typical n k (Cons i x ds)
1208 Cat x y -> best_typical n k (Cons i x (Cons i y ds))
1209 Nest j x -> let i' = i+j in seq i' (best_typical n k (Cons i' x ds))
1210 Union x y -> nicest n k (best_typical n k (Cons i x ds))
1211 (best_typical n k (Cons i y ds))
1212 Column f -> best_typical n k (Cons i (f k) ds)
1213 -- Columns f -> best_typical n k (Cons i (f (Just w)) ds)
1214 Nesting f -> best_typical n k (Cons i (f i) ds)
1215 Spaces l -> let k' = k+l in seq k' $ SText l (spaces l) (best_typical n k' ds)
1216 Color _ _ _ x | not with_color -> best_typical n k (Cons i x ds)
1217 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))
1219 mb_fc' = case l of { Background -> mb_fc; Foreground -> Just (t, c) }
1220 mb_bc' = case l of { Background -> Just (t, c); Foreground -> mb_bc }
1221 IfColor xt xf -> best_typical n k (if with_color then Cons i xt ds else Cons i xf ds)
1222 Intensify _ x | not with_color -> best_typical n k (Cons i x ds)
1223 Intensify t x -> SSGR [SetConsoleIntensity t] (best n k mb_fc mb_bc (Just t) mb_it mb_un (Cons i x ds_restore))
1224 Italicize _ x | not with_color -> best_typical n k (Cons i x ds)
1225 Italicize t x -> SSGR [SetItalicized t] (best n k mb_fc mb_bc mb_in (Just t) mb_un (Cons i x ds_restore))
1226 Underline _ x | not with_color -> best_typical n k (Cons i x ds)
1227 Underline u x -> SSGR [SetUnderlining u] (best n k mb_fc mb_bc mb_in mb_it (Just u) (Cons i x ds_restore))
1228 RestoreFormat{} | not with_color -> best_typical n k ds
1229 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)
1231 -- We need to be able to restore the entire SGR state, hence we carry around what we believe
1232 -- that state should be in all the arguments to this function. Note that in some cases we could
1233 -- avoid the Reset of the entire state, but not in general.
1234 sgrs = Reset : catMaybes [
1235 fmap (uncurry (SetColor Foreground)) mb_fc',
1236 fmap (uncurry (SetColor Background)) mb_bc',
1237 fmap SetConsoleIntensity mb_in',
1238 fmap SetItalicized mb_it',
1239 fmap SetUnderlining mb_un'
1242 best_typical n' k' ds' = best n' k' mb_fc mb_bc mb_in mb_it mb_un ds'
1243 ds_restore = Cons i (RestoreFormat mb_fc mb_bc mb_in mb_it mb_un) ds
1245 --nicest :: r = ribbon width, w = page width,
1246 -- n = indentation of current line, k = current column
1247 -- x and y, the (simple) documents to chose from.
1248 -- precondition: first lines of x are longer than the first lines of y.
1249 nicest n k x y | fits w64 (min n k) width_ x = x
1252 width_ = min (w64 - k) (r - k + n)
1254 -- @fits1@ does 1 line lookahead.
1255 fits1 :: Int64 -> Int64 -> Int64 -> SimpleDoc -> Bool
1256 fits1 _ _ w _x | w < 0 = False
1257 --fits1 _ _ w SFail = False
1258 fits1 _ _ _w SEmpty = True
1259 fits1 p m w (SChar _c x) = fits1 p m (w - 1) x
1260 fits1 p m w (SText l _s x) = fits1 p m (w - l) x
1261 fits1 _ _ _w (SLine _i _x) = True
1262 fits1 p m w (SSGR _ x) = fits1 p m w x
1264 -- @fitsR@ has a little more lookahead: assuming that nesting roughly
1265 -- corresponds to syntactic depth, @fitsR@ checks that not only the current line
1266 -- fits, but the entire syntactic structure being formatted at this level of
1267 -- indentation fits. If we were to remove the second case for @SLine@, we would
1268 -- check that not only the current structure fits, but also the rest of the
1269 -- document, which would be slightly more intelligent but would have exponential
1270 -- runtime (and is prohibitively expensive in practice).
1272 -- m = minimum nesting level to fit in
1273 -- w = the width in which to fit the first line
1274 fitsR :: Int64 -> Int64 -> Int64 -> SimpleDoc -> Bool
1275 fitsR _p _m w _x | w < 0 = False
1276 --fitsR p m w SFail = False
1277 fitsR _p _m _w SEmpty = True
1278 fitsR p m w (SChar _c x) = fitsR p m (w - 1) x
1279 fitsR p m w (SText l _s x) = fitsR p m (w - l) x
1280 fitsR p m _w (SLine i x) | m < i = fitsR p m (p - i) x
1282 fitsR p m w (SSGR _ x) = fitsR p m w x
1284 -----------------------------------------------------------
1285 -- renderCompact: renders documents without indentation
1286 -- fast and fewer characters output, good for machines
1287 -----------------------------------------------------------
1290 -- | @(renderCompact x)@ renders document @x@ without adding any
1291 -- indentation. Since no \'pretty\' printing is involved, this
1292 -- renderer is very fast. The resulting output contains fewer
1293 -- characters than a pretty printed version and can be used for
1294 -- output that is read by other programs.
1295 renderCompact :: Bool -> Doc -> SimpleDoc
1296 renderCompact with_color dc
1297 = scan 0 Nothing Nothing Nothing Nothing Nothing [dc]
1299 scan _ _mb_fc _mb_bc _mb_in _mb_it _mb_un [] = SEmpty
1300 scan k mb_fc mb_bc mb_in mb_it mb_un (d:ds)
1303 Char c -> let k' = k+1 in seq k' (SChar c (scan' k' ds))
1304 Text l s -> let k' = k+l in seq k' (SText l s (scan' k' ds))
1305 Line _ -> SLine 0 (scan' 0 ds)
1306 -- FlatAlt x _ -> scan' k (x:ds)
1307 Cat x y -> scan' k (x:y:ds)
1308 Nest _ x -> scan' k (x:ds)
1309 Union _ y -> scan' k (y:ds)
1310 Column f -> scan' k (f k:ds)
1311 -- Columns f -> scan' k (f Nothing:ds)
1312 Nesting f -> scan' k (f 0:ds)
1313 Spaces _ -> scan' k ds
1314 Color _ _ _ x | not with_color -> scan' k (x:ds)
1315 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))
1317 mb_fc' = case l of { Background -> mb_fc; Foreground -> Just (t, c) }
1318 mb_bc' = case l of { Background -> Just (t, c); Foreground -> mb_bc }
1319 IfColor x _ | not with_color -> scan' k (x:ds)
1320 IfColor _ x -> scan' k (x:ds)
1321 Intensify _ x | not with_color -> scan' k (x:ds)
1322 Intensify t x -> SSGR [SetConsoleIntensity t] (scan k mb_fc mb_bc (Just t) mb_it mb_un (x:ds_restore))
1323 Italicize _ x | not with_color -> scan' k (x:ds)
1324 Italicize t x -> SSGR [SetItalicized t] (scan k mb_fc mb_bc mb_in (Just t) mb_un (x:ds_restore))
1325 Underline _ x | not with_color -> scan' k (x:ds)
1326 Underline u x -> SSGR [SetUnderlining u] (scan k mb_fc mb_bc mb_in mb_it (Just u) (x:ds_restore))
1327 RestoreFormat{} | not with_color -> scan' k ds
1328 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)
1330 sgrs = Reset : catMaybes [
1331 fmap (uncurry (SetColor Foreground)) mb_fc',
1332 fmap (uncurry (SetColor Background)) mb_bc',
1333 fmap SetConsoleIntensity mb_in',
1334 fmap SetItalicized mb_it',
1335 fmap SetUnderlining mb_un'
1338 scan' k' ds' = scan k' mb_fc mb_bc mb_in mb_it mb_un ds'
1339 ds_restore = RestoreFormat mb_fc mb_bc mb_in mb_it mb_un:ds
1341 -- | @(renderOneLine x)@ renders document @x@ without adding any
1342 -- indentation or newlines.
1343 renderOneLine :: Bool -> Doc -> SimpleDoc
1344 renderOneLine with_color dc
1345 = scan 0 Nothing Nothing Nothing Nothing Nothing [dc]
1347 scan _ _mb_fc _mb_bc _mb_in _mb_it _mb_un [] = SEmpty
1348 scan k mb_fc mb_bc mb_in mb_it mb_un (d:ds)
1351 Char c -> let k' = k+1 in seq k' (SChar c (scan' k' ds))
1352 Text l s -> let k' = k+l in seq k' (SText l s (scan' k' ds))
1353 Line False -> let k' = k+1 in seq k' (SChar ' ' (scan' k' ds))
1354 Line _ -> scan' k ds
1355 Cat x y -> scan' k (x:y:ds)
1356 Nest _ x -> scan' k (x:ds)
1357 Union _ y -> scan' k (y:ds)
1358 Column f -> scan' k (f k:ds)
1359 Nesting f -> scan' k (f 0:ds)
1360 Spaces _ -> scan' k ds
1361 Color _ _ _ x | not with_color -> scan' k (x:ds)
1362 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))
1364 mb_fc' = case l of { Background -> mb_fc; Foreground -> Just (t, c) }
1365 mb_bc' = case l of { Background -> Just (t, c); Foreground -> mb_bc }
1366 IfColor x _ | with_color -> scan' k (x:ds)
1367 IfColor _ x -> scan' k (x:ds)
1368 Intensify _ x | with_color -> scan' k (x:ds)
1369 Intensify t x -> SSGR [SetConsoleIntensity t] (scan k mb_fc mb_bc (Just t) mb_it mb_un (x:ds_restore))
1370 Italicize _ x | with_color -> scan' k (x:ds)
1371 Italicize t x -> SSGR [SetItalicized t] (scan k mb_fc mb_bc mb_in (Just t) mb_un (x:ds_restore))
1372 Underline _ x | with_color -> scan' k (x:ds)
1373 Underline u x -> SSGR [SetUnderlining u] (scan k mb_fc mb_bc mb_in mb_it (Just u) (x:ds_restore))
1374 RestoreFormat{} | with_color -> scan' k ds
1375 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)
1377 sgrs = Reset : catMaybes [
1378 fmap (uncurry (SetColor Foreground)) mb_fc',
1379 fmap (uncurry (SetColor Background)) mb_bc',
1380 fmap SetConsoleIntensity mb_in',
1381 fmap SetItalicized mb_it',
1382 fmap SetUnderlining mb_un'
1385 scan' k' ds' = scan k' mb_fc mb_bc mb_in mb_it mb_un ds'
1386 ds_restore = RestoreFormat mb_fc mb_bc mb_in mb_it mb_un:ds
1388 -----------------------------------------------------------
1389 -- Displayers: displayS and displayIO
1390 -----------------------------------------------------------
1393 -- | @(displayB simpleDoc)@ takes the output @simpleDoc@ from a
1394 -- rendering function and transforms it to a 'Builder' type (for
1395 -- further manipulation before converting to a lazy 'Text').
1396 displayB :: SimpleDoc -> Builder
1397 displayB SEmpty = mempty
1398 displayB (SChar c x) = c `consB` displayB x
1399 displayB (SText _ s x) = s `mappend` displayB x
1400 displayB (SLine i x) = '\n' `consB` (indentation i `mappend` displayB x)
1401 displayB (SSGR s x) = B.fromLazyText (T.pack (setSGRCode s)) `mappend` displayB x
1403 consB :: Char -> Builder -> Builder
1404 c `consB` b = B.singleton c `mappend` b
1406 -- | @(displayT simpleDoc)@ takes the output @simpleDoc@ from a
1407 -- rendering function and transforms it to a lazy 'Text' value.
1409 -- > showWidth :: Int -> Doc -> Text
1410 -- > showWidth w x = displayT (renderPretty 0.4 w x)
1411 displayT :: SimpleDoc -> Text
1412 displayT = B.toLazyText . displayB
1414 -- | @(displayIO handle simpleDoc)@ writes @simpleDoc@ to the
1415 -- file handle @handle@. This function is used for example by
1418 -- > hPutDoc handle doc = displayIO handle (renderPretty 0.4 100 doc)
1419 displayIO :: Handle -> SimpleDoc -> IO ()
1420 displayIO handle simpleDoc
1423 display SEmpty = return ()
1424 display (SChar c x) = hPutChar handle c >> display x
1425 display (SText _ s x) = T.hPutStr handle (B.toLazyText s) >> display x
1426 display (SLine i x) = T.hPutStr handle newLine >> display x
1428 newLine = B.toLazyText $ '\n' `consB` indentation i
1429 display (SSGR s x) = hSetSGR handle s >> display x
1431 -----------------------------------------------------------
1432 -- default pretty printers: show, putDoc and hPutDoc
1433 -----------------------------------------------------------
1435 instance Show Doc where
1436 showsPrec d doc = showsPrec d (displayT $ renderPretty True 0.4 80 doc)
1437 show doc = T.unpack (displayT $ renderPretty True 0.4 80 doc)
1439 instance Show SimpleDoc where
1440 show simpleDoc = T.unpack (displayT simpleDoc)
1442 -- | The action @(putDoc doc)@ pretty prints document @doc@ to the
1443 -- standard output, with a page width of 100 characters and a ribbon
1444 -- width of 40 characters.
1447 -- > main = do{ putDoc (text "hello" <+> text "world") }
1449 -- Which would output
1454 putDoc :: Doc -> IO ()
1455 putDoc doc = hPutDoc stdout doc
1457 -- | @(hPutDoc handle doc)@ pretty prints document @doc@ to the file
1458 -- handle @handle@ with a page width of 100 characters and a ribbon
1459 -- width of 40 characters.
1461 -- > main = do handle <- 'openFile' "MyFile" 'WriteMode'
1462 -- > 'hPutDoc' handle ('vcat' ('map' 'text'
1463 -- > ['T.pack' "vertical", 'T.pack' "text"]))
1464 -- > 'hClose' handle
1465 hPutDoc :: Handle -> Doc -> IO ()
1466 hPutDoc handle doc = displayIO handle (renderPretty True 0.4 80 doc)
1468 -----------------------------------------------------------
1470 -- "indentation" used to insert tabs but tabs seem to cause
1471 -- more trouble than they solve :-)
1472 -----------------------------------------------------------
1473 spaces :: Int64 -> Builder
1476 | otherwise = B.fromLazyText $ T.replicate n (T.singleton ' ')
1478 spaced :: Int -> Doc
1479 spaced l = Spaces l'
1483 -- An alias for readability purposes
1484 indentation :: Int64 -> Builder
1485 indentation = spaces
1487 -- | Return a 'Doc' from a strict 'Text'
1488 strict_text :: Data.Text.Text -> Doc
1489 strict_text = text . T.fromStrict
1491 -- | Return a 'Doc' concatenating converted values of a 'Foldable'
1492 -- separated by a given 'Doc'.
1494 :: Data.Foldable.Foldable t
1495 => Doc -> (a -> Doc) -> t a -> Doc
1496 intercalate separator f =
1498 (\doc x -> doc <> (if is_empty doc then empty else separator) <> f x)
1501 class ToDoc m a where
1502 toDoc :: m -> a -> Doc
1503 instance ToDoc m Doc where
1506 -- LocalWords: PPrint combinators Wadler Wadler's encloseSep