Create convenience functions for type specialization module.

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