diff options
| -rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 7 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Utils.hs | 5 |
2 files changed, 10 insertions, 2 deletions
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index 9259ae61..71a96bf9 100644 --- a/src/Haddock/Backends/Xhtml.hs +++ b/src/Haddock/Backends/Xhtml.hs @@ -591,7 +591,8 @@ ppModuleContents exports | lev <= n = ( [], items ) | otherwise = ( html:secs, rest2 ) where - html = linkedAnchor id0 << docToHtml doc +++ mk_subsections ssecs + html = linkedAnchor (groupId id0) + << docToHtml doc +++ mk_subsections ssecs (ssecs, rest1) = process lev rest (secs, rest2) = process n rest1 process n (_ : rest) = process n rest @@ -614,7 +615,7 @@ numberSectionHeadings exports = go 1 exports processExport :: Bool -> LinksInfo -> Bool -> (ExportItem DocName) -> Maybe Html processExport summary _ _ (ExportGroup lev id0 doc) - = nothingIf summary $ groupTag lev ! [identifier id0] << docToHtml doc + = nothingIf summary $ groupHeading lev id0 << docToHtml doc processExport summary links unicode (ExportDecl decl doc subdocs insts) = processDecl summary $ ppDecl summary links decl doc insts subdocs unicode processExport summary _ _ (ExportNoDecl y []) @@ -641,6 +642,8 @@ processDeclOneLiner :: Bool -> Html -> Maybe Html processDeclOneLiner True = Just processDeclOneLiner False = Just . divTopDecl . declElem +groupHeading :: Int -> String -> Html -> Html +groupHeading lev id0 = groupTag lev ! [identifier (groupId id0)] groupTag :: Int -> Html -> Html groupTag lev diff --git a/src/Haddock/Backends/Xhtml/Utils.hs b/src/Haddock/Backends/Xhtml/Utils.hs index 10f9e766..f0b6941c 100644 --- a/src/Haddock/Backends/Xhtml/Utils.hs +++ b/src/Haddock/Backends/Xhtml/Utils.hs @@ -15,6 +15,7 @@ module Haddock.Backends.Xhtml.Utils ( namedAnchor, linkedAnchor, spliceURL, + groupId, (<+>), char, nonEmpty, keyword, punctuate, @@ -172,6 +173,10 @@ linkedAnchor :: String -> Html -> Html linkedAnchor n = anchor ! [href ('#':n)] +-- | generate an anchor identifier for a group +groupId :: String -> String +groupId g = makeAnchorId ("g:" ++ g) + -- -- A section of HTML which is collapsible. -- |