Module

Text.PrettyPrint.Leijen

This is port of https://github.com/ekmett/ansi-wl-pprint to ps without any ansi stuff as it's used by optparser, later we shuold use prettyprinter once this is fixed. Also see this

#list

list :: Array Doc -> Doc

The document @(list xs)@ comma separates 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 separators are put in front of the elements.

#tupled

tupled :: Array Doc -> Doc

The document @(tupled xs)@ comma separates 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 separators are put in front of the elements.

#semiBraces

semiBraces :: Array Doc -> Doc

The document @(semiBraces xs)@ separates the documents @xs@ with semicolons and encloses them in braces. The documents are rendered horizontally if that fits the page. Otherwise they are aligned vertically. All semicolons are put in front of the elements.

#encloseSep

encloseSep :: Doc -> Doc -> Doc -> Array Doc -> Doc

The document @(encloseSep l r sep xs)@ concatenates the documents @xs@ separated by @sep@ 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 separators 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] @

#punctuate

punctuate :: Doc -> Array Doc -> Array Doc

@(punctuate p xs)@ concatenates all documents in @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'.)

#sep

sep :: Array Doc -> Doc

The document @(sep xs)@ concatenates all documents @xs@ either horizontally with @(<+>)@, if it fits the page, or vertically with @(<$>)@.

sep xs = group (vsep xs)

#foldr1

foldr1 :: forall a. Monoid a => (a -> a -> a) -> Array a -> a

#fillSep

fillSep :: Array Doc -> Doc

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

#hsep

hsep :: Array Doc -> Doc

The document @(hsep xs)@ concatenates all documents @xs@ horizontally with @(<+>)@.

#vsep

vsep :: Array Doc -> Doc

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)

Which is printed as:

@ some text to lay out @

#cat

cat :: Array Doc -> Doc

The document @(cat xs)@ concatenates all documents @xs@ either horizontally with @(<>)@, if it fits the page, or vertically with @(<$$>)@.

cat xs = group (vcat xs)

#fillCat

fillCat :: Array Doc -> Doc

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 = foldr1 (<//>) empty

#hcat

hcat :: Array Doc -> Doc

The document @(hcat xs)@ concatenates all documents @xs@ horizontally with @(<>)@.

#vcat

vcat :: Array Doc -> Doc

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.

#appendWithSpace

appendWithSpace :: Doc -> Doc -> Doc

The document @(x <+> y)@ concatenates document @x@ and @y@ with a @space@ in between. (infixr 6)

#(<+>)

Operator alias for Text.PrettyPrint.Leijen.appendWithSpace (right-associative / precedence 6)

#appendWithSoftline

appendWithSoftline :: Doc -> Doc -> Doc

The document @(x </> y)@ concatenates document @x@ and @y@ with a 'softline' in between. This effectively puts @x@ and @y@ either next to each other (with a @space@ in between) or underneath each other. (infixr 5)

#(</>)

Operator alias for Text.PrettyPrint.Leijen.appendWithSoftline (right-associative / precedence 5)

#appendWithSoftbreak

appendWithSoftbreak :: Doc -> Doc -> Doc

The document @(x <//> y)@ concatenates document @x@ and @y@ with a 'softbreak' in between. This effectively puts @x@ and @y@ either right next to each other or underneath each other. (infixr 5)

#(<//>)

Operator alias for Text.PrettyPrint.Leijen.appendWithSoftbreak (right-associative / precedence 5)

#appendWithLine

appendWithLine :: Doc -> Doc -> Doc

The document @(x <$> y)@ concatenates document @x@ and @y@ with a 'line' in between. (infixr 5)

#(<$>)

Operator alias for Text.PrettyPrint.Leijen.appendWithLine (right-associative / precedence 5)

#appendWithLinebreak

appendWithLinebreak :: Doc -> Doc -> Doc

The document @(x <$$> y)@ concatenates document @x@ and @y@ with a @linebreak@ in between. (infixr 5)

#(<$$>)

Operator alias for Text.PrettyPrint.Leijen.appendWithLinebreak (right-associative / precedence 5)

#softline

softline :: Doc

The document @softline@ behaves like 'space' if the resulting output fits the page, otherwise it behaves like 'line'.

softline = group line

#softbreak

softbreak :: Doc

The document @softbreak@ behaves like 'empty' if the resulting output fits the page, otherwise it behaves like 'line'.

softbreak = group linebreak

#squotes

squotes :: Doc -> Doc

Document @(squotes x)@ encloses document @x@ with single quotes "'".

#dquotes

dquotes :: Doc -> Doc

Document @(dquotes x)@ encloses document @x@ with double quotes '"'.

#braces

braces :: Doc -> Doc

Document @(braces x)@ encloses document @x@ in braces, "{" and "}".

#parens

parens :: Doc -> Doc

Document @(parens x)@ encloses document @x@ in parenthesis, "(" and ")".

#angles

angles :: Doc -> Doc

Document @(angles x)@ encloses document @x@ in angles, "<" and ">".

#brackets

brackets :: Doc -> Doc

Document @(brackets x)@ encloses document @x@ in square brackets, "[" and "]".

#enclose

enclose :: Doc -> Doc -> Doc -> Doc

The document @(enclose l r x)@ encloses document @x@ between documents @l@ and @r@ using @(<>)@.

enclose l r x = l <> x <> r

#lparen

lparen :: Doc

The document @lparen@ contains a left parenthesis, "(".

#rparen

rparen :: Doc

The document @rparen@ contains a right parenthesis, ")".

#langle

langle :: Doc

The document @langle@ contains a left angle, "<".

#rangle

rangle :: Doc

The document @rangle@ contains a right angle, ">".

#lbrace

lbrace :: Doc

The document @lbrace@ contains a left brace, "{".

#rbrace

rbrace :: Doc

The document @rbrace@ contains a right brace, "}".

#lbracket

lbracket :: Doc

The document @lbracket@ contains a left square bracket, "[".

#rbracket

rbracket :: Doc

The document @rbracket@ contains a right square bracket, "]".

#squote

squote :: Doc

The document @squote@ contains a single quote, "'".

#dquote

dquote :: Doc

The document @dquote@ contains a double quote, '"'.

#semi

semi :: Doc

The document @semi@ contains a semicolon, ";".

#colon

colon :: Doc

The document @colon@ contains a colon, ":".

#comma

comma :: Doc

The document @comma@ contains a comma, ",".

#space

space :: Doc

The document @space@ contains a single space, " ".

x <+> y = x <> space <> y

#dot

dot :: Doc

The document @dot@ contains a single dot, ".".

#backslash

backslash :: Doc

The document @backslash@ contains a back slash, "\".

#equals

equals :: Doc

The document @equals@ contains an equal sign, "=".

#string

string :: String -> Doc

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.

#bool

bool :: Boolean -> Doc

The document @(bool b)@ shows the literal bool @b@ using 'text'.

#int

int :: Int -> Doc

The document @(int i)@ shows the literal integer @i@ using 'text'.

#number

number :: Number -> Doc

The document @(number f)@ shows the literal number @f@ using 'text'.

#fillBreak

fillBreak :: Int -> Doc -> Doc

The document @(fillBreak i x)@ first renders document @x@. It than appends @space@s until the width is equal to @i@. If the width of @x@ 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 @

#fill

fill :: Int -> Doc -> Doc

The document @(fill i x)@ renders document @x@. It than appends @space@s until the width is equal to @i@. If the width of @x@ 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 @

#width

width :: Doc -> (Int -> Doc) -> Doc

#indent

indent :: Int -> Doc -> Doc

The document @(indent i x)@ indents document @x@ 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 ! @

#hang

hang :: Int -> Doc -> Doc

The hang combinator implements hanging indentation. The document @(hang i x)@ renders document @x@ 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)

#align

align :: Doc -> Doc

The document @(align x)@ renders document @x@ 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 @

#Doc

data Doc

The abstract data type @Doc@ represents pretty documents.

More specifically, a value of type @Doc@ represents a non-empty set of possible renderings of a document. The rendering functions select one of these possibilities.

@Doc@ is an instance of the 'Show' class. @(show doc)@ pretty prints document @doc@ with a page width of 80 characters and a ribbon width of 32 characters.

show (text "hello" <$> text "world")

Which would return the string "hello\nworld", i.e.

@ hello world @

Constructors

Instances

#SimpleDoc

data SimpleDoc

The data type @SimpleDoc@ represents rendered documents and is used by the display functions.

Whereas values of the data type 'Doc' represent non-empty sets of possible renderings of a document, values of the data type @SimpleDoc@ represent single renderings of a document.

The @Int@ in @SText@ contains the length of the string. The @Int@ in @SLine@ contains the indentation for that line. The library provides two default display functions 'displayS' and 'displayIO'. You can provide your own display function by writing a function from a @SimpleDoc@ to your own output format.

Constructors

Instances

#empty

empty :: Doc

The empty document is, indeed, empty. Although @empty@ has no content, it does have a 'height' of 1 and behaves exactly like @(text "")@ (and is therefore not a unit of @<$>@).

#char

char :: Char -> Doc

The document @(char c)@ contains the literal character @c@. The character shouldn't be a newline (@'\n'@), the function 'line' should be used for line breaks.

#text

text :: String -> Doc

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.

#line

line :: Doc

The @line@ document 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'.

#linebreak

linebreak :: Doc

The @linebreak@ document advances to the next line and indents to the current nesting level. Document @linebreak@ behaves like 'empty' if the line break is undone by 'group'.

#hardline

hardline :: Doc

A linebreak that will never be flattened; it is guaranteed to render as a newline.

#beside

beside :: Doc -> Doc -> Doc

#nest

nest :: Int -> Doc -> Doc

The document @(nest i x)@ renders document @x@ 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 ! @

#column

column :: (Int -> Doc) -> Doc

#nesting

nesting :: (Int -> Doc) -> Doc

#columns

columns :: (Maybe Int -> Doc) -> Doc

#group

group :: Doc -> Doc

The @group@ combinator 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.

#flatAlt

flatAlt :: Doc -> Doc -> Doc

A document that is normally rendered as the first argument, but when flattened, is rendered as the second document.

#flatten

#Docs

data Docs

list of indentation/document pairs; saves an indirection over [(Int,Doc)]

Constructors

#renderPretty

renderPretty :: Number -> Int -> Doc -> SimpleDoc

This is the default pretty printer which is used by 'show', 'putDoc' and 'hPutDoc'. @(renderPretty ribbonfrac width x)@ renders document @x@ with a page width of @width@ and a ribbon width of @(ribbonfrac * width)@ characters. The ribbon width is the maximal amount of non-indentation characters on a line. The parameter @ribbonfrac@ should be between @0.0@ and @1.0@. If it is lower or higher, the ribbon width will be 0 or @width@ respectively.

#renderSmart

renderSmart :: Number -> Int -> Doc -> SimpleDoc

A slightly smarter rendering algorithm with more lookahead. It provides provide earlier breaking on deeply nested structures For example, consider this python-ish pseudocode: @fun(fun(fun(fun(fun([abcdefg, abcdefg])))))@ If we put a softbreak (+ nesting 2) after each open parenthesis, and align the elements of the list to match the opening brackets, this will render with @renderPretty@ and a page width of 20 as: @ fun(fun(fun(fun(fun([ | abcdef, | abcdef, ] ))))) | @ Where the 20c. boundary has been marked with |. Because @renderPretty@ only uses one-line lookahead, it sees that the first line fits, and is stuck putting the second and third lines after the 20-c mark. In contrast, @renderSmart@ will continue to check that the potential document up to the end of the indentation level. Thus, it will format the document as:

@ fun( | fun( | fun( | fun( | fun([ | abcdef, abcdef, ] | ))))) | @ Which fits within the 20c. boundary.

#renderFits

#fits1

fits1 :: Int -> Int -> Int -> LazySimpleDoc -> Boolean

@fits1@ does 1 line lookahead.

#fitsR

fitsR :: Int -> Int -> Int -> LazySimpleDoc -> Boolean

@fitsR@ has a little more lookahead: assuming that nesting roughly corresponds to syntactic depth, @fitsR@ checks that not only the current line fits, but the entire syntactic structure being formatted at this level of indentation fits. If we were to remove the second case for @SLine@, we would check that not only the current structure fits, but also the rest of the document, which would be slightly more intelligent but would have exponential runtime (and is prohibitively expensive in practice). p = pagewidth m = minimum nesting level to fit in w = the width in which to fit the first line

#renderCompact

renderCompact :: Doc -> SimpleDoc

@(renderCompact x)@ renders document @x@ without adding any indentation. Since no 'pretty' printing is involved, this renderer is very fast. The resulting output contains fewer characters than a pretty printed version and can be used for output that is read by other programs.

This rendering function does not add any colorisation information.

#displayS

displayS :: SimpleDoc -> String

@(displayS simpleDoc)@ takes the output @simpleDoc@ from a rendering function and transforms it to a 'ShowS' type (for use in the 'Show' class).

showWidth :: Int -> Doc -> String showWidth w x = displayS (renderPretty 0.4 w x) ""

ANSI color information will be discarded by this function unless you are running on a Unix-like operating system. This is due to a technical limitation in Windows ANSI support.

#spaces

#indentation

Modules