From 826c95646493284ab3c7c07ba159e959c760983c Mon Sep 17 00:00:00 2001 From: Simon Peyton Jones Date: Mon, 6 Feb 2012 09:14:41 +0000 Subject: Track changes in HsDecls --- src/Haddock/Interface/Create.hs | 6 +++--- src/Haddock/Interface/Rename.hs | 7 +++++-- 2 files changed, 8 insertions(+), 5 deletions(-) diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index e51c8367..7e9b6a2b 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 (InstDecl (L l _) _ _ _) -> maybeToList (M.lookup l instanceMap) -- See note [2]. + InstD (ClsInstDecl (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 [ tcdName d | L _ (TyClD d) <- decls, isFamInstDecl d ] + nub [ tcdName d | L _ (InstD (FamInstDecl 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 (InstDecl i _ _ ats)) <- decls + let instances = nub [ pretty i | L _ (InstD (ClsInstDecl i _ _ ats)) <- decls , not (null ats) ] unless (null instances) $ diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index 691dafbc..9595e4cc 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -408,11 +408,14 @@ renameForD (ForeignExport lname ltype co x) = do renameInstD :: InstDecl Name -> RnM (InstDecl DocName) -renameInstD (InstDecl ltype _ _ lATs) = do +renameInstD (ClsInstDecl ltype _ _ lATs) = do ltype' <- renameLType ltype lATs' <- mapM renameLTyClD lATs - return (InstDecl ltype' emptyBag [] lATs') + return (ClsInstDecl ltype' emptyBag [] lATs') +renameInstD (FamInstDecl d) = do + d' <- renameTyClD d + return (FamInstDecl d') renameExportItem :: ExportItem Name -> RnM (ExportItem DocName) renameExportItem item = case item of -- cgit v1.2.3