diff options
Diffstat (limited to 'src/Haddock')
| -rw-r--r-- | src/Haddock/Backends/LaTeX.hs | 6 | ||||
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 4 | ||||
| -rw-r--r-- | src/Haddock/Convert.hs | 12 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rename.hs | 5 |
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 |