From 376c911ff8aac92703fccb365d85799f806ab969 Mon Sep 17 00:00:00 2001
From: Mark Lentczner <markl@glyphic.com>
Date: Sat, 4 Sep 2010 23:19:47 +0000
Subject: make TOC group header identifiers validate

---
 src/Haddock/Backends/Xhtml.hs       | 7 +++++--
 src/Haddock/Backends/Xhtml/Utils.hs | 5 +++++
 2 files changed, 10 insertions(+), 2 deletions(-)

(limited to 'src/Haddock/Backends')

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.
 --
-- 
cgit v1.2.3