aboutsummaryrefslogtreecommitdiff
path: root/haddock-api/src/Haddock/Interface
diff options
context:
space:
mode:
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r--haddock-api/src/Haddock/Interface/Create.hs18
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs14
2 files changed, 17 insertions, 15 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index 922fdcf7..175fe8b5 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -343,7 +343,7 @@ typeDocs :: HsDecl Name -> Map Int HsDocString
typeDocs d =
let docs = go 0 in
case d of
- SigD (TypeSig _ ty) -> docs (unLoc ty)
+ SigD (TypeSig _ ty _) -> docs (unLoc ty)
SigD (PatSynSig _ _ req prov ty) ->
let allTys = ty : concat [ unLoc req, unLoc prov ]
in F.foldMap (docs . unLoc) allTys
@@ -351,7 +351,7 @@ typeDocs d =
TyClD (SynDecl { tcdRhs = ty }) -> docs (unLoc ty)
_ -> M.empty
where
- go n (HsForAllTy _ _ _ ty) = go n (unLoc ty)
+ go n (HsForAllTy _ _ _ _ ty) = go n (unLoc ty)
go n (HsFunTy (L _ (HsDocTy _ (L _ x))) (L _ ty)) = M.insert n x $ go (n+1) ty
go n (HsFunTy _ ty) = go (n+1) (unLoc ty)
go n (HsDocTy _ (L _ doc)) = M.singleton n doc
@@ -732,8 +732,8 @@ fullModuleContents dflags warnings gre (docMap, argMap, subMap, declMap, instMap
expandSig = foldr f []
where
f :: LHsDecl name -> [LHsDecl name] -> [LHsDecl name]
- f (L l (SigD (TypeSig names t))) xs = foldr (\n acc -> L l (SigD (TypeSig [n] t)) : acc) xs names
- f (L l (SigD (GenericSig names t))) xs = foldr (\n acc -> L l (SigD (GenericSig [n] t)) : acc) xs names
+ f (L l (SigD (TypeSig names t nwcs))) xs = foldr (\n acc -> L l (SigD (TypeSig [n] t nwcs)) : acc) xs names
+ f (L l (SigD (GenericSig names t))) xs = foldr (\n acc -> L l (SigD (GenericSig [n] t)) : acc) xs names
f x xs = x : xs
mkExportItem :: LHsDecl Name -> ErrMsgGhc (Maybe (ExportItem Name))
@@ -810,10 +810,10 @@ toTypeNoLoc = noLoc . HsTyVar . unLoc
extractClassDecl :: Name -> [Located Name] -> LSig Name -> LSig Name
-extractClassDecl c tvs0 (L pos (TypeSig lname ltype)) = case ltype of
- L _ (HsForAllTy expl tvs (L _ preds) ty) ->
- L pos (TypeSig lname (noLoc (HsForAllTy expl tvs (lctxt preds) ty)))
- _ -> L pos (TypeSig lname (noLoc (HsForAllTy Implicit emptyHsQTvs (lctxt []) ltype)))
+extractClassDecl c tvs0 (L pos (TypeSig lname ltype _)) = case ltype of
+ L _ (HsForAllTy expl _ tvs (L _ preds) ty) ->
+ L pos (TypeSig lname (noLoc (HsForAllTy expl Nothing tvs (lctxt preds) ty)) [])
+ _ -> L pos (TypeSig lname (noLoc (HsForAllTy Implicit Nothing emptyHsQTvs (lctxt []) ltype)) [])
where
lctxt = noLoc . ctxt
ctxt preds = nlHsTyConApp c (map toTypeNoLoc tvs0) : preds
@@ -827,7 +827,7 @@ extractRecSel _ _ _ _ [] = error "extractRecSel: selector not found"
extractRecSel nm mdl t tvs (L _ con : rest) =
case con_details con of
RecCon fields | ((n,L _ (ConDeclField _nn ty _)) : _) <- matching_fields fields ->
- L (getLoc n) (TypeSig [noLoc nm] (noLoc (HsFunTy data_ty (getBangType ty))))
+ L (getLoc n) (TypeSig [noLoc nm] (noLoc (HsFunTy data_ty (getBangType ty))) [])
_ -> extractRecSel nm mdl t tvs rest
where
matching_fields flds = [ (n,f) | f@(L _ (ConDeclField ns _ _)) <- flds, n <- ns, unLoc n == nm ]
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index 77159472..1ea212f5 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -182,11 +182,11 @@ renameMaybeLKind = traverse renameLKind
renameType :: HsType Name -> RnM (HsType DocName)
renameType t = case t of
- HsForAllTy expl tyvars lcontext ltype -> do
+ HsForAllTy expl extra tyvars lcontext ltype -> do
tyvars' <- renameLTyVarBndrs tyvars
lcontext' <- renameLContext lcontext
ltype' <- renameLType ltype
- return (HsForAllTy expl tyvars' lcontext' ltype')
+ return (HsForAllTy expl extra tyvars' lcontext' ltype')
HsTyVar n -> return . HsTyVar =<< rename n
HsBangTy b ltype -> return . HsBangTy b =<< renameLType ltype
@@ -235,6 +235,8 @@ renameType t = case t of
HsExplicitTupleTy a b -> HsExplicitTupleTy a <$> mapM renameLType b
HsQuasiQuoteTy a -> HsQuasiQuoteTy <$> renameHsQuasiQuote a
HsSpliceTy _ _ -> error "renameType: HsSpliceTy"
+ HsWildcardTy -> pure HsWildcardTy
+ HsNamedWildcardTy a -> HsNamedWildcardTy <$> rename a
renameHsQuasiQuote :: HsQuasiQuote Name -> RnM (HsQuasiQuote DocName)
renameHsQuasiQuote (HsQuasiQuote a b c) = HsQuasiQuote <$> rename a <*> pure b <*> pure c
@@ -399,10 +401,10 @@ renameConDeclFieldField (L l (ConDeclField names t doc)) = do
renameSig :: Sig Name -> RnM (Sig DocName)
renameSig sig = case sig of
- TypeSig lnames ltype -> do
+ TypeSig lnames ltype _ -> do
lnames' <- mapM renameL lnames
ltype' <- renameLType ltype
- return (TypeSig lnames' ltype')
+ return (TypeSig lnames' ltype' PlaceHolder)
PatSynSig lname (flag, qtvs) lreq lprov lty -> do
lname' <- renameL lname
qtvs' <- renameLTyVarBndrs qtvs
@@ -465,7 +467,7 @@ renameLTyFamInstEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = pats_w_bndrs,
; pats' <- mapM renameLType (hswb_cts pats_w_bndrs)
; rhs' <- renameLType rhs
; return (L loc (TyFamEqn { tfe_tycon = tc'
- , tfe_pats = HsWB pats' PlaceHolder PlaceHolder
+ , tfe_pats = HsWB pats' PlaceHolder PlaceHolder PlaceHolder
, tfe_rhs = rhs' })) }
renameLTyFamDefltEqn :: LTyFamDefltEqn Name -> RnM (LTyFamDefltEqn DocName)
@@ -484,7 +486,7 @@ renameDataFamInstD (DataFamInstDecl { dfid_tycon = tc, dfid_pats = pats_w_bndrs,
; defn' <- renameDataDefn defn
; return (DataFamInstDecl { dfid_tycon = tc'
, dfid_pats
- = HsWB pats' PlaceHolder PlaceHolder
+ = HsWB pats' PlaceHolder PlaceHolder PlaceHolder
, dfid_defn = defn', dfid_fvs = placeHolderNames }) }
renameExportItem :: ExportItem Name -> RnM (ExportItem DocName)
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 08:59:47 +0000