aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends/Xhtml
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Backends/Xhtml')
-rw-r--r--src/Haddock/Backends/Xhtml/DocMarkup.hs2
-rw-r--r--src/Haddock/Backends/Xhtml/Names.hs30
-rw-r--r--src/Haddock/Backends/Xhtml/Util.hs14
3 files changed, 21 insertions, 25 deletions
diff --git a/src/Haddock/Backends/Xhtml/DocMarkup.hs b/src/Haddock/Backends/Xhtml/DocMarkup.hs
index 6563f914..42fc39ca 100644
--- a/src/Haddock/Backends/Xhtml/DocMarkup.hs
+++ b/src/Haddock/Backends/Xhtml/DocMarkup.hs
@@ -39,7 +39,7 @@ parHtmlMarkup ppId isTyCon = Markup {
markupAppend = (+++),
markupIdentifier = thecode . ppId . choose,
markupModule = \m -> let (mdl,ref) = break (=='#') m
- in ppModule (mkModuleNoPackage mdl) ref,
+ in ppModuleRef (mkModuleNoPackage mdl) ref,
markupEmphasis = emphasize,
markupMonospaced = thecode,
markupUnorderedList = unordList,
diff --git a/src/Haddock/Backends/Xhtml/Names.hs b/src/Haddock/Backends/Xhtml/Names.hs
index 5b3732c6..b124d42b 100644
--- a/src/Haddock/Backends/Xhtml/Names.hs
+++ b/src/Haddock/Backends/Xhtml/Names.hs
@@ -13,7 +13,7 @@
module Haddock.Backends.Xhtml.Names (
ppName, ppDocName, ppLDocName, ppRdrName,
ppBinder, ppBinder',
- ppModule,
+ ppModule, ppModuleRef,
linkId
) where
@@ -50,8 +50,8 @@ ppName name = toHtml (getOccString name)
ppBinder :: Bool -> OccName -> Html
-- The Bool indicates whether we are generating the summary, in which case
-- the binder will be a link to the full definition.
-ppBinder True n = linkedAnchor (anchorNameStr n) << ppBinder' n
-ppBinder False n = namedAnchor (anchorNameStr n) << bold << ppBinder' n
+ppBinder True n = linkedAnchor (nameAnchorId n) << ppBinder' n
+ppBinder False n = namedAnchor (nameAnchorId n) << bold << ppBinder' n
ppBinder' :: OccName -> Html
@@ -65,13 +65,19 @@ linkId mdl mbName = linkIdOcc mdl (fmap nameOccName mbName)
linkIdOcc :: Module -> Maybe OccName -> Html -> Html
-linkIdOcc mdl mbName = anchor ! [href uri]
+linkIdOcc mdl mbName = anchor ! [href url]
where
- uri = case mbName of
- Nothing -> moduleHtmlFile mdl
- Just name -> nameHtmlRef mdl name
-
-ppModule :: Module -> String -> Html
-ppModule mdl ref = anchor ! [href ((moduleHtmlFile mdl) ++ ref)]
- << toHtml (moduleString mdl)
-
+ url = case mbName of
+ Nothing -> moduleUrl mdl
+ Just name -> moduleNameUrl mdl name
+
+ppModule :: Module -> Html
+ppModule mdl = anchor ! [href (moduleUrl mdl)]
+ << toHtml (moduleString mdl)
+
+ppModuleRef :: Module -> String -> Html
+ppModuleRef mdl ref = anchor ! [href (moduleUrl mdl ++ ref)]
+ << toHtml (moduleString mdl)
+ -- NB: The ref paramaeter already includes the '#'.
+ -- This function is only called from markupModule expanding a
+ -- DocModule, which doesn't seem to be ever be used.
diff --git a/src/Haddock/Backends/Xhtml/Util.hs b/src/Haddock/Backends/Xhtml/Util.hs
index 1fcf5e94..20b246d1 100644
--- a/src/Haddock/Backends/Xhtml/Util.hs
+++ b/src/Haddock/Backends/Xhtml/Util.hs
@@ -157,21 +157,11 @@ dot = toHtml "."
-- | Generate a named anchor
---
--- This used to generate two anchor tags, one with the name unescaped, and one
--- with the name URI-escaped. This is needed because Opera 9.52 (and later
--- versions) needs the name to be unescaped, while IE 7 needs it to be escaped.
--- The escaped form for IE 7 is probably erroneous and not needed...
-
namedAnchor :: String -> Html -> Html
-namedAnchor n c = anchor ! [XHtml.name n] << c
+namedAnchor n = anchor ! [XHtml.name n]
linkedAnchor :: String -> Html -> Html
-linkedAnchor frag = anchor ! [href hr_]
- where hr_ | null frag = ""
- | otherwise = '#': escapeStr frag
- -- this escape function is over-zealous for the fragment part of a URI
- -- (':' for example does not need to be escaped)
+linkedAnchor n = anchor ! [href ('#':n)]
--
-- A section of HTML which is collapsible via a +/- button.