aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Xhtml.hs
diff options
context:
space:
mode:
authoralexbiehl-gc <72160047+alexbiehl-gc@users.noreply.github.com>2021-02-07 18:14:46 +0100
committerGitHub <noreply@github.com>2021-02-07 18:14:46 +0100
commit0f7ff041fb824653a7930e1292b81f34df1e967d (patch)
tree3e7f15ac3b0abe417797ec89275aa1209f6ca297 /haddock-api/src/Haddock/Backends/Xhtml.hs
parent9f597b6647a53624eaf501a34bfb4d8d15425929 (diff)
parent010f0320dff64e3f86091ba4691bc69ce6999647 (diff)
Merge pull request #1317 from bgamari/wip/ghc-head-merge
Merge ghc-8.10 into ghc-head
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml.hs')
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml.hs15
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 [])