diff options
Diffstat (limited to 'src/Haddock/Interface')
| -rw-r--r-- | src/Haddock/Interface/AttachInstances.hs | 2 | ||||
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 13 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rename.hs | 19 |
3 files changed, 22 insertions, 12 deletions
diff --git a/src/Haddock/Interface/AttachInstances.hs b/src/Haddock/Interface/AttachInstances.hs index 62d08021..03d463cb 100644 --- a/src/Haddock/Interface/AttachInstances.hs +++ b/src/Haddock/Interface/AttachInstances.hs @@ -116,7 +116,7 @@ dropSilentArgs dfun theta = drop (dfunNSilent dfun) theta -- | Like GHC's getInfo but doesn't cut things out depending on the -- interative context, which we don't set sufficiently anyway. -getAllInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst Branched])) +getAllInfo :: GhcMonad m => Name -> m (Maybe (TyThing,Fixity,[ClsInst],[FamInst])) getAllInfo name = withSession $ \hsc_env -> do (_msgs, r) <- liftIO $ tcRnGetInfo hsc_env name return r diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index 40016a0b..d4adbe1c 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -385,16 +385,19 @@ warnAboutFilteredDecls :: DynFlags -> Module -> [LHsDecl Name] -> ErrMsgM () warnAboutFilteredDecls dflags mdl decls = do let modStr = moduleString mdl let typeInstances = - nub (concat [[ unLoc (tfie_tycon eqn) - | L _ (InstD (TyFamInstD (TyFamInstDecl { tfid_eqns = eqns }))) <- decls - , L _ eqn <- eqns ], + nub (concat [[ unLoc (tfie_tycon (unLoc eqn)) + | L _ (InstD (TyFamInstD (TyFamInstDecl { tfid_eqn = eqn }))) <- decls ], [ unLoc (dfid_tycon d) - | L _ (InstD (DataFamInstD { dfid_inst = d })) <- decls ]]) + | L _ (InstD (DataFamInstD { dfid_inst = d })) <- decls ], + [ unLoc tc + | L _ (TyClD (FamDecl (FamilyDecl { fdInfo = ClosedTypeFamily _ + , fdLName = tc }))) <- decls ]]) unless (null typeInstances) $ tell [ "Warning: " ++ modStr ++ ": Instances of type and data " - ++ "families are not yet supported. Instances of the following families " + ++ "families and equations of closed type families are not yet supported." + ++ "Instances of the following families " ++ "will be filtered out:\n " ++ (intercalate ", " $ map (occNameString . nameOccName) typeInstances) ] diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index a2499726..f21088d8 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -379,14 +379,22 @@ renameTyClD d = case d of renameLSig (L loc sig) = return . L loc =<< renameSig sig renameFamilyDecl :: FamilyDecl Name -> RnM (FamilyDecl DocName) -renameFamilyDecl (FamilyDecl { fdFlavour = flav, fdLName = lname +renameFamilyDecl (FamilyDecl { fdInfo = info, fdLName = lname , fdTyVars = ltyvars, fdKindSig = tckind }) = do + info' <- renameFamilyInfo info lname' <- renameL lname ltyvars' <- renameLTyVarBndrs ltyvars tckind' <- renameMaybeLKind tckind - return (FamilyDecl { fdFlavour = flav, fdLName = lname' + return (FamilyDecl { fdInfo = info', fdLName = lname' , fdTyVars = ltyvars', fdKindSig = tckind' }) +renameFamilyInfo :: FamilyInfo Name -> RnM (FamilyInfo DocName) +renameFamilyInfo DataFamily = return DataFamily +renameFamilyInfo OpenTypeFamily = return OpenTypeFamily +renameFamilyInfo (ClosedTypeFamily eqns) + = do { eqns' <- mapM (renameLThing renameTyFamInstEqn) eqns + ; return $ ClosedTypeFamily eqns' } + renameDataDefn :: HsDataDefn Name -> RnM (HsDataDefn DocName) renameDataDefn (HsDataDefn { dd_ND = nd, dd_ctxt = lcontext, dd_cType = cType , dd_kindSig = k, dd_cons = cons }) = do @@ -471,10 +479,9 @@ renameClsInstD (ClsInstDecl { cid_poly_ty =ltype, cid_tyfam_insts = lATs, cid_da renameTyFamInstD :: TyFamInstDecl Name -> RnM (TyFamInstDecl DocName) -renameTyFamInstD (TyFamInstDecl { tfid_eqns = eqns , tfid_group = eqn_group }) - = do { eqns' <- mapM (renameLThing renameTyFamInstEqn) eqns - ; return (TyFamInstDecl { tfid_eqns = eqns' - , tfid_group = eqn_group +renameTyFamInstD (TyFamInstDecl { tfid_eqn = eqn }) + = do { eqn' <- renameLThing renameTyFamInstEqn eqn + ; return (TyFamInstDecl { tfid_eqn = eqn' , tfid_fvs = placeHolderNames }) } renameTyFamInstEqn :: TyFamInstEqn Name -> RnM (TyFamInstEqn DocName) |