diff options
Diffstat (limited to 'src/Haddock/Backends/Xhtml')
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 27 |
1 files changed, 15 insertions, 12 deletions
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index c1f3a89a..44429167 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -35,7 +35,6 @@ import Text.XHtml hiding ( name, title, p, quote ) import GHC import Name import BasicTypes ( ipNameName ) -import Outputable ( ppr, showSDoc, Outputable ) -- TODO: use DeclInfo DocName or something @@ -150,8 +149,8 @@ ppTyName name -------------------------------------------------------------------------------- -ppTyFamHeader :: Bool -> Bool -> TyClDecl DocName -> Bool -> Html -ppTyFamHeader summary associated decl unicode = +ppTyFamHeader :: Bool -> Bool -> TyClDecl DocName -> Bool -> Qualification -> Html +ppTyFamHeader summary associated decl unicode qual = (case tcdFlavour decl of TypeFamily @@ -165,7 +164,7 @@ ppTyFamHeader summary associated decl unicode = ppTyClBinderWithVars summary decl <+> case tcdKind decl of - Just kind -> dcolon unicode <+> ppKind kind + Just kind -> dcolon unicode <+> ppLKind unicode qual kind Nothing -> noHtml @@ -173,13 +172,13 @@ ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) -> TyClDecl DocName -> Bool -> Qualification -> Html ppTyFam summary associated links loc mbDoc decl unicode qual - | summary = ppTyFamHeader True associated decl unicode + | summary = ppTyFamHeader True associated decl unicode qual | otherwise = header_ +++ maybeDocSection qual mbDoc +++ instancesBit where docname = tcdName decl - header_ = topDeclElem links loc [docname] (ppTyFamHeader summary associated decl unicode) + header_ = topDeclElem links loc [docname] (ppTyFamHeader summary associated decl unicode qual) instancesBit = ppInstances instances docname unicode qual @@ -635,10 +634,6 @@ ppDataHeader summary decl unicode qual -------------------------------------------------------------------------------- -ppKind :: Outputable a => a -> Html -ppKind k = toHtml $ showSDoc (ppr k) - - ppBang :: HsBang -> Html ppBang HsNoBang = noHtml ppBang _ = toHtml "!" -- Unpacked args is an implementation detail, @@ -684,6 +679,11 @@ ppType unicode qual ty = ppr_mono_ty pREC_TOP ty unicode qual ppParendType unicode qual ty = ppr_mono_ty pREC_CON ty unicode qual ppFunLhType unicode qual ty = ppr_mono_ty pREC_FUN ty unicode qual +ppLKind :: Bool -> Qualification-> LHsKind DocName -> Html +ppLKind unicode qual y = ppKind unicode qual (unLoc y) + +ppKind :: Bool -> Qualification-> HsKind DocName -> Html +ppKind unicode qual ki = ppr_mono_ty pREC_TOP ki unicode qual -- Drop top-level for-all type variables in user style -- since they are implicit in Haskell @@ -713,7 +713,7 @@ ppr_mono_ty _ (HsTyVar name) _ q = ppDocName q name ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) u q = ppr_fun_ty ctxt_prec ty1 ty2 u q ppr_mono_ty _ (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys) ppr_mono_ty _ (HsKindSig ty kind) u q = - parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppKind kind) + parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppLKind u q kind) ppr_mono_ty _ (HsListTy ty) u q = brackets (ppr_mono_lty pREC_TOP ty u q) ppr_mono_ty _ (HsPArrTy ty) u q = pabrackets (ppr_mono_lty pREC_TOP ty u q) ppr_mono_ty _ (HsIParamTy n ty) u q = brackets (ppDocName q (ipNameName n) <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q) @@ -725,6 +725,9 @@ ppr_mono_ty _ (HsQuasiQuoteTy {}) _ _ = error "ppr_mono_ty HsQuasiQuoteT #endif ppr_mono_ty _ (HsRecTy {}) _ _ = error "ppr_mono_ty HsRecTy" ppr_mono_ty _ (HsCoreTy {}) _ _ = error "ppr_mono_ty HsCoreTy" +ppr_mono_ty _ (HsExplicitListTy _ tys) u q = quote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys +ppr_mono_ty _ (HsExplicitTupleTy _ tys) u q = quote $ parenList $ map (ppLType u q) tys +ppr_mono_ty _ (HsWrapTy {}) _ _ = error "ppr_mono_ty HsWrapTy" ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual = maybeParen ctxt_prec pREC_OP $ @@ -734,7 +737,7 @@ ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual = maybeParen ctxt_prec pREC_CON $ hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual, ppr_mono_lty pREC_CON arg_ty unicode qual] -ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual +ppr_mono_ty ctxt_prec (HsOpTy ty1 (_, op) ty2) unicode qual = maybeParen ctxt_prec pREC_FUN $ ppr_mono_lty pREC_OP ty1 unicode qual <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual where |