1 files changed, 9 insertions, 1 deletions
diff --git a/haddock-test/src/Test/Haddock/Xhtml.hs b/haddock-test/src/Test/Haddock/Xhtml.hs
index d4520100..6c19dbca 100644
--- a/haddock-test/src/Test/Haddock/Xhtml.hs
+++ b/haddock-test/src/Test/Haddock/Xhtml.hs
@@ -8,7 +8,7 @@
 module Test.Haddock.Xhtml
     ( Xml(..)
     , parseXml, dumpXml
-    , stripLinks, stripLinksWhen, stripAnchorsWhen, stripFooter
+    , stripLinks, stripLinksWhen, stripAnchorsWhen, stripIdsWhen, stripFooter
     ) where
 
 import Data.Data ( Data(..), Typeable, eqT, (:~:)(..) )
@@ -62,6 +62,14 @@ stripAnchorsWhen p =
         | qName key == "name" && p val = attr { attrVal = "" }
         | otherwise = attr
 
+stripIdsWhen :: (String -> Bool) -> Xml -> Xml
+stripIdsWhen p =
+    processAnchors unname
+  where
+    unname attr@(Attr { attrKey = key, attrVal = val })
+        | qName key == "id" && p val = attr { attrVal = "" }
+        | otherwise = attr
+
 
 processAnchors :: (Attr -> Attr) -> Xml -> Xml
 processAnchors f = Xml . gmapEverywhere f . xmlElement