diff options
| author | Isaac Dupree <id@isaac.cedarswampstudios.org> | 2009-08-23 03:08:03 +0000 |
|---|---|---|
| committer | Isaac Dupree <id@isaac.cedarswampstudios.org> | 2009-08-23 03:08:03 +0000 |
| commit | 70945271f1f4deab363c1acfef3ce51a1b7f617d (patch) | |
| tree | 81d518f2ca4dde1a1c72072b8a67290de2952388 /src/Haddock/HsDoc.hs | |
| parent | 9dc98d20af5bbcb8bff7624b3d8c4d840ed6bb4e (diff) | |
Move doc parsing/lexing into Haddock for ghc>=6.11
Diffstat (limited to 'src/Haddock/HsDoc.hs')
| -rw-r--r-- | src/Haddock/HsDoc.hs | 73 |
1 files changed, 73 insertions, 0 deletions
diff --git a/src/Haddock/HsDoc.hs b/src/Haddock/HsDoc.hs new file mode 100644 index 00000000..489873a7 --- /dev/null +++ b/src/Haddock/HsDoc.hs @@ -0,0 +1,73 @@ +module Haddock.HsDoc ( + docAppend, + docParagraph + ) where + +#if __GLASGOW_HASKELL__ <= 610 + +import HsDoc -- just re-export + +#else + +import Haddock.Types + +import Data.Char (isSpace) + + +-- used to make parsing easier; we group the list items later +docAppend :: HsDoc id -> HsDoc id -> HsDoc id +docAppend (DocUnorderedList ds1) (DocUnorderedList ds2) + = DocUnorderedList (ds1++ds2) +docAppend (DocUnorderedList ds1) (DocAppend (DocUnorderedList ds2) d) + = DocAppend (DocUnorderedList (ds1++ds2)) d +docAppend (DocOrderedList ds1) (DocOrderedList ds2) + = DocOrderedList (ds1++ds2) +docAppend (DocOrderedList ds1) (DocAppend (DocOrderedList ds2) d) + = DocAppend (DocOrderedList (ds1++ds2)) d +docAppend (DocDefList ds1) (DocDefList ds2) + = DocDefList (ds1++ds2) +docAppend (DocDefList ds1) (DocAppend (DocDefList ds2) d) + = DocAppend (DocDefList (ds1++ds2)) d +docAppend DocEmpty d = d +docAppend d DocEmpty = d +docAppend d1 d2 + = DocAppend d1 d2 + +-- again to make parsing easier - we spot a paragraph whose only item +-- is a DocMonospaced and make it into a DocCodeBlock +docParagraph :: HsDoc id -> HsDoc id +docParagraph (DocMonospaced p) + = DocCodeBlock (docCodeBlock p) +docParagraph (DocAppend (DocString s1) (DocMonospaced p)) + | all isSpace s1 + = DocCodeBlock (docCodeBlock p) +docParagraph (DocAppend (DocString s1) + (DocAppend (DocMonospaced p) (DocString s2))) + | all isSpace s1 && all isSpace s2 + = DocCodeBlock (docCodeBlock p) +docParagraph (DocAppend (DocMonospaced p) (DocString s2)) + | all isSpace s2 + = DocCodeBlock (docCodeBlock p) +docParagraph p + = DocParagraph p + + +-- Drop trailing whitespace from @..@ code blocks. Otherwise this: +-- +-- -- @ +-- -- foo +-- -- @ +-- +-- turns into (DocCodeBlock "\nfoo\n ") which when rendered in HTML +-- gives an extra vertical space after the code block. The single space +-- on the final line seems to trigger the extra vertical space. +-- +docCodeBlock :: HsDoc id -> HsDoc id +docCodeBlock (DocString s) + = DocString (reverse $ dropWhile (`elem` " \t") $ reverse s) +docCodeBlock (DocAppend l r) + = DocAppend l (docCodeBlock r) +docCodeBlock d = d + +#endif + |