diff options
Diffstat (limited to 'src/Haddock/Interface')
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 6 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rename.hs | 19 |
2 files changed, 15 insertions, 10 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index 608928b2..f5b1e8d4 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -189,7 +189,7 @@ mkMaps dflags gre instances exports decls = do let subNames = map fst subDocs let names = case d of - InstD (ClsInstD (L l _) _ _ _) -> maybeToList (M.lookup l instanceMap) -- See note [2]. + InstD (ClsInstD { cid_poly_ty = L l _ }) -> maybeToList (M.lookup l instanceMap) -- See note [2]. _ -> filter (`elem` exports) (getMainDeclBinder d) let docMap' = M.fromList (mapMaybe (\(n,doc) -> fmap (n,) doc) ([ (n, mayDoc) | n <- names ] ++ subDocs)) @@ -296,7 +296,7 @@ warnAboutFilteredDecls :: Module -> [LHsDecl Name] -> ErrMsgM () warnAboutFilteredDecls mdl decls = do let modStr = moduleString mdl let typeInstances = - nub [ unLoc (fid_tycon d) | L _ (InstD (FamInstD d)) <- decls ] + nub [ unLoc (fid_tycon d) | L _ (InstD (FamInstD { lid_inst = d })) <- decls ] unless (null typeInstances) $ tell [ @@ -305,7 +305,7 @@ warnAboutFilteredDecls mdl decls = do ++ "will be filtered out:\n " ++ concat (intersperse ", " $ map (occNameString . nameOccName) typeInstances) ] - let instances = nub [ pretty i | L _ (InstD (ClsInstD i _ _ ats)) <- decls + let instances = nub [ pretty i | L _ (InstD (ClsInstD { cid_poly_ty = i, cid_fam_insts = ats })) <- decls , not (null ats) ] unless (null instances) $ diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index 1c54216b..a766be18 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -333,7 +333,8 @@ renameTyClD d = case d of defn' <- renameTyDefn defn return (TyDecl { tcdLName = lname', tcdTyVars = tyvars', tcdTyDefn = defn', tcdFVs = fvs }) - ClassDecl lcontext lname ltyvars lfundeps lsigs _ ats at_defs _ -> do + ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars + , tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do lcontext' <- renameLContext lcontext lname' <- renameL lname ltyvars' <- mapM renameLTyVarBndr ltyvars @@ -342,7 +343,9 @@ renameTyClD d = case d of ats' <- mapM renameLTyClD ats at_defs' <- mapM (mapM renameFamInstD) at_defs -- we don't need the default methods or the already collected doc entities - return (ClassDecl lcontext' lname' ltyvars' lfundeps' lsigs' emptyBag ats' at_defs' []) + return (ClassDecl { tcdCtxt = lcontext', tcdLName = lname', tcdTyVars = ltyvars' + , tcdFDs = lfundeps', tcdSigs = lsigs', tcdMeths= emptyBag + , tcdATs = ats', tcdATDefs = at_defs', tcdDocs = [], tcdFVs = placeHolderNames }) where renameLFunDep (L loc (xs, ys)) = do @@ -417,21 +420,23 @@ renameForD (ForeignExport lname ltype co x) = do renameInstD :: InstDecl Name -> RnM (InstDecl DocName) -renameInstD (ClsInstD ltype _ _ lATs) = do +renameInstD (ClsInstD { cid_poly_ty =ltype, cid_fam_insts = lATs }) = do ltype' <- renameLType ltype lATs' <- mapM (mapM renameFamInstD) lATs - return (ClsInstD ltype' emptyBag [] lATs') + return (ClsInstD { cid_poly_ty = ltype', cid_binds = emptyBag, cid_sigs = [] + , cid_fam_insts = lATs' }) -renameInstD (FamInstD d) = do +renameInstD (FamInstD { lid_inst = d }) = do d' <- renameFamInstD d - return (FamInstD d') + return (FamInstD { lid_inst = d' }) renameFamInstD :: FamInstDecl Name -> RnM (FamInstDecl DocName) renameFamInstD (FamInstDecl { fid_tycon = tc, fid_pats = HsBSig pats fvs, fid_defn = defn }) = do { tc' <- renameL tc ; pats' <- mapM renameLType pats ; defn' <- renameTyDefn defn - ; return (FamInstDecl { fid_tycon = tc', fid_pats = HsBSig pats' fvs, fid_defn = defn' }) } + ; return (FamInstDecl { fid_tycon = tc', fid_pats = HsBSig pats' fvs + , fid_defn = defn', fid_fvs = placeHolderNames }) } renameExportItem :: ExportItem Name -> RnM (ExportItem DocName) |