diff options
Diffstat (limited to 'src/Haddock/Interface/Create.hs')
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 28 |
1 files changed, 17 insertions, 11 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index 6c121ad4..40016a0b 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -35,7 +35,7 @@ import qualified Data.Traversable as T import qualified Packages import qualified Module import qualified SrcLoc -import GHC hiding (flags) +import GHC import HscTypes import Name import Bag @@ -192,7 +192,6 @@ moduleWarning dflags gre ws = WarnSome _ -> return Nothing WarnAll w -> Just <$> parseWarning dflags gre w - parseWarning :: DynFlags -> GlobalRdrEnv -> WarningTxt -> ErrMsgM (Doc Name) parseWarning dflags gre w = do r <- case w of @@ -280,7 +279,7 @@ mkMaps dflags gre instances decls = do instanceMap = M.fromList [ (getSrcSpan n, n) | i <- instances, let n = getName i ] names :: HsDecl Name -> [Name] - names (InstD (ClsInstD { cid_poly_ty = L l _ })) = maybeToList (M.lookup l instanceMap) -- See note [2]. + names (InstD (ClsInstD (ClsInstDecl { cid_poly_ty = L l _ }))) = maybeToList (M.lookup l instanceMap) -- See note [2]. names decl = getMainDeclBinder decl -- Note [2]: @@ -308,7 +307,7 @@ subordinates (TyClD decl) ] dataSubs = constrs ++ fields where - cons = map unL $ (td_cons (tcdTyDefn decl)) + cons = map unL $ (dd_cons (tcdDataDefn decl)) constrs = [ (unL $ con_name c, maybeToList $ fmap unL $ con_doc c, M.empty) | c <- cons ] fields = [ (unL n, maybeToList $ fmap unL doc, M.empty) @@ -324,7 +323,7 @@ typeDocs d = case d of SigD (TypeSig _ ty) -> docs (unLoc ty) ForD (ForeignImport _ ty _ _) -> docs (unLoc ty) - TyClD (TyDecl { tcdTyDefn = TySynonym {td_synRhs = ty}}) -> docs (unLoc ty) + TyClD (SynDecl { tcdRhs = ty }) -> docs (unLoc ty) _ -> M.empty where go n (HsForAllTy _ _ _ ty) = go n (unLoc ty) @@ -343,7 +342,7 @@ classDecls class_ = filterDecls . collectDocs . sortByLoc $ decls docs = mkDecls tcdDocs DocD class_ defs = mkDecls (bagToList . tcdMeths) ValD class_ sigs = mkDecls tcdSigs SigD class_ - ats = mkDecls tcdATs TyClD class_ + ats = mkDecls tcdATs (TyClD . FamDecl) class_ -- | The top-level declarations of a module that we care about, @@ -386,7 +385,11 @@ warnAboutFilteredDecls :: DynFlags -> Module -> [LHsDecl Name] -> ErrMsgM () warnAboutFilteredDecls dflags mdl decls = do let modStr = moduleString mdl let typeInstances = - nub [ unLoc (fid_tycon d) | L _ (InstD (FamInstD { lid_inst = d })) <- decls ] + nub (concat [[ unLoc (tfie_tycon eqn) + | L _ (InstD (TyFamInstD (TyFamInstDecl { tfid_eqns = eqns }))) <- decls + , L _ eqn <- eqns ], + [ unLoc (dfid_tycon d) + | L _ (InstD (DataFamInstD { dfid_inst = d })) <- decls ]]) unless (null typeInstances) $ tell [ @@ -395,8 +398,11 @@ warnAboutFilteredDecls dflags mdl decls = do ++ "will be filtered out:\n " ++ (intercalate ", " $ map (occNameString . nameOccName) typeInstances) ] - let instances = nub [ pretty dflags i | L _ (InstD (ClsInstD { cid_poly_ty = i, cid_fam_insts = ats })) <- decls - , not (null ats) ] + let instances = nub [ pretty dflags i | L _ (InstD (ClsInstD (ClsInstDecl + { cid_poly_ty = i + , cid_tyfam_insts = ats + , cid_datafam_insts = adts }))) <- decls + , not (null ats) || not (null adts) ] unless (null instances) $ tell [ @@ -747,11 +753,11 @@ extractDecl name mdl decl _ -> error "internal: extractDecl" TyClD d | isDataDecl d -> let (n, tyvar_names) = name_and_tyvars d - L pos sig = extractRecSel name mdl n tyvar_names (td_cons (tcdTyDefn d)) + L pos sig = extractRecSel name mdl n tyvar_names (dd_cons (tcdDataDefn d)) in L pos (SigD sig) _ -> error "internal: extractDecl" where - name_and_tyvars d = (unLoc (tcdLName d), hsLTyVarLocNames (tcdTyVars d)) + name_and_tyvars d = (tcdName d, hsLTyVarLocNames (tyClDeclTyVars d)) toTypeNoLoc :: Located Name -> LHsType Name |