aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock
diff options
context:
space:
mode:
Diffstat (limited to 'src/Haddock')
-rw-r--r--src/Haddock/Backends/LaTeX.hs1
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs7
-rw-r--r--src/Haddock/Convert.hs40
-rw-r--r--src/Haddock/Interface/AttachInstances.hs3
-rw-r--r--src/Haddock/Interface/Rename.hs2
-rw-r--r--src/Haddock/Interface/Rn.hs4
6 files changed, 39 insertions, 18 deletions
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index 7f53d926..71773d0d 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -874,7 +874,6 @@ ppr_mono_ty _ (HsKindSig ty kind) u = parens (ppr_mono_lty pREC_TOP ty u
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 _ (HsPredTy p) u = parens (ppPred u p)
-ppr_mono_ty _ (HsNumTy n) _ = text (show n) -- generics only
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"
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index ce0dccda..381802b4 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -711,11 +711,14 @@ ppr_mono_ty _ (HsKindSig ty kind) u q =
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 _ (HsPredTy p) u q = parens (ppPred u q p)
-ppr_mono_ty _ (HsNumTy n) _ _ = toHtml (show n) -- generics only
ppr_mono_ty _ (HsSpliceTy {}) _ _ = error "ppr_mono_ty HsSpliceTy"
+#if __GLASGOW_HASKELL__ == 612
+ppr_mono_ty _ (HsSpliceTyOut {}) _ _ = error "ppr_mono_ty HsQuasiQuoteTy"
+#else
ppr_mono_ty _ (HsQuasiQuoteTy {}) _ _ = error "ppr_mono_ty HsQuasiQuoteTy"
-ppr_mono_ty _ (HsCoreTy {}) _ _ = error "ppr_mono_ty HsCoreTy"
+#endif
ppr_mono_ty _ (HsRecTy {}) _ _ = error "ppr_mono_ty HsRecTy"
+ppr_mono_ty _ (HsCoreTy {}) _ _ = error "ppr_mono_ty HsCoreTy"
ppr_mono_ty ctxt_prec (HsAppTy fun_ty arg_ty) unicode qual
= maybeParen ctxt_prec pREC_CON $
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index dde8c1b6..9892ff47 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -18,7 +18,7 @@ module Haddock.Convert where
import HsSyn
-import TcType ( tcSplitSigmaTy )
+import TcType ( tcSplitTyConApp_maybe, tcSplitSigmaTy )
import TypeRep
import Coercion ( splitKindFunTys, synTyConResKind )
import Name
@@ -44,9 +44,15 @@ tyThingToLHsDecl t = noLoc $ case t of
-- into a ForD instead of a SigD if we wanted. Haddock doesn't
-- need to care.
AnId i -> SigD (synifyIdSig ImplicitizeForAll i)
+
-- type-constructors (e.g. Maybe) are complicated, put the definition
-- later in the file (also it's used for class associated-types too.)
ATyCon tc -> TyClD (synifyTyCon tc)
+
+ -- type-constructors (e.g. Maybe) are complicated, put the definition
+ -- later in the file (also it's used for class associated-types too.)
+ ACoAxiom ax -> TyClD (synifyAxiom ax)
+
-- a data-constructor alone just gets rendered as a function:
ADataCon dc -> SigD (TypeSig (synifyName dc)
(synifyType ImplicitizeForAll (dataConUserType dc)))
@@ -71,6 +77,16 @@ tyThingToLHsDecl t = noLoc $ case t of
synifyClassAT :: TyCon -> LTyClDecl Name
synifyClassAT = noLoc . synifyTyCon
+synifyAxiom :: CoAxiom -> TyClDecl Name
+synifyAxiom (CoAxiom { co_ax_tvs = tvs, co_ax_lhs = lhs, co_ax_rhs = rhs })
+ | Just (tc, args) <- tcSplitTyConApp_maybe lhs
+ = let name = synifyName tc
+ tyvars = synifyTyVars tvs
+ typats = map (synifyType WithinType) args
+ hs_rhs_ty = synifyType WithinType rhs
+ in TySynonym name tyvars (Just typats) hs_rhs_ty
+ | otherwise
+ = error "synifyAxiom"
synifyTyCon :: TyCon -> TyClDecl Name
synifyTyCon tc
@@ -162,11 +178,15 @@ synifyDataCon use_gadt_syntax dc = noLoc $
use_named_field_syntax = not (null field_tys)
name = synifyName dc
-- con_qvars means a different thing depending on gadt-syntax
+ (univ_tvs, ex_tvs, _eq_spec, theta, arg_tys, res_ty) = dataConFullSig dc
+
qvars = if use_gadt_syntax
- then synifyTyVars (dataConAllTyVars dc)
- else synifyTyVars (dataConExTyVars dc)
+ then synifyTyVars (univ_tvs ++ ex_tvs)
+ else synifyTyVars ex_tvs
+
-- skip any EqTheta, use 'orig'inal syntax
- ctx = synifyCtx (dataConDictTheta dc)
+ ctx = synifyCtx theta
+
linear_tys = zipWith (\ty bang ->
let tySyn = synifyType WithinType ty
in case bang of
@@ -175,23 +195,23 @@ synifyDataCon use_gadt_syntax dc = noLoc $
-- HsNoBang never appears, it's implied instead.
_ -> noLoc $ HsBangTy bang tySyn
)
- (dataConOrigArgTys dc) (dataConStrictMarks dc)
+ arg_tys (dataConStrictMarks dc)
field_tys = zipWith (\field synTy -> ConDeclField
(synifyName field) synTy Nothing)
(dataConFieldLabels dc) linear_tys
- tys = case (use_named_field_syntax, use_infix_syntax) of
+ hs_arg_tys = case (use_named_field_syntax, use_infix_syntax) of
(True,True) -> error "synifyDataCon: contradiction!"
(True,False) -> RecCon field_tys
(False,False) -> PrefixCon linear_tys
(False,True) -> case linear_tys of
[a,b] -> InfixCon a b
_ -> error "synifyDataCon: infix with non-2 args?"
- res_ty = if use_gadt_syntax
- then ResTyGADT (synifyType WithinType (dataConOrigResTy dc))
- else ResTyH98
+ hs_res_ty = if use_gadt_syntax
+ then ResTyGADT (synifyType WithinType res_ty)
+ else ResTyH98
-- finally we get synifyDataCon's result!
in ConDecl name Implicit{-we don't know nor care-}
- qvars ctx tys res_ty Nothing
+ qvars ctx hs_arg_tys hs_res_ty Nothing
False --we don't want any "deprecated GADT syntax" warnings!
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs
index cc2dfa19..e4da3233 100644
--- a/src/Haddock/Interface/AttachInstances.hs
+++ b/src/Haddock/Interface/AttachInstances.hs
@@ -30,9 +30,10 @@ import GhcMonad (withSession)
#else
import HscTypes (withSession)
#endif
+import TysPrim( funTyCon )
import MonadUtils (liftIO)
import TcRnDriver (tcRnGetInfo)
-import TypeRep hiding (funTyConName)
+import TypeRep
import Var hiding (varName)
import TyCon
import PrelNames
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index e28ff639..b53f579c 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -265,8 +265,6 @@ renameType t = case t of
HsParTy ty -> return . HsParTy =<< renameLType ty
- HsNumTy n -> return (HsNumTy n)
-
HsPredTy p -> return . HsPredTy =<< renamePred p
HsKindSig ty k -> do
diff --git a/src/Haddock/Interface/Rn.hs b/src/Haddock/Interface/Rn.hs
index 4c040f3e..6f7af908 100644
--- a/src/Haddock/Interface/Rn.hs
+++ b/src/Haddock/Interface/Rn.hs
@@ -6,7 +6,7 @@ import RnEnv ( dataTcOccs )
import RdrName ( RdrName, gre_name, GlobalRdrEnv, lookupGRE_RdrName )
import Name ( Name )
-import Outputable ( ppr, defaultUserStyle )
+import Outputable ( ppr, showSDoc )
rnHaddockModInfo :: GlobalRdrEnv -> HaddockModInfo RdrName -> HaddockModInfo Name
rnHaddockModInfo gre (HaddockModInfo desc port stab maint) =
@@ -14,7 +14,7 @@ rnHaddockModInfo gre (HaddockModInfo desc port stab maint) =
ids2string :: [RdrName] -> String
ids2string [] = []
-ids2string (x:_) = show $ ppr x defaultUserStyle
+ids2string (x:_) = showSDoc $ ppr x
data Id x = Id {unId::x}
instance Monad Id where (Id v)>>=f = f v; return = Id
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 05:46:43 +0000