From c351007981df04542872f4fd7622e49e3c0a0e9f Mon Sep 17 00:00:00 2001 From: Alec Theriault Date: Thu, 27 Dec 2018 16:39:38 -0500 Subject: Remove `haddock-test`'s dep. on `syb` (#987) The functionality is easily inlined into one short function: `gmapEverywhere`. This doesn't warrant pulling in another package. --- haddock-test/src/Test/Haddock/Xhtml.hs | 18 ++++++++++++------ 1 file changed, 12 insertions(+), 6 deletions(-) (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 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 = [] } -- cgit v1.2.3