aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends/Xhtml/Decl.hs
diff options
context:
space:
mode:
authorJose Pedro Magalhaes <jpm@cs.uu.nl>2011-11-11 09:07:39 +0000
committerJose Pedro Magalhaes <jpm@cs.uu.nl>2011-11-11 09:07:39 +0000
commit96154b6154c6e7556a92695428d0fc8ddf015d2a (patch)
tree66e9ea53712153c3b86675210df5bd0b1b0c0855 /src/Haddock/Backends/Xhtml/Decl.hs
parent2a8f4845d919c5508452f30ffc419646d8841841 (diff)
New kind-polymorphic core
This big patch implements a kind-polymorphic core for GHC. The current implementation focuses on making sure that all kind-monomorphic programs still work in the new core; it is not yet guaranteed that kind-polymorphic programs (using the new -XPolyKinds flag) will work. For more information, see http://haskell.org/haskellwiki/GHC/Kinds
Diffstat (limited to 'src/Haddock/Backends/Xhtml/Decl.hs')
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs27
1 files changed, 15 insertions, 12 deletions
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index c1f3a89a..44429167 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -35,7 +35,6 @@ import Text.XHtml hiding ( name, title, p, quote )
import GHC
import Name
import BasicTypes ( ipNameName )
-import Outputable ( ppr, showSDoc, Outputable )
-- TODO: use DeclInfo DocName or something
@@ -150,8 +149,8 @@ ppTyName name
--------------------------------------------------------------------------------
-ppTyFamHeader :: Bool -> Bool -> TyClDecl DocName -> Bool -> Html
-ppTyFamHeader summary associated decl unicode =
+ppTyFamHeader :: Bool -> Bool -> TyClDecl DocName -> Bool -> Qualification -> Html
+ppTyFamHeader summary associated decl unicode qual =
(case tcdFlavour decl of
TypeFamily
@@ -165,7 +164,7 @@ ppTyFamHeader summary associated decl unicode =
ppTyClBinderWithVars summary decl <+>
case tcdKind decl of
- Just kind -> dcolon unicode <+> ppKind kind
+ Just kind -> dcolon unicode <+> ppLKind unicode qual kind
Nothing -> noHtml
@@ -173,13 +172,13 @@ ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) ->
TyClDecl DocName -> Bool -> Qualification -> Html
ppTyFam summary associated links loc mbDoc decl unicode qual
- | summary = ppTyFamHeader True associated decl unicode
+ | summary = ppTyFamHeader True associated decl unicode qual
| otherwise = header_ +++ maybeDocSection qual mbDoc +++ instancesBit
where
docname = tcdName decl
- header_ = topDeclElem links loc [docname] (ppTyFamHeader summary associated decl unicode)
+ header_ = topDeclElem links loc [docname] (ppTyFamHeader summary associated decl unicode qual)
instancesBit = ppInstances instances docname unicode qual
@@ -635,10 +634,6 @@ ppDataHeader summary decl unicode qual
--------------------------------------------------------------------------------
-ppKind :: Outputable a => a -> Html
-ppKind k = toHtml $ showSDoc (ppr k)
-
-
ppBang :: HsBang -> Html
ppBang HsNoBang = noHtml
ppBang _ = toHtml "!" -- Unpacked args is an implementation detail,
@@ -684,6 +679,11 @@ ppType unicode qual ty = ppr_mono_ty pREC_TOP 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 :: Bool -> Qualification-> LHsKind DocName -> Html
+ppLKind unicode qual y = ppKind unicode qual (unLoc y)
+
+ppKind :: Bool -> 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
-- since they are implicit in Haskell
@@ -713,7 +713,7 @@ ppr_mono_ty _ (HsTyVar name) _ q = ppDocName q 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 _ (HsKindSig ty kind) u q =
- parens (ppr_mono_lty pREC_TOP ty u q <+> dcolon u <+> ppKind kind)
+ 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)
ppr_mono_ty _ (HsPArrTy ty) u q = pabrackets (ppr_mono_lty pREC_TOP ty u q)
ppr_mono_ty _ (HsIParamTy n ty) u q = brackets (ppDocName q (ipNameName n) <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u q)
@@ -725,6 +725,9 @@ ppr_mono_ty _ (HsQuasiQuoteTy {}) _ _ = error "ppr_mono_ty HsQuasiQuoteT
#endif
ppr_mono_ty _ (HsRecTy {}) _ _ = error "ppr_mono_ty HsRecTy"
ppr_mono_ty _ (HsCoreTy {}) _ _ = error "ppr_mono_ty HsCoreTy"
+ppr_mono_ty _ (HsExplicitListTy _ tys) u q = quote $ brackets $ hsep $ punctuate comma $ map (ppLType u q) tys
+ppr_mono_ty _ (HsExplicitTupleTy _ tys) u q = quote $ parenList $ map (ppLType u q) tys
+ppr_mono_ty _ (HsWrapTy {}) _ _ = error "ppr_mono_ty HsWrapTy"
ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode qual
= maybeParen ctxt_prec pREC_OP $
@@ -734,7 +737,7 @@ ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual
= maybeParen ctxt_prec pREC_CON $
hsep [ppr_mono_lty pREC_FUN fun_ty unicode qual, ppr_mono_lty pREC_CON arg_ty unicode qual]
-ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode qual
+ppr_mono_ty ctxt_prec (HsOpTy ty1 (_, op) ty2) unicode qual
= maybeParen ctxt_prec pREC_FUN $
ppr_mono_lty pREC_OP ty1 unicode qual <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode qual
where