ansi-wl-pprint-1.0.2: The Wadler/Leijen Pretty Printer for colored ANSI terminal output
CopyrightDaan Leijen (c) 2000 http://www.cs.uu.nl/~daan
Max Bolingbroke (c) 2008 http://blog.omega-prime.co.uk
LicenseBSD-style (see the file LICENSE)
MaintainerEdward Kmett <ekmett@gmail.com>
Stabilityprovisional
Portabilityportable
Safe HaskellTrustworthy
LanguageHaskell2010

Text.PrettyPrint.ANSI.Leijen

Description

Deprecated: Compatibility module for users of ansi-wl-pprint - use Prettyprinter instead

This module is an extended implementation of the functional pretty printer given by Philip Wadler (1997):

     "A prettier printer"
     Draft paper, April 1997, revised March 1998.
     https://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf

In their bare essence, the combinators given by Wadler are not expressive enough to describe some commonly occurring layouts. This library adds new primitives to describe these layouts and works well in practice.

The library is based on a single way to concatenate documents, which is associative and has both a left and right unit. This simple design leads to an efficient and short implementation. The simplicity is reflected in the predictable behaviour of the combinators which make them easy to use in practice.

A thorough description of the primitive combinators and their implementation can be found in Philip Wadler's paper. The main differences with his original paper are:

  • The nil document is called empty.
  • The above combinator is called <$>. The operator </> is used for soft line breaks.
  • There are three new primitives: align, fill and fillBreak. These are very useful in practice.
  • There are many additional useful combinators, like fillSep and list.
  • There are two renderers: renderPretty for pretty printing, and renderCompact for quickly rendered, compact output more suitable for generating input to other programs.
  • The pretty printing algorithm used by renderPretty extends the algorithm given by Wadler to take into account a "ribbon width", i.e., a desired maximum number of non-indentation characters to output on any one line.
  • There are two displayers, displayS for strings and displayIO for file-based output.
  • There is a Pretty class.
  • The implementation uses optimised representations and strictness annotations.
  • The library has been extended to allow formatting text for output to ANSI style consoles. New combinators allow control of foreground and background color and the ability to make parts of the text bold or underlined.
Synopsis

The algebra of pretty-printing

The combinators in this library satisfy many algebraic laws.

The concatenation operator <> is associative and has empty as a left and right unit:

x <> (y <> z)           = (x <> y) <> z
x <> empty              = x
empty <> x              = x

The text combinator is a homomorphism from string concatenation to document concatenation:

text (s ++ t)           = text s <> text t
text ""                 = empty

The char combinator behaves like one-element text:

char c                  = text [c]

The nest combinator is a homomorphism from addition to document composition. nest also distributes through document concatenation and is absorbed by text and align:

nest (i + j) x          = nest i (nest j x)
nest 0 x                = x
nest i (x <> y)         = nest i x <> nest i y
nest i empty            = empty
nest i (text s)         = text s
nest i (align x)        = align x

The group combinator is absorbed by empty. group is commutative with nest and align:

group empty             = empty
group (text s <> x)     = text s <> group x
group (nest i x)        = nest i (group x)
group (align x)         = align (group x)

The align combinator is absorbed by empty and text. align is idempotent:

align empty             = empty
align (text s)          = text s
align (align x)         = align x

From the laws of the primitive combinators, we can derive many other laws for the derived combinators. For example, the above operator <$> is defined as:

x <$> y                 = x <> line <> y

It follows that <$> is associative and that <$> and <> associate with each other:

x <$> (y <$> z)         = (x <$> y) <$> z
x <> (y <$> z)          = (x <> y) <$> z
x <$> (y <> z)          = (x <$> y) <> z

Similar laws also hold for the other line break operators </>, <$$>, and <//>.

Documents

Basic combinators

char :: Char -> Doc #

int :: Int -> Doc #

bool :: Bool -> Doc #

(<>) :: Semigroup a => a -> a -> a infixr 6 #

An associative operation.

>>> [1,2,3] <> [4,5,6]
[1,2,3,4,5,6]

nest :: Int -> Doc -> Doc #

group :: Doc -> Doc #

flatAlt :: Doc -> Doc -> Doc #

Alignment combinators

The combinators in this section cannot be described by Wadler's original combinators. They align their output relative to the current output position — in contrast to nest which always aligns to the current nesting level. This deprives these combinators from being `optimal'. In practice however they prove to be very useful. The combinators in this section should be used with care, since they are more expensive than the other combinators. For example, align shouldn't be used to pretty print all top-level declarations of a language, but using hang for let expressions is fine.

align :: Doc -> Doc #

hang :: Int -> Doc -> Doc #

indent :: Int -> Doc -> Doc #

encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc #

list :: [Doc] -> Doc #

tupled :: [Doc] -> Doc #

Operators

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

(<$>) :: Doc -> Doc -> Doc #

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

(<$$>) :: Doc -> Doc -> Doc #

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

List combinators

hsep :: [Doc] -> Doc #

vsep :: [Doc] -> Doc #

fillSep :: [Doc] -> Doc #

sep :: [Doc] -> Doc #

hcat :: [Doc] -> Doc #

vcat :: [Doc] -> Doc #

fillCat :: [Doc] -> Doc #

cat :: [Doc] -> Doc #

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

Filler combinators

fill :: Int -> Doc -> Doc #

fillBreak :: Int -> Doc -> Doc #

Bracketing combinators

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

parens :: Doc -> Doc #

angles :: Doc -> Doc #

braces :: Doc -> Doc #

Named character combinators

dot :: Doc #

ANSI formatting combinators

This terminal formatting functionality is, as far as possible, portable across platforms with their varying terminals. However, note that to display ANSI colors and formatting will only be displayed on Windows consoles if the Doc value is output using the putDoc function or one of its friends. Rendering the Doc to a String and then outputing that will only work on Unix-style operating systems.

Forecolor combinators

black :: Doc -> Doc #

red :: Doc -> Doc #

green :: Doc -> Doc #

yellow :: Doc -> Doc #

blue :: Doc -> Doc #

cyan :: Doc -> Doc #

white :: Doc -> Doc #

Backcolor combinators

onred :: Doc -> Doc #

onblue :: Doc -> Doc #

oncyan :: Doc -> Doc #

Emboldening combinators

bold :: Doc -> Doc #

debold :: Doc -> Doc #

Underlining combinators

Formatting elimination combinators

plain :: Doc -> Doc #

Pretty class

class Pretty a where #

Overloaded conversion to Doc.

Laws:

  1. output should be pretty. :-)

Minimal complete definition

pretty

Methods

pretty :: a -> Doc ann #

>>> pretty 1 <+> pretty "hello" <+> pretty 1.234
1 hello 1.234

prettyList :: [a] -> Doc ann #

prettyList is only used to define the instance Pretty a => Pretty [a]. In normal circumstances only the pretty function is used.

>>> prettyList [1, 23, 456]
[1, 23, 456]

Instances

Instances details
Pretty Void

Finding a good example for printing something that does not exist is hard, so here is an example of printing a list full of nothing.

>>> pretty ([] :: [Void])
[]
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Void -> Doc ann #

prettyList :: [Void] -> Doc ann #

Pretty Int16 
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Int16 -> Doc ann #

prettyList :: [Int16] -> Doc ann #

Pretty Int32 
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Int32 -> Doc ann #

prettyList :: [Int32] -> Doc ann #

Pretty Int64 
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Int64 -> Doc ann #

prettyList :: [Int64] -> Doc ann #

Pretty Int8 
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Int8 -> Doc ann #

prettyList :: [Int8] -> Doc ann #

Pretty Word16 
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Word16 -> Doc ann #

prettyList :: [Word16] -> Doc ann #

Pretty Word32 
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Word32 -> Doc ann #

prettyList :: [Word32] -> Doc ann #

Pretty Word64 
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Word64 -> Doc ann #

prettyList :: [Word64] -> Doc ann #

Pretty Word8 
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Word8 -> Doc ann #

prettyList :: [Word8] -> Doc ann #

Pretty Text

Automatically converts all newlines to line.

>>> pretty ("hello\nworld" :: Text)
hello
world

Note that line can be undone by group:

>>> group (pretty ("hello\nworld" :: Text))
hello world

Manually use hardline if you definitely want newlines.

Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Text -> Doc ann #

prettyList :: [Text] -> Doc ann #

Pretty Text

(lazy Doc instance, identical to the strict version)

Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Text -> Doc ann #

prettyList :: [Text] -> Doc ann #

Pretty Integer
>>> pretty (2^123 :: Integer)
10633823966279326983230456482242756608
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Integer -> Doc ann #

prettyList :: [Integer] -> Doc ann #

Pretty Natural 
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Natural -> Doc ann #

prettyList :: [Natural] -> Doc ann #

Pretty ()
>>> pretty ()
()

The argument is not used:

>>> pretty (error "Strict?" :: ())
()
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: () -> Doc ann #

prettyList :: [()] -> Doc ann #

Pretty Bool
>>> pretty True
True
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Bool -> Doc ann #

prettyList :: [Bool] -> Doc ann #

Pretty Char

Instead of (pretty 'n'), consider using line as a more readable alternative.

>>> pretty 'f' <> pretty 'o' <> pretty 'o'
foo
>>> pretty ("string" :: String)
string
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Char -> Doc ann #

prettyList :: [Char] -> Doc ann #

Pretty Double
>>> pretty (exp 1 :: Double)
2.71828182845904...
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Double -> Doc ann #

prettyList :: [Double] -> Doc ann #

Pretty Float
>>> pretty (pi :: Float)
3.1415927
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Float -> Doc ann #

prettyList :: [Float] -> Doc ann #

Pretty Int
>>> pretty (123 :: Int)
123
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Int -> Doc ann #

prettyList :: [Int] -> Doc ann #

Pretty Word 
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Word -> Doc ann #

prettyList :: [Word] -> Doc ann #

Pretty a => Pretty (Identity a)
>>> pretty (Identity 1)
1
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Identity a -> Doc ann #

prettyList :: [Identity a] -> Doc ann #

Pretty a => Pretty (NonEmpty a) 
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: NonEmpty a -> Doc ann #

prettyList :: [NonEmpty a] -> Doc ann #

Pretty a => Pretty (Maybe a)

Ignore Nothings, print Just contents.

>>> pretty (Just True)
True
>>> braces (pretty (Nothing :: Maybe Bool))
{}
>>> pretty [Just 1, Nothing, Just 3, Nothing]
[1, 3]
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Maybe a -> Doc ann #

prettyList :: [Maybe a] -> Doc ann #

Pretty a => Pretty [a]
>>> pretty [1,2,3]
[1, 2, 3]
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: [a] -> Doc ann #

prettyList :: [[a]] -> Doc ann #

(Pretty a1, Pretty a2) => Pretty (a1, a2)
>>> pretty (123, "hello")
(123, hello)
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: (a1, a2) -> Doc ann #

prettyList :: [(a1, a2)] -> Doc ann #

Pretty a => Pretty (Const a b) 
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: Const a b -> Doc ann #

prettyList :: [Const a b] -> Doc ann #

(Pretty a1, Pretty a2, Pretty a3) => Pretty (a1, a2, a3)
>>> pretty (123, "hello", False)
(123, hello, False)
Instance details

Defined in Prettyprinter.Internal

Methods

pretty :: (a1, a2, a3) -> Doc ann #

prettyList :: [(a1, a2, a3)] -> Doc ann #

Rendering and displaying documents

Simple (i.e., rendered) documents

Simultaneous rendering and displaying of documents

putDoc :: Doc -> IO () #

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

Undocumented

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

columns :: (Maybe Int -> Doc) -> Doc #

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

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