mainland-pretty-0.1.1.0: Pretty printing designed for printing source code.

Portabilityportable
Stabilityprovisional
Maintainermainland@eecs.harvard.edu
Safe HaskellNone

Text.PrettyPrint.Mainland

Contents

Description

This module is based on A Prettier Printer by Phil Wadler in /The Fun of Programming/, Jeremy Gibbons and Oege de Moor (eds) http://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf

At the time it was originally written I didn't know about Daan Leijen's pretty printing module based on the same paper. I have since incorporated many of his improvements. This module is geared towards pretty printing source code; its main advantages over other libraries are a Pretty class that handles precedence and the ability to automatically track the source locations associated with pretty printed values and output appropriate #line pragmas.

Synopsis

The document type

data Doc Source

Instances

Basic combinators

empty :: DocSource

The empty document.

text :: String -> DocSource

The document text s consists of the string s, which should not contain any newlines. For a string that may include newlines, use string.

char :: Char -> DocSource

The document char c consists the single character c.

string :: String -> DocSource

The document string s consists of all the characters in s but with newlines replaced by line.

line :: DocSource

The document line advances to the next line and indents to the current indentation level. When undone by group, it behaves like space.

nest :: Int -> Doc -> DocSource

The document nest i d renders the document d with the current indentation level increased by i.

srcloc :: Located a => a -> DocSource

The document srcloc x adds the.

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

Operators

Character documents

backquote :: DocSource

The document backquote consists of a backquote, "`".

colon :: DocSource

The document colon consists of a colon, ":".

comma :: DocSource

The document comma consists of a comma, ",".

dot :: DocSource

The document dot consists of a period, ".".

dquote :: DocSource

The document dquote consists of a double quote, "\"".

equals :: DocSource

The document equals consists of an equals sign, "=".

semi :: DocSource

The document semi consists of a semicolon, ";".

space :: DocSource

The document space consists of a space, " ".

spaces :: Int -> DocSource

The document space n consists of n spaces.

squote :: DocSource

The document squote consists of a single quote, "\'".

star :: DocSource

The document star consists of an asterisk, "*".

langle :: DocSource

The document langle consists of a less-than sign, "<".

rangle :: DocSource

The document rangle consists of a greater-than sign, ">".

lbrace :: DocSource

The document lbrace consists of a left brace, "{".

rbrace :: DocSource

The document rbrace consists of a right brace, "}".

lbracket :: DocSource

The document lbracket consists of a right brace, "[".

rbracket :: DocSource

The document rbracket consists of a right brace, "]".

lparen :: DocSource

The document lparen consists of a right brace, "(".

rparen :: DocSource

The document rparen consists of a right brace, ")".

Bracketing combinators

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

The document enclose l r d) encloses the document d between the documents l and r using . It obeys the law

enclose l r d = l  d  r

angles :: Doc -> DocSource

The document angles d encloses the aligned document d in ....

backquotes :: Doc -> DocSource

The document backquotes d encloses the aligned document d in ....

braces :: Doc -> DocSource

The document braces d encloses the aligned document d in {...}.

brackets :: Doc -> DocSource

The document brackets d encloses the aligned document d in [...].

dquotes :: Doc -> DocSource

The document dquotes d encloses the aligned document d in ....

parens :: Doc -> DocSource

The document parens d encloses the aligned document d in (...).

parensIf :: Bool -> Doc -> DocSource

The document parensIf p d encloses the document d in parenthesis if p is True, and otherwise yields just d.

squotes :: Doc -> DocSource

The document parens d encloses the document d in ....

Alignment and indentation

align :: Doc -> DocSource

The document align d renders d with a nesting level set to the current column.

hang :: Int -> Doc -> DocSource

The document hang i d renders d with a nesting level set to the current column plus i. This differs from indent in that the first line of d is not indented.

indent :: Int -> Doc -> DocSource

The document indent i d indents d i spaces relative to the current column. This differs from hang in that the first line of d is indented.

Combining lists of documents

folddoc :: (Doc -> Doc -> Doc) -> [Doc] -> DocSource

The document folddoc f ds obeys the laws:

spread :: [Doc] -> DocSource

The document spread ds concatenates the documents ds using +.

stack :: [Doc] -> DocSource

The document stack ds concatenates the documents ds using /.

cat :: [Doc] -> DocSource

The document cat ds separates the documents ds with the empty document as long as there is room, and uses newlines when there isn't.

sep :: [Doc] -> DocSource

The document sep ds separates the documents ds with the empty document as long as there is room, and uses spaces when there isn't.

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

The document punctuate p ds obeys the law:

punctuate p [d1, d2, ..., dn] = [d1  p, d2  p, ..., dn]

commasep :: [Doc] -> DocSource

The document commasep ds comma-space separates ds, aligning the resulting document to the current nesting level.

semisep :: [Doc] -> DocSource

The document semisep ds semicolon-space separates ds, aligning the resulting document to the current nesting level.

encloseSep :: Doc -> Doc -> Doc -> [Doc] -> DocSource

The document encloseSep l r p ds separates ds with the punctuation p and encloses the result using l and r. When wrapped, punctuation appears at the end of the line. The enclosed portion of the document is aligned one column to the right of the opening document.

 > ws = map text (words "The quick brown fox jumps over the lazy dog")
 > test = pretty 15 (encloseSep lparen rparen comma ws)

will be layed out as:

 (The, quick,
  brown, fox,
  jumps, over,
  the, lazy,
  dog)

tuple :: [Doc] -> DocSource

The document tuple ds separates ds with commas and encloses them with parentheses.

list :: [Doc] -> DocSource

The document tuple ds separates ds with commas and encloses them with brackets.

The rendered document type

data RDoc Source

A rendered document.

Constructors

REmpty

The empty document

RChar Char RDoc

A single character

RText !Int String RDoc

Text with associated length (to avoid recomputation)

RPos Pos RDoc

Tag output with source location

RLine !Int RDoc

A newline with the indentation of the subsequent line

Document rendering

render :: Int -> Doc -> RDocSource

Render a document given a maximum width.

renderCompact :: Doc -> RDocSource

Render a document without indentation on infinitely long lines. Since no 'pretty' printing is involved, this renderer is fast. The resulting output contains fewer characters.

displayS :: RDoc -> ShowSSource

Display a rendered document.

prettyS :: Int -> Doc -> ShowSSource

Render and display a document.

pretty :: Int -> Doc -> StringSource

Render and convert a document to a String.

displayPragmaS :: RDoc -> ShowSSource

Display a rendered document with #line pragmas.

prettyPragmaS :: Int -> Doc -> ShowSSource

Render and display a document with #line pragmas.

prettyPragma :: Int -> Doc -> StringSource

Render and convert a document to a String with #line pragmas.

The Pretty type class for pretty printing

class Pretty a whereSource

Methods

ppr :: a -> DocSource

pprPrec :: Int -> a -> DocSource

pprList :: [a] -> DocSource

faildoc :: Monad m => Doc -> m aSource

Equivalent of fail, but with a document instead of a string.

errordoc :: Doc -> aSource

Equivalent of error, but with a document instead of a string.