diff options
| author | Niklas Haas <git@nand.wakku.to> | 2014-03-13 07:01:27 +0100 |
|---|---|---|
| committer | Mateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk> | 2014-03-13 19:18:08 +0000 |
| commit | 64175d6ade5717b7e0c7fa0a122d16cae6779031 (patch) | |
| tree | 199d1f0e05f51033c7edd423a581433c27f07a12 /src/Haddock/Backends/Xhtml | |
| parent | 3606ad5fdb8b9c2c3f9a62de1d26702ad41f9a10 (diff) | |
Add UnicodeSyntax alternatives for * and ->
I could not find a cleaner way to do this other than checking for
string equality with the given built-in types. But seeing as it's
actually equivalent to string rewriting in GHC's implementation of
UnicodeSyntax, it's probably fitting.
Diffstat (limited to 'src/Haddock/Backends/Xhtml')
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 9 |
1 files changed, 7 insertions, 2 deletions
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index c1b9032e..cd504d8e 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -769,10 +769,10 @@ ppCtxType unicode qual ty = ppr_mono_ty pREC_CTX 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 :: Unicode -> Qualification-> LHsKind DocName -> Html +ppLKind :: Unicode -> Qualification -> LHsKind DocName -> Html ppLKind unicode qual y = ppKind unicode qual (unLoc y) -ppKind :: Unicode -> Qualification-> HsKind DocName -> Html +ppKind :: Unicode -> 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 @@ -798,6 +798,11 @@ ppr_mono_ty ctxt_prec (HsForAllTy expl tvs ctxt ty) unicode qual = maybeParen ctxt_prec pREC_FUN $ hsep [ppForAll expl tvs ctxt unicode qual, ppr_mono_lty pREC_TOP ty unicode qual] +-- UnicodeSyntax alternatives +ppr_mono_ty _ (HsTyVar name) True _ + | getOccString (getName name) == "*" = toHtml "★" + | getOccString (getName name) == "(->)" = toHtml "(→)" + ppr_mono_ty _ (HsBangTy b ty) u q = ppBang b +++ ppLParendType u q ty ppr_mono_ty _ (HsTyVar name) _ q = ppDocName q Prefix True name ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2) u q = ppr_fun_ty ctxt_prec ty1 ty2 u q |