diff options
Diffstat (limited to 'src/Haddock')
| -rw-r--r-- | src/Haddock/Backends/Html.hs | 23 |
1 files changed, 17 insertions, 6 deletions
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs index bd305518..9e01e67d 100644 --- a/src/Haddock/Backends/Html.hs +++ b/src/Haddock/Backends/Html.hs @@ -1586,13 +1586,13 @@ ppModule mod ref = anchor ! [href ((moduleHtmlFile mod) ++ ref)] -- ----------------------------------------------------------------------------- -- * Doc Markup -parHtmlMarkup :: (a -> Html) -> DocMarkup a Html -parHtmlMarkup ppId = Markup { +parHtmlMarkup :: (a -> Html) -> (a -> Bool) -> DocMarkup a Html +parHtmlMarkup ppId isTyCon = Markup { markupParagraph = paragraph, markupEmpty = toHtml "", markupString = toHtml, markupAppend = (+++), - markupIdentifier = tt . ppId . head, + markupIdentifier = tt . ppId . choose, markupModule = \m -> let (mod,ref) = break (=='#') m in ppModule (mkModuleNoPackage mod) ref, markupEmphasis = emphasize . toHtml, markupMonospaced = tt . toHtml, @@ -1604,12 +1604,23 @@ parHtmlMarkup ppId = Markup { markupURL = \url -> anchor ! [href url] << toHtml url, markupAName = \aname -> namedAnchor aname << toHtml "" } + where + -- If an id can refer to multiple things, we give precedence to type + -- constructors. This should ideally be done during renaming from RdrName + -- to Name, but since we will move this process from GHC into Haddock in + -- the future, we fix it here in the meantime. + -- TODO: mention this rule in the documentation. + choose [x] = x + choose (x:y:_) + | isTyCon x = x + | otherwise = y + markupDef (a,b) = dterm << a +++ ddef << b -htmlMarkup = parHtmlMarkup ppDocName -htmlOrigMarkup = parHtmlMarkup ppName -htmlRdrMarkup = parHtmlMarkup ppRdrName +htmlMarkup = parHtmlMarkup ppDocName (isTyConName . getName) +htmlOrigMarkup = parHtmlMarkup ppName isTyConName +htmlRdrMarkup = parHtmlMarkup ppRdrName isRdrTc -- If the doc is a single paragraph, don't surround it with <P> (this causes -- ugly extra whitespace with some browsers). |