diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/HaddockHtml.hs | 20 | ||||
| -rw-r--r-- | src/HsSyn.lhs | 20 |
2 files changed, 29 insertions, 11 deletions
diff --git a/src/HaddockHtml.hs b/src/HaddockHtml.hs index 7009ba89..db4016bf 100644 --- a/src/HaddockHtml.hs +++ b/src/HaddockHtml.hs @@ -860,6 +860,7 @@ ppHsModule mdl = anchor ! [href ((moduleHtmlFile fp modname) ++ ref)] << toHtml -- ----------------------------------------------------------------------------- -- * Doc Markup + htmlMarkup :: DocMarkup [HsQName] Html htmlMarkup = Markup { markupParagraph = paragraph, @@ -880,9 +881,22 @@ htmlMarkup = Markup { -- If the doc is a single paragraph, don't surround it with <P> (this causes -- ugly extra whitespace with some browsers). docToHtml :: Doc -> Html -docToHtml (DocParagraph d) = docToHtml d -docToHtml (DocCodeBlock d) = docToHtml (DocMonospaced d) -docToHtml doc = markup htmlMarkup doc +docToHtml doc = markup htmlMarkup (unParagraph (markup htmlCleanup doc)) + +-- If there is a single paragraph, then surrounding it with <P>..</P> +-- can add too much whitespace in some browsers (eg. IE). However if +-- we have multiple paragraphs, then we want the extra whitespace to +-- separate them. So we catch the single paragraph case and transform it +-- here. +unParagraph (DocParagraph d) = d +unParagraph (DocCodeBlock d) = (DocMonospaced d) +unParagraph doc = doc + +htmlCleanup :: DocMarkup [HsQName] Doc +htmlCleanup = idMarkup { + markupUnorderedList = DocUnorderedList . map unParagraph, + markupOrderedList = DocOrderedList . map unParagraph + } -- ----------------------------------------------------------------------------- -- * Misc diff --git a/src/HsSyn.lhs b/src/HsSyn.lhs index cde2ce63..d7d18f20 100644 --- a/src/HsSyn.lhs +++ b/src/HsSyn.lhs @@ -1,5 +1,5 @@ % ----------------------------------------------------------------------------- -% $Id: HsSyn.lhs,v 1.14 2002/07/25 14:37:29 simonmar Exp $ +% $Id: HsSyn.lhs,v 1.15 2002/08/02 09:25:23 simonmar Exp $ % % (c) The GHC Team, 1997-2002 % @@ -31,7 +31,7 @@ module HsSyn ( unit_tycon, fun_tycon, list_tycon, tuple_tycon, GenDoc(..), Doc, DocMarkup(..), - markup, mapIdent, + markup, mapIdent, idMarkup, docAppend, docParagraph, ) where @@ -432,16 +432,14 @@ markup m (DocCodeBlock d) = markupCodeBlock m (markup m d) markup m (DocURL url) = markupURL m url markup m (DocAName ref) = markupAName m ref --- | Since marking up is just a matter of mapping 'Doc' into some --- other type, we can \'rename\' documentation by marking up 'Doc' into --- the same thing, modifying only the identifiers embedded in it. -mapIdent :: (a -> GenDoc b) -> DocMarkup a (GenDoc b) -mapIdent f = Markup { +-- | The identity markup +idMarkup :: DocMarkup a (GenDoc a) +idMarkup = Markup { markupEmpty = DocEmpty, markupString = DocString, markupParagraph = DocParagraph, markupAppend = DocAppend, - markupIdentifier = f, + markupIdentifier = DocIdentifier, markupModule = DocModule, markupEmphasis = DocEmphasis, markupMonospaced = DocMonospaced, @@ -452,6 +450,12 @@ mapIdent f = Markup { markupAName = DocAName } +-- | Since marking up is just a matter of mapping 'Doc' into some +-- other type, we can \'rename\' documentation by marking up 'Doc' into +-- the same thing, modifying only the identifiers embedded in it. +mapIdent :: (a -> GenDoc b) -> DocMarkup a (GenDoc b) +mapIdent f = idMarkup{ markupIdentifier = f } + -- ----------------------------------------------------------------------------- -- ** Smart constructors |