diff options
| -rw-r--r-- | haddock-test/haddock-test.cabal | 2 | ||||
| -rw-r--r-- | haddock-test/src/Test/Haddock/Xhtml.hs | 18 |
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 = [] } |