aboutsummaryrefslogtreecommitdiff
path: root/haddock-test/src/Test
diff options
context:
space:
mode:
authorAlec Theriault <alec.theriault@gmail.com>2018-12-27 16:39:38 -0500
committerGitHub <noreply@github.com>2018-12-27 16:39:38 -0500
commitc351007981df04542872f4fd7622e49e3c0a0e9f (patch)
tree9b09d4a2010b00de150011c701887861e0fd971e /haddock-test/src/Test
parent7dd0a79cce7c4c048e7c145c9f378da3a96392d0 (diff)
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.
Diffstat (limited to 'haddock-test/src/Test')
-rw-r--r--haddock-test/src/Test/Haddock/Xhtml.hs18
1 files changed, 12 insertions, 6 deletions
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 = [] }