aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Xhtml
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml')
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs9
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs18
2 files changed, 15 insertions, 12 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
index 294af864..7255bf42 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs
@@ -31,7 +31,6 @@ import Haddock.Doc (combineDocumentation)
import Data.List ( intersperse, sort )
import qualified Data.Map as Map
-import qualified Data.Set as Set
import Data.Maybe
import Text.XHtml hiding ( name, title, p, quote )
@@ -601,13 +600,9 @@ ppInstanceSigs :: LinksInfo -> Splice -> Unicode -> Qualification
-> LHsTyVarBndrs DocName -> [HsType DocName] -> [Sig DocName]
-> [Html]
ppInstanceSigs links splice unicode qual bndrs tys sigs = do
- TypeSig lnames (L loc typ) _ <- sigs
+ TypeSig lnames (L loc typ) _ <- map (specializeSig bndrs tys) sigs
let names = map unLoc lnames
- let typ' = rename' . sugar $ specializeTyVarBndrs bndrs tys typ
- return $ ppSimpleSig links splice unicode qual loc names typ'
- where
- fv = foldr Set.union Set.empty . map freeVariables $ tys
- rename' = rename fv
+ return $ ppSimpleSig links splice unicode qual loc names typ
lookupAnySubdoc :: Eq id1 => id1 -> [(id1, DocForDecl id2)] -> DocForDecl id2
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs
index 109788fd..2295605b 100644
--- a/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs
+++ b/haddock-api/src/Haddock/Backends/Xhtml/Specialize.hs
@@ -5,11 +5,7 @@
module Haddock.Backends.Xhtml.Specialize
- ( specialize, specialize'
- , specializeTyVarBndrs
- , specializePseudoFamilyDecl
- , sugar, rename
- , freeVariables
+ ( specializePseudoFamilyDecl, specializeSig
) where
@@ -80,6 +76,18 @@ specializePseudoFamilyDecl bndrs typs decl =
specializeTyVars = specializeTyVarBndrs bndrs typs
+specializeSig :: (Eq name, Typeable name, DataId name, SetName name)
+ => LHsTyVarBndrs name -> [HsType name]
+ -> Sig name
+ -> Sig name
+specializeSig bndrs typs (TypeSig lnames (L loc typ) prn) =
+ TypeSig lnames (L loc typ') prn
+ where
+ typ' = rename fv . sugar $ specializeTyVarBndrs bndrs typs typ
+ fv = foldr Set.union Set.empty . map freeVariables $ typs
+specializeSig _ _ sig = sig
+
+
-- | Make given type use tuple and list literals where appropriate.
--
-- After applying 'specialize' function some terms may not use idiomatic list