diff options
| author | Vladislav Zavialov <vlad.z.4096@gmail.com> | 2018-06-07 15:45:22 +0300 |
|---|---|---|
| committer | Ben Gamari <ben@smart-cactus.org> | 2018-06-14 17:06:21 -0400 |
| commit | 97c6cb949ffe707865b9c46016f97b441d114e45 (patch) | |
| tree | a81623757978b726043bb42cc55e4000d41bcd13 /haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | |
| parent | 5b25163bad9c28040fdc61555659b4b4b6168032 (diff) | |
Handle -XStarIsType
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml/Decl.hs')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 23 |
1 files changed, 14 insertions, 9 deletions
diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index 819c9aa6..224802a7 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -1192,16 +1192,22 @@ ppr_mono_ty ctxt_prec (HsQualTy _ ctxt ty) unicode qual emptyCtxts -- UnicodeSyntax alternatives ppr_mono_ty _ (HsTyVar _ _ (L _ name)) True _ _ - | getOccString (getName name) == "*" = toHtml "★" | getOccString (getName name) == "(->)" = toHtml "(→)" -ppr_mono_ty _ (HsBangTy _ b ty) u q _ = ppBang b +++ ppLParendType u q HideEmptyContexts ty -ppr_mono_ty _ (HsTyVar _ _ (L _ name)) _ q _ = ppDocName q Prefix True name -ppr_mono_ty ctxt_prec (HsFunTy _ ty1 ty2) u q e = ppr_fun_ty ctxt_prec ty1 ty2 u q e -ppr_mono_ty _ (HsTupleTy _ con tys) u q _ = tupleParens con (map (ppLType u q HideEmptyContexts) tys) -ppr_mono_ty _ (HsSumTy _ tys) u q _ = sumParens (map (ppLType u q HideEmptyContexts) tys) -ppr_mono_ty _ (HsKindSig _ ty kind) u q e = - parens (ppr_mono_lty pREC_TOP ty u q e <+> dcolon u <+> ppLKind u q kind) +ppr_mono_ty _ (HsBangTy _ b ty) u q _ = + ppBang b +++ ppLParendType u q HideEmptyContexts ty +ppr_mono_ty _ (HsTyVar _ _ (L _ name)) _ q _ = + ppDocName q Prefix True name +ppr_mono_ty _ (HsStarTy _ isUni) u _ _ = + toHtml (if u || isUni then "★" else "*") +ppr_mono_ty ctxt_prec (HsFunTy _ ty1 ty2) u q e = + ppr_fun_ty ctxt_prec ty1 ty2 u q e +ppr_mono_ty _ (HsTupleTy _ con tys) u q _ = + tupleParens con (map (ppLType u q HideEmptyContexts) tys) +ppr_mono_ty _ (HsSumTy _ tys) u q _ = + sumParens (map (ppLType u q HideEmptyContexts) tys) +ppr_mono_ty _ (HsKindSig _ ty kind) u q e = + parens (ppr_mono_lty pREC_TOP ty u q e <+> dcolon u <+> ppLKind u q kind) ppr_mono_ty _ (HsListTy _ ty) u q _ = brackets (ppr_mono_lty pREC_TOP ty u q HideEmptyContexts) ppr_mono_ty ctxt_prec (HsIParamTy _ (L _ n) ty) u q _ = maybeParen ctxt_prec pREC_CTX $ ppIPName n <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q HideEmptyContexts @@ -1214,7 +1220,6 @@ ppr_mono_ty _ (XHsType (NHsCoreTy {})) _ _ _ = error "ppr_mono_ty HsCore ppr_mono_ty _ (HsExplicitListTy _ Promoted tys) u q _ = promoQuote $ brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys ppr_mono_ty _ (HsExplicitListTy _ NotPromoted tys) u q _ = brackets $ hsep $ punctuate comma $ map (ppLType u q HideEmptyContexts) tys ppr_mono_ty _ (HsExplicitTupleTy _ tys) u q _ = promoQuote $ parenList $ map (ppLType u q HideEmptyContexts) tys -ppr_mono_ty _ (HsAppsTy {}) _ _ _ = error "ppr_mono_ty HsAppsTy" ppr_mono_ty ctxt_prec (HsEqTy _ ty1 ty2) unicode qual _ = maybeParen ctxt_prec pREC_CTX $ |