Copyright | (c) The University of Glasgow 2001 |
---|---|
License | BSD-style (see the file LICENSE) |
Maintainer | David Terei <code@davidterei.com> |
Stability | stable |
Portability | portable |
Safe Haskell | Safe-Inferred |
Language | Haskell2010 |
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.cse.chalmers.se/~rjmh/Papers/pretty.ps
Synopsis
- data Doc
- data TextDetails
- char :: Char -> Doc
- text :: String -> Doc
- ftext :: FastString -> Doc
- ptext :: PtrString -> Doc
- ztext :: FastZString -> Doc
- sizedText :: Int -> String -> Doc
- zeroWidthText :: String -> Doc
- emptyText :: Doc
- int :: Int -> Doc
- integer :: Integer -> Doc
- float :: Float -> Doc
- double :: Double -> Doc
- rational :: Rational -> Doc
- hex :: Integer -> Doc
- semi :: Doc
- comma :: Doc
- colon :: Doc
- space :: Doc
- equals :: Doc
- lparen :: Doc
- rparen :: Doc
- lbrack :: Doc
- rbrack :: Doc
- lbrace :: Doc
- rbrace :: Doc
- parens :: Doc -> Doc
- brackets :: Doc -> Doc
- braces :: Doc -> Doc
- quotes :: Doc -> Doc
- squotes :: Doc -> Doc
- quote :: Doc -> Doc
- doubleQuotes :: Doc -> Doc
- maybeParens :: Bool -> Doc -> Doc
- empty :: Doc
- (<>) :: Doc -> Doc -> Doc
- (<+>) :: Doc -> Doc -> Doc
- hcat :: [Doc] -> Doc
- hsep :: [Doc] -> Doc
- ($$) :: Doc -> Doc -> Doc
- ($+$) :: Doc -> Doc -> Doc
- vcat :: [Doc] -> Doc
- sep :: [Doc] -> Doc
- cat :: [Doc] -> Doc
- fsep :: [Doc] -> Doc
- fcat :: [Doc] -> Doc
- nest :: Int -> Doc -> Doc
- hang :: Doc -> Int -> Doc -> Doc
- hangNotEmpty :: Doc -> Int -> Doc -> Doc
- punctuate :: Doc -> [Doc] -> [Doc]
- isEmpty :: Doc -> Bool
- docHead :: Doc -> (Maybe Char, Doc)
- data Style = Style {
- mode :: Mode
- lineLength :: Int
- ribbonsPerLine :: Float
- style :: Style
- renderStyle :: Style -> Doc -> String
- data Mode
- = PageMode {
- asciiSpace :: Bool
- | ZigZagMode
- | LeftMode
- | OneLineMode
- = PageMode {
- fullRender :: Mode -> Int -> Float -> (TextDetails -> a -> a) -> a -> Doc -> a
- txtPrinter :: TextDetails -> String -> String
- printDoc :: Mode -> Int -> Handle -> Doc -> IO ()
- printDoc_ :: Mode -> Int -> Handle -> Doc -> IO ()
- bufLeftRender :: BufHandle -> Doc -> IO ()
- printLeftRender :: Handle -> Doc -> IO ()
The document type
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.
data TextDetails Source #
The TextDetails data type
A TextDetails represents a fragment of text that will be output at some point.
Constructing documents
Converting values into documents
ftext :: FastString -> Doc Source #
ztext :: FastZString -> Doc Source #
sizedText :: Int -> String -> Doc Source #
Some text with any width. (text s = sizedText (length s) s
)
zeroWidthText :: String -> Doc Source #
Some text, but without any width. Use for non-printing text such as a HTML or Latex tags
Simple derived documents
Wrapping documents in delimiters
Combining documents
($$) :: Doc -> Doc -> Doc infixl 5 Source #
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
nest :: Int -> Doc -> Doc Source #
Nest (or indent) a document by a given number of positions
(which may also be negative). nest
satisfies the laws:
nest
0 x = xnest
k (nest
k' x) =nest
(k+k') xnest
k (x<>
y) =nest
k z<>
nest
k ynest
k (x$$
y) =nest
k x$$
nest
k ynest
kempty
=empty
x
, if<>
nest
k y = x<>
yx
non-empty
The side condition on the last law is needed because
empty
is a left identity for <>
.
punctuate :: Doc -> [Doc] -> [Doc] Source #
punctuate p [d1, ... dn] = [d1 <> p, d2 <> p, ... dn-1 <> p, dn]
Predicates on documents
docHead :: Doc -> (Maybe Char, Doc) Source #
Get the first character of a document. We also return a new document, equivalent to the original one but faster to render. Use it to avoid work duplication.
Rendering documents
Rendering with a particular style
A rendering style.
Style | |
|
Rendering mode.
PageMode | Normal |
| |
ZigZagMode | With zig-zag cuts |
LeftMode | No indentation, infinitely long lines |
OneLineMode | All on one line |
General rendering
:: 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.
txtPrinter :: TextDetails -> String -> String Source #
Default TextDetails printer