From bf07847e45356024e10d1a325f015ac53544ea85 Mon Sep 17 00:00:00 2001
From: Alec Theriault <alec.theriault@gmail.com>
Date: Thu, 31 Jan 2019 12:43:39 -0800
Subject: Fix some Hyperlinker test suite fallout

* Amend `ParserSpec` to match new Hyperlinker API
    - pass in compiler info
    - strip out null tokens

* Make `hypsrc-test` pass reliably
    - strip out `local-*` ids
    - strip out `line-*` ids from the `ClangCppBug` test
    - re-accept output
---
 haddock-test/src/Test/Haddock/Xhtml.hs | 10 +++++++++-
 1 file changed, 9 insertions(+), 1 deletion(-)

(limited to 'haddock-test/src/Test/Haddock/Xhtml.hs')

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