Merge branch 'anchors-redux'

3 files changed, 11 insertions, 8 deletions

diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
index 98df09fe..26aeaff8 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
@@ -43,12 +43,13 @@ import Haddock.Backends.Xhtml.DocMarkup
 import Haddock.Backends.Xhtml.Types
 import Haddock.Backends.Xhtml.Utils
 import Haddock.Types
-import Haddock.Utils (makeAnchorId)
+import Haddock.Utils (makeAnchorId, nameAnchorId)
 import qualified Data.Map as Map
 import Text.XHtml hiding ( name, title, p, quote )
 
 import FastString            ( unpackFS )
 import GHC
+import Name (nameOccName)
 
 --------------------------------------------------------------------------------
 -- * Sections of the document
@@ -256,9 +257,11 @@ topDeclElem lnks loc splice names html =
 -- | Adds a source and wiki link at the right hand side of the box.
 -- Name must be documented, otherwise we wouldn't get here.
 links :: LinksInfo -> SrcSpan -> Bool -> DocName -> Html
-links ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice (Documented n mdl) =
-   (srcLink <+> wikiLink)
-  where srcLink = let nameUrl = Map.lookup origPkg sourceMap
+links ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice docName@(Documented n mdl) =
+  srcLink <+> wikiLink <+> (selfLink ! [theclass "selflink"] << "#")
+  where selfLink = linkedAnchor (nameAnchorId (nameOccName (getName docName)))
+
+        srcLink = let nameUrl = Map.lookup origPkg sourceMap
                       lineUrl = Map.lookup origPkg lineMap
                       mUrl | splice    = lineUrl
                                         -- Use the lineUrl as a backup
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
index c69710d1..5492178b 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Names.hs
@@ -120,11 +120,11 @@ ppBinderWith :: Notation -> Bool -> OccName -> Html
 -- the documentation or is the actual definition; in the latter case, we also
 -- set the 'id' and 'class' attributes.
 ppBinderWith notation isRef n =
-  linkedAnchor name ! attributes << ppBinder' notation n
+  makeAnchor << ppBinder' notation n
   where
     name = nameAnchorId n
-    attributes | isRef     = []
-               | otherwise = [identifier name, theclass "def"]
+    makeAnchor | isRef     = linkedAnchor name
+               | otherwise = namedAnchor name ! [theclass "def"]
 
 ppBinder' :: Notation -> OccName -> Html
 ppBinder' notation n = wrapInfix notation n $ ppOccName n
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
index 98ff4007..1d49807d 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs
@@ -195,7 +195,7 @@ dot = toHtml "."
 
 -- | Generate a named anchor
 namedAnchor :: String -> Html -> Html
-namedAnchor n = anchor ! [XHtml.name n]
+namedAnchor n = anchor ! [XHtml.identifier n]
 
 
 linkedAnchor :: String -> Html -> Html