aboutsummaryrefslogtreecommitdiff
path: root/haddock-test
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2019-01-31 12:43:39 -0800
committerAlec Theriault <alec.theriault@gmail.com>2019-02-02 18:06:12 -0800
commitbf07847e45356024e10d1a325f015ac53544ea85 (patch)
treedcf55b0db9ff72eeeac16add251df55805c3ab5e /haddock-test
parentbc683d664657dc2ed228b57a05344e1b0cfd8fa6 (diff)
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
Diffstat (limited to 'haddock-test')
-rw-r--r--haddock-test/src/Test/Haddock/Xhtml.hs10
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