pretty 1.0.0.0 → 1.0.1.0
raw patch · 2 files changed
+235/−129 lines, 2 filesnew-uploader
Files
- Text/PrettyPrint/HughesPJ.hs +231/−127
- pretty.cabal +4/−2
Text/PrettyPrint/HughesPJ.hs view
@@ -174,7 +174,7 @@ -- * Constructing documents -- ** Converting values into documents- char, text, ptext,+ char, text, ptext, zeroWidthText, int, integer, float, double, rational, -- ** Simple derived documents@@ -260,6 +260,10 @@ -- | An obsolete function, now identical to 'text'. ptext :: String -> Doc +-- | Some text, but without any width. Use for non-printing text+-- such as a HTML or Latex tags+zeroWidthText :: String -> 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)@@@ -347,7 +351,7 @@ -- Displaying @Doc@ values. instance Show Doc where- showsPrec prec doc cont = showDoc doc cont+ showsPrec _ doc cont = showDoc doc cont -- | Renders the document as a string using the default 'style'. render :: Doc -> String@@ -407,6 +411,10 @@ ~~~~~~~~~~~~~ <t1> text s <> text t = text (s++t) <t2> text "" <> x = x, if x non-empty+ +** because of law n6, t2 only holds if x doesn't+** start with `nest'.+ Laws for nest ~~~~~~~~~~~~~@@ -422,8 +430,8 @@ Miscellaneous ~~~~~~~~~~~~~-<m1> (text s <> x) $$ y = text s <> ((text "" <> x)) $$ - nest (-length s) y)+<m1> (text s <> x) $$ y = text s <> ((text "" <> x) $$+ nest (-length s) y) <m2> (x $$ y) <> z = x $$ (y <> z) if y non-empty@@ -483,18 +491,31 @@ brackets p = char '[' <> p <> char ']' braces p = char '{' <> p <> char '}' +-- lazy list versions+hcat = reduceAB . foldr (beside_' False) empty+hsep = reduceAB . foldr (beside_' True) empty+vcat = reduceAB . foldr (above_' True) empty -hcat = foldr (<>) empty-hsep = foldr (<+>) empty-vcat = foldr ($$) empty+beside_' :: Bool -> Doc -> Doc -> Doc+beside_' _ p Empty = p+beside_' g p q = Beside p g q +above_' :: Bool -> Doc -> Doc -> Doc+above_' _ p Empty = p+above_' g p q = Above p g q++reduceAB :: Doc -> Doc+reduceAB (Above Empty _ q) = q+reduceAB (Beside Empty _ q) = q+reduceAB doc = doc+ hang d1 n d2 = sep [d1, nest n d2] -punctuate p [] = []+punctuate _ [] = [] punctuate p (d:ds) = go d ds where- go d [] = [d]- go d (e:es) = (d <> p) : go e es+ go d' [] = [d']+ go d' (e:es) = (d' <> p) : go e es -- --------------------------------------------------------------------------- -- The Doc data type@@ -526,47 +547,50 @@ data TextDetails = Chr Char | Str String | PStr String+space_text, nl_text :: TextDetails space_text = Chr ' ' nl_text = Chr '\n' {- Here are the invariants: - * The argument of NilAbove is never Empty. Therefore- a NilAbove occupies at least two lines.+ 1) The argument of NilAbove is never Empty. Therefore+ a NilAbove occupies at least two lines. - * The arugment of @TextBeside@ is never @Nest@.+ 2) The argument of @TextBeside@ is never @Nest@. - * The layouts of the two arguments of @Union@ both flatten to the same - string.+ 3) The layouts of the two arguments of @Union@ both flatten to the same + string. - * The arguments of @Union@ are either @TextBeside@, or @NilAbove@.+ 4) The arguments of @Union@ are either @TextBeside@, or @NilAbove@. - * The right argument of a union cannot be equivalent to the empty set- (@NoDoc@). If the left argument of a union is equivalent to the- empty set (@NoDoc@), then the @NoDoc@ appears in the first line.+ 5) A @NoDoc@ may only appear on the first line of the left argument of an + union. Therefore, the right argument of an union can never be equivalent+ to the empty set (@NoDoc@). - * An empty document is always represented by @Empty@. It can't be- hidden inside a @Nest@, or a @Union@ of two @Empty@s.+ 6) An empty document is always represented by @Empty@. It can't be+ hidden inside a @Nest@, or a @Union@ of two @Empty@s. - * The first line of every layout in the left argument of @Union@ is- longer than the first line of any layout in the right argument.- (1) ensures that the left argument has a first line. In view of- (3), this invariant means that the right argument must have at- least two lines.+ 7) The first line of every layout in the left argument of @Union@ is+ longer than the first line of any layout in the right argument.+ (1) ensures that the left argument has a first line. In view of+ (3), this invariant means that the right argument must have at+ least two lines. -} - -- Arg of a NilAbove is always an RDoc+-- Invariant: Args to the 4 functions below are always RDocs+nilAbove_ :: RDoc -> RDoc nilAbove_ p = NilAbove p -- Arg of a TextBeside is always an RDoc+textBeside_ :: TextDetails -> Int -> RDoc -> RDoc textBeside_ s sl p = TextBeside s sl p - -- Arg of Nest is always an RDoc+nest_ :: Int -> RDoc -> RDoc nest_ k p = Nest k p - -- Args of union are always RDocs+union_ :: RDoc -> RDoc -> RDoc union_ p q = Union p q @@ -588,19 +612,22 @@ char c = textBeside_ (Chr c) 1 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}+zeroWidthText s = textBeside_ (Str s) 0 Empty nest k p = mkNest k (reduceDoc p) -- Externally callable version -- mkNest checks for Nest's invariant that it doesn't have an Empty inside it+mkNest :: Int -> Doc -> Doc mkNest k _ | k `seq` False = undefined mkNest k (Nest k1 p) = mkNest (k + k1) p-mkNest k NoDoc = NoDoc-mkNest k Empty = Empty+mkNest _ NoDoc = NoDoc+mkNest _ Empty = Empty mkNest 0 p = p -- Worth a try! mkNest k p = nest_ k p -- mkUnion checks for an empty document-mkUnion Empty q = Empty+mkUnion :: Doc -> Doc -> Doc+mkUnion Empty _ = Empty mkUnion p q = p `union_` q -- ---------------------------------------------------------------------------@@ -623,11 +650,11 @@ -- Specfication: aboveNest p g k q = p $g$ (nest k q) aboveNest _ _ k _ | k `seq` False = undefined-aboveNest NoDoc g k q = NoDoc+aboveNest NoDoc _ _ _ = NoDoc aboveNest (p1 `Union` p2) g k q = aboveNest p1 g k q `union_` aboveNest p2 g k q -aboveNest Empty g k q = mkNest k q+aboveNest Empty _ k q = mkNest k q aboveNest (Nest k1 p) g k q = nest_ k1 (aboveNest p g (k - k1) q) -- p can't be Empty, so no need for mkNest @@ -637,7 +664,9 @@ k1 = k - sl rest = case p of Empty -> nilAboveNest g k1 q- other -> aboveNest p g k1 q+ _ -> aboveNest p g k1 q+aboveNest (Above {}) _ _ _ = error "aboveNest Above"+aboveNest (Beside {}) _ _ _ = error "aboveNest Beside" nilAboveNest :: Bool -> Int -> RDoc -> RDoc@@ -645,7 +674,7 @@ -- = text s <> (text "" $g$ nest k q) nilAboveNest _ k _ | k `seq` False = undefined-nilAboveNest g k Empty = Empty -- Here's why the "text s <>" is in the spec!+nilAboveNest _ _ Empty = Empty -- Here's why the "text s <>" is in the spec! nilAboveNest g k (Nest k1 q) = nilAboveNest g (k + k1) q nilAboveNest g k q | (not g) && (k > 0) -- No newline if no overlap@@ -667,9 +696,9 @@ beside :: Doc -> Bool -> RDoc -> RDoc -- Specification: beside g p q = p <g> q -beside NoDoc g q = NoDoc+beside NoDoc _ _ = NoDoc beside (p1 `Union` p2) g q = (beside p1 g q) `union_` (beside p2 g q)-beside Empty g q = q+beside Empty _ q = q beside (Nest k p) g q = nest_ k (beside p g q) -- p non-empty beside p@(Beside p1 g1 q1) g2 q2 {- (A `op1` B) `op2` C == A `op1` (B `op2` C) iff op1 == op2 @@ -682,14 +711,14 @@ where rest = case p of Empty -> nilBeside g q- other -> beside p g q+ _ -> beside p g q nilBeside :: Bool -> RDoc -> RDoc -- Specification: text "" <> nilBeside g p -- = text "" <g> p -nilBeside g Empty = Empty -- Hence the text "" in the spec+nilBeside _ Empty = Empty -- Hence the text "" in the spec nilBeside g (Nest _ p) = nilBeside g p nilBeside g p | g = textBeside_ space_text 1 p | otherwise = p@@ -704,7 +733,8 @@ sep = sepX True -- Separate with spaces cat = sepX False -- Don't -sepX x [] = empty+sepX :: Bool -> [Doc] -> Doc+sepX _ [] = empty sepX x (p:ps) = sep1 x (reduceDoc p) 0 ps @@ -713,8 +743,8 @@ -- `union` x $$ nest k (vcat ys) sep1 :: Bool -> RDoc -> Int -> [Doc] -> RDoc-sep1 g _ k ys | k `seq` False = undefined-sep1 g NoDoc k ys = NoDoc+sep1 _ _ k _ | k `seq` False = undefined+sep1 _ NoDoc _ _ = NoDoc sep1 g (p `Union` q) k ys = sep1 g p k ys `union_` (aboveNest q False k (reduceDoc (vcat ys)))@@ -722,18 +752,22 @@ sep1 g Empty k ys = mkNest k (sepX g ys) sep1 g (Nest n p) k ys = nest_ n (sep1 g p (k - n) ys) -sep1 g (NilAbove p) k ys = nilAbove_ (aboveNest p False k (reduceDoc (vcat ys)))+sep1 _ (NilAbove p) k ys = nilAbove_ (aboveNest p False k (reduceDoc (vcat ys))) sep1 g (TextBeside s sl p) k ys = textBeside_ s sl (sepNB g p (k - sl) ys)+sep1 _ (Above {}) _ _ = error "sep1 Above"+sep1 _ (Beside {}) _ _ = error "sep1 Beside" -- Specification: sepNB p k ys = sep1 (text "" <> p) k ys -- Called when we have already found some text in the first item -- We have to eat up nests -sepNB g (Nest _ p) k ys = sepNB g p k ys+sepNB :: Bool -> Doc -> Int -> [Doc] -> Doc +sepNB g (Nest _ p) k ys = sepNB g p k ys -- Never triggered, because of invariant (2)+ sepNB g Empty k ys = oneLiner (nilBeside g (reduceDoc rest)) `mkUnion` - nilAboveNest False k (reduceDoc (vcat ys))+ nilAboveNest True k (reduceDoc (vcat ys)) where rest | g = hsep ys | otherwise = hcat ys@@ -746,21 +780,29 @@ fsep = fill True fcat = fill False --- Specification: --- fill [] = empty--- fill [p] = p--- fill (p1:p2:ps) = oneLiner p1 <#> nest (length p1) --- (fill (oneLiner p2 : ps))--- `union`--- p1 $$ fill ps+-- Specification:+--+-- fill g docs = fillIndent 0 docs+--+-- fillIndent k [] = []+-- fillIndent k [p] = p+-- fillIndent k (p1:p2:ps) =+-- oneLiner p1 <g> fillIndent (k + length p1 + g ? 1 : 0) (remove_nests (oneLiner p2) : ps)+-- `Union`+-- (p1 $*$ nest (-k) (fillIndent 0 ps))+--+-- $*$ is defined for layouts (not Docs) as+-- layout1 $*$ layout2 | hasMoreThanOneLine layout1 = layout1 $$ layout2+-- | otherwise = layout1 $+$ layout2 -fill g [] = empty+fill :: Bool -> [Doc] -> RDoc+fill _ [] = empty fill g (p:ps) = fill1 g (reduceDoc p) 0 ps fill1 :: Bool -> RDoc -> Int -> [Doc] -> Doc-fill1 g _ k ys | k `seq` False = undefined-fill1 g NoDoc k ys = NoDoc+fill1 _ _ k _ | k `seq` False = undefined+fill1 _ NoDoc _ _ = NoDoc fill1 g (p `Union` q) k ys = fill1 g p k ys `union_` (aboveNest q False k (fill g ys))@@ -770,19 +812,28 @@ fill1 g (NilAbove p) k ys = nilAbove_ (aboveNest p False k (fill g ys)) fill1 g (TextBeside s sl p) k ys = textBeside_ s sl (fillNB g p (k - sl) ys)+fill1 _ (Above {}) _ _ = error "fill1 Above"+fill1 _ (Beside {}) _ _ = error "fill1 Beside" -fillNB g _ k ys | k `seq` False = undefined-fillNB g (Nest _ p) k ys = fillNB g p k ys-fillNB g Empty k [] = Empty-fillNB g Empty k (y:ys) = nilBeside g (fill1 g (oneLiner (reduceDoc y)) k1 ys)+fillNB :: Bool -> Doc -> Int -> [Doc] -> Doc+fillNB _ _ k _ | k `seq` False = undefined+fillNB g (Nest _ p) k ys = fillNB g p k ys -- Never triggered, because of invariant (2)+fillNB _ Empty _ [] = Empty+fillNB g Empty k (Empty:ys) = fillNB g Empty k ys+fillNB g Empty k (y:ys) = fillNBE g k y ys+fillNB g p k ys = fill1 g p k ys++fillNBE :: Bool -> Int -> Doc -> [Doc] -> Doc+fillNBE g k y ys = nilBeside g (fill1 g ((elideNest . oneLiner . reduceDoc) y) k1 ys) `mkUnion` - nilAboveNest False k (fill g (y:ys))+ nilAboveNest True k (fill g (y:ys)) where k1 | g = k - 1 | otherwise = k -fillNB g p k ys = fill1 g p k ys-+elideNest :: Doc -> Doc+elideNest (Nest _ d) = d+elideNest d = d -- --------------------------------------------------------------------------- -- Selecting the best layout@@ -793,28 +844,32 @@ -> RDoc -> RDoc -- No unions in here! -best OneLineMode w r p- = get p+best OneLineMode _ _ p0+ = get p0 -- unused, due to the use of easy_display in full_render where get Empty = Empty get NoDoc = NoDoc get (NilAbove p) = nilAbove_ (get p) get (TextBeside s sl p) = textBeside_ s sl (get p)- get (Nest k p) = get p -- Elide nest+ get (Nest _ p) = get p -- Elide nest get (p `Union` q) = first (get p) (get q)+ get (Above {}) = error "best OneLineMode get Above"+ get (Beside {}) = error "best OneLineMode get Beside" -best mode w r p- = get w p+best _ w0 r p0+ = get w0 p0 where get :: Int -- (Remaining) width of line -> Doc -> Doc get w _ | w==0 && False = undefined- get w Empty = Empty- get w NoDoc = NoDoc+ get _ Empty = Empty+ get _ NoDoc = NoDoc get w (NilAbove p) = nilAbove_ (get w p) get w (TextBeside s sl p) = textBeside_ s sl (get1 w sl p) get w (Nest k p) = nest_ k (get (w - k) p) get w (p `Union` q) = nicest w r (get w p) (get w q)+ get _ (Above {}) = error "best get Above"+ get _ (Beside {}) = error "best get Beside" get1 :: Int -- (Remaining) width of line -> Int -- Amount of first line already eaten up@@ -822,15 +877,20 @@ -> Doc -- No unions in here! get1 w _ _ | w==0 && False = undefined- get1 w sl Empty = Empty- get1 w sl NoDoc = NoDoc+ get1 _ _ Empty = Empty+ get1 _ _ NoDoc = NoDoc get1 w sl (NilAbove p) = nilAbove_ (get (w - sl) p) get1 w sl (TextBeside t tl p) = textBeside_ t tl (get1 w (sl + tl) p)- get1 w sl (Nest k p) = get1 w sl p+ get1 w sl (Nest _ p) = get1 w sl p get1 w sl (p `Union` q) = nicest1 w r sl (get1 w sl p) (get1 w sl q)+ get1 _ _ (Above {}) = error "best get1 Above"+ get1 _ _ (Beside {}) = error "best get1 Beside" +nicest :: Int -> Int -> Doc -> Doc -> Doc nicest w r p q = nicest1 w r 0 p q++nicest1 :: Int -> Int -> Int -> Doc -> Doc -> Doc nicest1 w r sl p q | fits ((w `minn` r) - sl) p = p | otherwise = q @@ -838,53 +898,67 @@ -> Doc -> Bool -- True if *first line* of Doc fits in space available -fits n p | n < 0 = False-fits n NoDoc = False-fits n Empty = True-fits n (NilAbove _) = True+fits n _ | n < 0 = False+fits _ NoDoc = False+fits _ Empty = True+fits _ (NilAbove _) = True fits n (TextBeside _ sl p) = fits (n - sl) p+fits _ (Above {}) = error "fits Above"+fits _ (Beside {}) = error "fits Beside"+fits _ (Union {}) = error "fits Union"+fits _ (Nest {}) = error "fits Nest" +minn :: Int -> Int -> Int minn x y | x < y = x | otherwise = y -- @first@ and @nonEmptySet@ are similar to @nicest@ and @fits@, only simpler. -- @first@ returns its first argument if it is non-empty, otherwise its second. -first p q | nonEmptySet p = p +first :: Doc -> Doc -> Doc+first p q | nonEmptySet p = p -- unused, because (get OneLineMode) is unused | otherwise = q +nonEmptySet :: Doc -> Bool nonEmptySet NoDoc = False-nonEmptySet (p `Union` q) = True+nonEmptySet (_ `Union` _) = True nonEmptySet Empty = True-nonEmptySet (NilAbove p) = True -- NoDoc always in first line+nonEmptySet (NilAbove _) = True -- NoDoc always in first line nonEmptySet (TextBeside _ _ p) = nonEmptySet p nonEmptySet (Nest _ p) = nonEmptySet p+nonEmptySet (Above {}) = error "nonEmptySet Above"+nonEmptySet (Beside {}) = error "nonEmptySet Beside" -- @oneLiner@ returns the one-line members of the given set of @Doc@s. oneLiner :: Doc -> Doc oneLiner NoDoc = NoDoc oneLiner Empty = Empty-oneLiner (NilAbove p) = NoDoc+oneLiner (NilAbove _) = NoDoc oneLiner (TextBeside s sl p) = textBeside_ s sl (oneLiner p) oneLiner (Nest k p) = nest_ k (oneLiner p)-oneLiner (p `Union` q) = oneLiner p+oneLiner (p `Union` _) = oneLiner p+oneLiner (Above {}) = error "oneLiner Above"+oneLiner (Beside {}) = error "oneLiner Beside" -- --------------------------------------------------------------------------- -- Displaying the best layout -renderStyle style doc - = fullRender (mode style)- (lineLength style)- (ribbonsPerLine style)+renderStyle the_style doc+ = fullRender (mode the_style)+ (lineLength the_style)+ (ribbonsPerLine the_style) string_txt "" doc render doc = showDoc doc ""++showDoc :: Doc -> String -> String showDoc doc rest = fullRender PageMode 100 1.5 string_txt rest doc +string_txt :: TextDetails -> String -> String string_txt (Chr c) s = c:s string_txt (Str s1) s2 = s1 ++ s2 string_txt (PStr s1) s2 = s1 ++ s2@@ -893,27 +967,34 @@ fullRender OneLineMode _ _ txt end doc = easy_display space_text txt end (reduceDoc doc) fullRender LeftMode _ _ txt end doc = easy_display nl_text txt end (reduceDoc doc) -fullRender mode line_length ribbons_per_line txt end doc- = display mode line_length ribbon_length txt end best_doc+fullRender the_mode line_length ribbons_per_line txt end doc+ = display the_mode line_length ribbon_length txt end best_doc where - best_doc = best mode hacked_line_length ribbon_length (reduceDoc doc)+ best_doc = best the_mode hacked_line_length ribbon_length (reduceDoc doc) hacked_line_length, ribbon_length :: Int ribbon_length = round (fromIntegral line_length / ribbons_per_line)- hacked_line_length = case mode of { ZigZagMode -> maxBound; other -> line_length }+ hacked_line_length = case the_mode of+ ZigZagMode -> maxBound+ _ -> line_length -display mode page_width ribbon_width txt end doc+display :: Mode -> Int -> Int -> (TextDetails -> a -> a) -> a -> Doc -> a+display the_mode page_width ribbon_width txt end doc = case page_width - ribbon_width of { gap_width -> case gap_width `quot` 2 of { shift -> let lay k _ | k `seq` False = undefined lay k (Nest k1 p) = lay (k + k1) p- lay k Empty = end+ lay _ Empty = end+ lay _ (Above {}) = error "display lay Above"+ lay _ (Beside {}) = error "display lay Beside"+ lay _ NoDoc = error "display lay NoDoc"+ lay _ (Union {}) = error "display lay Union" lay k (NilAbove p) = nl_text `txt` lay k p lay k (TextBeside s sl p)- = case mode of+ = case the_mode of ZigZagMode | k >= gap_width -> nl_text `txt` ( Str (multi_ch shift '/') `txt` (@@ -926,7 +1007,7 @@ nl_text `txt` ( lay1 (k + shift) s sl p ))) - other -> lay1 k s sl p+ _ -> lay1 k s sl p lay1 k _ sl _ | k+sl `seq` False = undefined lay1 k s sl p = Str (indent k) `txt` (s `txt` lay2 (k + sl) p)@@ -935,57 +1016,80 @@ lay2 k (NilAbove p) = nl_text `txt` lay k p lay2 k (TextBeside s sl p) = s `txt` (lay2 (k + sl) p) lay2 k (Nest _ p) = lay2 k p- lay2 k Empty = end+ lay2 _ Empty = end+ lay2 _ (Above {}) = error "display lay2 Above"+ lay2 _ (Beside {}) = error "display lay2 Beside"+ lay2 _ NoDoc = error "display lay2 NoDoc"+ lay2 _ (Union {}) = error "display lay2 Union" in lay 0 doc }} +cant_fail :: a cant_fail = error "easy_display: NoDoc"-easy_display nl_text txt end doc ++easy_display :: TextDetails -> (TextDetails -> a -> a) -> a -> Doc -> a+easy_display nl_space_text txt end doc = lay doc cant_fail where lay NoDoc no_doc = no_doc- lay (Union p q) no_doc = {- lay p -} (lay q cant_fail) -- Second arg can't be NoDoc- lay (Nest k p) no_doc = lay p no_doc- lay Empty no_doc = end- 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+ lay (Union _p q) _ = {- lay p -} (lay q cant_fail) -- Second arg can't be NoDoc+ lay (Nest _ p) no_doc = lay p no_doc+ lay Empty _ = end+ lay (NilAbove p) _ = nl_space_text `txt` lay p cant_fail -- NoDoc always on first line+ lay (TextBeside s _ p) no_doc = s `txt` lay p no_doc+ lay (Above {}) _ = error "easy_display Above"+ lay (Beside {}) _ = error "easy_display Beside" -- 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 :: Int -> String indent n = spaces n -multi_ch 0 ch = ""+multi_ch :: Int -> Char -> String+multi_ch 0 _ = "" multi_ch n ch = ch : multi_ch (n - 1) ch -- (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)+-- returns the empty string on negative argument.+--+spaces :: Int -> String+spaces n+ {-+ | n < 0 = trace "Warning: negative indentation" ""+ -}+ | n <= 0 = ""+ | otherwise = ' ' : spaces (n - 1) -{- Comments from Johannes Waldmann about what the problem might be:+{-+Q: What is the reason for negative indentation (i.e. argument to indent+ is < 0) ? - 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+A:+This indicates an error in the library client's code.+If we compose a <> b, and the first line of b is more indented than some+other lines of b, the law <n6> (<> eats nests) may cause the pretty+printer to produce an invalid layout:++doc |0123345+------------------+d1 |a...|+d2 |...b|+ |c...|++d1<>d2 |ab..|+ c|....|++Consider a <> b, let `s' be the length of the last line of `a', `k' the+indentation of the first line of b, and `k0' the indentation of the+left-most line b_i of b.++The produced layout will have negative indentation if `k - k0 > s', as+the first line of b will be put on the (s+1)th column, effectively+translating b horizontally by (k-s). Now if the i^th line of b has an+indentation k0 < (k-s), it is translated out-of-page, causing+`negative indentation'. -}+
pretty.cabal view
@@ -1,11 +1,13 @@ name: pretty-version: 1.0.0.0+version: 1.0.1.0 license: BSD3 license-file: LICENSE maintainer: libraries@haskell.org synopsis: Pretty-printing library+category: Text description:- This package contains a pretty-printing library.+ This package contains John Hughes's pretty-printing library,+ heavily modified by Simon Peyton Jones. build-type: Simple exposed-modules: Text.PrettyPrint