aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends
diff options
context:
space:
mode:
authorƁukasz Hanuszczak <lukasz.hanuszczak@gmail.com>2015-07-15 18:25:36 +0200
committerMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2015-08-21 18:22:30 +0100
commit6fc527b41b1ba80c706a375420f40e6eed8c81c8 (patch)
tree75b0b2f60473c16f9c76b5b977251230ebcd7249 /haddock-api/src/Haddock/Backends
parent0a02b70bea9781e4c1d03e88bcfe404934e4e2c6 (diff)
Create convenience functions for type specialization module.
Diffstat (limited to 'haddock-api/src/Haddock/Backends')
-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