aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Syb.hs
diff options
context:
space:
mode:
authoralexbiehl-gc <72160047+alexbiehl-gc@users.noreply.github.com>2021-02-07 18:39:59 +0100
committerGitHub <noreply@github.com>2021-02-07 18:39:59 +0100
commit786d3e69799398c3aac26fbd5017a127bc69cacc (patch)
tree883ee3f8c0e195299925b790cba6f88a537200f6 /haddock-api/src/Haddock/Syb.hs
parente90e79815960823a749287968fb1c6d09559a67f (diff)
parent0f7ff041fb824653a7930e1292b81f34df1e967d (diff)
Merge branch 'ghc-head' into ghc-9.0
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)