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

Copyright(c) 2006-2011 Harvard University
(c) 2011-2012 Geoffrey Mainland
(c) 2015-2016 Drexel University
LicenseBSD-style
Maintainermainland@drexel.edu
Stabilityprovisional
Portabilityportable
Safe HaskellNone
LanguageHaskell98

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 the ability to automatically track the source locations associated with pretty printed values and output appropriate #line pragmas and the use of Text for output.

Synopsis

The document type

data Doc #

The abstract type of documents.

Instances

IsString Doc # 

Methods

fromString :: String -> Doc #

Monoid Doc # 

Methods

mempty :: Doc #

mappend :: Doc -> Doc -> Doc #

mconcat :: [Doc] -> Doc #

Constructing documents

Converting values into documents

text :: String -> Doc #

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

bool :: Bool -> Doc #

The document bool b is equivalent to text (show b).

char :: Char -> Doc #

The document char c consists the single character c.

string :: String -> Doc #

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

int :: Int -> Doc #

The document int i is equivalent to text (show i).

integer :: Integer -> Doc #

The document integer i is equivalent to text (show i). text.

float :: Float -> Doc #

The document float f is equivalent to text (show f).

double :: Double -> Doc #

The document double d is equivalent to text (show d).

rational :: Rational -> Doc #

The document rational r is equivalent to text (show r).

strictText :: Text -> Doc #

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

lazyText :: Text -> Doc #

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

Simple documents documents

star :: Doc #

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

colon :: Doc #

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

comma :: Doc #

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

dot :: Doc #

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

equals :: Doc #

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

semi :: Doc #

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

space :: Doc #

The document space consists of a space, " ".

spaces :: Int -> Doc #

The document space n consists of n spaces.

backquote :: Doc #

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

squote :: Doc #

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

dquote :: Doc #

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

langle :: Doc #

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

rangle :: Doc #

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

lbrace :: Doc #

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

rbrace :: Doc #

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

lbracket :: Doc #

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

rbracket :: Doc #

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

lparen :: Doc #

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

rparen :: Doc #

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

Basic document combinators

empty :: Doc #

The empty document.

srcloc :: Located a => a -> Doc #

The document srcloc x tags the current line with locOf x. Only shown when running prettyPragma and friends.

line :: Doc #

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

softline :: Doc #

Becomes space if there is room, otherwise line.

pretty 11 $ text "foo" <+/> text "bar" <+/> text "baz" =="foo bar baz"
pretty  7 $ text "foo" <+/> text "bar" <+/> text "baz" == "foo bar\nbaz"
pretty  6 $ text "foo" <+/> text "bar" <+/> text "baz" == "foo\nbar\nbaz"

softbreak :: Doc #

Becomes empty if there is room, otherwise line.

(<>) :: Monoid m => m -> m -> m infixr 6 #

An infix synonym for mappend.

Since: 4.5.0.0

(<|>) :: Doc -> Doc -> Doc infixl 3 #

Provide alternative layouts of the same content. Invariant: both arguments must flatten to the same document.

(<+>) :: Doc -> Doc -> Doc infixr 6 #

Concatenates two documents with a space in between, with identity empty.

(</>) :: Doc -> Doc -> Doc infixr 5 #

Concatenates two documents with a line in between.

(<+/>) :: Doc -> Doc -> Doc infixr 5 #

Concatenates two documents with a softline in between, with identity empty.

(<//>) :: Doc -> Doc -> Doc infixr 5 #

Concatenates two documents with a softbreak in between.

group :: Doc -> Doc #

The document group d will flatten d to one line if there is room for it, otherwise the original d.

flatten :: Doc -> Doc #

The document flatten d will flatten d to one line.

Wrapping documents in delimiters

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

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

squotes :: Doc -> Doc #

The document squotes d encloses the alinged document d in '...'.

dquotes :: Doc -> Doc #

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

angles :: Doc -> Doc #

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

backquotes :: Doc -> Doc #

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

braces :: Doc -> Doc #

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

brackets :: Doc -> Doc #

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

parens :: Doc -> Doc #

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

parensIf :: Bool -> Doc -> Doc #

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

Combining lists of documents

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

The document folddoc f ds obeys the laws:

spread :: [Doc] -> Doc #

The document spread ds concatenates the documents ds with space.

stack :: [Doc] -> Doc #

The document stack ds concatenates the documents ds with line.

cat :: [Doc] -> Doc #

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

sep :: [Doc] -> Doc #

The document sep ds concatenates the documents ds with the space document as long as there is room, and uses line when there isn't.

punctuate :: Doc -> [Doc] -> [Doc] #

The document punctuate p ds obeys the law:

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

commasep :: [Doc] -> Doc #

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

semisep :: [Doc] -> Doc #

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

enclosesep :: Doc -> Doc -> Doc -> [Doc] -> Doc #

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] -> Doc #

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

list :: [Doc] -> Doc #

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

Alignment and indentation

align :: Doc -> Doc #

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

hang :: Int -> Doc -> Doc #

The document hang i d renders d with a nesting level set to the current column plus i, not including the first line.

indent :: Int -> Doc -> Doc #

The document indent i d renders d with a nesting level set to the current column plus i, including the first line.

nest :: Int -> Doc -> Doc #

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

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

The document column f is produced by calling f with the current column.

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

The document column f is produced by calling f with the current nesting level.

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

The document width d f is produced by concatenating d with the result of calling f with the width of the document d.

fill :: Int -> Doc -> Doc #

The document fill i d renders document x, appending spaces until the width is equal to i. If the width of d is already greater than i, nothing is appended.

fillbreak :: Int -> Doc -> Doc #

The document fillbreak i d renders document d, appending spaces until the width is equal to i. If the width of d is already greater than i, the nesting level is increased by i and a line is appended.

Utilities

faildoc :: Monad m => Doc -> m a #

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

errordoc :: Doc -> a #

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

The rendered document type

data RDoc #

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. If this is followed by a RPos, output an appropriate #line pragma before the newline.

Document rendering

render :: Int -> Doc -> RDoc #

Render a document given a maximum width.

renderCompact :: Doc -> RDoc #

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 -> ShowS #

Display a rendered document.

prettyS :: Int -> Doc -> ShowS #

Render and display a document.

pretty :: Int -> Doc -> String #

Render and convert a document to a String.

displayPragmaS :: RDoc -> ShowS #

Display a rendered document with #line pragmas.

prettyPragmaS :: Int -> Doc -> ShowS #

Render and display a document with #line pragmas.

prettyPragma :: Int -> Doc -> String #

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

> let loc = Loc (Pos "filename" 3 5 7) (Pos "filename" 5 7 9)
> in  putStrLn $ prettyPragma 80 $ srcloc loc <> text "foo" </> text "bar" </> text "baz"

will be printed as

foo
#line 3 "filename"
bar
baz

displayLazyText :: RDoc -> Text #

Display a rendered document as Text. Uses a builder.

prettyLazyText :: Int -> Doc -> Text #

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

displayPragmaLazyText :: RDoc -> Text #

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

prettyPragmaLazyText :: Int -> Doc -> Text #

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

Document output

putDoc :: Doc -> IO () #

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

putDocLn :: Doc -> IO () #

Render a document with a width of 80 and print it to standard output, followed by a newline.

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

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

hPutDocLn :: Handle -> Doc -> IO () #

Render a document with a width of 80 and print it to the specified handle, followed by a newline.

The Pretty type class for pretty printing

class Pretty a where #

Minimal complete definition

pprPrec | ppr

Methods

ppr :: a -> Doc #

pprPrec :: Int -> a -> Doc #

pprList :: [a] -> Doc #

Instances

Pretty Bool # 

Methods

ppr :: Bool -> Doc #

pprPrec :: Int -> Bool -> Doc #

pprList :: [Bool] -> Doc #

Pretty Char # 

Methods

ppr :: Char -> Doc #

pprPrec :: Int -> Char -> Doc #

pprList :: [Char] -> Doc #

Pretty Double # 

Methods

ppr :: Double -> Doc #

pprPrec :: Int -> Double -> Doc #

pprList :: [Double] -> Doc #

Pretty Float # 

Methods

ppr :: Float -> Doc #

pprPrec :: Int -> Float -> Doc #

pprList :: [Float] -> Doc #

Pretty Int # 

Methods

ppr :: Int -> Doc #

pprPrec :: Int -> Int -> Doc #

pprList :: [Int] -> Doc #

Pretty Int8 # 

Methods

ppr :: Int8 -> Doc #

pprPrec :: Int -> Int8 -> Doc #

pprList :: [Int8] -> Doc #

Pretty Int16 # 

Methods

ppr :: Int16 -> Doc #

pprPrec :: Int -> Int16 -> Doc #

pprList :: [Int16] -> Doc #

Pretty Int32 # 

Methods

ppr :: Int32 -> Doc #

pprPrec :: Int -> Int32 -> Doc #

pprList :: [Int32] -> Doc #

Pretty Int64 # 

Methods

ppr :: Int64 -> Doc #

pprPrec :: Int -> Int64 -> Doc #

pprList :: [Int64] -> Doc #

Pretty Integer # 

Methods

ppr :: Integer -> Doc #

pprPrec :: Int -> Integer -> Doc #

pprList :: [Integer] -> Doc #

Pretty Word8 # 

Methods

ppr :: Word8 -> Doc #

pprPrec :: Int -> Word8 -> Doc #

pprList :: [Word8] -> Doc #

Pretty Word16 # 

Methods

ppr :: Word16 -> Doc #

pprPrec :: Int -> Word16 -> Doc #

pprList :: [Word16] -> Doc #

Pretty Word32 # 

Methods

ppr :: Word32 -> Doc #

pprPrec :: Int -> Word32 -> Doc #

pprList :: [Word32] -> Doc #

Pretty Word64 # 

Methods

ppr :: Word64 -> Doc #

pprPrec :: Int -> Word64 -> Doc #

pprList :: [Word64] -> Doc #

Pretty () # 

Methods

ppr :: () -> Doc #

pprPrec :: Int -> () -> Doc #

pprList :: [()] -> Doc #

Pretty Pos # 

Methods

ppr :: Pos -> Doc #

pprPrec :: Int -> Pos -> Doc #

pprList :: [Pos] -> Doc #

Pretty Loc # 

Methods

ppr :: Loc -> Doc #

pprPrec :: Int -> Loc -> Doc #

pprList :: [Loc] -> Doc #

Pretty Text # 

Methods

ppr :: Text -> Doc #

pprPrec :: Int -> Text -> Doc #

pprList :: [Text] -> Doc #

Pretty Text # 

Methods

ppr :: Text -> Doc #

pprPrec :: Int -> Text -> Doc #

pprList :: [Text] -> Doc #

Pretty a => Pretty [a] # 

Methods

ppr :: [a] -> Doc #

pprPrec :: Int -> [a] -> Doc #

pprList :: [[a]] -> Doc #

Pretty a => Pretty (Maybe a) # 

Methods

ppr :: Maybe a -> Doc #

pprPrec :: Int -> Maybe a -> Doc #

pprList :: [Maybe a] -> Doc #

(Integral a, Pretty a) => Pretty (Ratio a) # 

Methods

ppr :: Ratio a -> Doc #

pprPrec :: Int -> Ratio a -> Doc #

pprList :: [Ratio a] -> Doc #

Pretty a => Pretty (Set a) # 

Methods

ppr :: Set a -> Doc #

pprPrec :: Int -> Set a -> Doc #

pprList :: [Set a] -> Doc #

Pretty x => Pretty (L x) # 

Methods

ppr :: L x -> Doc #

pprPrec :: Int -> L x -> Doc #

pprList :: [L x] -> Doc #

(Pretty a, Pretty b) => Pretty (a, b) # 

Methods

ppr :: (a, b) -> Doc #

pprPrec :: Int -> (a, b) -> Doc #

pprList :: [(a, b)] -> Doc #

(Pretty k, Pretty v) => Pretty (Map k v) # 

Methods

ppr :: Map k v -> Doc #

pprPrec :: Int -> Map k v -> Doc #

pprList :: [Map k v] -> Doc #

(Pretty a, Pretty b, Pretty c) => Pretty (a, b, c) # 

Methods

ppr :: (a, b, c) -> Doc #

pprPrec :: Int -> (a, b, c) -> Doc #

pprList :: [(a, b, c)] -> Doc #

(Pretty a, Pretty b, Pretty c, Pretty d) => Pretty (a, b, c, d) # 

Methods

ppr :: (a, b, c, d) -> Doc #

pprPrec :: Int -> (a, b, c, d) -> Doc #

pprList :: [(a, b, c, d)] -> Doc #

(Pretty a, Pretty b, Pretty c, Pretty d, Pretty e) => Pretty (a, b, c, d, e) # 

Methods

ppr :: (a, b, c, d, e) -> Doc #

pprPrec :: Int -> (a, b, c, d, e) -> Doc #

pprList :: [(a, b, c, d, e)] -> Doc #

(Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f) => Pretty (a, b, c, d, e, f) # 

Methods

ppr :: (a, b, c, d, e, f) -> Doc #

pprPrec :: Int -> (a, b, c, d, e, f) -> Doc #

pprList :: [(a, b, c, d, e, f)] -> Doc #

(Pretty a, Pretty b, Pretty c, Pretty d, Pretty e, Pretty f, Pretty g) => Pretty (a, b, c, d, e, f, g) # 

Methods

ppr :: (a, b, c, d, e, f, g) -> Doc #

pprPrec :: Int -> (a, b, c, d, e, f, g) -> Doc #

pprList :: [(a, b, c, d, e, f, g)] -> Doc #

(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) # 

Methods

ppr :: (a, b, c, d, e, f, g, h) -> Doc #

pprPrec :: Int -> (a, b, c, d, e, f, g, h) -> Doc #

pprList :: [(a, b, c, d, e, f, g, h)] -> Doc #

(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) # 

Methods

ppr :: (a, b, c, d, e, f, g, h, i) -> Doc #

pprPrec :: Int -> (a, b, c, d, e, f, g, h, i) -> Doc #

pprList :: [(a, b, c, d, e, f, g, h, i)] -> Doc #

(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) # 

Methods

ppr :: (a, b, c, d, e, f, g, h, i, j) -> Doc #

pprPrec :: Int -> (a, b, c, d, e, f, g, h, i, j) -> Doc #

pprList :: [(a, b, c, d, e, f, g, h, i, j)] -> Doc #

(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) # 

Methods

ppr :: (a, b, c, d, e, f, g, h, i, j, k) -> Doc #

pprPrec :: Int -> (a, b, c, d, e, f, g, h, i, j, k) -> Doc #

pprList :: [(a, b, c, d, e, f, g, h, i, j, k)] -> Doc #

(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) # 

Methods

ppr :: (a, b, c, d, e, f, g, h, i, j, k, l) -> Doc #

pprPrec :: Int -> (a, b, c, d, e, f, g, h, i, j, k, l) -> Doc #

pprList :: [(a, b, c, d, e, f, g, h, i, j, k, l)] -> Doc #

(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) # 

Methods

ppr :: (a, b, c, d, e, f, g, h, i, j, k, l, m) -> Doc #

pprPrec :: Int -> (a, b, c, d, e, f, g, h, i, j, k, l, m) -> Doc #

pprList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m)] -> Doc #

(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) # 

Methods

ppr :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> Doc #

pprPrec :: Int -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n) -> Doc #

pprList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m, n)] -> Doc #

(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) # 

Methods

ppr :: (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> Doc #

pprPrec :: Int -> (a, b, c, d, e, f, g, h, i, j, k, l, m, n, o) -> Doc #

pprList :: [(a, b, c, d, e, f, g, h, i, j, k, l, m, n, o)] -> Doc #