Comments only
[ghc-hetmet.git] / compiler / hsSyn / HsDoc.hs
1 module HsDoc (
2   HsDoc(..),
3   LHsDoc,
4   docAppend,
5   docParagraph,
6   ppr_mbDoc
7   ) where
8
9 #include "HsVersions.h"
10
11 import Outputable
12 import SrcLoc
13
14 import Data.Char (isSpace)
15
16 data HsDoc id
17   = DocEmpty
18   | DocAppend (HsDoc id) (HsDoc id)
19   | DocString String
20   | DocParagraph (HsDoc id)
21   | DocIdentifier [id]
22   | DocModule String
23   | DocEmphasis (HsDoc id)
24   | DocMonospaced (HsDoc id)
25   | DocUnorderedList [HsDoc id]
26   | DocOrderedList [HsDoc id]
27   | DocDefList [(HsDoc id, HsDoc id)]
28   | DocCodeBlock (HsDoc id)
29   | DocURL String
30   | DocPic String
31   | DocAName String
32   deriving (Eq, Show)
33
34 type LHsDoc a = Located (HsDoc a)
35
36 instance Outputable (HsDoc a) where
37   ppr _ = text "<document comment>"
38
39 ppr_mbDoc :: Maybe (LHsDoc a) -> SDoc
40 ppr_mbDoc (Just doc) = ppr doc
41 ppr_mbDoc Nothing    = empty
42
43 -- used to make parsing easier; we group the list items later
44 docAppend :: HsDoc id -> HsDoc id -> HsDoc id
45 docAppend (DocUnorderedList ds1) (DocUnorderedList ds2)
46   = DocUnorderedList (ds1++ds2)
47 docAppend (DocUnorderedList ds1) (DocAppend (DocUnorderedList ds2) d)
48   = DocAppend (DocUnorderedList (ds1++ds2)) d
49 docAppend (DocOrderedList ds1) (DocOrderedList ds2)
50   = DocOrderedList (ds1++ds2)
51 docAppend (DocOrderedList ds1) (DocAppend (DocOrderedList ds2) d)
52   = DocAppend (DocOrderedList (ds1++ds2)) d
53 docAppend (DocDefList ds1) (DocDefList ds2)
54   = DocDefList (ds1++ds2)
55 docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d)
56   = DocAppend (DocDefList (ds1++ds2)) d
57 docAppend DocEmpty d = d
58 docAppend d DocEmpty = d
59 docAppend d1 d2
60   = DocAppend d1 d2
61
62 -- again to make parsing easier - we spot a paragraph whose only item
63 -- is a DocMonospaced and make it into a DocCodeBlock
64 docParagraph :: HsDoc id -> HsDoc id
65 docParagraph (DocMonospaced p)
66   = DocCodeBlock (docCodeBlock p)
67 docParagraph (DocAppend (DocString s1) (DocMonospaced p))
68   | all isSpace s1
69   = DocCodeBlock (docCodeBlock p)
70 docParagraph (DocAppend (DocString s1)
71     (DocAppend (DocMonospaced p) (DocString s2)))
72   | all isSpace s1 && all isSpace s2
73   = DocCodeBlock (docCodeBlock p)
74 docParagraph (DocAppend (DocMonospaced p) (DocString s2))
75   | all isSpace s2
76   = DocCodeBlock (docCodeBlock p)
77 docParagraph p
78   = DocParagraph p
79
80
81 -- Drop trailing whitespace from @..@ code blocks.  Otherwise this:
82 --
83 --    -- @
84 --    -- foo
85 --    -- @
86 --
87 -- turns into (DocCodeBlock "\nfoo\n ") which when rendered in HTML
88 -- gives an extra vertical space after the code block.  The single space
89 -- on the final line seems to trigger the extra vertical space.
90 --
91 docCodeBlock :: HsDoc id -> HsDoc id
92 docCodeBlock (DocString s)
93   = DocString (reverse $ dropWhile (`elem` " \t") $ reverse s)
94 docCodeBlock (DocAppend l r)
95   = DocAppend l (docCodeBlock r)
96 docCodeBlock d = d