Merge pull request #1317 from bgamari/wip/ghc-head-merge

Merge ghc-8.10 into ghc-head

1 files changed, 13 insertions, 2 deletions

diff --git a/haddock-api/src/Haddock/Backends/Xhtml.hs b/haddock-api/src/Haddock/Backends/Xhtml.hs
index 3453bb0c..1bdbf81b 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml.hs
@@ -292,6 +292,10 @@ ppHtmlContents state odir doctitle _maybe_package
           ]
   createDirectoryIfMissing True odir
   writeUtf8File (joinPath [odir, contentsHtmlFile]) (renderToString debug html)
+  where
+    -- Extract a module's short description.
+    toInstalledDescription :: InstalledInterface -> Maybe (MDoc Name)
+    toInstalledDescription = fmap mkMeta . hmi_description . instInfo
 
 
 ppPrologue :: Maybe Package -> Qualification -> String -> Maybe (MDoc GHC.RdrName) -> Html
@@ -301,6 +305,7 @@ ppPrologue pkg qual title (Just doc) =
 
 
 ppSignatureTree :: Maybe Package -> Qualification -> [ModuleTree] -> Html
+ppSignatureTree _ _ [] = mempty
 ppSignatureTree pkg qual ts =
   divModuleList << (sectionName << "Signatures" +++ mkNodeList pkg qual [] "n" ts)
 
@@ -666,16 +671,22 @@ numberSectionHeadings = go 1
   where go :: Int -> [ExportItem DocNameI] -> [ExportItem DocNameI]
         go _ [] = []
         go n (ExportGroup lev _ doc : es)
-          = ExportGroup lev (show n) doc : go (n+1) es
+          = case collectAnchors doc of
+              [] -> ExportGroup lev (show n) doc : go (n+1) es
+              (a:_) -> ExportGroup lev a doc : go (n+1) es
         go n (other:es)
           = other : go n es
 
+        collectAnchors :: DocH (Wrap (ModuleName, OccName)) (Wrap DocName) -> [String]
+        collectAnchors (DocAppend a b) = collectAnchors a ++ collectAnchors b
+        collectAnchors (DocAName a) = [a]
+        collectAnchors _ = []
 
 processExport :: Bool -> LinksInfo -> Bool -> Maybe Package -> Qualification
               -> ExportItem DocNameI -> Maybe Html
 processExport _ _ _ _ _ ExportDecl { expItemDecl = L _ (InstD {}) } = Nothing -- Hide empty instances
 processExport summary _ _ pkg qual (ExportGroup lev id0 doc)
-  = nothingIf summary $ groupHeading lev id0 << docToHtml (Just id0) pkg qual (mkMeta doc)
+  = nothingIf summary $ groupHeading lev id0 << docToHtmlNoAnchors (Just id0) pkg qual (mkMeta doc)
 processExport summary links unicode pkg qual (ExportDecl decl pats doc subdocs insts fixities splice)
   = processDecl summary $ ppDecl summary links decl pats doc insts fixities subdocs splice unicode pkg qual
 processExport summary _ _ _ qual (ExportNoDecl y [])