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. | 
