refactoring of anchor ID and fragment handling

8 files changed, 32 insertions, 38 deletions

diff --git a/src/Haddock/Backends/DevHelp.hs b/src/Haddock/Backends/DevHelp.hs
index 4028890d..e6225303 100644
--- a/src/Haddock/Backends/DevHelp.hs
+++ b/src/Haddock/Backends/DevHelp.hs
@@ -82,5 +82,5 @@ ppDevHelpFile odir doctitle maybe_package ifaces = do
     ppReference :: Name -> [Module] -> Doc
     ppReference _ [] = empty
     ppReference name (mdl:refs) =  
-      text "<function name=\""<>text (escapeStr (getOccString name))<>text"\" link=\""<>text (nameHtmlRef mdl (nameOccName name))<>text"\"/>" $$
+      text "<function name=\""<>text (escapeStr (getOccString name))<>text"\" link=\""<>text (moduleNameUrl mdl (nameOccName name))<>text"\"/>" $$
       ppReference name refs
diff --git a/src/Haddock/Backends/HH.hs b/src/Haddock/Backends/HH.hs
index 39390573..7f58fd02 100644
--- a/src/Haddock/Backends/HH.hs
+++ b/src/Haddock/Backends/HH.hs
@@ -125,7 +125,7 @@ ppHHIndex odir maybe_package ifaces = do
 
 	ppReference name [] = empty
 	ppReference name (Module mdl:refs) =
-		text "<PARAM name=\"Local\" value=\"" <> text (nameHtmlRef mdl name) <> text "\">" $$
+		text "<PARAM name=\"Local\" value=\"" <> text (moduleNameURL mdl name) <> text "\">" $$
 		ppReference name refs
 
 
diff --git a/src/Haddock/Backends/HH2.hs b/src/Haddock/Backends/HH2.hs
index 7a49bded..b2fe5e92 100644
--- a/src/Haddock/Backends/HH2.hs
+++ b/src/Haddock/Backends/HH2.hs
@@ -114,7 +114,7 @@ ppHH2Index odir maybe_package ifaces = do
 		text "</Keyword>" $$
 		ppList vs
 
-	ppJump name (Module mdl) = text "<Jump Url=\"" <> text (nameHtmlRef mdl name) <> text "\"/>"
+	ppJump name (Module mdl) = text "<Jump Url=\"" <> text (moduleNameUrl mdl name) <> text "\"/>"
 
 
 -----------------------------------------------------------------------------------
diff --git a/src/Haddock/Backends/Html.hs b/src/Haddock/Backends/Html.hs
index 09d9fc5e..013f6bc4 100644
--- a/src/Haddock/Backends/Html.hs
+++ b/src/Haddock/Backends/Html.hs
@@ -729,8 +729,7 @@ processForMiniSynopsis _ _ _ = noHtml
 
 ppNameMini :: Module -> OccName -> Html
 ppNameMini mdl nm =
-    anchor ! [ href ( moduleHtmlFile mdl ++ "#"
-                      ++ (escapeStr (anchorNameStr nm)))
+    anchor ! [ href (moduleNameUrl mdl nm)
              , target mainFrameName ]
       << ppBinder' nm
 
@@ -1669,7 +1668,7 @@ ppDocName (Documented name mdl) =
 ppDocName (Undocumented name) = toHtml (getOccString name)
 
 linkTarget :: OccName -> Html
-linkTarget n = namedAnchor (anchorNameStr n) << toHtml "" 
+linkTarget n = namedAnchor (nameAnchorId n) << toHtml "" 
 
 ppName :: Name -> Html
 ppName name = toHtml (getOccString name)
@@ -1678,7 +1677,7 @@ 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 True n = linkedAnchor (nameAnchorId n) << ppBinder' n
 ppBinder False n = linkTarget n +++ bold << ppBinder' n
 
 
@@ -1696,8 +1695,8 @@ linkIdOcc :: Module -> Maybe OccName -> Html -> Html
 linkIdOcc mdl mbName = anchor ! [href uri]
   where 
     uri = case mbName of
-      Nothing   -> moduleHtmlFile mdl
-      Just name -> nameHtmlRef mdl name
+      Nothing   -> moduleUrl mdl
+      Just name -> moduleNameUrl mdl name
 
 ppModule :: Module -> String -> Html
 ppModule mdl ref = anchor ! [href ((moduleHtmlFile mdl) ++ ref)] 
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 786a4996..a8e2e8e0 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -318,7 +318,7 @@ mkNode ss p (Node s leaf pkg short ts) =
     htmlModule = thespan ! [theclass "module" ] <<
       (if leaf
         then ppModule (mkModule (stringToPackageId (fromMaybe "" pkg)) 
-                                       (mkModuleName mdl)) ""
+                                       (mkModuleName mdl))
         else toHtml s
       )
       
@@ -597,8 +597,7 @@ processForMiniSynopsis _ _ _ = Nothing
 
 ppNameMini :: Module -> OccName -> Html
 ppNameMini mdl nm =
-    anchor ! [ href ( moduleHtmlFile mdl ++ "#"
-                      ++ (escapeStr (anchorNameStr nm)))
+    anchor ! [ href (moduleNameUrl mdl nm)
              , target mainFrameName ]
       << ppBinder' nm
 
@@ -656,7 +655,7 @@ processExport summary _ _ (ExportNoDecl y subs)
 processExport summary _ _ (ExportDoc doc)
   = nothingIf summary $ docSection doc
 processExport summary _ _ (ExportModule mdl)
-  = processDeclOneLiner summary $ toHtml "module" <+> ppModule mdl ""
+  = processDeclOneLiner summary $ toHtml "module" <+> ppModule mdl
 
 nothingIf :: Bool -> a -> Maybe a
 nothingIf True _ = Nothing
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.