mainland-pretty-0.2.3: 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.

fromText :: Text -> DocSource

The document fromText s consists of the Text s, which should not contain any newlines.

fromLazyText :: Text -> DocSource

The document fromLazyText s consists of the Text s, which should not contain any newlines.

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

(<>) :: Monoid m => m -> m -> m

An infix synonym for mappend.

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

RString !Int String RDoc

String with associated length (to avoid recomputation)

RText Text RDoc

Text

RLazyText Text RDoc

Text

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.

displayLazyText :: RDoc -> TextSource

Display a rendered document as Text. Uses a builder.

prettyLazyText :: Int -> Doc -> TextSource

Render and display a document as Text. Uses a builder.

displayPragmaLazyText :: RDoc -> TextSource

Display a rendered document with #line pragmas as Text. Uses a builder.

prettyPragmaLazyText :: Int -> Doc -> TextSource

Render and convert a document to Text with #line pragmas. Uses a builder.

Document output

putDoc :: Doc -> IO ()Source

Render a document with a width of 80 and print it to standard output.

hPutDoc :: Handle -> Doc -> IO ()Source

Render a document with a width of 80 and print it to the specified handle.

The Pretty type class for pretty printing

class Pretty a whereSource

Methods

ppr :: a -> DocSource

pprPrec :: Int -> a -> DocSource

pprList :: [a] -> DocSource

Instances

Pretty Bool 
Pretty Char 
Pretty Double 
Pretty Float 
Pretty Int 
Pretty Int8 
Pretty Int16 
Pretty Int32 
Pretty Int64 
Pretty Integer 
Pretty Word8 
Pretty Word16 
Pretty Word32 
Pretty Word64 
Pretty () 
Pretty Pos 
Pretty Loc 
Pretty Text 
Pretty Text 
Pretty a => Pretty [a] 
(Integral a, Pretty a) => Pretty (Ratio a) 
Pretty a => Pretty (Maybe a) 
Pretty a => Pretty (Set a) 
Pretty x => Pretty (L x) 
(Pretty a, Pretty b) => Pretty (a, b) 
(Pretty k, Pretty v) => Pretty (Map k v) 
(Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) 
(Pretty a, Pretty b, Pretty c, Pretty d) => Pretty (a, b, c, d) 
(Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) => Pretty (a, b, c, d, e) 
(Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f) => Pretty (a, b, c, d, e, f) 
(Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g) => Pretty (a, b, c, d, e, f, g) 
(Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g, Pretty h) => Pretty (a, b, c, d, e, f, g, h) 
(Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g, Pretty h, Pretty i) => Pretty (a, b, c, d, e, f, g, h, i) 
(Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g, Pretty h, Pretty i, Pretty j) => Pretty (a, b, c, d, e, f, g, h, i, j) 
(Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, Pretty k) => Pretty (a, b, c, d, e, f, g, h, i, j, k) 
(Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, Pretty k, Pretty l) => Pretty (a, b, c, d, e, f, g, h, i, j, k, l) 
(Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, Pretty k, Pretty l, Pretty m) => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m) 
(Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, Pretty k, Pretty l, Pretty m, Pretty n) => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m, n) 
(Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g, Pretty h, Pretty i, Pretty j, Pretty k, Pretty l, Pretty m, Pretty n, Pretty o) => Pretty (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) 

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.