aboutsummaryrefslogtreecommitdiff
path: root/haddock-test
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-test')
-rw-r--r--haddock-test/haddock-test.cabal2
-rw-r--r--haddock-test/src/Test/Haddock/Xhtml.hs18
2 files changed, 13 insertions, 7 deletions
diff --git a/haddock-test/haddock-test.cabal b/haddock-test/haddock-test.cabal
index 48314600..23b5953c 100644
--- a/haddock-test/haddock-test.cabal
+++ b/haddock-test/haddock-test.cabal
@@ -16,7 +16,7 @@ library
default-language: Haskell2010
ghc-options: -Wall
hs-source-dirs: src
- build-depends: base >= 4.3 && < 4.13, bytestring, directory, process, filepath, Cabal, xml, xhtml, syb
+ build-depends: base >= 4.3 && < 4.13, bytestring, directory, process, filepath, Cabal, xml, xhtml
exposed-modules:
Test.Haddock
diff --git a/haddock-test/src/Test/Haddock/Xhtml.hs b/haddock-test/src/Test/Haddock/Xhtml.hs
index 8bfc973f..d4520100 100644
--- a/haddock-test/src/Test/Haddock/Xhtml.hs
+++ b/haddock-test/src/Test/Haddock/Xhtml.hs
@@ -1,5 +1,8 @@
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StandaloneDeriving #-}
+{-# LANGUAGE TypeApplications #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Test.Haddock.Xhtml
@@ -8,10 +11,7 @@ module Test.Haddock.Xhtml
, stripLinks, stripLinksWhen, stripAnchorsWhen, stripFooter
) where
-
-import Data.Generics.Aliases
-import Data.Generics.Schemes
-
+import Data.Data ( Data(..), Typeable, eqT, (:~:)(..) )
import Text.XML.Light
import Text.XHtml (Html, HtmlAttr, (!))
import qualified Text.XHtml as Xhtml
@@ -26,6 +26,12 @@ deriving instance Eq Element
deriving instance Eq Content
deriving instance Eq CData
+-- | Similar to @everywhere (mkT f) x@ from SYB.
+gmapEverywhere :: forall a b. (Data a, Typeable b) => (b -> b) -> a -> a
+gmapEverywhere f x = gmapT (gmapEverywhere f) $ case eqT @a @b of
+ Nothing -> x
+ Just Refl -> f x
+
parseXml :: String -> Maybe Xml
parseXml = fmap Xml . parseXMLDoc
@@ -58,12 +64,12 @@ stripAnchorsWhen p =
processAnchors :: (Attr -> Attr) -> Xml -> Xml
-processAnchors f = Xml . everywhere (mkT f) . xmlElement
+processAnchors f = Xml . gmapEverywhere f . xmlElement
stripFooter :: Xml -> Xml
stripFooter =
- Xml . everywhere (mkT defoot) . xmlElement
+ Xml . gmapEverywhere defoot . xmlElement
where
defoot el
| isFooter el = el { elContent = [] }