-- Stability : provisional
-- Portability : portable
--
--- John Hughes\'s and Simon Peyton Jones\'s Pretty Printer Combinators
+-- John Hughes's and Simon Peyton Jones's Pretty Printer Combinators
--
-- Based on /The Design of a Pretty-printing Library/
-- in Advanced Functional Programming,
nest k empty = empty
which wasn't true before.
- * Fixed an obscure bug in sep that occassionally gave very wierd behaviour
+ * Fixed an obscure bug in sep that occassionally gave very weird behaviour
* Added $+$
It is Really Useful in practice.
2. There is a paragraph-fill combinator, fsep, that's much like sep,
- only it keeps fitting things on one line until itc can't fit any more.
+ only it keeps fitting things on one line until it can't fit any more.
3. Some random useful extra combinators are provided.
<+> puts its arguments beside each other with a space between them,
sep (separate) is either like hsep or like vcat, depending on what fits
- cat is behaves like sep, but it uses <> for horizontal conposition
- fcat is behaves like fsep, but it uses <> for horizontal conposition
+ cat behaves like sep, but it uses <> for horizontal conposition
+ fcat behaves like fsep, but it uses <> for horizontal conposition
These new ones do the obvious things:
char, semi, comma, colon, space,
last line of the top argument stops before the first line of the
second begins.
- For example: text "hi" $$ nest 5 "there"
+ For example: text "hi" $$ nest 5 (text "there")
lays out as
hi there
rather than
-}
module Text.PrettyPrint.HughesPJ (
- Doc, -- Abstract
- Mode(..), TextDetails(..),
- empty, isEmpty, nest,
+ -- * The document type
+ Doc, -- Abstract
- text, char, ptext,
+ -- * Constructing documents
+ -- ** Converting values into documents
+ char, text, ptext,
int, integer, float, double, rational,
- parens, brackets, braces, quotes, doubleQuotes,
+
+ -- ** Simple derived documents
semi, comma, colon, space, equals,
lparen, rparen, lbrack, rbrack, lbrace, rbrace,
+ -- ** Wrapping documents in delimiters
+ parens, brackets, braces, quotes, doubleQuotes,
+
+ -- ** Combining documents
+ empty,
(<>), (<+>), hcat, hsep,
($$), ($+$), vcat,
sep, cat,
fsep, fcat,
-
+ nest,
hang, punctuate,
--- renderStyle, -- Haskell 1.3 only
- render, fullRender
+ -- * Predicates on documents
+ isEmpty,
+
+ -- * Rendering documents
+
+ -- ** Default rendering
+ render,
+
+ -- ** Rendering with a particular style
+ Style(..),
+ style,
+ renderStyle,
+
+ -- ** General rendering
+ fullRender,
+ Mode(..), TextDetails(..),
+
) where
-- The primitive Doc values
-empty :: Doc
-isEmpty :: Doc -> Bool
-text :: String -> Doc
-char :: Char -> Doc
-
-semi, comma, colon, space, equals :: Doc
-lparen, rparen, lbrack, rbrack, lbrace, rbrace :: Doc
+isEmpty :: Doc -> Bool; -- ^ Returns 'True' if the document is empty
+
+-- | The empty document, with no height and no width.
+-- 'empty' is the identity for '<>', '<+>', '$$' and '$+$', and anywhere
+-- in the argument list for 'sep', 'hcat', 'hsep', 'vcat', 'fcat' etc.
+empty :: Doc
+
+semi :: Doc; -- ^ A ';' character
+comma :: Doc; -- ^ A ',' character
+colon :: Doc; -- ^ A ':' character
+space :: Doc; -- ^ A space character
+equals :: Doc; -- ^ A '=' character
+lparen :: Doc; -- ^ A '(' character
+rparen :: Doc; -- ^ A ')' character
+lbrack :: Doc; -- ^ A '[' character
+rbrack :: Doc; -- ^ A ']' character
+lbrace :: Doc; -- ^ A '{' character
+rbrace :: Doc; -- ^ A '}' character
+
+-- | A document of height and width 1, containing a literal character.
+char :: Char -> Doc
+
+-- | A document of height 1 containing a literal string.
+-- 'text' satisfies the following laws:
+--
+-- * @'text' s '<>' 'text' t = 'text' (s'++'t)@
+--
+-- * @'text' \"\" '<>' x = x@, if @x@ non-empty
+--
+-- The side condition on the last law is necessary because @'text' \"\"@
+-- has height 1, while 'empty' has no height.
+text :: String -> Doc
-parens, brackets, braces :: Doc -> Doc
-quotes, doubleQuotes :: Doc -> Doc
+-- | An obsolete function, now identical to 'text'.
+ptext :: String -> Doc
-int :: Int -> Doc
-integer :: Integer -> Doc
-float :: Float -> Doc
-double :: Double -> Doc
-rational :: Rational -> Doc
+int :: Int -> Doc; -- ^ @int n = text (show n)@
+integer :: Integer -> Doc; -- ^ @integer n = text (show n)@
+float :: Float -> Doc; -- ^ @float n = text (show n)@
+double :: Double -> Doc; -- ^ @double n = text (show n)@
+rational :: Rational -> Doc; -- ^ @rational n = text (show n)@
+parens :: Doc -> Doc; -- ^ Wrap document in @(...)@
+brackets :: Doc -> Doc; -- ^ Wrap document in @[...]@
+braces :: Doc -> Doc; -- ^ Wrap document in @{...}@
+quotes :: Doc -> Doc; -- ^ Wrap document in @\'...\'@
+doubleQuotes :: Doc -> Doc; -- ^ Wrap document in @\"...\"@
-- Combining @Doc@ values
-(<>) :: Doc -> Doc -> Doc -- Beside
-hcat :: [Doc] -> Doc -- List version of <>
-(<+>) :: Doc -> Doc -> Doc -- Beside, separated by space
-hsep :: [Doc] -> Doc -- List version of <+>
+-- | Beside.
+-- '<>' is associative, with identity 'empty'.
+(<>) :: Doc -> Doc -> Doc
+
+-- | Beside, separated by space, unless one of the arguments is 'empty'.
+-- '<+>' is associative, with identity 'empty'.
+(<+>) :: Doc -> Doc -> Doc
+
+-- | 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
+--
+-- '$$' is associative, with identity 'empty', and also satisfies
+--
+-- * @(x '$$' y) '<>' z = x '$$' (y '<>' z)@, if @y@ non-empty.
+--
+($$) :: Doc -> Doc -> Doc
-($$) :: Doc -> Doc -> Doc -- Above; if there is no
- -- overlap it "dovetails" the two
-vcat :: [Doc] -> Doc -- List version of $$
+-- | Above, with no overlapping.
+-- '$+$' is associative, with identity 'empty'.
+($+$) :: Doc -> Doc -> Doc
-cat :: [Doc] -> Doc -- Either hcat or vcat
-sep :: [Doc] -> Doc -- Either hsep or vcat
-fcat :: [Doc] -> Doc -- ``Paragraph fill'' version of cat
-fsep :: [Doc] -> Doc -- ``Paragraph fill'' version of sep
+hcat :: [Doc] -> Doc; -- ^List version of '<>'.
+hsep :: [Doc] -> Doc; -- ^List version of '<+>'.
+vcat :: [Doc] -> Doc; -- ^List version of '$$'.
-nest :: Int -> Doc -> Doc -- Nested
+cat :: [Doc] -> Doc; -- ^ Either 'hcat' or 'vcat'.
+sep :: [Doc] -> Doc; -- ^ Either 'hsep' or 'vcat'.
+fcat :: [Doc] -> Doc; -- ^ \"Paragraph fill\" version of 'cat'.
+fsep :: [Doc] -> Doc; -- ^ \"Paragraph fill\" version of 'sep'.
+-- | Nest (or indent) a document by a given number of positions
+-- (which may also be negative). 'nest' satisfies the laws:
+--
+-- * @'nest' 0 x = x@
+--
+-- * @'nest' k ('nest' k' x) = 'nest' (k+k') x@
+--
+-- * @'nest' k (x '<>' y) = 'nest' k z '<>' 'nest' k y@
+--
+-- * @'nest' k (x '$$' y) = 'nest' k x '$$' 'nest' k y@
+--
+-- * @'nest' k 'empty' = 'empty'@
+--
+-- * @x '<>' 'nest' k y = x '<>' y@, if @x@ non-empty
+--
+-- The side condition on the last law is needed because
+-- 'empty' is a left identity for '<>'.
+nest :: Int -> Doc -> Doc
-- GHC-specific ones.
+-- | @hang d1 n d2 = sep [d1, nest n d2]@
hang :: Doc -> Int -> Doc -> Doc
-punctuate :: Doc -> [Doc] -> [Doc] -- punctuate p [d1, ... dn] = [d1 <> p, d2 <> p, ... dn-1 <> p, dn]
+
+-- | @punctuate p [d1, ... dn] = [d1 \<> p, d2 \<> p, ... dn-1 \<> p, dn]@
+punctuate :: Doc -> [Doc] -> [Doc]
-- Displaying @Doc@ values.
instance Show Doc where
showsPrec prec doc cont = showDoc doc cont
-render :: Doc -> String -- Uses default style
-fullRender :: Mode
- -> Int -- Line length
- -> Float -- Ribbons per line
- -> (TextDetails -> a -> a) -- What to do with text
- -> a -- What to do at the end
- -> Doc
- -> a -- Result
+-- | Renders the document as a string using the default 'style'.
+render :: Doc -> String
+
+-- | The general rendering interface.
+fullRender :: 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
-{- When we start using 1.3
+-- | Render the document as a string using a specified style.
renderStyle :: Style -> Doc -> String
-data Style = Style { lineLength :: Int, -- In chars
- ribbonsPerLine :: Float, -- Ratio of ribbon length to line length
- mode :: Mode
- }
-style :: Style -- The default style
-style = Style { lineLength = 100, ribbonsPerLine = 2.5, mode = PageMode }
--}
-data Mode = PageMode -- Normal
- | ZigZagMode -- With zig-zag cuts
- | LeftMode -- No indentation, infinitely long lines
- | OneLineMode -- All on one line
+-- | A rendering style.
+data Style
+ = Style { mode :: Mode -- ^ The rendering mode
+ , lineLength :: Int -- ^ Length of line, in chars
+ , ribbonsPerLine :: Float -- ^ Ratio of ribbon length to line length
+ }
+-- | The default style (@mode=PageMode, lineLength=100, ribbonsPerLine=1.5@).
+style :: Style
+style = Style { lineLength = 100, ribbonsPerLine = 1.5, mode = PageMode }
+
+-- | Rendering mode.
+data Mode = PageMode -- ^Normal
+ | ZigZagMode -- ^With zig-zag cuts
+ | LeftMode -- ^No indentation, infinitely long lines
+ | OneLineMode -- ^All on one line
-- ---------------------------------------------------------------------------
-- The Doc calculus
-- SIGBJORN wrote instead:
-- rational n = text (show (fromRationalX n))
-quotes p = char '`' <> p <> char '\''
+quotes p = char '\'' <> p <> char '\''
doubleQuotes p = char '"' <> p <> char '"'
parens p = char '(' <> p <> char ')'
brackets p = char '[' <> p <> char ']'
-- A Doc represents a *set* of layouts. A Doc with
-- no occurrences of Union or NoDoc represents just one layout.
+-- | The abstract type of documents.
+-- The 'Show' instance is equivalent to using 'render'.
data Doc
= Empty -- empty
| NilAbove Doc -- text "" $$ x
isEmpty _ = False
char c = textBeside_ (Chr c) 1 Empty
-text s = case length s of {sl -> textBeside_ (Str s) sl Empty}
+text s = case length s of {sl -> textBeside_ (Str s) sl Empty}
ptext s = case length s of {sl -> textBeside_ (PStr s) sl Empty}
nest k p = mkNest k (reduceDoc p) -- Externally callable version
-- ---------------------------------------------------------------------------
-- Vertical composition @$$@
-p $$ q = Above p False q
-p $+$ q = Above p True q
+above_ :: Doc -> Bool -> Doc -> Doc
+above_ p _ Empty = p
+above_ Empty _ q = q
+above_ p g q = Above p g q
+
+p $$ q = above_ p False q
+p $+$ q = above_ p True q
above :: Doc -> Bool -> RDoc -> RDoc
above (Above p g1 q1) g2 q2 = above p g1 (above q1 g2 q2)
-- ---------------------------------------------------------------------------
-- Horizontal composition @<>@
-p <> q = Beside p False q
-p <+> q = Beside p True q
+beside_ :: Doc -> Bool -> Doc -> Doc
+beside_ p _ Empty = p
+beside_ Empty _ q = q
+beside_ p g q = Beside p g q
+
+p <> q = beside_ p False q
+p <+> q = beside_ p True q
beside :: Doc -> Bool -> RDoc -> RDoc
-- Specification: beside g p q = p <g> q
-- ---------------------------------------------------------------------------
-- Displaying the best layout
-{-
-renderStyle Style{mode, lineLength, ribbonsPerLine} doc
- = fullRender mode lineLength ribbonsPerLine doc ""
--}
+renderStyle style doc
+ = fullRender (mode style)
+ (lineLength style)
+ (ribbonsPerLine style)
+ string_txt
+ ""
+ doc
render doc = showDoc doc ""
showDoc doc rest = fullRender PageMode 100 1.5 string_txt rest doc
lay (NilAbove p) no_doc = nl_text `txt` lay p cant_fail -- NoDoc always on first line
lay (TextBeside s sl p) no_doc = s `txt` lay p no_doc
-indent n | n >= 8 = '\t' : indent (n - 8)
- | otherwise = spaces n
+-- OLD version: we shouldn't rely on tabs being 8 columns apart in the output.
+-- indent n | n >= 8 = '\t' : indent (n - 8)
+-- | otherwise = spaces n
+indent n = spaces n
multi_ch 0 ch = ""
multi_ch n ch = ch : multi_ch (n - 1) ch
-spaces 0 = ""
-spaces n = ' ' : spaces (n - 1)
-
+-- (spaces n) generates a list of n spaces
+--
+-- It should never be called with 'n' < 0, but that can happen for reasons I don't understand
+-- Here's a test case:
+-- ncat x y = nest 4 $ cat [ x, y ]
+-- d1 = foldl1 ncat $ take 50 $ repeat $ char 'a'
+-- d2 = parens $ sep [ d1, text "+" , d1 ]
+-- main = print d2
+-- I don't feel motivated enough to find the Real Bug, so meanwhile we just test for n<=0
+spaces n | n <= 0 = ""
+ | otherwise = ' ' : spaces (n - 1)
+
+{- Comments from Johannes Waldmann about what the problem might be:
+
+ In the example above, d2 and d1 are deeply nested, but `text "+"' is not,
+ so the layout function tries to "out-dent" it.
+
+ when I look at the Doc values that are generated, there are lots of
+ Nest constructors with negative arguments. see this sample output of
+ d1 (obtained with hugs, :s -u)
+
+ tBeside (TextDetails_Chr 'a') 1 Doc_Empty) (Doc_NilAbove (Doc_Nest
+ (-241) (Doc_TextBeside (TextDetails_Chr 'a') 1 Doc_Empty)))))
+ (Doc_NilAbove (Doc_Nest (-236) (Doc_TextBeside (TextDetails_Chr 'a') 1
+ (Doc_NilAbove (Doc_Nest (-5) (Doc_TextBeside (TextDetails_Chr 'a') 1
+ Doc_Empty)))))))) (Doc_NilAbove (Doc_Nest (-231) (Doc_TextBeside
+ (TextDetails_Chr 'a') 1 (Doc_NilAbove (Doc_Nest (-5) (Doc_TextBeside
+ (TextDetails_Chr 'a') 1 (Doc_NilAbove (Doc_Nest (-5) (Doc_TextBeside
+ (TextDetails_Chr 'a') 1 Doc_Empty))))))))))) (Doc_NilAbove (Doc_Nest
+-}
projects / haskell-directory.git / blobdiff