aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--haddock-api/src/Haddock/Backends/LaTeX.hs5
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs4
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Utils.hs6
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs1
-rw-r--r--haddock-api/src/Haddock/Interface/Specialize.hs1
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