{-# LANGUAGE CPP #-} {-# LANGUAGE OverlappingInstances #-} ----------------------------------------------------------------------------- -- | -- Module : Text.PrettyPrint.Leijen -- Copyright : Daan Leijen (c) 2000, http://www.cs.uu.nl/~daan -- License : BSD-style (see the file LICENSE) -- -- Maintainer : otakar.smrz cmu.edu -- Stability : provisional -- Portability : portable -- -- Pretty print module based on Philip Wadler's \"prettier printer\" -- -- @ -- \"A prettier printer\" -- Draft paper, April 1997, revised March 1998. -- <http://homepages.inf.ed.ac.uk/wadler/papers/prettier/prettier.pdf> -- @ -- -- PPrint is an implementation of the pretty printing combinators -- described by Philip Wadler (1997). In their bare essence, the -- combinators of Wadler are not expressive enough to describe some -- commonly occurring layouts. The PPrint 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 -- (1997). Additions and 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. -- -- * Lots of other useful combinators, like 'fillSep' and 'list'. -- -- * There are two renderers, 'renderPretty' for pretty printing and -- 'renderCompact' for compact output. The pretty printing algorithm -- also uses a ribbon-width now for even prettier output. -- -- * 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. -- -- Full documentation available at <http://www.cs.uu.nl/~daan/download/pprint/pprint.html>. ----------------------------------------------------------- module Text.PrettyPrint.Leijen ( -- * Documents Doc, putDoc, hPutDoc, -- * Basic combinators empty, char, text, (<>), nest, line, linebreak, group, softline, softbreak, -- * Alignment -- -- The combinators in this section can not 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, hang, indent, encloseSep, list, tupled, semiBraces, -- * Operators (<+>), (<$>), (</>), (<$$>), (<//>), -- * List combinators hsep, vsep, fillSep, sep, hcat, vcat, fillCat, cat, punctuate, -- * Fillers fill, fillBreak, -- * Bracketing combinators enclose, squotes, dquotes, parens, angles, braces, brackets, -- * Character documents lparen, rparen, langle, rangle, lbrace, rbrace, lbracket, rbracket, squote, dquote, semi, colon, comma, space, dot, backslash, equals, -- * Primitive type documents string, int, integer, float, double, rational, -- * Pretty class Pretty(..), -- * Rendering SimpleDoc(..), renderPretty, renderCompact, displayS, displayIO -- * Undocumented , bool , column, nesting, width ) where import System.IO (Handle,hPutStr,hPutChar,stdout) #if MIN_VERSION_base(4,8,0) import Prelude hiding ((<$>)) #endif #if !MIN_VERSION_base(4,11,0) import Data.Monoid (Monoid(..)) #endif infixr 5 </>,<//>,<$>,<$$> infixr 6 <+> #if !MIN_VERSION_base(4,11,0) infixr 6 <> #endif ----------------------------------------------------------- -- list, tupled and semiBraces pretty print a list of -- documents either horizontally or vertically aligned. ----------------------------------------------------------- -- | The document @(list xs)@ comma separates the documents @xs@ and -- encloses them in square brackets. The documents are rendered -- horizontally if that fits the page. Otherwise they are aligned -- vertically. All comma separators are put in front of the elements. list :: [Doc] -> Doc list :: [Doc] -> Doc list = Doc -> Doc -> Doc -> [Doc] -> Doc encloseSep Doc lbracket Doc rbracket Doc comma -- | The document @(tupled xs)@ comma separates the documents @xs@ and -- encloses them in parenthesis. The documents are rendered -- horizontally if that fits the page. Otherwise they are aligned -- vertically. All comma separators are put in front of the elements. tupled :: [Doc] -> Doc tupled :: [Doc] -> Doc tupled = Doc -> Doc -> Doc -> [Doc] -> Doc encloseSep Doc lparen Doc rparen Doc comma -- | The document @(semiBraces xs)@ separates the documents @xs@ with -- semi colons and encloses them in braces. The documents are rendered -- horizontally if that fits the page. Otherwise they are aligned -- vertically. All semi colons are put in front of the elements. semiBraces :: [Doc] -> Doc semiBraces :: [Doc] -> Doc semiBraces = Doc -> Doc -> Doc -> [Doc] -> Doc encloseSep Doc lbrace Doc rbrace Doc semi -- | The document @(encloseSep l r sep xs)@ concatenates the documents -- @xs@ separated by @sep@ and encloses the resulting document by @l@ -- and @r@. The documents are rendered horizontally if that fits the -- page. Otherwise they are aligned vertically. All separators are put -- in front of the elements. For example, the combinator 'list' can be -- defined with @encloseSep@: -- -- > list xs = encloseSep lbracket rbracket comma xs -- > test = text "list" <+> (list (map int [10,200,3000])) -- -- Which is layed out with a page width of 20 as: -- -- @ -- list [10,200,3000] -- @ -- -- But when the page width is 15, it is layed out as: -- -- @ -- list [10 -- ,200 -- ,3000] -- @ encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc encloseSep :: Doc -> Doc -> Doc -> [Doc] -> Doc encloseSep Doc left Doc right Doc sep [Doc] ds = case [Doc] ds of [] -> Doc left forall a. Semigroup a => a -> a -> a <> Doc right [Doc d] -> Doc left forall a. Semigroup a => a -> a -> a <> Doc d forall a. Semigroup a => a -> a -> a <> Doc right [Doc] _ -> Doc -> Doc align ([Doc] -> Doc cat (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c] zipWith forall a. Semigroup a => a -> a -> a (<>) (Doc left forall a. a -> [a] -> [a] : forall a. a -> [a] repeat Doc sep) [Doc] ds) forall a. Semigroup a => a -> a -> a <> Doc right) ----------------------------------------------------------- -- punctuate p [d1,d2,...,dn] => [d1 <> p,d2 <> p, ... ,dn] ----------------------------------------------------------- -- | @(punctuate p xs)@ concatenates all documents in @xs@ with -- document @p@ except for the last document. -- -- > someText = map text ["words","in","a","tuple"] -- > test = parens (align (cat (punctuate comma someText))) -- -- This is layed out on a page width of 20 as: -- -- @ -- (words,in,a,tuple) -- @ -- -- But when the page width is 15, it is layed out as: -- -- @ -- (words, -- in, -- a, -- tuple) -- @ -- -- (If you want put the commas in front of their elements instead of -- at the end, you should use 'tupled' or, in general, 'encloseSep'.) punctuate :: Doc -> [Doc] -> [Doc] punctuate :: Doc -> [Doc] -> [Doc] punctuate Doc p [] = [] punctuate Doc p [Doc d] = [Doc d] punctuate Doc p (Doc d:[Doc] ds) = (Doc d forall a. Semigroup a => a -> a -> a <> Doc p) forall a. a -> [a] -> [a] : Doc -> [Doc] -> [Doc] punctuate Doc p [Doc] ds ----------------------------------------------------------- -- high-level combinators ----------------------------------------------------------- -- | The document @(sep xs)@ concatenates all documents @xs@ either -- horizontally with @(\<+\>)@, if it fits the page, or vertically with -- @(\<$\>)@. -- -- > sep xs = group (vsep xs) sep :: [Doc] -> Doc sep :: [Doc] -> Doc sep = Doc -> Doc group forall b c a. (b -> c) -> (a -> b) -> a -> c . [Doc] -> Doc vsep -- | The document @(fillSep xs)@ concatenates documents @xs@ -- horizontally with @(\<+\>)@ as long as its fits the page, than -- inserts a @line@ and continues doing that for all documents in -- @xs@. -- -- > fillSep xs = foldr (\<\/\>) empty xs fillSep :: [Doc] -> Doc fillSep :: [Doc] -> Doc fillSep = (Doc -> Doc -> Doc) -> [Doc] -> Doc fold Doc -> Doc -> Doc (</>) -- | The document @(hsep xs)@ concatenates all documents @xs@ -- horizontally with @(\<+\>)@. hsep :: [Doc] -> Doc hsep :: [Doc] -> Doc hsep = (Doc -> Doc -> Doc) -> [Doc] -> Doc fold Doc -> Doc -> Doc (<+>) -- | The document @(vsep xs)@ concatenates all documents @xs@ -- vertically with @(\<$\>)@. If a 'group' undoes the line breaks -- inserted by @vsep@, all documents are separated with a space. -- -- > someText = map text (words ("text to lay out")) -- > -- > test = text "some" <+> vsep someText -- -- This is layed out as: -- -- @ -- some text -- to -- lay -- out -- @ -- -- The 'align' combinator can be used to align the documents under -- their first element -- -- > test = text "some" <+> align (vsep someText) -- -- Which is printed as: -- -- @ -- some text -- to -- lay -- out -- @ vsep :: [Doc] -> Doc vsep :: [Doc] -> Doc vsep = (Doc -> Doc -> Doc) -> [Doc] -> Doc fold Doc -> Doc -> Doc (<$>) -- | The document @(cat xs)@ concatenates all documents @xs@ either -- horizontally with @(\<\>)@, if it fits the page, or vertically with -- @(\<$$\>)@. -- -- > cat xs = group (vcat xs) cat :: [Doc] -> Doc cat :: [Doc] -> Doc cat = Doc -> Doc group forall b c a. (b -> c) -> (a -> b) -> a -> c . [Doc] -> Doc vcat -- | The document @(fillCat xs)@ concatenates documents @xs@ -- horizontally with @(\<\>)@ as long as its fits the page, than inserts -- a @linebreak@ and continues doing that for all documents in @xs@. -- -- > fillCat xs = foldr (\<\/\/\>) empty xs fillCat :: [Doc] -> Doc fillCat :: [Doc] -> Doc fillCat = (Doc -> Doc -> Doc) -> [Doc] -> Doc fold Doc -> Doc -> Doc (<//>) -- | The document @(hcat xs)@ concatenates all documents @xs@ -- horizontally with @(\<\>)@. hcat :: [Doc] -> Doc hcat :: [Doc] -> Doc hcat = (Doc -> Doc -> Doc) -> [Doc] -> Doc fold forall a. Semigroup a => a -> a -> a (<>) -- | The document @(vcat xs)@ concatenates all documents @xs@ -- vertically with @(\<$$\>)@. If a 'group' undoes the line breaks -- inserted by @vcat@, all documents are directly concatenated. vcat :: [Doc] -> Doc vcat :: [Doc] -> Doc vcat = (Doc -> Doc -> Doc) -> [Doc] -> Doc fold Doc -> Doc -> Doc (<$$>) fold :: (Doc -> Doc -> Doc) -> [Doc] -> Doc fold Doc -> Doc -> Doc f [] = Doc empty fold Doc -> Doc -> Doc f [Doc] ds = forall (t :: * -> *) a. Foldable t => (a -> a -> a) -> t a -> a foldr1 Doc -> Doc -> Doc f [Doc] ds -- | The document @(x \<\> y)@ concatenates document @x@ and document -- @y@. It is an associative operation having 'empty' as a left and -- right unit. (infixr 6) #if MIN_VERSION_base(4,11,0) instance Semigroup Doc where Doc x <> :: Doc -> Doc -> Doc <> Doc y = Doc x Doc -> Doc -> Doc `beside` Doc y #else (<>) :: Doc -> Doc -> Doc x <> y = x `beside` y #endif instance Monoid Doc where mempty :: Doc mempty = Doc empty mappend :: Doc -> Doc -> Doc mappend = forall a. Semigroup a => a -> a -> a (<>) -- | The document @(x \<+\> y)@ concatenates document @x@ and @y@ with a -- @space@ in between. (infixr 6) (<+>) :: Doc -> Doc -> Doc Doc x <+> :: Doc -> Doc -> Doc <+> Doc y = Doc x forall a. Semigroup a => a -> a -> a <> Doc space forall a. Semigroup a => a -> a -> a <> Doc y -- | The document @(x \<\/\> y)@ concatenates document @x@ and @y@ with a -- 'softline' in between. This effectively puts @x@ and @y@ either -- next to each other (with a @space@ in between) or underneath each -- other. (infixr 5) (</>) :: Doc -> Doc -> Doc Doc x </> :: Doc -> Doc -> Doc </> Doc y = Doc x forall a. Semigroup a => a -> a -> a <> Doc softline forall a. Semigroup a => a -> a -> a <> Doc y -- | The document @(x \<\/\/\> y)@ concatenates document @x@ and @y@ with -- a 'softbreak' in between. This effectively puts @x@ and @y@ either -- right next to each other or underneath each other. (infixr 5) (<//>) :: Doc -> Doc -> Doc Doc x <//> :: Doc -> Doc -> Doc <//> Doc y = Doc x forall a. Semigroup a => a -> a -> a <> Doc softbreak forall a. Semigroup a => a -> a -> a <> Doc y -- | The document @(x \<$\> y)@ concatenates document @x@ and @y@ with a -- 'line' in between. (infixr 5) (<$>) :: Doc -> Doc -> Doc Doc x <$> :: Doc -> Doc -> Doc <$> Doc y = Doc x forall a. Semigroup a => a -> a -> a <> Doc line forall a. Semigroup a => a -> a -> a <> Doc y -- | The document @(x \<$$\> y)@ concatenates document @x@ and @y@ with -- a @linebreak@ in between. (infixr 5) (<$$>) :: Doc -> Doc -> Doc Doc x <$$> :: Doc -> Doc -> Doc <$$> Doc y = Doc x forall a. Semigroup a => a -> a -> a <> Doc linebreak forall a. Semigroup a => a -> a -> a <> Doc y -- | The document @softline@ behaves like 'space' if the resulting -- output fits the page, otherwise it behaves like 'line'. -- -- > softline = group line softline :: Doc softline :: Doc softline = Doc -> Doc group Doc line -- | The document @softbreak@ behaves like 'empty' if the resulting -- output fits the page, otherwise it behaves like 'line'. -- -- > softbreak = group linebreak softbreak :: Doc softbreak :: Doc softbreak = Doc -> Doc group Doc linebreak -- | Document @(squotes x)@ encloses document @x@ with single quotes -- \"'\". squotes :: Doc -> Doc squotes :: Doc -> Doc squotes = Doc -> Doc -> Doc -> Doc enclose Doc squote Doc squote -- | Document @(dquotes x)@ encloses document @x@ with double quotes -- '\"'. dquotes :: Doc -> Doc dquotes :: Doc -> Doc dquotes = Doc -> Doc -> Doc -> Doc enclose Doc dquote Doc dquote -- | Document @(braces x)@ encloses document @x@ in braces, \"{\" and -- \"}\". braces :: Doc -> Doc braces :: Doc -> Doc braces = Doc -> Doc -> Doc -> Doc enclose Doc lbrace Doc rbrace -- | Document @(parens x)@ encloses document @x@ in parenthesis, \"(\" -- and \")\". parens :: Doc -> Doc parens :: Doc -> Doc parens = Doc -> Doc -> Doc -> Doc enclose Doc lparen Doc rparen -- | Document @(angles x)@ encloses document @x@ in angles, \"\<\" and -- \"\>\". angles :: Doc -> Doc angles :: Doc -> Doc angles = Doc -> Doc -> Doc -> Doc enclose Doc langle Doc rangle -- | Document @(brackets x)@ encloses document @x@ in square brackets, -- \"[\" and \"]\". brackets :: Doc -> Doc brackets :: Doc -> Doc brackets = Doc -> Doc -> Doc -> Doc enclose Doc lbracket Doc rbracket -- | The document @(enclose l r x)@ encloses document @x@ between -- documents @l@ and @r@ using @(\<\>)@. -- -- > enclose l r x = l <> x <> r enclose :: Doc -> Doc -> Doc -> Doc enclose :: Doc -> Doc -> Doc -> Doc enclose Doc l Doc r Doc x = Doc l forall a. Semigroup a => a -> a -> a <> Doc x forall a. Semigroup a => a -> a -> a <> Doc r -- | The document @lparen@ contains a left parenthesis, \"(\". lparen :: Doc lparen :: Doc lparen = Char -> Doc char Char '(' -- | The document @rparen@ contains a right parenthesis, \")\". rparen :: Doc rparen :: Doc rparen = Char -> Doc char Char ')' -- | The document @langle@ contains a left angle, \"\<\". langle :: Doc langle :: Doc langle = Char -> Doc char Char '<' -- | The document @rangle@ contains a right angle, \">\". rangle :: Doc rangle :: Doc rangle = Char -> Doc char Char '>' -- | The document @lbrace@ contains a left brace, \"{\". lbrace :: Doc lbrace :: Doc lbrace = Char -> Doc char Char '{' -- | The document @rbrace@ contains a right brace, \"}\". rbrace :: Doc rbrace :: Doc rbrace = Char -> Doc char Char '}' -- | The document @lbracket@ contains a left square bracket, \"[\". lbracket :: Doc lbracket :: Doc lbracket = Char -> Doc char Char '[' -- | The document @rbracket@ contains a right square bracket, \"]\". rbracket :: Doc rbracket :: Doc rbracket = Char -> Doc char Char ']' -- | The document @squote@ contains a single quote, \"'\". squote :: Doc squote :: Doc squote = Char -> Doc char Char '\'' -- | The document @dquote@ contains a double quote, '\"'. dquote :: Doc dquote :: Doc dquote = Char -> Doc char Char '"' -- | The document @semi@ contains a semi colon, \";\". semi :: Doc semi :: Doc semi = Char -> Doc char Char ';' -- | The document @colon@ contains a colon, \":\". colon :: Doc colon :: Doc colon = Char -> Doc char Char ':' -- | The document @comma@ contains a comma, \",\". comma :: Doc comma :: Doc comma = Char -> Doc char Char ',' -- | The document @space@ contains a single space, \" \". -- -- > x <+> y = x <> space <> y space :: Doc space :: Doc space = Char -> Doc char Char ' ' -- | The document @dot@ contains a single dot, \".\". dot :: Doc dot :: Doc dot = Char -> Doc char Char '.' -- | The document @backslash@ contains a back slash, \"\\\". backslash :: Doc backslash :: Doc backslash = Char -> Doc char Char '\\' -- | The document @equals@ contains an equal sign, \"=\". equals :: Doc equals :: Doc equals = Char -> Doc char Char '=' ----------------------------------------------------------- -- Combinators for prelude types ----------------------------------------------------------- -- string is like "text" but replaces '\n' by "line" -- | The document @(string s)@ concatenates all characters in @s@ -- using @line@ for newline characters and @char@ for all other -- characters. It is used instead of 'text' whenever the text contains -- newline characters. string :: String -> Doc string :: String -> Doc string String "" = Doc empty string (Char '\n':String s) = Doc line forall a. Semigroup a => a -> a -> a <> String -> Doc string String s string String s = case (forall a. (a -> Bool) -> [a] -> ([a], [a]) span (forall a. Eq a => a -> a -> Bool /=Char '\n') String s) of (String xs,String ys) -> String -> Doc text String xs forall a. Semigroup a => a -> a -> a <> String -> Doc string String ys bool :: Bool -> Doc bool :: Bool -> Doc bool Bool b = String -> Doc text (forall a. Show a => a -> String show Bool b) -- | The document @(int i)@ shows the literal integer @i@ using -- 'text'. int :: Int -> Doc int :: Int -> Doc int Int i = String -> Doc text (forall a. Show a => a -> String show Int i) -- | The document @(integer i)@ shows the literal integer @i@ using -- 'text'. integer :: Integer -> Doc integer :: Integer -> Doc integer Integer i = String -> Doc text (forall a. Show a => a -> String show Integer i) -- | The document @(float f)@ shows the literal float @f@ using -- 'text'. float :: Float -> Doc float :: Float -> Doc float Float f = String -> Doc text (forall a. Show a => a -> String show Float f) -- | The document @(double d)@ shows the literal double @d@ using -- 'text'. double :: Double -> Doc double :: Double -> Doc double Double d = String -> Doc text (forall a. Show a => a -> String show Double d) -- | The document @(rational r)@ shows the literal rational @r@ using -- 'text'. rational :: Rational -> Doc rational :: Rational -> Doc rational Rational r = String -> Doc text (forall a. Show a => a -> String show Rational r) ----------------------------------------------------------- -- overloading "pretty" ----------------------------------------------------------- -- | The member @prettyList@ is only used to define the @instance Pretty -- a => Pretty [a]@. In normal circumstances only the @pretty@ function -- is used. class Pretty a where pretty :: a -> Doc prettyList :: [a] -> Doc prettyList = [Doc] -> Doc list forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a b. (a -> b) -> [a] -> [b] map forall a. Pretty a => a -> Doc pretty instance Pretty a => Pretty [a] where pretty :: [a] -> Doc pretty = forall a. Pretty a => [a] -> Doc prettyList instance Pretty Doc where pretty :: Doc -> Doc pretty = forall a. a -> a id instance Pretty () where pretty :: () -> Doc pretty () = String -> Doc text String "()" instance Pretty Bool where pretty :: Bool -> Doc pretty Bool b = Bool -> Doc bool Bool b instance Pretty Char where pretty :: Char -> Doc pretty Char c = Char -> Doc char Char c prettyList :: String -> Doc prettyList String s = String -> Doc string String s instance Pretty Int where pretty :: Int -> Doc pretty Int i = Int -> Doc int Int i instance Pretty Integer where pretty :: Integer -> Doc pretty Integer i = Integer -> Doc integer Integer i instance Pretty Float where pretty :: Float -> Doc pretty Float f = Float -> Doc float Float f instance Pretty Double where pretty :: Double -> Doc pretty Double d = Double -> Doc double Double d --instance Pretty Rational where -- pretty r = rational r instance (Pretty a,Pretty b) => Pretty (a,b) where pretty :: (a, b) -> Doc pretty (a x,b y) = [Doc] -> Doc tupled [forall a. Pretty a => a -> Doc pretty a x, forall a. Pretty a => a -> Doc pretty b y] instance (Pretty a,Pretty b,Pretty c) => Pretty (a,b,c) where pretty :: (a, b, c) -> Doc pretty (a x,b y,c z)= [Doc] -> Doc tupled [forall a. Pretty a => a -> Doc pretty a x, forall a. Pretty a => a -> Doc pretty b y, forall a. Pretty a => a -> Doc pretty c z] instance Pretty a => Pretty (Maybe a) where pretty :: Maybe a -> Doc pretty Maybe a Nothing = Doc empty pretty (Just a x) = forall a. Pretty a => a -> Doc pretty a x ----------------------------------------------------------- -- semi primitive: fill and fillBreak ----------------------------------------------------------- -- | The document @(fillBreak i x)@ first renders document @x@. It -- than appends @space@s until the width is equal to @i@. If the -- width of @x@ is already larger than @i@, the nesting level is -- increased by @i@ and a @line@ is appended. When we redefine @ptype@ -- in the previous example to use @fillBreak@, we get a useful -- variation of the previous output: -- -- > ptype (name,tp) -- > = fillBreak 6 (text name) <+> text "::" <+> text tp -- -- The output will now be: -- -- @ -- let empty :: Doc -- nest :: Int -> Doc -> Doc -- linebreak -- :: Doc -- @ fillBreak :: Int -> Doc -> Doc fillBreak :: Int -> Doc -> Doc fillBreak Int f Doc x = Doc -> (Int -> Doc) -> Doc width Doc x (\Int w -> if (Int w forall a. Ord a => a -> a -> Bool > Int f) then Int -> Doc -> Doc nest Int f Doc linebreak else String -> Doc text (Int -> String spaces (Int f forall a. Num a => a -> a -> a - Int w))) -- | The document @(fill i x)@ renders document @x@. It than appends -- @space@s until the width is equal to @i@. If the width of @x@ is -- already larger, nothing is appended. This combinator is quite -- useful in practice to output a list of bindings. The following -- example demonstrates this. -- -- > types = [("empty","Doc") -- > ,("nest","Int -> Doc -> Doc") -- > ,("linebreak","Doc")] -- > -- > ptype (name,tp) -- > = fill 6 (text name) <+> text "::" <+> text tp -- > -- > test = text "let" <+> align (vcat (map ptype types)) -- -- Which is layed out as: -- -- @ -- let empty :: Doc -- nest :: Int -> Doc -> Doc -- linebreak :: Doc -- @ fill :: Int -> Doc -> Doc fill :: Int -> Doc -> Doc fill Int f Doc d = Doc -> (Int -> Doc) -> Doc width Doc d (\Int w -> if (Int w forall a. Ord a => a -> a -> Bool >= Int f) then Doc empty else String -> Doc text (Int -> String spaces (Int f forall a. Num a => a -> a -> a - Int w))) width :: Doc -> (Int -> Doc) -> Doc width :: Doc -> (Int -> Doc) -> Doc width Doc d Int -> Doc f = (Int -> Doc) -> Doc column (\Int k1 -> Doc d forall a. Semigroup a => a -> a -> a <> (Int -> Doc) -> Doc column (\Int k2 -> Int -> Doc f (Int k2 forall a. Num a => a -> a -> a - Int k1))) ----------------------------------------------------------- -- semi primitive: Alignment and indentation ----------------------------------------------------------- -- | The document @(indent i x)@ indents document @x@ with @i@ spaces. -- -- > test = indent 4 (fillSep (map text -- > (words "the indent combinator indents these words !"))) -- -- Which lays out with a page width of 20 as: -- -- @ -- the indent -- combinator -- indents these -- words ! -- @ indent :: Int -> Doc -> Doc indent :: Int -> Doc -> Doc indent Int i Doc d = Int -> Doc -> Doc hang Int i (String -> Doc text (Int -> String spaces Int i) forall a. Semigroup a => a -> a -> a <> Doc d) -- | The hang combinator implements hanging indentation. The document -- @(hang i x)@ renders document @x@ with a nesting level set to the -- current column plus @i@. The following example uses hanging -- indentation for some text: -- -- > test = hang 4 (fillSep (map text -- > (words "the hang combinator indents these words !"))) -- -- Which lays out on a page with a width of 20 characters as: -- -- @ -- the hang combinator -- indents these -- words ! -- @ -- -- The @hang@ combinator is implemented as: -- -- > hang i x = align (nest i x) hang :: Int -> Doc -> Doc hang :: Int -> Doc -> Doc hang Int i Doc d = Doc -> Doc align (Int -> Doc -> Doc nest Int i Doc d) -- | The document @(align x)@ renders document @x@ with the nesting -- level set to the current column. It is used for example to -- implement 'hang'. -- -- As an example, we will put a document right above another one, -- regardless of the current nesting level: -- -- > x $$ y = align (x <$> y) -- -- > test = text "hi" <+> (text "nice" $$ text "world") -- -- which will be layed out as: -- -- @ -- hi nice -- world -- @ align :: Doc -> Doc align :: Doc -> Doc align Doc d = (Int -> Doc) -> Doc column (\Int k -> (Int -> Doc) -> Doc nesting (\Int i -> Int -> Doc -> Doc nest (Int k forall a. Num a => a -> a -> a - Int i) Doc d)) --nesting might be negative :-) ----------------------------------------------------------- -- Primitives ----------------------------------------------------------- -- | The abstract data type @Doc@ represents pretty documents. -- -- @Doc@ is an instance of the 'Show' class. @(show doc)@ pretty -- prints document @doc@ with a page width of 100 characters and a -- ribbon width of 40 characters. -- -- > show (text "hello" <$> text "world") -- -- Which would return the string \"hello\\nworld\", i.e. -- -- @ -- hello -- world -- @ data Doc = Empty | Char Char -- invariant: char is not '\n' | Text !Int String -- invariant: text doesn't contain '\n' | Line !Bool -- True <=> when undone by group, do not insert a space | Cat Doc Doc | Nest !Int Doc | Union Doc Doc -- invariant: first lines of first doc longer than the first lines of the second doc | Column (Int -> Doc) | Nesting (Int -> Doc) -- | The data type @SimpleDoc@ represents rendered documents and is -- used by the display functions. -- -- The @Int@ in @SText@ contains the length of the string. The @Int@ -- in @SLine@ contains the indentation for that line. The library -- provides two default display functions 'displayS' and -- 'displayIO'. You can provide your own display function by writing a -- function from a @SimpleDoc@ to your own output format. data SimpleDoc = SEmpty | SChar Char SimpleDoc | SText !Int String SimpleDoc | SLine !Int SimpleDoc -- | The empty document is, indeed, empty. Although @empty@ has no -- content, it does have a \'height\' of 1 and behaves exactly like -- @(text \"\")@ (and is therefore not a unit of @\<$\>@). empty :: Doc empty :: Doc empty = Doc Empty -- | The document @(char c)@ contains the literal character @c@. The -- character shouldn't be a newline (@'\n'@), the function 'line' -- should be used for line breaks. char :: Char -> Doc char :: Char -> Doc char Char '\n' = Doc line char Char c = Char -> Doc Char Char c -- | The document @(text s)@ contains the literal string @s@. The -- string shouldn't contain any newline (@'\n'@) characters. If the -- string contains newline characters, the function 'string' should be -- used. text :: String -> Doc text :: String -> Doc text String "" = Doc Empty text String s = Int -> String -> Doc Text (forall (t :: * -> *) a. Foldable t => t a -> Int length String s) String s -- | The @line@ document advances to the next line and indents to the -- current nesting level. Document @line@ behaves like @(text \" \")@ -- if the line break is undone by 'group'. line :: Doc line :: Doc line = Bool -> Doc Line Bool False -- | The @linebreak@ document advances to the next line and indents to -- the current nesting level. Document @linebreak@ behaves like -- 'empty' if the line break is undone by 'group'. linebreak :: Doc linebreak :: Doc linebreak = Bool -> Doc Line Bool True beside :: Doc -> Doc -> Doc beside Doc x Doc y = Doc -> Doc -> Doc Cat Doc x Doc y -- | The document @(nest i x)@ renders document @x@ with the current -- indentation level increased by i (See also 'hang', 'align' and -- 'indent'). -- -- > nest 2 (text "hello" <$> text "world") <$> text "!" -- -- outputs as: -- -- @ -- hello -- world -- ! -- @ nest :: Int -> Doc -> Doc nest :: Int -> Doc -> Doc nest Int i Doc x = Int -> Doc -> Doc Nest Int i Doc x column, nesting :: (Int -> Doc) -> Doc column :: (Int -> Doc) -> Doc column Int -> Doc f = (Int -> Doc) -> Doc Column Int -> Doc f nesting :: (Int -> Doc) -> Doc nesting Int -> Doc f = (Int -> Doc) -> Doc Nesting Int -> Doc f -- | The @group@ combinator is used to specify alternative -- layouts. The document @(group x)@ undoes all line breaks in -- document @x@. The resulting line is added to the current line if -- that fits the page. Otherwise, the document @x@ is rendered without -- any changes. group :: Doc -> Doc group :: Doc -> Doc group Doc x = Doc -> Doc -> Doc Union (Doc -> Doc flatten Doc x) Doc x flatten :: Doc -> Doc flatten :: Doc -> Doc flatten (Cat Doc x Doc y) = Doc -> Doc -> Doc Cat (Doc -> Doc flatten Doc x) (Doc -> Doc flatten Doc y) flatten (Nest Int i Doc x) = Int -> Doc -> Doc Nest Int i (Doc -> Doc flatten Doc x) flatten (Line Bool break) = if Bool break then Doc Empty else Int -> String -> Doc Text Int 1 String " " flatten (Union Doc x Doc y) = Doc -> Doc flatten Doc x flatten (Column Int -> Doc f) = (Int -> Doc) -> Doc Column (Doc -> Doc flatten forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Doc f) flatten (Nesting Int -> Doc f) = (Int -> Doc) -> Doc Nesting (Doc -> Doc flatten forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> Doc f) flatten Doc other = Doc other --Empty,Char,Text ----------------------------------------------------------- -- Renderers ----------------------------------------------------------- ----------------------------------------------------------- -- renderPretty: the default pretty printing algorithm ----------------------------------------------------------- -- list of indentation/document pairs; saves an indirection over [(Int,Doc)] data Docs = Nil | Cons !Int Doc Docs -- | This is the default pretty printer which is used by 'show', -- 'putDoc' and 'hPutDoc'. @(renderPretty ribbonfrac width x)@ renders -- document @x@ with a page width of @width@ and a ribbon width of -- @(ribbonfrac * width)@ characters. The ribbon width is the maximal -- amount of non-indentation characters on a line. The parameter -- @ribbonfrac@ should be between @0.0@ and @1.0@. If it is lower or -- higher, the ribbon width will be 0 or @width@ respectively. renderPretty :: Float -> Int -> Doc -> SimpleDoc renderPretty :: Float -> Int -> Doc -> SimpleDoc renderPretty Float rfrac Int w Doc x = Int -> Int -> Docs -> SimpleDoc best Int 0 Int 0 (Int -> Doc -> Docs -> Docs Cons Int 0 Doc x Docs Nil) where -- r :: the ribbon width in characters r :: Int r = forall a. Ord a => a -> a -> a max Int 0 (forall a. Ord a => a -> a -> a min Int w (forall a b. (RealFrac a, Integral b) => a -> b round (forall a b. (Integral a, Num b) => a -> b fromIntegral Int w forall a. Num a => a -> a -> a * Float rfrac))) -- best :: n = indentation of current line -- k = current column -- (ie. (k >= n) && (k - n == count of inserted characters) best :: Int -> Int -> Docs -> SimpleDoc best Int n Int k Docs Nil = SimpleDoc SEmpty best Int n Int k (Cons Int i Doc d Docs ds) = case Doc d of Doc Empty -> Int -> Int -> Docs -> SimpleDoc best Int n Int k Docs ds Char Char c -> let k' :: Int k' = Int kforall a. Num a => a -> a -> a +Int 1 in seq :: forall a b. a -> b -> b seq Int k' (Char -> SimpleDoc -> SimpleDoc SChar Char c (Int -> Int -> Docs -> SimpleDoc best Int n Int k' Docs ds)) Text Int l String s -> let k' :: Int k' = Int kforall a. Num a => a -> a -> a +Int l in seq :: forall a b. a -> b -> b seq Int k' (Int -> String -> SimpleDoc -> SimpleDoc SText Int l String s (Int -> Int -> Docs -> SimpleDoc best Int n Int k' Docs ds)) Line Bool _ -> Int -> SimpleDoc -> SimpleDoc SLine Int i (Int -> Int -> Docs -> SimpleDoc best Int i Int i Docs ds) Cat Doc x Doc y -> Int -> Int -> Docs -> SimpleDoc best Int n Int k (Int -> Doc -> Docs -> Docs Cons Int i Doc x (Int -> Doc -> Docs -> Docs Cons Int i Doc y Docs ds)) Nest Int j Doc x -> let i' :: Int i' = Int iforall a. Num a => a -> a -> a +Int j in seq :: forall a b. a -> b -> b seq Int i' (Int -> Int -> Docs -> SimpleDoc best Int n Int k (Int -> Doc -> Docs -> Docs Cons Int i' Doc x Docs ds)) Union Doc x Doc y -> Int -> Int -> SimpleDoc -> SimpleDoc -> SimpleDoc nicest Int n Int k (Int -> Int -> Docs -> SimpleDoc best Int n Int k (Int -> Doc -> Docs -> Docs Cons Int i Doc x Docs ds)) (Int -> Int -> Docs -> SimpleDoc best Int n Int k (Int -> Doc -> Docs -> Docs Cons Int i Doc y Docs ds)) Column Int -> Doc f -> Int -> Int -> Docs -> SimpleDoc best Int n Int k (Int -> Doc -> Docs -> Docs Cons Int i (Int -> Doc f Int k) Docs ds) Nesting Int -> Doc f -> Int -> Int -> Docs -> SimpleDoc best Int n Int k (Int -> Doc -> Docs -> Docs Cons Int i (Int -> Doc f Int i) Docs ds) --nicest :: r = ribbon width, w = page width, -- n = indentation of current line, k = current column -- x and y, the (simple) documents to chose from. -- precondition: first lines of x are longer than the first lines of y. nicest :: Int -> Int -> SimpleDoc -> SimpleDoc -> SimpleDoc nicest Int n Int k SimpleDoc x SimpleDoc y | Int -> SimpleDoc -> Bool fits Int width SimpleDoc x = SimpleDoc x | Bool otherwise = SimpleDoc y where width :: Int width = forall a. Ord a => a -> a -> a min (Int w forall a. Num a => a -> a -> a - Int k) (Int r forall a. Num a => a -> a -> a - Int k forall a. Num a => a -> a -> a + Int n) fits :: Int -> SimpleDoc -> Bool fits Int w SimpleDoc x | Int w forall a. Ord a => a -> a -> Bool < Int 0 = Bool False fits Int w SimpleDoc SEmpty = Bool True fits Int w (SChar Char c SimpleDoc x) = Int -> SimpleDoc -> Bool fits (Int w forall a. Num a => a -> a -> a - Int 1) SimpleDoc x fits Int w (SText Int l String s SimpleDoc x) = Int -> SimpleDoc -> Bool fits (Int w forall a. Num a => a -> a -> a - Int l) SimpleDoc x fits Int w (SLine Int i SimpleDoc x) = Bool True ----------------------------------------------------------- -- renderCompact: renders documents without indentation -- fast and fewer characters output, good for machines ----------------------------------------------------------- -- | @(renderCompact x)@ renders document @x@ without adding any -- indentation. Since no \'pretty\' printing is involved, this -- renderer is very fast. The resulting output contains fewer -- characters than a pretty printed version and can be used for output -- that is read by other programs. renderCompact :: Doc -> SimpleDoc renderCompact :: Doc -> SimpleDoc renderCompact Doc x = Int -> [Doc] -> SimpleDoc scan Int 0 [Doc x] where scan :: Int -> [Doc] -> SimpleDoc scan Int k [] = SimpleDoc SEmpty scan Int k (Doc d:[Doc] ds) = case Doc d of Doc Empty -> Int -> [Doc] -> SimpleDoc scan Int k [Doc] ds Char Char c -> let k' :: Int k' = Int kforall a. Num a => a -> a -> a +Int 1 in seq :: forall a b. a -> b -> b seq Int k' (Char -> SimpleDoc -> SimpleDoc SChar Char c (Int -> [Doc] -> SimpleDoc scan Int k' [Doc] ds)) Text Int l String s -> let k' :: Int k' = Int kforall a. Num a => a -> a -> a +Int l in seq :: forall a b. a -> b -> b seq Int k' (Int -> String -> SimpleDoc -> SimpleDoc SText Int l String s (Int -> [Doc] -> SimpleDoc scan Int k' [Doc] ds)) Line Bool _ -> Int -> SimpleDoc -> SimpleDoc SLine Int 0 (Int -> [Doc] -> SimpleDoc scan Int 0 [Doc] ds) Cat Doc x Doc y -> Int -> [Doc] -> SimpleDoc scan Int k (Doc xforall a. a -> [a] -> [a] :Doc yforall a. a -> [a] -> [a] :[Doc] ds) Nest Int j Doc x -> Int -> [Doc] -> SimpleDoc scan Int k (Doc xforall a. a -> [a] -> [a] :[Doc] ds) Union Doc x Doc y -> Int -> [Doc] -> SimpleDoc scan Int k (Doc yforall a. a -> [a] -> [a] :[Doc] ds) Column Int -> Doc f -> Int -> [Doc] -> SimpleDoc scan Int k (Int -> Doc f Int kforall a. a -> [a] -> [a] :[Doc] ds) Nesting Int -> Doc f -> Int -> [Doc] -> SimpleDoc scan Int k (Int -> Doc f Int 0forall a. a -> [a] -> [a] :[Doc] ds) ----------------------------------------------------------- -- Displayers: displayS and displayIO ----------------------------------------------------------- -- | @(displayS simpleDoc)@ takes the output @simpleDoc@ from a -- rendering function and transforms it to a 'ShowS' type (for use in -- the 'Show' class). -- -- > showWidth :: Int -> Doc -> String -- > showWidth w x = displayS (renderPretty 0.4 w x) "" displayS :: SimpleDoc -> ShowS displayS :: SimpleDoc -> ShowS displayS SimpleDoc SEmpty = forall a. a -> a id displayS (SChar Char c SimpleDoc x) = Char -> ShowS showChar Char c forall b c a. (b -> c) -> (a -> b) -> a -> c . SimpleDoc -> ShowS displayS SimpleDoc x displayS (SText Int l String s SimpleDoc x) = String -> ShowS showString String s forall b c a. (b -> c) -> (a -> b) -> a -> c . SimpleDoc -> ShowS displayS SimpleDoc x displayS (SLine Int i SimpleDoc x) = String -> ShowS showString (Char '\n'forall a. a -> [a] -> [a] :Int -> String indentation Int i) forall b c a. (b -> c) -> (a -> b) -> a -> c . SimpleDoc -> ShowS displayS SimpleDoc x -- | @(displayIO handle simpleDoc)@ writes @simpleDoc@ to the file -- handle @handle@. This function is used for example by 'hPutDoc': -- -- > hPutDoc handle doc = displayIO handle (renderPretty 0.4 100 doc) displayIO :: Handle -> SimpleDoc -> IO () displayIO :: Handle -> SimpleDoc -> IO () displayIO Handle handle SimpleDoc simpleDoc = SimpleDoc -> IO () display SimpleDoc simpleDoc where display :: SimpleDoc -> IO () display SimpleDoc SEmpty = forall (m :: * -> *) a. Monad m => a -> m a return () display (SChar Char c SimpleDoc x) = do{ Handle -> Char -> IO () hPutChar Handle handle Char c; SimpleDoc -> IO () display SimpleDoc x} display (SText Int l String s SimpleDoc x) = do{ Handle -> String -> IO () hPutStr Handle handle String s; SimpleDoc -> IO () display SimpleDoc x} display (SLine Int i SimpleDoc x) = do{ Handle -> String -> IO () hPutStr Handle handle (Char '\n'forall a. a -> [a] -> [a] :Int -> String indentation Int i); SimpleDoc -> IO () display SimpleDoc x} ----------------------------------------------------------- -- default pretty printers: show, putDoc and hPutDoc ----------------------------------------------------------- instance Show Doc where showsPrec :: Int -> Doc -> ShowS showsPrec Int d Doc doc = SimpleDoc -> ShowS displayS (Float -> Int -> Doc -> SimpleDoc renderPretty Float 0.4 Int 80 Doc doc) -- | The action @(putDoc doc)@ pretty prints document @doc@ to the -- standard output, with a page width of 100 characters and a ribbon -- width of 40 characters. -- -- > main :: IO () -- > main = do{ putDoc (text "hello" <+> text "world") } -- -- Which would output -- -- @ -- hello world -- @ putDoc :: Doc -> IO () putDoc :: Doc -> IO () putDoc Doc doc = Handle -> Doc -> IO () hPutDoc Handle stdout Doc doc -- | @(hPutDoc handle doc)@ pretty prints document @doc@ to the file -- handle @handle@ with a page width of 100 characters and a ribbon -- width of 40 characters. -- -- > main = do{ handle <- openFile "MyFile" WriteMode -- > ; hPutDoc handle (vcat (map text -- > ["vertical","text"])) -- > ; hClose handle -- > } hPutDoc :: Handle -> Doc -> IO () hPutDoc :: Handle -> Doc -> IO () hPutDoc Handle handle Doc doc = Handle -> SimpleDoc -> IO () displayIO Handle handle (Float -> Int -> Doc -> SimpleDoc renderPretty Float 0.4 Int 80 Doc doc) ----------------------------------------------------------- -- insert spaces -- "indentation" used to insert tabs but tabs seem to cause -- more trouble than they solve :-) ----------------------------------------------------------- spaces :: Int -> String spaces Int n | Int n forall a. Ord a => a -> a -> Bool <= Int 0 = String "" | Bool otherwise = forall a. Int -> a -> [a] replicate Int n Char ' ' indentation :: Int -> String indentation Int n = Int -> String spaces Int n --indentation n | n >= 8 = '\t' : indentation (n-8) -- | otherwise = spaces n -- LocalWords: PPrint combinators Wadler Wadler's encloseSep