aboutsummaryrefslogtreecommitdiff
path: root/haddock-api
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api')
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs31
1 files changed, 26 insertions, 5 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs
index e8e80da1..fa5ba536 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs
@@ -1,7 +1,10 @@
{-# LANGUAGE FlexibleContexts #-}
-module Haddock.Backends.Xhtml.Specialize (specialize) where
+module Haddock.Backends.Xhtml.Specialize
+ ( specialize, specialize'
+ , specializeTyVarBndrs
+ ) where
import Haddock.Syb
@@ -14,8 +17,26 @@ import Data.Data
specialize :: (Eq name, Typeable name)
=> Data a
=> name -> HsType name -> a -> a
-specialize name details = everywhere (mkT $ specialize' name details)
+specialize name details = everywhere (mkT $ specializeStep name details)
-specialize' :: Eq name => name -> HsType name -> HsType name -> HsType name
-specialize' name details (HsTyVar name') | name == name' = details
-specialize' _ _ typ = typ
+
+specialize' :: (Eq name, Typeable name)
+ => Data a
+ => [(name, HsType name)] -> a -> a
+specialize' = flip $ foldr (uncurry specialize)
+
+
+specializeStep :: Eq name => name -> HsType name -> HsType name -> HsType name
+specializeStep name details (HsTyVar name') | name == name' = details
+specializeStep _ _ typ = typ
+
+
+specializeTyVarBndrs :: (Eq name, Typeable name, DataId name)
+ => LHsTyVarBndrs name -> [HsType name]
+ -> HsType name -> HsType name
+specializeTyVarBndrs bndrs typs =
+ specialize' $ zip bndrs' typs
+ where
+ bndrs' = map (bname . unLoc) . hsq_tvs $ bndrs
+ bname (UserTyVar name) = name
+ bname (KindedTyVar (L _ name) _) = name