pretty-1.1.1.0: Pretty-printing library

Portabilityportable
Stabilitystable
MaintainerDavid Terei <dave.terei@gmail.com>
Safe HaskellSafe

Text.PrettyPrint.HughesPJ

Contents

Description

John Hughes's and Simon Peyton Jones's Pretty Printer Combinators

Based on The Design of a Pretty-printing Library in Advanced Functional Programming, Johan Jeuring and Erik Meijer (eds), LNCS 925 http://www.cs.chalmers.se/~rjmh/Papers/pretty.ps

Heavily modified by Simon Peyton Jones (December 1996).

Synopsis

The document type

data Doc Source

The abstract type of documents. A Doc represents a *set* of layouts. A Doc with no occurrences of Union or NoDoc represents just one layout.

Instances

data TextDetails Source

The TextDetails data type

A TextDetails represents a fragment of text that will be output at some point.

Constructors

Chr !Char

A single Char fragment

Str String

A whole String fragment

PStr String

Used to represent a Fast String fragment but now deprecated and identical to the Str constructor.

Constructing documents

Converting values into documents

char :: Char -> DocSource

A document of height and width 1, containing a literal character.

text :: String -> DocSource

A document of height 1 containing a literal string. text satisfies the following laws:

The side condition on the last law is necessary because text "" has height 1, while empty has no height.

ptext :: String -> DocSource

Same as text. Used to be used for Bytestrings.

sizedText :: Int -> String -> DocSource

Some text with any width. (text s = sizedText (length s) s)

zeroWidthText :: String -> DocSource

Some text, but without any width. Use for non-printing text such as a HTML or Latex tags

intSource

Arguments

:: Int 
-> Doc
int n = text (show n)

integerSource

Arguments

:: Integer 
-> Doc
integer n = text (show n)

floatSource

Arguments

:: Float 
-> Doc
float n = text (show n)

doubleSource

Arguments

:: Double 
-> Doc
double n = text (show n)

rationalSource

Arguments

:: Rational 
-> Doc
rational n = text (show n)

Simple derived documents

semiSource

Arguments

:: Doc

A ';' character

commaSource

Arguments

:: Doc

A ',' character

colonSource

Arguments

:: Doc

A : character

spaceSource

Arguments

:: Doc

A space character

equalsSource

Arguments

:: Doc

A '=' character

lparenSource

Arguments

:: Doc

A '(' character

rparenSource

Arguments

:: Doc

A ')' character

lbrackSource

Arguments

:: Doc

A '[' character

rbrackSource

Arguments

:: Doc

A ']' character

lbraceSource

Arguments

:: Doc

A '{' character

rbraceSource

Arguments

:: Doc

A '}' character

Wrapping documents in delimiters

parensSource

Arguments

:: Doc 
-> Doc

Wrap document in (...)

bracketsSource

Arguments

:: Doc 
-> Doc

Wrap document in [...]

bracesSource

Arguments

:: Doc 
-> Doc

Wrap document in {...}

quotesSource

Arguments

:: Doc 
-> Doc

Wrap document in '...'

doubleQuotesSource

Arguments

:: Doc 
-> Doc

Wrap document in "..."

Combining documents

empty :: DocSource

The empty document, with no height and no width. empty is the identity for <>, <+>, $$ and $+$, and anywhere in the argument list for sep, hcat, hsep, vcat, fcat etc.

(<>) :: Doc -> Doc -> DocSource

Beside. <> is associative, with identity empty.

(<+>) :: Doc -> Doc -> DocSource

Beside, separated by space, unless one of the arguments is empty. <+> is associative, with identity empty.

hcat :: [Doc] -> DocSource

List version of <>.

hsep :: [Doc] -> DocSource

List version of <+>.

($$) :: Doc -> Doc -> DocSource

Above, except that if the last line of the first argument stops at least one position before the first line of the second begins, these two lines are overlapped. For example:

    text "hi" $$ nest 5 (text "there")

lays out as

    hi   there

rather than

    hi
         there

$$ is associative, with identity empty, and also satisfies

  • (x $$ y) <> z = x $$ (y <> z), if y non-empty.

($+$) :: Doc -> Doc -> DocSource

Above, with no overlapping. $+$ is associative, with identity empty.

vcat :: [Doc] -> DocSource

List version of $$.

sep :: [Doc] -> DocSource

Either hsep or vcat.

cat :: [Doc] -> DocSource

Either hcat or vcat.

fsep :: [Doc] -> DocSource

"Paragraph fill" version of sep.

fcat :: [Doc] -> DocSource

"Paragraph fill" version of cat.

nest :: Int -> Doc -> DocSource

Nest (or indent) a document by a given number of positions (which may also be negative). nest satisfies the laws:

The side condition on the last law is needed because empty is a left identity for <>.

hang :: Doc -> Int -> Doc -> DocSource

hang d1 n d2 = sep [d1, nest n d2]

punctuate :: Doc -> [Doc] -> [Doc]Source

punctuate p [d1, ... dn] = [d1 <> p, d2 <> p, ... dn-1 <> p, dn]

Predicates on documents

isEmpty :: Doc -> BoolSource

Returns True if the document is empty

Utility functions for documents

first :: Doc -> Doc -> DocSource

first returns its first argument if it is non-empty, otherwise its second.

reduceDoc :: Doc -> RDoc aSource

Perform some simplification of a built up GDoc.

Rendering documents

Default rendering

render :: Doc -> StringSource

Render the Doc to a String using the default Style.

Rendering with a particular style

data Style Source

A rendering style.

Constructors

Style 

Fields

mode :: Mode

The rendering mode

lineLength :: Int

Length of line, in chars

ribbonsPerLine :: Float

Ratio of ribbon length to line length

style :: StyleSource

The default style (mode=PageMode, lineLength=100, ribbonsPerLine=1.5).

renderStyle :: Style -> Doc -> StringSource

Render the Doc to a String using the given Style.

data Mode Source

Rendering mode.

Constructors

PageMode

Normal

ZigZagMode

With zig-zag cuts

LeftMode

No indentation, infinitely long lines

OneLineMode

All on one line

General rendering

fullRenderSource

Arguments

:: Mode

Rendering mode

-> Int

Line length

-> Float

Ribbons per line

-> (TextDetails -> a -> a)

What to do with text

-> a

What to do at the end

-> Doc

The document

-> a

Result

The general rendering interface.