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