aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Backends
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock/Backends')
-rw-r--r--src/Haddock/Backends/LaTeX.hs20
-rw-r--r--src/Haddock/Backends/Xhtml.hs4
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs27
3 files changed, 29 insertions, 22 deletions
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index d6a71f27..c6ac2b0a 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -17,7 +17,7 @@ module Haddock.Backends.LaTeX (
import Haddock.Types
import Haddock.Utils
import Haddock.GhcUtils
-import Pretty hiding (Doc)
+import Pretty hiding (Doc, quote)
import qualified Pretty
import GHC
@@ -25,7 +25,6 @@ import OccName
import Name ( isTyConName, nameOccName )
import RdrName ( rdrNameOcc, isRdrTc )
import BasicTypes ( ipNameName )
-import Outputable ( Outputable, ppr, showSDoc )
import FastString ( unpackFS, unpackLitString )
import qualified Data.Map as Map
@@ -791,10 +790,6 @@ pp_hs_context cxt unicode = parenList (map (ppType unicode) cxt)
-------------------------------------------------------------------------------
-ppKind :: Outputable a => a -> LaTeX
-ppKind k = text (showSDoc (ppr k))
-
-
ppBang :: HsBang -> LaTeX
ppBang HsNoBang = empty
ppBang _ = char '!' -- Unpacked args is an implementation detail,
@@ -840,6 +835,12 @@ ppType unicode ty = ppr_mono_ty pREC_TOP ty unicode
ppParendType unicode ty = ppr_mono_ty pREC_CON ty unicode
ppFunLhType unicode ty = ppr_mono_ty pREC_FUN ty unicode
+ppLKind :: Bool -> LHsKind DocName -> LaTeX
+ppLKind unicode y = ppKind unicode (unLoc y)
+
+ppKind :: Bool -> HsKind DocName -> LaTeX
+ppKind unicode ki = ppr_mono_ty pREC_TOP ki unicode
+
-- Drop top-level for-all type variables in user style
-- since they are implicit in Haskell
@@ -868,7 +869,7 @@ ppr_mono_ty _ (HsBangTy b ty) u = ppBang b <> ppLParendType u ty
ppr_mono_ty _ (HsTyVar 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 _ (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u <+> dcolon u <+> ppKind kind)
+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)
ppr_mono_ty _ (HsIParamTy n ty) u = brackets (ppDocName (ipNameName n) <+> dcolon u <+> ppr_mono_lty pREC_TOP ty u)
@@ -876,6 +877,9 @@ ppr_mono_ty _ (HsSpliceTy {}) _ = error "ppr_mono_ty HsSpliceTy"
ppr_mono_ty _ (HsQuasiQuoteTy {}) _ = error "ppr_mono_ty HsQuasiQuoteTy"
ppr_mono_ty _ (HsRecTy {}) _ = error "ppr_mono_ty HsRecTy"
ppr_mono_ty _ (HsCoreTy {}) _ = error "ppr_mono_ty HsCoreTy"
+ppr_mono_ty _ (HsExplicitListTy _ tys) u = Pretty.quote $ brackets $ hsep $ punctuate comma $ map (ppLType u) tys
+ppr_mono_ty _ (HsExplicitTupleTy _ tys) u = Pretty.quote $ parenList $ map (ppLType u) tys
+ppr_mono_ty _ (HsWrapTy {}) _ = error "ppr_mono_ty HsWrapTy"
ppr_mono_ty ctxt_prec (HsEqTy ty1 ty2) unicode
= maybeParen ctxt_prec pREC_OP $
@@ -885,7 +889,7 @@ ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode
= maybeParen ctxt_prec pREC_CON $
hsep [ppr_mono_lty pREC_FUN fun_ty unicode, ppr_mono_lty pREC_CON arg_ty unicode]
-ppr_mono_ty ctxt_prec (HsOpTy ty1 op ty2) unicode
+ppr_mono_ty ctxt_prec (HsOpTy ty1 (_, op) ty2) unicode
= maybeParen ctxt_prec pREC_FUN $
ppr_mono_lty pREC_OP ty1 unicode <+> ppr_op <+> ppr_mono_lty pREC_OP ty2 unicode
where
diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs
index 08e2fe07..9ac4211a 100644
--- a/src/Haddock/Backends/Xhtml.hs
+++ b/src/Haddock/Backends/Xhtml.hs
@@ -558,10 +558,10 @@ miniSynopsis mdl iface unicode qual =
processForMiniSynopsis :: Module -> Bool -> Qualification -> ExportItem DocName
-> [Html]
-processForMiniSynopsis mdl unicode _ (ExportDecl (L _loc decl0) _doc _ _insts) =
+processForMiniSynopsis mdl unicode qual (ExportDecl (L _loc decl0) _doc _ _insts) =
((divTopDecl <<).(declElem <<)) `fmap` case decl0 of
TyClD d -> let b = ppTyClBinderWithVarsMini mdl d in case d of
- (TyFamily{}) -> [ppTyFamHeader True False d unicode]
+ (TyFamily{}) -> [ppTyFamHeader True False d unicode qual]
(TyData{tcdTyPats = ps})
| Nothing <- ps -> [keyword "data" <+> b]
| Just _ <- ps -> [keyword "data" <+> keyword "instance" <+> b]
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
generated by cgit v1.2.3 (git 2.39.1) at 2024-09-21 14:39:09 +0000