------------------------------------------------------------------------------ --- This library provides pretty printing combinators. --- The interface is that of --- [Daan Leijen's library](), (<+>), ($$), (<$+$>), (), (<$$>), (), (<$!$>), -- list combinators compose, hsep, vsep, vsepBlank, fillSep, sep, hcat, vcat, fillCat, cat, punctuate, encloseSep, encloseSepSpaced, hEncloseSep, fillEncloseSep, fillEncloseSepSpaced, list, listSpaced, set, setSpaced, tupled, tupledSpaced, semiBraces, semiBracesSpaced, -- bracketing combinators enclose, squotes, dquotes, bquotes, parens, parensIf, angles, braces, brackets, -- fillers fill, fillBreak, -- primitive type documents bool, char, string, int, float, -- character documents lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket, squote, dquote, semi, colon, comma, space, dot, backslash, equals, larrow, rarrow, doubleArrow, doubleColon, bar, at, tilde, -- formatting combinators bold, faint, blinkSlow, blinkRapid, italic, underline, crossout, inverse, -- colorisation combinators black, red, green, yellow, blue, magenta, cyan, white, bgBlack, bgRed, bgGreen, bgYellow, bgBlue, bgMagenta, bgCyan, bgWhite, -- Pretty class Pretty (..) ) where import Text.PrettyImpl infixl 5 $$, <$$>, , , <$!$>, <$+$> infixl 6 <>, <+> --- Standard printing with a column length of 80. pPrint :: Doc -> String pPrint = showWidth 80 --- The empty document --- @return an empty document empty :: Doc empty = Doc Empty --- Is the document empty? isEmpty :: Doc -> Bool isEmpty (Doc d) = isEmptyText (d EOD) where isEmptyText t = case t of Empty EOD -> True _ -> False --- The document `(text s)` contains the literal string `s`. --- The string shouldn't contain any newline ('\n') characters. --- If the string contains newline characters, --- the function `string` should be used. --- @param s - a string without newline (`'\n'`) characters --- @return a document which contains the literal string text :: String -> Doc text s = Doc (Text s) --- The document `(linesep s)` advances to the next line and indents --- to the current nesting level. Document `(linesep s)` --- behaves like `(text s)` if the line break is undone by `group`. --- @param s - a string --- @return a document which advances to the next line or behaves --- like `(text s)` linesep :: String -> Doc linesep = Doc . LineBreak . Just --- The document `hardline` advances to the next line and indents --- to the current nesting level. `hardline` cannot be undone by `group`. --- @return a document which advances to the next line hardline :: Doc hardline = Doc (LineBreak Nothing) --- The document `line` advances to the next line and indents to the current --- nesting level. Document `line` behaves like `(text " ")` if the line break --- is undone by `group`. --- @return a document which advances to the next line or behaves --- like `(text " ")` line :: Doc line = linesep " " --- The document `linebreak` advances to the next line and indents to --- the current nesting level. Document `linebreak` behaves like `(text "")` --- if the line break is undone by `group`. --- @return a document which advances to the next line or behaves like --- `(text "")` linebreak :: Doc linebreak = linesep "" --- The document `softline` behaves like `space` if the resulting output --- fits the page, otherwise it behaves like `line`. --- `softline = group line` --- @return a document which behaves like `space` or `line` softline :: Doc softline = group line --- The document `softbreak` behaves like `(text "")` if the resulting output --- fits the page, otherwise it behaves like `line`. --- `softbreak = group linebreak` --- @return a document which behaves like `(text "")` or `line` softbreak :: Doc softbreak = group linebreak --- The combinator `group` is used to specify alternative layouts. --- The document `(group x)` undoes all line breaks in document `x`. --- The resulting line is added to the current line if that fits the page. --- Otherwise, the document `x` is rendered without any changes. --- @param d - a document --- @return document d without line breaks if that fits the page. group :: Doc -> Doc group d = Doc (OpenGroup . deDoc d . CloseGroup) --- The document `(nest i d)` renders document `d` with the current --- indentation level increased by `i` (See also `hang`, --- `align` and `indent`). --- --- nest 2 (text "hello" $$ text "world") $$ text "!" --- --- outputs as: --- --- hello --- world --- ! --- --- @param i - an integer which increases the indentation level --- @param d - a document --- @return document d with an indentation level increased by i nest :: Int -> Doc -> Doc nest i d = Doc (OpenNest (Inc i) . deDoc d . CloseNest) --- The combinator `hang` implements hanging indentation. --- The document `(hang i d)` renders document `d` with a nesting level set --- to the current column plus `i`. The following example uses hanging --- indentation for some text: --- --- test = hang 4 --- (fillSep --- (map text --- (words "the hang combinator indents these words !"))) --- --- Which lays out on a page with a width of 20 characters as: --- --- the hang combinator --- indents these --- words ! --- --- The hang combinator is implemented as: --- --- hang i x = align (nest i x) --- --- @param i - an integer which increases the indentation level --- @param d - a document --- @return document d with an indentation level set to the current column plus i hang :: Int -> Doc -> Doc hang i x = align (nest i x) --- The document `(align d)` renders document `d with the nesting level --- set to the current column. It is used for example to implement `hang`. --- --- As an example, we will put a document right above another one, --- regardless of the current nesting level: --- --- x $$ y = align (x $$ y) --- test = text "hi" <+> (text "nice" $$ text "world") --- --- which will be layed out as: --- --- hi nice --- world --- --- @param d - a document --- @return document d with the nesting level set to the current column align :: Doc -> Doc align d = Doc (OpenNest Align . deDoc d . CloseNest) --- The document `(indent i d)` indents document `d` with `i` spaces. --- --- test = indent 4 (fillSep (map text --- (words "the indent combinator indents these words !"))) --- --- Which lays out with a page width of 20 as: --- --- the indent --- combinator --- indents these --- words ! --- --- @param i - an integer which increases the indentation level --- @param d - a document --- @return document d with an indentation level set to the current column --- plus i indent :: Int -> Doc -> Doc indent i d = hang i (spaces i <> d) --- The document `(combine c d1 d2)` combines document `d1` and `d2` with --- document `c` in between using `(<>)` with identity `empty`. --- Thus, the following equations hold. --- --- combine c d1 empty == d1 --- combine c empty d2 == d2 --- combine c d1 d2 == d1 <> c <> d2 if neither d1 nor d2 are empty --- --- @param c - the middle document --- @param d1 - the left document --- @param d2 - the right document --- @return concatenation of d1 and d2 with c in between unless one --- of the documents is empty combine :: Doc -> Doc -> Doc -> Doc combine c d1 d2 | isEmpty d1 = d2 | isEmpty d2 = d1 | otherwise = enclose d1 d2 c --- The document `(x <> y)` concatenates document `x` and document `y`. --- It is an associative operation having `empty` as a left and right unit. --- @param x - the first document --- @param y - the second document --- @return concatenation of x and y without seperator with identity empty (<>) :: Doc -> Doc -> Doc d1 <> d2 | isEmpty d1 = d2 | isEmpty d2 = d1 | otherwise = Doc (deDoc d1 . deDoc d2) --- The document `(x <+> y)` concatenates document `x` and `y` with a --- `space` in between with identity `empty`. --- @param x - the first document --- @param y - the second document --- @return concatenation of x and y with a space in between (<+>) :: Doc -> Doc -> Doc (<+>) = combine space --- The document `(x $$ y)` concatenates document x and y with a --- `line` in between with identity `empty`. --- @param x - the first document --- @param y - the second document --- @return concatenation of x and y with a line in between ($$) :: Doc -> Doc -> Doc ($$) = combine line --- The document `(x <$+$> y)` concatenates document `x` and `y` with a --- blank line in between with identity `empty`. --- @param x - the first document --- @param y - the second document --- @return concatenation of x and y with a blank line in between (<$+$>) :: Doc -> Doc -> Doc (<$+$>) = combine (line <> linebreak) --- The document `(x y)` concatenates document `x` and `y` with --- a `softline` in between with identity `empty`. --- This effectively puts `x` and `y` either next to each other --- (with a `space` in between) or underneath each other. --- @param x - the first document --- @param y - the second document --- @return concatenation of x and y with a softline in between () :: Doc -> Doc -> Doc () = combine softline --- The document `(x <$$> y)` concatenates document `x` and `y` with a --- `linebreak` in between with identity `empty`. --- @param x - the first document --- @param y - the second document --- @return concatenation of x and y with a linebreak in between (<$$>) :: Doc -> Doc -> Doc (<$$>) = combine linebreak --- The document `(x y)` concatenates document `x` and `y` with a --- `softbreak` in between with identity `empty`. --- This effectively puts `x` and `y` either right next to each other --- or underneath each other. --- @param x - the first document --- @param y - the second document --- @return concatenation of x and y with a softbreak in between () :: Doc -> Doc -> Doc () = combine softbreak --- The document `(x <$!$> y)` concatenates document `x` and `y` with a --- `hardline` in between with identity `empty`. --- This effectively puts `x` and `y` underneath each other. --- @param x - the first document --- @param y - the second document --- @return concatenation of x and y with a hardline in between (<$!$>) :: Doc -> Doc -> Doc (<$!$>) = combine hardline --- The document `(compose f xs)` concatenates all documents `xs` --- with function `f`. --- Function `f` should be like `(<+>)`, `($$)` and so on. --- @param f - a combiner function --- @param xs - a list of documents --- @return concatenation of documents compose :: (Doc -> Doc -> Doc) -> [Doc] -> Doc compose _ [] = empty compose op ds@(_:_) = foldr1 op ds -- no seperator at the end --- The document `(hsep xs)` concatenates all documents `xs` --- horizontally with `(<+>)`. --- @param xs - a list of documents --- @return horizontal concatenation of documents hsep :: [Doc] -> Doc hsep = compose (<+>) --- The document `(vsep xs)` concatenates all documents `xs` vertically with --- `($$)`. If a group undoes the line breaks inserted by `vsep`, --- all documents are separated with a `space`. --- --- someText = map text (words ("text to lay out")) --- test = text "some" <+> vsep someText --- --- This is layed out as: --- --- some text --- to --- lay --- out --- --- The `align` combinator can be used to align the documents --- under their first element: --- --- test = text "some" <+> align (vsep someText) --- --- This is printed as: --- --- some text --- to --- lay --- out --- --- @param xs - a list of documents --- @return vertical concatenation of documents vsep :: [Doc] -> Doc vsep = compose ($$) --- The document `vsep xs` concatenates all documents `xs` vertically with --- `(<$+$>)`. If a group undoes the line breaks inserted by `vsepBlank`, --- all documents are separated with a `space`. --- @param xs - a list of documents --- @return vertical concatenation of documents vsepBlank :: [Doc] -> Doc vsepBlank = compose (<$+$>) --- The document `(fillSep xs)` concatenates documents `xs` horizontally with --- `()` as long as its fits the page, than inserts a --- `line` and continues doing that for all documents in `xs`. --- `fillSep xs = foldr () empty xs` --- @param xs - a list of documents --- @return horizontal concatenation of documents fillSep :: [Doc] -> Doc fillSep = compose () --- The document `(sep xs)` concatenates all documents `xs` either horizontally --- with `(<+>)`, if it fits the page, or vertically --- with `($$)`. --- `sep xs = group (vsep xs)` --- @param xs - a list of documents --- @return horizontal concatenation of documents, if it fits the page, --- or vertical concatenation else sep :: [Doc] -> Doc sep = group . vsep --- The document `(hcat xs)` concatenates all documents `xs` horizontally --- with `(<>)`. --- @param xs - a list of documents --- @return horizontal concatenation of documents hcat :: [Doc] -> Doc hcat = compose (<>) --- The document `(vcat xs)` concatenates all documents `xs` vertically --- with `(<$$>)`. If a `group` undoes the line breaks inserted by `vcat`, --- all documents are directly concatenated. --- @param xs - a list of documents --- @return vertical concatenation of documents vcat :: [Doc] -> Doc vcat = compose (<$$>) --- The document `(fillCat xs)` concatenates documents `xs` horizontally --- with `()` as long as its fits the page, than inserts a `linebreak` --- and continues doing that for all documents in `xs`. --- `fillCat xs = foldr () empty xs` --- @param xs - a list of documents --- @return horizontal concatenation of documents fillCat :: [Doc] -> Doc fillCat = compose () --- The document `(cat xs)` concatenates all documents `xs` either horizontally --- with `(<>)`, if it fits the page, or vertically with --- `(<$$>)`. --- `cat xs = group (vcat xs)` --- @param xs - a list of documents --- @return horizontal concatenation of documents cat :: [Doc] -> Doc cat = group . vcat --- `(punctuate p xs)` concatenates all documents `xs` with document `p` except --- for the last document. --- --- someText = map text ["words","in","a","tuple"] --- test = parens (align (cat (punctuate comma someText))) --- --- This is layed out on a page width of 20 as: --- --- (words,in,a,tuple) --- --- But when the page width is 15, it is layed out as: --- --- (words, --- in, --- a, --- tuple) --- --- (If you want put the commas in front of their elements instead of at the --- end, you should use `tupled` or, in general, `encloseSep`.) --- @param p - a document as seperator --- @param xs - a list of documents --- @return concatenation of documents with p in between punctuate :: Doc -> [Doc] -> [Doc] punctuate d ds = go ds where go [] = [] go [x] = [x] go (x:xs@(_:_)) = (x <> d) : go xs --- The document `(encloseSep l r s xs)` concatenates the documents `xs` --- seperated by `s` and encloses the resulting document by `l` and `r`. --- The documents are rendered horizontally if that fits the page. Otherwise --- they are aligned vertically. All seperators are put in front of the --- elements. --- --- For example, the combinator `list` can be defined with `encloseSep`: --- --- list xs = encloseSep lbracket rbracket comma xs --- test = text "list" <+> (list (map int [10,200,3000])) --- --- Which is layed out with a page width of 20 as: --- --- list [10,200,3000] --- --- But when the page width is 15, it is layed out as: --- --- list [10 --- ,200 --- ,3000] --- --- @param l - left document --- @param r - right document --- @param s - a document as seperator --- @param xs - a list of documents --- @return concatenation of l, xs (with s in between) and r encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc encloseSep l r _ [] = l <> r encloseSep l r s (d:ds) = align (enclose l r (cat (d : map (s <>) ds))) --- The document `(encloseSepSpaced l r s xs)` concatenates the documents `xs` --- seperated by `s` and encloses the resulting document by `l` and `r`. --- In addition, after each occurrence of `s`, after `l`, and before `r`, --- a `space` is inserted. --- The documents are rendered horizontally if that fits the page. Otherwise --- they are aligned vertically. All seperators are put in front of the --- elements. --- --- @param l - left document --- @param r - right document --- @param s - a document as seperator --- @param xs - a list of documents --- @return concatenation of l, xs (with s in between) and r encloseSepSpaced :: Doc -> Doc -> Doc -> [Doc] -> Doc encloseSepSpaced l r s = encloseSep (l <> space) (space <> r) (s <> space) --- The document `(hEncloseSep l r s xs)` concatenates the documents `xs` --- seperated by `s` and encloses the resulting document by `l` and `r`. --- --- The documents are rendered horizontally. --- @param l - left document --- @param r - right document --- @param s - a document as seperator --- @param xs - a list of documents --- @return concatenation of l, xs (with s in between) and r hEncloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc hEncloseSep l r _ [] = l <> r hEncloseSep l r s (d:ds) = align (enclose l r (hcat (d : map (s <>) ds))) --- The document `(fillEncloseSep l r s xs)` concatenates the documents `xs` --- seperated by `s` and encloses the resulting document by `l` and `r`. --- --- The documents are rendered horizontally if that fits the page. --- Otherwise they are aligned vertically. --- All seperators are put in front of the elements. --- @param l - left document --- @param r - right document --- @param s - a document as seperator --- @param xs - a list of documents --- @return concatenation of l, xs (with s in between) and r fillEncloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc fillEncloseSep l r _ [] = l <> r fillEncloseSep l r s (d:ds) = align (enclose l r (fillCat (d : map (s <>) ds))) --- The document `(fillEncloseSepSpaced l r s xs)` concatenates the documents --- `xs` seperated by `s` and encloses the resulting document by `l` and `r`. --- In addition, after each occurrence of `s`, after `l`, and before `r`, --- a `space` is inserted. --- --- The documents are rendered horizontally if that fits the page. --- Otherwise, they are aligned vertically. --- All seperators are put in front of the elements. --- @param l - left document --- @param r - right document --- @param s - a document as seperator --- @param xs - a list of documents --- @return concatenation of l, xs (with s in between) and r fillEncloseSepSpaced :: Doc -> Doc -> Doc -> [Doc] -> Doc fillEncloseSepSpaced l r s = fillEncloseSep (l <> space) (space <> r) (s <> space) --- The document `(list xs)` comma seperates the documents `xs` and encloses --- them in square brackets. The documents are rendered horizontally if --- that fits the page. Otherwise they are aligned vertically. --- All comma seperators are put in front of the elements. --- @param xs - a list of documents --- @return comma seperated documents xs and enclosed in square brackets list :: [Doc] -> Doc list = encloseSep lbracket rbracket comma --- Spaced version of `list` listSpaced :: [Doc] -> Doc listSpaced = encloseSepSpaced lbracket rbracket comma --- The document `(set xs)` comma seperates the documents `xs` and encloses --- them in braces. The documents are rendered horizontally if --- that fits the page. Otherwise they are aligned vertically. --- All comma seperators are put in front of the elements. --- @param xs - a list of documents --- @return comma seperated documents xs and enclosed in braces set :: [Doc] -> Doc set = encloseSep lbrace rbrace comma --- Spaced version of `set` setSpaced :: [Doc] -> Doc setSpaced = encloseSepSpaced lbrace rbrace comma --- The document `(tupled xs)` comma seperates the documents `xs` and encloses --- them in parenthesis. The documents are rendered horizontally if that fits --- the page. Otherwise they are aligned vertically. --- All comma seperators are put in front of the elements. --- @param xs - a list of documents --- @return comma seperated documents xs and enclosed in parenthesis tupled :: [Doc] -> Doc tupled = encloseSep lparen rparen comma --- Spaced version of `tupled` tupledSpaced :: [Doc] -> Doc tupledSpaced = encloseSepSpaced lparen rparen comma --- The document `(semiBraces xs)` seperates the documents `xs` with semi colons --- and encloses them in braces. The documents are rendered horizontally --- if that fits the page. Otherwise they are aligned vertically. --- All semi colons are put in front of the elements. --- @param xs - a list of documents --- @return documents xs seperated with semi colons and enclosed in braces semiBraces :: [Doc] -> Doc semiBraces = encloseSep lbrace rbrace semi --- Spaced version of `semiBraces` semiBracesSpaced :: [Doc] -> Doc semiBracesSpaced = encloseSepSpaced lbrace rbrace semi --- The document `(enclose l r x)` encloses document `x` between --- documents `l` and `r` using `(<>)`. --- `enclose l r x = l <> x <> r` --- @param l - the left document --- @param r - the right document --- @param x - the middle document --- @return concatenation of l, x and r enclose :: Doc -> Doc -> Doc -> Doc enclose l r d = l <> d <> r --- Document `(squotes x)` encloses document `x` with single quotes `"'"`. --- @param x - a document --- @return document x enclosed by single quotes squotes :: Doc -> Doc squotes = enclose squote squote --- Document `(dquotes x)` encloses document `x` with double quotes. --- @param x - a document --- @return document x enclosed by double quotes dquotes :: Doc -> Doc dquotes = enclose dquote dquote --- Document `(bquotes x)` encloses document `x` with back quotes `"\`"`. --- @param x - a document --- @return document x enclosed by `\`` quotes bquotes :: Doc -> Doc bquotes = enclose bquote bquote --- Document `(parens x)` encloses document `x` in parenthesis, --- `"("` and `")"`. --- @param x - a document --- @return document x enclosed in parenthesis parens :: Doc -> Doc parens = enclose lparen rparen --- Document `(parensIf x)` encloses document `x` in parenthesis,`"("` and `")"`, --- iff the condition is true. --- @param x - a document --- @return document x enclosed in parenthesis iff the condition is true parensIf :: Bool -> Doc -> Doc parensIf b s = if b then parens s else s --- Document `(angles x)` encloses document `x` in angles, `"<"` and `">"`. --- @param x - a document --- @return document x enclosed in angles angles :: Doc -> Doc angles = enclose langle rangle --- Document `(braces x)` encloses document `x` in braces, `"{"` and `"}"`. --- @param x - a document --- @return document x enclosed in braces braces :: Doc -> Doc braces = enclose lbrace rbrace --- Document `(brackets x)` encloses document `x` in square brackets, --- `"["` and `"]"`. --- @param x - a document --- @return document x enclosed in square brackets brackets :: Doc -> Doc brackets = enclose lbracket rbracket --- The document `(bool b)` shows the boolean `b` using `text`. --- @param b - a boolean --- @return a document which contains the boolean b bool :: Bool -> Doc bool b = text (show b) --- The document `(char c)` contains the literal character `c`. --- The character should not be a newline (`\n`), --- the function `line` should be used for line breaks. --- @param c - a character (not `\n`) --- @return a document which contains the literal character c char :: Char -> Doc char c = text [c] --- The document `(string s)` concatenates all characters in `s` using --- `line` for newline characters and `char` for all other characters. --- It is used instead of `text` whenever the text contains newline characters. --- @param s - a string --- @return a document which contains the string s string :: String -> Doc string = hcat . map (\c -> if elem c ['\n','\r'] then line else char c) --- The document `(int i)` shows the literal integer `i` using `text`. --- @param i - an integer --- @return a document which contains the integer i int :: Int -> Doc int n = text (show n) --- The document `(float f)` shows the literal float `f` using `text`. --- @param f - a float --- @return a document which contains the float f float :: Float -> Doc float x = text (show x) --- The document `lparen` contains a left parenthesis, `"("`. --- @return a document which contains a left parenthesis lparen :: Doc lparen = char '(' --- The document `rparen` contains a right parenthesis, `")"`. --- @return a document which contains a right parenthesis rparen :: Doc rparen = char ')' --- The document `langle` contains a left angle, `"<"`. --- @return a document which contains a left angle langle :: Doc langle = char '<' --- The document `rangle` contains a right angle, `">"`. --- @return a document which contains a right angle rangle :: Doc rangle = char '>' --- The document `lbrace` contains a left brace, `"{"`. --- @return a document which contains a left brace lbrace :: Doc lbrace = char '{' --- The document `rbrace` contains a right brace, `"}"`. --- @return a document which contains a right brace rbrace :: Doc rbrace = char '}' --- The document `lbracket` contains a left square bracket, `"["`. --- @return a document which contains a left square bracket lbracket :: Doc lbracket = char '[' --- The document `rbracket` contains a right square bracket, `"]"`. --- @return a document which contains a right square bracket rbracket :: Doc rbracket = char ']' --- The document `squote` contains a single quote, `"'"`. --- @return a document which contains a single quote squote :: Doc squote = char '\'' --- The document `dquote` contains a double quote. --- @return a document which contains a double quote dquote :: Doc dquote = char '"' --- The document `dquote` contains a `'`'` quote. --- @return a document which contains a `'`'` quote bquote :: Doc bquote = char '`' --- The document `semi` contains a semi colon, `";"`. --- @return a document which contains a semi colon semi :: Doc semi = char ';' --- The document `colon` contains a colon, `":"`. --- @return a document which contains a colon colon :: Doc colon = char ':' --- The document `comma` contains a comma, `","`. --- @return a document which contains a comma comma :: Doc comma = char ',' --- The document `space` contains a single space, `" "`. --- --- x <+> y = x <> space <> y --- --- @return a document which contains a single space space :: Doc space = char ' ' --- The document `(spaces n)` contains `n` spaces, when `n` is greater than 0. --- Otherwise the document is empty. --- --- @return a document which contains n spaces or the empty document, --- if n <= 0 spaces :: Int -> Doc spaces n | n <= 0 = empty | otherwise = text $ replicate n ' ' --- The document `dot` contains a single dot, `"."`. --- @return a document which contains a single dot dot :: Doc dot = char '.' --- The document `backslash` contains a back slash, `"\\"`. --- @return a document which contains a back slash backslash :: Doc backslash = char '\\' --- The document `equals` contains an equal sign, `"="`. --- @return a document which contains an equal equals :: Doc equals = char '=' --- The document `larrow` contains a left arrow sign, `"<-"`. --- @return a document which contains a left arrow sign larrow :: Doc larrow = text "<-" --- The document `rarrow` contains a right arrow sign, `"->"`. --- @return a document which contains a right arrow sign rarrow :: Doc rarrow = text "->" --- The document `doubleArrow` contains an double arrow sign, `"=>"`. --- @return a document which contains an double arrow sign doubleArrow :: Doc doubleArrow = text "=>" --- The document `doubleColon` contains a double colon sign, `"::"`. --- @return a document which contains a double colon sign doubleColon :: Doc doubleColon = text "::" --- The document `bar` contains a vertical bar sign, `"|"`. --- @return a document which contains a vertical bar sign bar :: Doc bar = char '|' --- The document `at` contains an at sign, `"@"`. --- @return a document which contains an at sign at :: Doc at = char '@' --- The document `tilde` contains a tilde sign, `"~"`. --- @return a document which contains a tilde sign tilde :: Doc tilde = char '~' --- The document `(fill i d)` renders document `d`. It than appends --- `space`s until the width is equal to `i`. If the width of `d` is --- already larger, nothing is appended. This combinator is quite --- useful in practice to output a list of bindings. The following --- example demonstrates this. --- --- types = [("empty","Doc") --- ,("nest","Int -> Doc -> Doc") --- ,("linebreak","Doc")] --- --- ptype (name,tp) --- = fill 6 (text name) <+> text "::" <+> text tp --- --- test = text "let" <+> align (vcat (map ptype types)) --- --- Which is layed out as: --- --- let empty :: Doc --- nest :: Int -> Doc -> Doc --- linebreak :: Doc --- --- Note that `fill` is not guaranteed to be linear-time bounded since it has to --- compute the width of a document before pretty printing it fill :: Int -> Doc -> Doc fill i d = d <> fill' where w = width d fill' = if w >= i then empty else spaces (i - w) --- The document `(fillBreak i d)` first renders document `d`. It --- than appends `space`s until the width is equal to `i`. If the --- width of `d` is already larger than `i`, the nesting level is --- increased by `i` and a `line` is appended. When we redefine `ptype` --- in the previous example to use `fillBreak`, we get a useful --- variation of the previous output: --- --- ptype (name,tp) --- = fillBreak 6 (text name) <+> text "::" <+> text tp --- --- The output will now be: --- --- let empty :: Doc --- nest :: Int -> Doc -> Doc --- linebreak --- :: Doc --- --- Note that `fillBreak` is not guaranteed to be linear-time bounded since it --- has to compute the width of a document before pretty printing it fillBreak :: Int -> Doc -> Doc fillBreak i d = d <> fill' where w = width d fill' = if w >= i then nest i linebreak else spaces (i - w) --- Compute the width of a given document width :: Doc -> Int width (Doc d) = width' 0 (d EOD) where width' w EOD = w width' w (Empty ts) = width' w ts width' w (Text s ts) = width' (w + lengthVis s) ts width' w (LineBreak Nothing ts) = width' w ts width' w (LineBreak (Just s) ts) = width' (w + lengthVis s) ts width' w (OpenGroup ts) = width' w ts width' w (CloseGroup ts) = width' w ts width' w (OpenNest _ ts) = width' w ts width' w (CloseNest ts) = width' w ts width' w (OpenFormat _ ts) = width' w ts width' w (CloseFormat ts) = width' w ts -- ----------------------------------------------------------------------------- -- Formatting combinators -- ----------------------------------------------------------------------------- --- The document `(bold d)` displays document `d` with bold text --- @param d - a document --- @return document d displayed with bold text bold :: Doc -> Doc bold d = Doc (OpenFormat (SetIntensity Bold) . deDoc d . CloseFormat) --- The document `(faint d)` displays document `d` with faint text --- @param d - a document --- @return document d displayed with faint text faint :: Doc -> Doc faint d = Doc (OpenFormat (SetIntensity Faint) . deDoc d . CloseFormat) --- The document `(blinkSlow d)` displays document `d` with slowly blinking text --- (rarely supported) --- @param d - a document --- @return document d displayed with slowly blinking text blinkSlow :: Doc -> Doc blinkSlow d = Doc (OpenFormat (SetBlinkMode Slow) . deDoc d . CloseFormat) --- The document `(blinkRapid d)` displays document `d` with rapidly blinking --- text (rarely supported) --- @param d - a document --- @return document d displayed with rapidly blinking text blinkRapid :: Doc -> Doc blinkRapid d = Doc (OpenFormat (SetBlinkMode Rapid) . deDoc d . CloseFormat) --- The document `(italic d)` displays document `d` with italicized text --- (rarely supported) --- @param d - a document --- @return document d displayed with italicized text italic :: Doc -> Doc italic d = Doc (OpenFormat (SetItalicized True) . deDoc d . CloseFormat) --- The document `(underline d)` displays document `d` with underlined text --- @param d - a document --- @return document d displayed with underlined text underline :: Doc -> Doc underline d = Doc (OpenFormat (SetUnderlined True) . deDoc d . CloseFormat) --- The document `(crossout d)` displays document `d` with crossed out text --- @param d - a document --- @return document d displayed with crossed out text crossout :: Doc -> Doc crossout d = Doc (OpenFormat (SetCrossedout True) . deDoc d . CloseFormat) --- The document `(inverse d)` displays document `d` with inversed coloring, --- i.e. use text color of `d` as background color and background color of `d` --- as text color --- @param d - a document --- @return document d displayed with inversed coloring inverse :: Doc -> Doc inverse d = Doc (OpenFormat (InverseColoring True) . deDoc d . CloseFormat) -- ----------------------------------------------------------------------------- -- Colorisation combinators -- ----------------------------------------------------------------------------- -- foreground colors --- The document `(black d)` displays document `d` with black text color --- @param d - a document --- @return document d displayed with black text color black :: Doc -> Doc black d = Doc (OpenFormat (SetForeground Black) . deDoc d . CloseFormat) --- The document `(red d)` displays document `d` with red text color --- @param d - a document --- @return document d displayed with red text color red :: Doc -> Doc red d = Doc (OpenFormat (SetForeground Red) . deDoc d . CloseFormat) --- The document `(green d)` displays document `d` with green text color --- @param d - a document --- @return document d displayed with green text color green :: Doc -> Doc green d = Doc (OpenFormat (SetForeground Green) . deDoc d . CloseFormat) --- The document `(yellow d)` displays document `d` with yellow text color --- @param d - a document --- @return document d displayed with yellow text color yellow :: Doc -> Doc yellow d = Doc (OpenFormat (SetForeground Yellow) . deDoc d . CloseFormat) --- The document `(blue d)` displays document `d` with blue text color --- @param d - a document --- @return document d displayed with blue text color blue :: Doc -> Doc blue d = Doc (OpenFormat (SetForeground Blue) . deDoc d . CloseFormat) --- The document `(magenta d)` displays document `d` with magenta text color --- @param d - a document --- @return document d displayed with magenta text color magenta :: Doc -> Doc magenta d = Doc (OpenFormat (SetForeground Magenta) . deDoc d . CloseFormat) --- The document `(cyan d)` displays document `d` with cyan text color --- @param d - a document --- @return document d displayed with cyan text color cyan :: Doc -> Doc cyan d = Doc (OpenFormat (SetForeground Cyan) . deDoc d . CloseFormat) --- The document `(white d)` displays document `d` with white text color --- @param d - a document --- @return document d displayed with white text color white :: Doc -> Doc white d = Doc (OpenFormat (SetForeground White) . deDoc d . CloseFormat) -- background colors --- The document `(bgBlack d)` displays document `d` with black background color --- @param d - a document --- @return document d displayed with black background color bgBlack :: Doc -> Doc bgBlack d = Doc (OpenFormat (SetBackground Black) . deDoc d . CloseFormat) --- The document `(bgRed d)` displays document `d` with red background color --- @param d - a document --- @return document d displayed with red background color bgRed :: Doc -> Doc bgRed d = Doc (OpenFormat (SetBackground Red) . deDoc d . CloseFormat) --- The document `(bgGreen d)` displays document `d` with green background color --- @param d - a document --- @return document d displayed with green background color bgGreen :: Doc -> Doc bgGreen d = Doc (OpenFormat (SetBackground Green) . deDoc d . CloseFormat) --- The document `(bgYellow d)` displays document `d` with yellow background --- color --- @param d - a document --- @return document d displayed with yellow background color bgYellow :: Doc -> Doc bgYellow d = Doc (OpenFormat (SetBackground Yellow) . deDoc d . CloseFormat) --- The document `(bgBlue d)` displays document `d` with blue background color --- @param d - a document --- @return document d displayed with blue background color bgBlue :: Doc -> Doc bgBlue d = Doc (OpenFormat (SetBackground Blue) . deDoc d . CloseFormat) --- The document `(bgMagenta d)` displays document `d` with magenta background --- color --- @param d - a document --- @return document d displayed with magenta background color bgMagenta :: Doc -> Doc bgMagenta d = Doc (OpenFormat (SetBackground Magenta) . deDoc d . CloseFormat) --- The document `(bgCyan d)` displays document `d` with cyan background color --- @param d - a document --- @return document d displayed with cyan background color bgCyan :: Doc -> Doc bgCyan d = Doc (OpenFormat (SetBackground Cyan) . deDoc d . CloseFormat) --- The document `(bgWhite d)` displays document `d` with white background color --- @param d - a document --- @return document d displayed with white background color bgWhite :: Doc -> Doc bgWhite d = Doc (OpenFormat (SetBackground White) . deDoc d . CloseFormat) -------------------------------------------------------------------------------- -- Pretty type class and instances for basic types -------------------------------------------------------------------------------- class Pretty a where pretty :: a -> Doc prettyList :: [a] -> Doc prettyList = list . map pretty instance Pretty a => Pretty [a] where pretty = prettyList instance Pretty Doc where pretty = id instance Pretty () where pretty () = text "()" instance Pretty Bool where pretty = bool instance Pretty Char where pretty = char prettyList = string instance Pretty Int where pretty = int instance Pretty Float where pretty = float instance (Pretty a, Pretty b) => Pretty (a,b) where pretty (x,y) = tupled [pretty x, pretty y]