aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Haddock/Backends/LaTeX.hs6
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs4
-rw-r--r--src/Haddock/Convert.hs12
-rw-r--r--src/Haddock/Interface/Rename.hs5
4 files changed, 14 insertions, 13 deletions
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 59fff6ae..d6a71f27 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -473,7 +473,7 @@ ppClassDecl :: [DocInstance DocName] -> SrcSpan
-> Maybe (Doc DocName) -> [(DocName, DocForDecl DocName)]
-> TyClDecl DocName -> Bool -> LaTeX
ppClassDecl instances loc mbDoc subdocs
- (ClassDecl lctxt lname ltyvars lfds lsigs _ ats _) unicode
+ (ClassDecl lctxt lname ltyvars lfds lsigs _ ats at_defs _) unicode
= declWithDoc classheader (if null body then Nothing else Just (vcat body)) $$
instancesBit
where
@@ -486,8 +486,8 @@ ppClassDecl instances loc mbDoc subdocs
body = catMaybes [fmap docToLaTeX mbDoc, body_]
body_
- | null lsigs, null ats = Nothing
- | null ats = Just methodTable
+ | null lsigs, null ats, null at_defs = Nothing
+ | null ats, null at_defs = Just methodTable
--- | otherwise = atTable $$ methodTable
| otherwise = error "LaTeX.ppClassDecl"
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index eb1219f4..28132046 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -344,7 +344,7 @@ ppFds fds unicode qual =
ppShortClassDecl :: Bool -> LinksInfo -> TyClDecl DocName -> SrcSpan
-> [(DocName, DocForDecl DocName)] -> Bool -> Qualification
-> Html
-ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _) loc
+ppShortClassDecl summary links (ClassDecl lctxt lname tvs fds sigs _ ats _ _) loc
subdocs unicode qual =
if null sigs && null ats
then (if summary then id else topDeclElem links loc [nm]) hdr
@@ -373,7 +373,7 @@ ppClassDecl :: Bool -> LinksInfo -> [DocInstance DocName] -> SrcSpan
-> Maybe (Doc DocName) -> [(DocName, DocForDecl DocName)]
-> TyClDecl DocName -> Bool -> Qualification -> Html
ppClassDecl summary links instances loc mbDoc subdocs
- decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ ats _) unicode qual
+ decl@(ClassDecl lctxt lname ltyvars lfds lsigs _ ats _ _) unicode qual
| summary = ppShortClassDecl summary links decl loc subdocs unicode qual
| otherwise = classheader +++ maybeDocSection qual mbDoc
+++ atBit +++ methodBit +++ instancesBit
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index b3549fdc..d4f75662 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -61,7 +61,9 @@ tyThingToLHsDecl t = noLoc $ case t of
(map (noLoc . synifyIdSig DeleteTopLevelQuantification)
(classMethods cl))
emptyBag --ignore default method definitions, they don't affect signature
- (map synifyClassAT (classATs cl))
+ -- class associated-types are a subset of TyCon:
+ [noLoc (synifyTyCon at_tc) | (at_tc, _) <- classATItems cl]
+ [] --ignore associated type defaults
[] --we don't have any docs at this point
| otherwise
-> TyClD (synifyTyCon tc)
@@ -74,11 +76,9 @@ tyThingToLHsDecl t = noLoc $ case t of
ADataCon dc -> SigD (TypeSig [synifyName dc]
(synifyType ImplicitizeForAll (dataConUserType dc)))
-
--- class associated-types are a subset of TyCon
--- (mainly only type/data-families)
-synifyClassAT :: TyCon -> LTyClDecl Name
-synifyClassAT = noLoc . synifyTyCon
+synifyATDefault :: TyCon -> LTyClDecl Name
+synifyATDefault tc = noLoc (synifyAxiom ax)
+ where Just ax = tyConFamilyCoercion_maybe tc
synifyAxiom :: CoAxiom -> TyClDecl Name
synifyAxiom (CoAxiom { co_ax_tvs = tvs, co_ax_lhs = lhs, co_ax_rhs = rhs })
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index cc49cd53..4ea22a2e 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -332,15 +332,16 @@ renameTyClD d = case d of
typats' <- mapM (mapM renameLType) typats
return (TySynonym lname' ltyvars' typats' ltype')
- ClassDecl lcontext lname ltyvars lfundeps lsigs _ ats _ -> do
+ ClassDecl lcontext lname ltyvars lfundeps lsigs _ ats at_defs _ -> do
lcontext' <- renameLContext lcontext
lname' <- renameL lname
ltyvars' <- mapM renameLTyVarBndr ltyvars
lfundeps' <- mapM renameLFunDep lfundeps
lsigs' <- mapM renameLSig lsigs
ats' <- mapM renameLTyClD ats
+ at_defs' <- mapM renameLTyClD at_defs
-- we don't need the default methods or the already collected doc entities
- return (ClassDecl lcontext' lname' ltyvars' lfundeps' lsigs' emptyBag ats' [])
+ return (ClassDecl lcontext' lname' ltyvars' lfundeps' lsigs' emptyBag ats' at_defs' [])
where
renameLCon (L loc con) = return . L loc =<< renameCon con