diff options
| author | Alec Theriault <alec.theriault@gmail.com> | 2019-01-31 12:43:39 -0800 |
|---|---|---|
| committer | Alec Theriault <alec.theriault@gmail.com> | 2019-02-02 18:06:12 -0800 |
| commit | bf07847e45356024e10d1a325f015ac53544ea85 (patch) | |
| tree | dcf55b0db9ff72eeeac16add251df55805c3ab5e /haddock-test/src/Test | |
| parent | bc683d664657dc2ed228b57a05344e1b0cfd8fa6 (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/src/Test')
| -rw-r--r-- | haddock-test/src/Test/Haddock/Xhtml.hs | 10 |
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 |