|
sourcecode:
|
--- @author Sebastian Fischer, Bjoern Peemoeller, Jan Tikovsky
--- @version October 2017
--- @category general
------------------------------------------------------------------------------
module Text.Pretty (
-- pretty printer and document type
Doc, pPrint, showWidth,
-- basic document combinators
empty, isEmpty, text, linesep, line, linebreak, group, softline, softbreak,
hardline,
-- alignment combinators
nest, hang, align, indent,
-- composition combinators
combine, (<>), (<+>), ($$), (<$+$>), (</>), (<$$>), (<//>), (<$!$>),
-- 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]
|