diff options
Diffstat (limited to 'haddock-api/src/Haddock')
| -rw-r--r-- | haddock-api/src/Haddock/Backends/LaTeX.hs | 5 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Decl.hs | 4 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Backends/Xhtml/Utils.hs | 6 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Rename.hs | 1 | ||||
| -rw-r--r-- | haddock-api/src/Haddock/Interface/Specialize.hs | 1 | 
5 files changed, 16 insertions, 1 deletions
diff --git a/haddock-api/src/Haddock/Backends/LaTeX.hs b/haddock-api/src/Haddock/Backends/LaTeX.hs index 3b0c38c4..ffb4d782 100644 --- a/haddock-api/src/Haddock/Backends/LaTeX.hs +++ b/haddock-api/src/Haddock/Backends/LaTeX.hs @@ -885,6 +885,10 @@ tupleParens HsUnboxedTuple = ubxParenList  tupleParens _              = parenList +sumParens :: [LaTeX] -> LaTeX +sumParens = ubxparens . hsep . punctuate (text " | ") + +  -------------------------------------------------------------------------------  -- * Rendering of HsType  -- @@ -948,6 +952,7 @@ ppr_mono_ty _         (HsBangTy b ty)     u = ppBang b <> ppLParendType u ty  ppr_mono_ty _         (HsTyVar (L _ name)) _ = ppDocName name  ppr_mono_ty ctxt_prec (HsFunTy ty1 ty2)   u = ppr_fun_ty ctxt_prec ty1 ty2 u  ppr_mono_ty _         (HsTupleTy con tys) u = tupleParens con (map (ppLType u) tys) +ppr_mono_ty _         (HsSumTy tys) u       = sumParens (map (ppLType u) tys)  ppr_mono_ty _         (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppLKind u kind)  ppr_mono_ty _         (HsListTy ty)       u = brackets (ppr_mono_lty pREC_TOP ty u)  ppr_mono_ty _         (HsPArrTy ty)       u = pabrackets (ppr_mono_lty pREC_TOP ty u) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs index ed9fd964..c6f1100b 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Decl.hs @@ -913,6 +913,9 @@ tupleParens HsUnboxedTuple = ubxParenList  tupleParens _              = parenList +sumParens :: [Html] -> Html +sumParens = ubxSumList +  --------------------------------------------------------------------------------  -- * Rendering of HsType  -------------------------------------------------------------------------------- @@ -989,6 +992,7 @@ ppr_mono_ty _         (HsBangTy b ty)     u q = ppBang b +++ ppLParendType u q t  ppr_mono_ty _         (HsTyVar (L _ 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  ppr_mono_ty _         (HsTupleTy con tys) u q = tupleParens con (map (ppLType u q) tys) +ppr_mono_ty _         (HsSumTy tys) u q = sumParens (map (ppLType u q) tys)  ppr_mono_ty _         (HsKindSig ty kind) u q =      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) diff --git a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs index 391bb50c..a8b4a4ec 100644 --- a/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs +++ b/haddock-api/src/Haddock/Backends/Xhtml/Utils.hs @@ -20,7 +20,7 @@ module Haddock.Backends.Xhtml.Utils (    (<+>), (<=>), char,    keyword, punctuate, -  braces, brackets, pabrackets, parens, parenList, ubxParenList, +  braces, brackets, pabrackets, parens, parenList, ubxParenList, ubxSumList,    arrow, comma, dcolon, dot, darrow, equals, forallSymbol, quote, promoQuote,    hsep, vcat, @@ -177,6 +177,10 @@ ubxParenList :: [Html] -> Html  ubxParenList = ubxparens . hsep . punctuate comma +ubxSumList :: [Html]  -> Html +ubxSumList = ubxparens . hsep . punctuate (toHtml " | ") + +  ubxparens :: Html -> Html  ubxparens h = toHtml "(#" +++ h +++ toHtml "#)" diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs index d786d0cc..cf3b72ac 100644 --- a/haddock-api/src/Haddock/Interface/Rename.hs +++ b/haddock-api/src/Haddock/Interface/Rename.hs @@ -238,6 +238,7 @@ renameType t = case t of    HsEqTy ty1 ty2 -> liftM2 HsEqTy (renameLType ty1) (renameLType ty2)    HsTupleTy b ts -> return . HsTupleTy b =<< mapM renameLType ts +  HsSumTy ts -> HsSumTy <$> mapM renameLType ts    HsOpTy a (L loc op) b -> do      op' <- rename op diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs index 198bc4ff..3e0df4e1 100644 --- a/haddock-api/src/Haddock/Interface/Specialize.hs +++ b/haddock-api/src/Haddock/Interface/Specialize.hs @@ -273,6 +273,7 @@ renameType (HsFunTy la lr) = HsFunTy <$> renameLType la <*> renameLType lr  renameType (HsListTy lt) = HsListTy <$> renameLType lt  renameType (HsPArrTy lt) = HsPArrTy <$> renameLType lt  renameType (HsTupleTy srt lt) = HsTupleTy srt <$> mapM renameLType lt +renameType (HsSumTy lt) = HsSumTy <$> mapM renameLType lt  renameType (HsOpTy la lop lb) =      HsOpTy <$> renameLType la <*> located renameName lop <*> renameLType lb  renameType (HsParTy lt) = HsParTy <$> renameLType lt  | 
