[commit: haddock] v2.14: Add UnicodeSyntax alternatives for * and -> (1fda06f)

[git at git.haskell.org]

Repository : ssh://git@git.haskell.org/haddock

On branch  : v2.14
Link       : http://git.haskell.org/haddock.git/commitdiff/1fda06fd41239acef228e83a55871c71e1a4856c

>---------------------------------------------------------------

commit 1fda06fd41239acef228e83a55871c71e1a4856c
Author: Niklas Haas <git at nand.wakku.to>
Date:   Thu Mar 13 07:01:27 2014 +0100

    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.


>---------------------------------------------------------------

1fda06fd41239acef228e83a55871c71e1a4856c
 src/Haddock/Backends/Xhtml/Decl.hs |    9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index c1b9032..cd504d8 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