Merge remote-tracking branch 'origin/master' into ghc-head

5 files changed, 35 insertions, 28 deletions

diff --git a/haddock-api/src/Haddock.hs b/haddock-api/src/Haddock.hs
index 72a6cc92..5e8f4a4a 100644
--- a/haddock-api/src/Haddock.hs
+++ b/haddock-api/src/Haddock.hs
@@ -248,6 +248,9 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
     opt_latex_style      = optLaTeXStyle     flags
     opt_source_css       = optSourceCssFile  flags
     opt_mathjax          = optMathjax        flags
+    dflags'
+      | unicode          = gopt_set dflags Opt_PrintUnicodeSyntax
+      | otherwise        = dflags
 
     visibleIfaces    = [ i | i <- ifaces, OptHide `notElem` ifaceOptions i ]
 
@@ -287,24 +290,24 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
     sourceUrls' = (srcBase, srcModule', pkgSrcMap', pkgSrcLMap')
 
   libDir   <- getHaddockLibDir flags
-  prologue <- getPrologue dflags flags
+  prologue <- getPrologue dflags' flags
   themes   <- getThemes libDir flags >>= either bye return
 
   when (Flag_GenIndex `elem` flags) $ do
     ppHtmlIndex odir title pkgStr
-                themes opt_contents_url sourceUrls' opt_wiki_urls
+                themes opt_mathjax opt_contents_url sourceUrls' opt_wiki_urls
                 allVisibleIfaces pretty
     copyHtmlBits odir libDir themes
 
   when (Flag_GenContents `elem` flags) $ do
-    ppHtmlContents dflags odir title pkgStr
+    ppHtmlContents dflags' odir title pkgStr
                    themes opt_mathjax opt_index_url sourceUrls' opt_wiki_urls
                    allVisibleIfaces True prologue pretty
                    (makeContentsQual qual)
     copyHtmlBits odir libDir themes
 
   when (Flag_Html `elem` flags) $ do
-    ppHtml dflags title pkgStr visibleIfaces odir
+    ppHtml dflags' title pkgStr visibleIfaces odir
                 prologue
                 themes opt_mathjax sourceUrls' opt_wiki_urls
                 opt_contents_url opt_index_url unicode qual
@@ -326,7 +329,7 @@ render dflags flags qual ifaces installedIfaces extSrcMap = do
       Just (PackageName pkgNameFS, pkgVer) ->
           let pkgNameStr | unpackFS pkgNameFS == "main" && title /= [] = title
                          | otherwise = unpackFS pkgNameFS
-          in ppHoogle dflags pkgNameStr pkgVer title (fmap _doc prologue)
+          in ppHoogle dflags' pkgNameStr pkgVer title (fmap _doc prologue)
                visibleIfaces odir
 
   when (Flag_LaTeX `elem` flags) $ do
diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index ebd53370..f7284062 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -90,11 +90,11 @@ ppHtml dflags doctitle maybe_package ifaces odir prologue
 
   when (isNothing maybe_index_url) $
     ppHtmlIndex odir doctitle maybe_package
-      themes maybe_contents_url maybe_source_url maybe_wiki_url
+      themes maybe_mathjax_url maybe_contents_url maybe_source_url maybe_wiki_url
       (map toInstalledIface visible_ifaces) debug
 
   mapM_ (ppHtmlModule odir doctitle themes
-           maybe_source_url maybe_wiki_url
+           maybe_mathjax_url maybe_source_url maybe_wiki_url
            maybe_contents_url maybe_index_url unicode qual debug) visible_ifaces
 
 
@@ -269,7 +269,7 @@ ppHtmlContents dflags odir doctitle _maybe_package
   writeFile (joinPath [odir, contentsHtmlFile]) (renderToString debug html)
 
   -- XXX: think of a better place for this?
-  ppHtmlContentsFrame odir doctitle themes ifaces debug
+  ppHtmlContentsFrame odir doctitle themes mathjax_url ifaces debug
 
 
 ppPrologue :: Qualification -> String -> Maybe (MDoc GHC.RdrName) -> Html
@@ -342,12 +342,12 @@ flatModuleTree ifaces =
         << toHtml txt
 
 
-ppHtmlContentsFrame :: FilePath -> String -> Themes
+ppHtmlContentsFrame :: FilePath -> String -> Themes -> Maybe String
   -> [InstalledInterface] -> Bool -> IO ()
-ppHtmlContentsFrame odir doctitle themes ifaces debug = do
+ppHtmlContentsFrame odir doctitle themes maybe_mathjax_url ifaces debug = do
   let mods = flatModuleTree ifaces
       html =
-        headHtml doctitle Nothing themes Nothing +++
+        headHtml doctitle Nothing themes maybe_mathjax_url +++
         miniBody << divModuleList <<
           (sectionName << "Modules" +++
            ulist << [ li ! [theclass "module"] << m | m <- mods ])
@@ -365,13 +365,14 @@ ppHtmlIndex :: FilePath
             -> Maybe String
             -> Themes
             -> Maybe String
+            -> Maybe String
             -> SourceURLs
             -> WikiURLs
             -> [InstalledInterface]
             -> Bool
             -> IO ()
 ppHtmlIndex odir doctitle _maybe_package themes
-  maybe_contents_url maybe_source_url maybe_wiki_url ifaces debug = do
+  maybe_mathjax_url maybe_contents_url maybe_source_url maybe_wiki_url ifaces debug = do
   let html = indexPage split_indices Nothing
               (if split_indices then [] else index)
 
@@ -387,7 +388,7 @@ ppHtmlIndex odir doctitle _maybe_package themes
 
   where
     indexPage showLetters ch items =
-      headHtml (doctitle ++ " (" ++ indexName ch ++ ")") Nothing themes Nothing +++
+      headHtml (doctitle ++ " (" ++ indexName ch ++ ")") Nothing themes maybe_mathjax_url +++
       bodyHtml doctitle Nothing
         maybe_source_url maybe_wiki_url
         maybe_contents_url Nothing << [
@@ -487,11 +488,11 @@ ppHtmlIndex odir doctitle _maybe_package themes
 
 ppHtmlModule
         :: FilePath -> String -> Themes
-        -> SourceURLs -> WikiURLs
+        -> Maybe String -> SourceURLs -> WikiURLs
         -> Maybe String -> Maybe String -> Bool -> QualOption
         -> Bool -> Interface -> IO ()
 ppHtmlModule odir doctitle themes
-  maybe_source_url maybe_wiki_url
+  maybe_mathjax_url maybe_source_url maybe_wiki_url
   maybe_contents_url maybe_index_url unicode qual debug iface = do
   let
       mdl = ifaceMod iface
@@ -499,7 +500,7 @@ ppHtmlModule odir doctitle themes
       mdl_str = moduleString mdl
       real_qual = makeModuleQual qual aliases mdl
       html =
-        headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes Nothing +++
+        headHtml mdl_str (Just $ "mini_" ++ moduleHtmlFile mdl) themes maybe_mathjax_url +++
         bodyHtml doctitle (Just iface)
           maybe_source_url maybe_wiki_url
           maybe_contents_url maybe_index_url << [
@@ -509,14 +510,14 @@ ppHtmlModule odir doctitle themes
 
   createDirectoryIfMissing True odir
   writeFile (joinPath [odir, moduleHtmlFile mdl]) (renderToString debug html)
-  ppHtmlModuleMiniSynopsis odir doctitle themes iface unicode real_qual debug
+  ppHtmlModuleMiniSynopsis odir doctitle themes maybe_mathjax_url iface unicode real_qual debug
 
 ppHtmlModuleMiniSynopsis :: FilePath -> String -> Themes
-  -> Interface -> Bool -> Qualification -> Bool -> IO ()
-ppHtmlModuleMiniSynopsis odir _doctitle themes iface unicode qual debug = do
+  -> Maybe String -> Interface -> Bool -> Qualification -> Bool -> IO ()
+ppHtmlModuleMiniSynopsis odir _doctitle themes maybe_mathjax_url iface unicode qual debug = do
   let mdl = ifaceMod iface
       html =
-        headHtml (moduleString mdl) Nothing themes Nothing +++
+        headHtml (moduleString mdl) Nothing themes maybe_mathjax_url +++
         miniBody <<
           (divModuleHeader << sectionName << moduleString mdl +++
            miniSynopsis mdl iface unicode qual)
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