aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
diff options
context:
space:
mode:
authorPhil Ruffwind <rf@rufflewind.com>2015-09-30 02:22:43 -0400
committerBen Gamari <ben@smart-cactus.org>2016-02-08 17:51:21 +0100
commit1b6bcd62e7f5534be45a0d5737b76d181c2d934b (patch)
treecff5673e3bf990748c1b75cb7d25f19d8dd6283f /haddock-api/src/Haddock/Backends/Xhtml/Layout.hs
parent228a0d72baa04be161b0fc918266f2edb0c6519b (diff)
Move the permalinks to "#" on the right side
Since pull request #407, the identifiers have been permalinked to themselves, but this makes it difficult to copy the identifier by double-clicking. To work around this usability problem, the permalinks are now placed on the far right adjacent to "Source", indicated by "#". Also, 'namedAnchor' now uses 'id' instead of 'name' (which is obsolete).
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml/Layout.hs')
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Layout.hs11
1 files changed, 7 insertions, 4 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