From 00571a39acaa5aaa292b5a4bd5c17f122951f7ae Mon Sep 17 00:00:00 2001 From: Ɓukasz Hanuszczak Date: Wed, 29 Jul 2015 18:21:04 +0200 Subject: Apply type specializer to associated type family declarations. --- haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 7 ++++--- haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs | 14 +++++++++++++- 2 files changed, 17 insertions(+), 4 deletions(-) (limited to 'haddock-api/src/Haddock/Backends/Xhtml') diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index e6869916..294af864 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -567,7 +567,7 @@ ppInstHead links splice unicode qual mdoc origin no (InstHead {..}) = sigs = ppInstanceSigs links splice unicode qual clsiTyVars ihdTypes clsiSigs ats = ppInstanceAssocTys links splice unicode qual - clsiAssocTys + clsiTyVars ihdTypes clsiAssocTys TypeInst rhs -> (ptype, mdoc, []) where @@ -588,10 +588,11 @@ ppInstHead links splice unicode qual mdoc origin no (InstHead {..}) = ppInstanceAssocTys :: LinksInfo -> Splice -> Unicode -> Qualification + -> LHsTyVarBndrs DocName -> [HsType DocName] -> [PseudoFamilyDecl DocName] -> [Html] -ppInstanceAssocTys links splice unicode qual = - map ppFamilyDecl' +ppInstanceAssocTys links splice unicode qual bndrs tys = + map ppFamilyDecl' . map (specializePseudoFamilyDecl bndrs tys) where ppFamilyDecl' = ppPseudoFamilyDecl links splice unicode qual diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs index a8a4e8ec..109788fd 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs @@ -7,6 +7,7 @@ module Haddock.Backends.Xhtml.Specialize ( specialize, specialize' , specializeTyVarBndrs + , specializePseudoFamilyDecl , sugar, rename , freeVariables ) where @@ -58,8 +59,9 @@ specialize' = flip $ foldr (uncurry specialize) -- Again, it is just a convenience function around 'specialize'. Note that -- length of type list should be the same as the number of binders. specializeTyVarBndrs :: (Eq name, Typeable name, DataId name) + => Data a => LHsTyVarBndrs name -> [HsType name] - -> HsType name -> HsType name + -> a -> a specializeTyVarBndrs bndrs typs = specialize' $ zip bndrs' typs where @@ -68,6 +70,16 @@ specializeTyVarBndrs bndrs typs = bname (KindedTyVar (L _ name) _) = name +specializePseudoFamilyDecl :: (Eq name, Typeable name, DataId name) + => LHsTyVarBndrs name -> [HsType name] + -> PseudoFamilyDecl name + -> PseudoFamilyDecl name +specializePseudoFamilyDecl bndrs typs decl = + decl { pfdTyVars = map specializeTyVars (pfdTyVars decl) } + where + specializeTyVars = specializeTyVarBndrs bndrs typs + + -- | Make given type use tuple and list literals where appropriate. -- -- After applying 'specialize' function some terms may not use idiomatic list -- cgit v1.2.3