aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends
diff options
context:
space:
mode:
authorDavid Waern <david.waern@gmail.com>2011-11-26 04:20:12 +0100
committerDavid Waern <david.waern@gmail.com>2011-11-26 04:20:12 +0100
commit3ebdc745d7bc79307986332dc71f3495099b4579 (patch)
treec1e15b26b65e079a52000b37791077eee687d659 /src/Haddock/Backends
parentc3278a9d3c17ea0929d39116e431a2839bb845ca (diff)
Give preference to type over data constructors for doc comment links at renaming time.
Previously this was done in the backends. Also, warn when a doc comment refers to something that is in scope but which we don't have the .haddock file for. These changes mean we can make DocIdentifier [a] into DocIdentifier a.
Diffstat (limited to 'src/Haddock/Backends')
-rw-r--r--src/Haddock/Backends/Hoogle.hs2
-rw-r--r--src/Haddock/Backends/LaTeX.hs26
-rw-r--r--src/Haddock/Backends/Xhtml/DocMarkup.hs25
3 files changed, 14 insertions, 39 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index 45399963..ed8d4665 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -232,7 +232,7 @@ markupTag = Markup {
markupEmpty = str "",
markupString = str,
markupAppend = (++),
- markupIdentifier = box (TagInline "a") . str . out . head,
+ markupIdentifier = box (TagInline "a") . str . out,
markupModule = box (TagInline "a") . str,
markupEmphasis = box (TagInline "i"),
markupMonospaced = box (TagInline "tt"),
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 5c21f0cf..fc313888 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -22,8 +22,8 @@ import qualified Pretty
import GHC
import OccName
-import Name ( isTyConName, nameOccName )
-import RdrName ( rdrNameOcc, isRdrTc )
+import Name ( nameOccName )
+import RdrName ( rdrNameOcc )
import BasicTypes ( ipNameName )
import FastString ( unpackFS, unpackLitString )
@@ -997,9 +997,8 @@ latexMonoMunge c s = latexMunge c s
-------------------------------------------------------------------------------
-parLatexMarkup :: (a -> LaTeX) -> (a -> Bool)
- -> DocMarkup a (StringContext -> LaTeX)
-parLatexMarkup ppId isTyCon = Markup {
+parLatexMarkup :: (a -> LaTeX) -> DocMarkup a (StringContext -> LaTeX)
+parLatexMarkup ppId = Markup {
markupParagraph = \p v -> p v <> text "\\par" $$ text "",
markupEmpty = \_ -> empty,
markupString = \s v -> text (fixString v s),
@@ -1027,26 +1026,15 @@ parLatexMarkup ppId isTyCon = Markup {
Verb -> theid
Mono -> theid
Plain -> text "\\haddockid" <> braces theid
- where theid = ppId (choose id)
-
- -- 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 [] = error "empty identifier list in HsDoc"
- choose [x] = x
- choose (x:y:_)
- | isTyCon x = x
- | otherwise = y
+ where theid = ppId id
latexMarkup :: DocMarkup DocName (StringContext -> LaTeX)
-latexMarkup = parLatexMarkup ppVerbDocName (isTyConName . getName)
+latexMarkup = parLatexMarkup ppVerbDocName
rdrLatexMarkup :: DocMarkup RdrName (StringContext -> LaTeX)
-rdrLatexMarkup = parLatexMarkup ppVerbRdrName isRdrTc
+rdrLatexMarkup = parLatexMarkup ppVerbRdrName
docToLaTeX :: Doc DocName -> LaTeX
diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 93536834..05ce7dbb 100644
--- a/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -28,17 +28,15 @@ import Haddock.Utils
import Text.XHtml hiding ( name, title, p, quote )
import GHC
-import Name
-import RdrName
-parHtmlMarkup :: (a -> Html) -> (a -> Bool) -> DocMarkup a Html
-parHtmlMarkup ppId isTyCon = Markup {
+parHtmlMarkup :: (a -> Html) -> DocMarkup a Html
+parHtmlMarkup ppId = Markup {
markupEmpty = noHtml,
markupString = toHtml,
markupParagraph = paragraph,
markupAppend = (+++),
- markupIdentifier = thecode . ppId . choose,
+ markupIdentifier = thecode . ppId,
markupModule = \m -> let (mdl,ref) = break (=='#') m
in ppModuleRef (mkModuleNoPackage mdl) ref,
markupEmphasis = emphasize,
@@ -53,17 +51,6 @@ parHtmlMarkup ppId isTyCon = Markup {
markupExample = examplesToHtml
}
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 [] = error "empty identifier list in HsDoc"
- choose [x] = x
- choose (x:y:_)
- | isTyCon x = x
- | otherwise = y
-
examplesToHtml l = pre (concatHtml $ map exampleToHtml l) ! [theclass "screen"]
exampleToHtml (Example expression result) = htmlExample
@@ -77,17 +64,17 @@ parHtmlMarkup ppId isTyCon = Markup {
-- ugly extra whitespace with some browsers). FIXME: Does this still apply?
docToHtml :: Qualification -> Doc DocName -> Html
docToHtml qual = markup fmt . cleanup
- where fmt = parHtmlMarkup (ppDocName qual) (isTyConName . getName)
+ where fmt = parHtmlMarkup (ppDocName qual)
origDocToHtml :: Doc Name -> Html
origDocToHtml = markup fmt . cleanup
- where fmt = parHtmlMarkup ppName isTyConName
+ where fmt = parHtmlMarkup ppName
rdrDocToHtml :: Doc RdrName -> Html
rdrDocToHtml = markup fmt . cleanup
- where fmt = parHtmlMarkup ppRdrName isRdrTc
+ where fmt = parHtmlMarkup ppRdrName
docElement :: (Html -> Html) -> Html -> Html