2 -- The above warning supression flag is a temporary kludge.
3 -- While working on this module you are encouraged to remove it and fix
4 -- any warnings in the module. See
5 -- http://hackage.haskell.org/trac/ghc/wiki/Commentary/CodingStyle#Warnings
16 #include "HsVersions.h"
21 import Data.Char (isSpace)
25 | DocAppend (HsDoc id) (HsDoc id)
27 | DocParagraph (HsDoc id)
30 | DocEmphasis (HsDoc id)
31 | DocMonospaced (HsDoc id)
32 | DocUnorderedList [HsDoc id]
33 | DocOrderedList [HsDoc id]
34 | DocDefList [(HsDoc id, HsDoc id)]
35 | DocCodeBlock (HsDoc id)
40 type LHsDoc a = Located (HsDoc a)
42 instance Outputable (HsDoc a) where
43 ppr _ = text "<document comment>"
45 ppr_mbDoc (Just doc) = ppr doc
46 ppr_mbDoc Nothing = empty
48 -- used to make parsing easier; we group the list items later
49 docAppend :: HsDoc id -> HsDoc id -> HsDoc id
50 docAppend (DocUnorderedList ds1) (DocUnorderedList ds2)
51 = DocUnorderedList (ds1++ds2)
52 docAppend (DocUnorderedList ds1) (DocAppend (DocUnorderedList ds2) d)
53 = DocAppend (DocUnorderedList (ds1++ds2)) d
54 docAppend (DocOrderedList ds1) (DocOrderedList ds2)
55 = DocOrderedList (ds1++ds2)
56 docAppend (DocOrderedList ds1) (DocAppend (DocOrderedList ds2) d)
57 = DocAppend (DocOrderedList (ds1++ds2)) d
58 docAppend (DocDefList ds1) (DocDefList ds2)
59 = DocDefList (ds1++ds2)
60 docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d)
61 = DocAppend (DocDefList (ds1++ds2)) d
62 docAppend DocEmpty d = d
63 docAppend d DocEmpty = d
67 -- again to make parsing easier - we spot a paragraph whose only item
68 -- is a DocMonospaced and make it into a DocCodeBlock
69 docParagraph :: HsDoc id -> HsDoc id
70 docParagraph (DocMonospaced p)
71 = DocCodeBlock (docCodeBlock p)
72 docParagraph (DocAppend (DocString s1) (DocMonospaced p))
74 = DocCodeBlock (docCodeBlock p)
75 docParagraph (DocAppend (DocString s1)
76 (DocAppend (DocMonospaced p) (DocString s2)))
77 | all isSpace s1 && all isSpace s2
78 = DocCodeBlock (docCodeBlock p)
79 docParagraph (DocAppend (DocMonospaced p) (DocString s2))
81 = DocCodeBlock (docCodeBlock p)
86 -- Drop trailing whitespace from @..@ code blocks. Otherwise this:
92 -- turns into (DocCodeBlock "\nfoo\n ") which when rendered in HTML
93 -- gives an extra vertical space after the code block. The single space
94 -- on the final line seems to trigger the extra vertical space.
96 docCodeBlock :: HsDoc id -> HsDoc id
97 docCodeBlock (DocString s)
98 = DocString (reverse $ dropWhile (`elem` " \t") $ reverse s)
99 docCodeBlock (DocAppend l r)
100 = DocAppend l (docCodeBlock r)