From 6fc527b41b1ba80c706a375420f40e6eed8c81c8 Mon Sep 17 00:00:00 2001 From: Łukasz Hanuszczak Date: Wed, 15 Jul 2015 18:25:36 +0200 Subject: Create convenience functions for type specialization module. --- .../src/Haddock/Backends/Xhtml/Specialize.hs | 31 ++++++++++++++++++---- 1 file changed, 26 insertions(+), 5 deletions(-) (limited to 'haddock-api') 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 -- cgit v1.2.3