aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Backends/Xhtml
diff options
context:
space:
mode:
authorÖmer Sinan Ağacan <omeragacan@gmail.com>2016-07-01 10:11:48 +0000
committerBen Gamari <ben@smart-cactus.org>2016-07-21 13:30:47 +0200
commitcdc81a1b73bd4d1b330a32870d4369e1a2af3610 (patch)
treee03c999a9b829e0d57f675db6fafc994735ed4a0 /haddock-api/src/Haddock/Backends/Xhtml
parent008e61d0c4b10713751c2a1de4958acc75367396 (diff)
Add support for unboxed sums
Diffstat (limited to 'haddock-api/src/Haddock/Backends/Xhtml')
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Decl.hs4
-rw-r--r--haddock-api/src/Haddock/Backends/Xhtml/Utils.hs6
2 files changed, 9 insertions, 1 deletions
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 "#)"