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.hs4
-rw-r--r--haddock-api/src/Haddock/Interface/Rename.hs6
-rw-r--r--haddock-api/src/Haddock/Interface/Specialize.hs7
3 files changed, 11 insertions, 6 deletions
diff --git a/haddock-api/src/Haddock/Interface/Create.hs b/haddock-api/src/Haddock/Interface/Create.hs
index b039e095..02fc86d9 100644
--- a/haddock-api/src/Haddock/Interface/Create.hs
+++ b/haddock-api/src/Haddock/Interface/Create.hs
@@ -1108,9 +1108,9 @@ extractPatternSyn nm t tvs cons =
typ = longArrow args (data_ty con)
typ' =
case con of
- ConDeclH98 { con_mb_cxt = Just cxt } -> noLoc (HsQualTy noExtField cxt typ)
+ ConDeclH98 { con_mb_cxt = Just cxt } -> noLoc (HsQualTy noExtField (Just cxt) typ)
_ -> typ
- typ'' = noLoc (HsQualTy noExtField (noLoc []) typ')
+ typ'' = noLoc (HsQualTy noExtField Nothing typ')
in PatSynSig noExtField [noLoc nm] (mkEmptySigType typ'')
longArrow :: [LHsType GhcRn] -> LHsType GhcRn -> LHsType GhcRn
diff --git a/haddock-api/src/Haddock/Interface/Rename.hs b/haddock-api/src/Haddock/Interface/Rename.hs
index b212adce..b62f79ce 100644
--- a/haddock-api/src/Haddock/Interface/Rename.hs
+++ b/haddock-api/src/Haddock/Interface/Rename.hs
@@ -258,7 +258,7 @@ renameType t = case t of
, hst_tele = tele', hst_body = ltype' })
HsQualTy { hst_ctxt = lcontext , hst_body = ltype } -> do
- lcontext' <- renameLContext lcontext
+ lcontext' <- traverse renameLContext lcontext
ltype' <- renameLType ltype
return (HsQualTy { hst_xqual = noExtField, hst_ctxt = lcontext', hst_body = ltype' })
@@ -432,7 +432,7 @@ renameTyClD d = case d of
ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars, tcdFixity = fixity
, tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do
- lcontext' <- renameLContext lcontext
+ lcontext' <- traverse renameLContext lcontext
lname' <- renameL lname
ltyvars' <- renameLHsQTyVars ltyvars
lfundeps' <- mapM renameLFunDep lfundeps
@@ -490,7 +490,7 @@ renameFamilyInfo (ClosedTypeFamily eqns)
renameDataDefn :: HsDataDefn GhcRn -> RnM (HsDataDefn DocNameI)
renameDataDefn (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext, dd_cType = cType
, dd_kindSig = k, dd_cons = cons }) = do
- lcontext' <- renameLContext lcontext
+ lcontext' <- traverse renameLContext lcontext
k' <- renameMaybeLKind k
cons' <- mapM (mapM renameCon) cons
-- I don't think we need the derivings, so we return Nothing
diff --git a/haddock-api/src/Haddock/Interface/Specialize.hs b/haddock-api/src/Haddock/Interface/Specialize.hs
index f37e1da9..5ef5d92d 100644
--- a/haddock-api/src/Haddock/Interface/Specialize.hs
+++ b/haddock-api/src/Haddock/Interface/Specialize.hs
@@ -284,7 +284,7 @@ renameType (HsForAllTy x tele lt) =
<*> renameLType lt
renameType (HsQualTy x lctxt lt) =
HsQualTy x
- <$> located renameContext lctxt
+ <$> renameMContext lctxt
<*> renameLType lt
renameType (HsTyVar x ip name) = HsTyVar x ip <$> located renameName name
renameType t@(HsStarTy _ _) = pure t
@@ -325,6 +325,11 @@ renameLKind = renameLType
renameLTypes :: [LHsType GhcRn] -> Rename (IdP GhcRn) [LHsType GhcRn]
renameLTypes = mapM renameLType
+renameMContext :: Maybe (LHsContext GhcRn) -> Rename (IdP GhcRn) (Maybe (LHsContext GhcRn))
+renameMContext Nothing = return Nothing
+renameMContext (Just (L l ctxt)) = do
+ ctxt' <- renameContext ctxt
+ return (Just (L l ctxt'))
renameContext :: HsContext GhcRn -> Rename (IdP GhcRn) (HsContext GhcRn)
renameContext = renameLTypes