aboutsummaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
Diffstat (limited to 'src')
-rw-r--r--src/Haddock/Backends/Hoogle.hs7
-rw-r--r--src/Haddock/Backends/LaTeX.hs12
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs16
-rw-r--r--src/Haddock/Convert.hs12
-rw-r--r--src/Haddock/Interface/Rename.hs33
5 files changed, 43 insertions, 37 deletions
diff --git a/src/Haddock/Backends/Hoogle.hs b/src/Haddock/Backends/Hoogle.hs
index c0569006..d176c9f7 100644
--- a/src/Haddock/Backends/Hoogle.hs
+++ b/src/Haddock/Backends/Hoogle.hs
@@ -141,10 +141,10 @@ ppClass x = out x{tcdSigs=[]} :
addContext _ = error "expected TypeSig"
f (HsForAllTy a b con d) = HsForAllTy a b (reL (context : unLoc con)) d
- f t = HsForAllTy Implicit [] (reL [context]) (reL t)
+ f t = HsForAllTy Implicit (mkHsQTvs []) (reL [context]) (reL t)
context = nlHsTyConApp (unL $ tcdLName x)
- (map (reL . HsTyVar . hsTyVarName . unL) (tcdTyVars x))
+ (map (reL . HsTyVar . hsTyVarName . unL) (hsQTvBndrs (tcdTyVars x)))
ppInstance :: ClsInst -> [String]
@@ -193,7 +193,8 @@ ppCtor dat subdocs con = doc (lookupCon subdocs (con_name con))
name = out $ unL $ con_name con
resType = case con_res con of
- ResTyH98 -> apps $ map (reL . HsTyVar) $ unL (tcdLName dat) : [hsTyVarName v | v@UserTyVar {} <- map unL $ tcdTyVars dat]
+ ResTyH98 -> apps $ map (reL . HsTyVar) $
+ unL (tcdLName dat) : [hsTyVarName v | L _ (v@UserTyVar {}) <- hsQTvBndrs $ tcdTyVars dat]
ResTyGADT x -> x
diff --git a/src/Haddock/Backends/LaTeX.hs b/src/Haddock/Backends/LaTeX.hs
index a02079c6..fc07a07e 100644
--- a/src/Haddock/Backends/LaTeX.hs
+++ b/src/Haddock/Backends/LaTeX.hs
@@ -388,12 +388,12 @@ ppTypeSig nms ty unicode =
<+> ppType unicode ty
-ppTyVars :: [LHsTyVarBndr DocName] -> [LaTeX]
+ppTyVars :: LHsTyVarBndrs DocName -> [LaTeX]
ppTyVars tvs = map ppSymName (tyvarNames tvs)
-tyvarNames :: [LHsTyVarBndr DocName] -> [Name]
-tyvarNames = map (getName . hsTyVarName . unLoc)
+tyvarNames :: LHsTyVarBndrs DocName -> [Name]
+tyvarNames = map getName . hsLTyVarNames
declWithDoc :: LaTeX -> Maybe LaTeX -> LaTeX
@@ -442,7 +442,7 @@ rDoc = maybeDoc . fmap latexStripTrailingWhitespace
ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
- -> [Located (HsTyVarBndr DocName)] -> [Located ([DocName], [DocName])]
+ -> LHsTyVarBndrs DocName -> [Located ([DocName], [DocName])]
-> Bool -> LaTeX
ppClassHdr summ lctxt n tvs fds unicode =
keyword "class"
@@ -826,13 +826,13 @@ 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
-ppForAll :: HsExplicitFlag -> [Located (HsTyVarBndr DocName)]
+ppForAll :: HsExplicitFlag -> LHsTyVarBndrs DocName
-> Located (HsContext DocName) -> Bool -> LaTeX
ppForAll expl tvs cxt unicode
| show_forall = forall_part <+> ppLContext cxt unicode
| otherwise = ppLContext cxt unicode
where
- show_forall = not (null tvs) && is_explicit
+ show_forall = not (null (hsQTvBndrs tvs)) && is_explicit
is_explicit = case expl of {Explicit -> True; Implicit -> False}
forall_part = hsep (forallSymbol unicode : ppTyVars tvs) <> dot
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs
index 18506e8f..b4afee3d 100644
--- a/src/Haddock/Backends/Xhtml/Decl.hs
+++ b/src/Haddock/Backends/Xhtml/Decl.hs
@@ -99,12 +99,12 @@ ppTypeOrFunSig summary links loc docnames typ (doc, argDocs) (pref1, pref2, sep)
= (leader <+> ppType unicode qual t, argDoc n, []) : []
-ppTyVars :: [LHsTyVarBndr DocName] -> [Html]
+ppTyVars :: LHsTyVarBndrs DocName -> [Html]
ppTyVars tvs = map ppTyName (tyvarNames tvs)
-tyvarNames :: [LHsTyVarBndr DocName] -> [Name]
-tyvarNames = map (getName . hsTyVarName . unLoc)
+tyvarNames :: LHsTyVarBndrs DocName -> [Name]
+tyvarNames = map getName . hsLTyVarNames
ppFor :: Bool -> LinksInfo -> SrcSpan -> DocForDecl DocName
@@ -162,8 +162,8 @@ ppTyFamHeader summary associated decl unicode qual =
ppTyClBinderWithVars summary decl <+>
case tcdKindSig decl of
- Just (HsBSig kind _) -> dcolon unicode <+> ppLKind unicode qual kind
- Nothing -> noHtml
+ Just kind -> dcolon unicode <+> ppLKind unicode qual kind
+ Nothing -> noHtml
ppTyFam :: Bool -> Bool -> LinksInfo -> SrcSpan -> Maybe (Doc DocName) ->
@@ -275,7 +275,7 @@ pp_hs_context cxt unicode qual = parenList (map (ppType unicode qual) cxt)
ppClassHdr :: Bool -> Located [LHsType DocName] -> DocName
- -> [Located (HsTyVarBndr DocName)] -> [Located ([DocName], [DocName])]
+ -> LHsTyVarBndrs DocName -> [Located ([DocName], [DocName])]
-> Bool -> Qualification -> Html
ppClassHdr summ lctxt n tvs fds unicode qual =
keyword "class"
@@ -646,13 +646,13 @@ 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
-ppForAll :: HsExplicitFlag -> [Located (HsTyVarBndr DocName)]
+ppForAll :: HsExplicitFlag -> LHsTyVarBndrs DocName
-> Located (HsContext DocName) -> Bool -> Qualification -> Html
ppForAll expl tvs cxt unicode qual
| show_forall = forall_part <+> ppLContext cxt unicode qual
| otherwise = ppLContext cxt unicode qual
where
- show_forall = not (null tvs) && is_explicit
+ show_forall = not (null (hsQTvBndrs tvs)) && is_explicit
is_explicit = case expl of {Explicit -> True; Implicit -> False}
forall_part = hsep (forallSymbol unicode : ppTyVars tvs) +++ dot
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs
index 58f6a872..e2eb990b 100644
--- a/src/Haddock/Convert.hs
+++ b/src/Haddock/Convert.hs
@@ -87,7 +87,7 @@ synifyAxiom (CoAxiom { co_ax_tvs = tvs, co_ax_lhs = lhs, co_ax_rhs = rhs })
typats = map (synifyType WithinType) args
hs_rhs_ty = synifyType WithinType rhs
in FamInstDecl { fid_tycon = name
- , fid_pats = HsBSig typats ([], map tyVarName tvs)
+ , fid_pats = HsWB { hswb_cts = typats, hswb_kvs = [], hswb_tvs = map tyVarName tvs }
, fid_defn = TySynonym hs_rhs_ty, fid_fvs = placeHolderNames }
| otherwise
= error "synifyAxiom"
@@ -97,7 +97,7 @@ synifyTyCon tc
| isFunTyCon tc || isPrimTyCon tc
= TyDecl { tcdLName = synifyName tc
, tcdTyVars = -- tyConTyVars doesn't work on fun/prim, but we can make them up:
- zipWith
+ mkHsQTvs $ zipWith
(\fakeTyVar realKind -> noLoc $
KindedTyVar (getName fakeTyVar)
(synifyKindSig realKind))
@@ -230,8 +230,8 @@ synifyCtx :: [PredType] -> LHsContext Name
synifyCtx = noLoc . map (synifyType WithinType)
-synifyTyVars :: [TyVar] -> [LHsTyVarBndr Name]
-synifyTyVars = map synifyTyVar
+synifyTyVars :: [TyVar] -> LHsTyVarBndrs Name
+synifyTyVars tvs = mkHsQTvs (map synifyTyVar tvs)
where
synifyTyVar tv = noLoc $ let
kind = tyVarKind tv
@@ -311,8 +311,8 @@ synifyTyLit :: TyLit -> HsTyLit
synifyTyLit (NumTyLit n) = HsNumTy n
synifyTyLit (StrTyLit s) = HsStrTy s
-synifyKindSig :: Kind -> HsBndrSig (LHsKind Name)
-synifyKindSig k = mkHsBSig (synifyType (error "synifyKind") k)
+synifyKindSig :: Kind -> LHsKind Name
+synifyKindSig k = synifyType (error "synifyKind") k
synifyInstHead :: ([TyVar], [PredType], Class, [Type]) ->
([HsType Name], Name, [HsType Name])
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index a766be18..5e819e59 100644
--- a/src/Haddock/Interface/Rename.hs
+++ b/src/Haddock/Interface/Rename.hs
@@ -206,17 +206,17 @@ renameLType = mapM renameType
renameLKind :: LHsKind Name -> RnM (LHsKind DocName)
renameLKind = renameLType
-renameMaybeLKind :: Maybe (HsBndrSig (LHsKind Name))
- -> RnM (Maybe (HsBndrSig (LHsKind DocName)))
+renameMaybeLKind :: Maybe (LHsKind Name)
+ -> RnM (Maybe (LHsKind DocName))
renameMaybeLKind Nothing = return Nothing
-renameMaybeLKind (Just (HsBSig ki fvs))
+renameMaybeLKind (Just ki)
= do { ki' <- renameLKind ki
- ; return (Just (HsBSig ki' fvs)) }
+ ; return (Just ki') }
renameType :: HsType Name -> RnM (HsType DocName)
renameType t = case t of
HsForAllTy expl tyvars lcontext ltype -> do
- tyvars' <- mapM renameLTyVarBndr tyvars
+ tyvars' <- renameLTyVarBndrs tyvars
lcontext' <- renameLContext lcontext
ltype' <- renameLType ltype
return (HsForAllTy expl tyvars' lcontext' ltype')
@@ -264,14 +264,19 @@ renameType t = case t of
_ -> error "renameType"
+renameLTyVarBndrs :: LHsTyVarBndrs Name -> RnM (LHsTyVarBndrs DocName)
+renameLTyVarBndrs qtvs
+ = do { tvs' <- mapM renameLTyVarBndr (hsQTvBndrs qtvs)
+ ; return (mkHsQTvs tvs') }
+
renameLTyVarBndr :: LHsTyVarBndr Name -> RnM (LHsTyVarBndr DocName)
renameLTyVarBndr (L loc (UserTyVar n))
= do { n' <- rename n
; return (L loc (UserTyVar n')) }
-renameLTyVarBndr (L loc (KindedTyVar n (HsBSig k fvs)))
+renameLTyVarBndr (L loc (KindedTyVar n k))
= do { n' <- rename n
; k' <- renameLKind k
- ; return (L loc (KindedTyVar n' (HsBSig k' fvs))) }
+ ; return (L loc (KindedTyVar n' k')) }
renameLContext :: Located [LHsType Name] -> RnM (Located [LHsType DocName])
renameLContext (L loc context) = do
@@ -321,7 +326,7 @@ renameTyClD d = case d of
-- TyFamily flav lname ltyvars kind tckind -> do
TyFamily flav lname ltyvars tckind -> do
lname' <- renameL lname
- ltyvars' <- mapM renameLTyVarBndr ltyvars
+ ltyvars' <- renameLTyVarBndrs ltyvars
-- kind' <- renameMaybeLKind kind
tckind' <- renameMaybeLKind tckind
-- return (TyFamily flav lname' ltyvars' kind' tckind)
@@ -329,7 +334,7 @@ renameTyClD d = case d of
TyDecl { tcdLName = lname, tcdTyVars = tyvars, tcdTyDefn = defn, tcdFVs = fvs } -> do
lname' <- renameL lname
- tyvars' <- mapM renameLTyVarBndr tyvars
+ tyvars' <- renameLTyVarBndrs tyvars
defn' <- renameTyDefn defn
return (TyDecl { tcdLName = lname', tcdTyVars = tyvars', tcdTyDefn = defn', tcdFVs = fvs })
@@ -337,7 +342,7 @@ renameTyClD d = case d of
, tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do
lcontext' <- renameLContext lcontext
lname' <- renameL lname
- ltyvars' <- mapM renameLTyVarBndr ltyvars
+ ltyvars' <- renameLTyVarBndrs ltyvars
lfundeps' <- mapM renameLFunDep lfundeps
lsigs' <- mapM renameLSig lsigs
ats' <- mapM renameLTyClD ats
@@ -374,7 +379,7 @@ renameCon decl@(ConDecl { con_name = lname, con_qvars = ltyvars
, con_cxt = lcontext, con_details = details
, con_res = restype, con_doc = mbldoc }) = do
lname' <- renameL lname
- ltyvars' <- mapM renameLTyVarBndr ltyvars
+ ltyvars' <- renameLTyVarBndrs ltyvars
lcontext' <- renameLContext lcontext
details' <- renameDetails details
restype' <- renameResType restype
@@ -431,11 +436,11 @@ renameInstD (FamInstD { lid_inst = d }) = do
return (FamInstD { lid_inst = d' })
renameFamInstD :: FamInstDecl Name -> RnM (FamInstDecl DocName)
-renameFamInstD (FamInstDecl { fid_tycon = tc, fid_pats = HsBSig pats fvs, fid_defn = defn })
+renameFamInstD (FamInstDecl { fid_tycon = tc, fid_pats = pats_w_bndrs, fid_defn = defn })
= do { tc' <- renameL tc
- ; pats' <- mapM renameLType pats
+ ; pats' <- mapM renameLType (hswb_cts pats_w_bndrs)
; defn' <- renameTyDefn defn
- ; return (FamInstDecl { fid_tycon = tc', fid_pats = HsBSig pats' fvs
+ ; return (FamInstDecl { fid_tycon = tc', fid_pats = pats_w_bndrs { hswb_cts = pats' }
, fid_defn = defn', fid_fvs = placeHolderNames }) }
generated by cgit v1.2.3 (git 2.39.1) at 2025-10-31 10:36:07 +0000