aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Syb.hs
diff options
context:
space:
mode:
authorRyan Scott <ryan.gl.scott@gmail.com>2020-09-23 20:37:34 -0400
committerRyan Scott <ryan.gl.scott@gmail.com>2020-10-30 19:35:59 -0400
commitad9cbad7312a64e6757c32bd9488c55ba4f2fec9 (patch)
tree1c0035b3bf571673c539aad1b992a8a392d7bf4b /haddock-api/src/Haddock/Syb.hs
parent3cce1bdee8c61bb6daa089059e12435178f50770 (diff)
Adapt to HsOuterTyVarBndrs
These changes accompany ghc/ghc!4107, which aims to be a fix for #16762.
Diffstat (limited to 'haddock-api/src/Haddock/Syb.hs')
-rw-r--r--haddock-api/src/Haddock/Syb.hs17
1 files changed, 16 insertions, 1 deletions
diff --git a/haddock-api/src/Haddock/Syb.hs b/haddock-api/src/Haddock/Syb.hs
index 7e34ae8c..fc946c8e 100644
--- a/haddock-api/src/Haddock/Syb.hs
+++ b/haddock-api/src/Haddock/Syb.hs
@@ -6,7 +6,7 @@
module Haddock.Syb
( everything, everythingButType, everythingWithState
, everywhere, everywhereButType
- , mkT
+ , mkT, mkQ, extQ
, combine
) where
@@ -91,6 +91,21 @@ mkT f = case cast f of
Just f' -> f'
Nothing -> id
+-- | Create generic query.
+--
+-- Another function stolen from SYB package.
+mkQ :: (Typeable a, Typeable b) => r -> (b -> r) -> a -> r
+(r `mkQ` br) a = case cast a of
+ Just b -> br b
+ Nothing -> r
+
+
+-- | Extend a generic query by a type-specific case.
+--
+-- Another function stolen from SYB package.
+extQ :: (Typeable a, Typeable b) => (a -> q) -> (b -> q) -> a -> q
+extQ f g a = maybe (f a) g (cast a)
+
-- | Combine two queries into one using alternative combinator.
combine :: Alternative f => (forall a. Data a => a -> f r)
-> (forall a. Data a => a -> f r)