diff options
Diffstat (limited to 'src/Haddock/Backends/Xhtml')
-rw-r--r-- | src/Haddock/Backends/Xhtml/DocMarkup.hs | 2 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Names.hs | 30 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Util.hs | 14 |
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. |