diff options
Diffstat (limited to 'haddock-api/src/Haddock/Interface')
-rw-r--r-- | haddock-api/src/Haddock/Interface/Create.hs | 4 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/Rename.hs | 6 | ||||
-rw-r--r-- | haddock-api/src/Haddock/Interface/Specialize.hs | 7 |
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 |