diff options
| -rw-r--r-- | src/Haddock/Convert.hs | 10 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rename.hs | 27 |
2 files changed, 26 insertions, 11 deletions
diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs index dfb0f14f..48306392 100644 --- a/src/Haddock/Convert.hs +++ b/src/Haddock/Convert.hs @@ -81,7 +81,7 @@ tyThingToLHsDecl t = noLoc $ case t of , tcdATs = atFamDecls , tcdATDefs = [] --ignore associated type defaults , tcdDocs = [] --we don't have any docs at this point - , tcdFVs = placeHolderNames } + , tcdFVs = placeHolderNamesTc } | otherwise -> TyClD (synifyTyCon Nothing tc) @@ -118,7 +118,7 @@ synifyAxiom ax@(CoAxiom { co_ax_tc = tc }) | isOpenSynFamilyTyCon tc , Just branch <- coAxiomSingleBranch_maybe ax = InstD (TyFamInstD (TyFamInstDecl { tfid_eqn = noLoc $ synifyAxBranch tc branch - , tfid_fvs = placeHolderNames })) + , tfid_fvs = placeHolderNamesTc })) | Just ax' <- isClosedSynFamilyTyCon_maybe tc , getUnique ax' == getUnique ax -- without the getUniques, type error @@ -148,7 +148,7 @@ synifyTyCon coax tc -- we have their kind accurately: , dd_cons = [] -- No constructors , dd_derivs = Nothing } - , tcdFVs = placeHolderNames } + , tcdFVs = placeHolderNamesTc } | isSynFamilyTyCon tc = case synTyConRhs_maybe tc of @@ -177,7 +177,7 @@ synifyTyCon coax tc SynDecl { tcdLName = synifyName tc , tcdTyVars = synifyTyVars (tyConTyVars tc) , tcdRhs = synifyType WithinType ty - , tcdFVs = placeHolderNames } + , tcdFVs = placeHolderNamesTc } _ -> error "synifyTyCon: impossible synTyCon" | otherwise = -- (closed) newtype and data @@ -217,7 +217,7 @@ synifyTyCon coax tc , dd_cons = cons , dd_derivs = alg_deriv } in DataDecl { tcdLName = name, tcdTyVars = tyvars, tcdDataDefn = defn - , tcdFVs = placeHolderNames } + , tcdFVs = placeHolderNamesTc } -- User beware: it is your responsibility to pass True (use_gadt_syntax) -- for any constructor that would be misrepresented by omitting its diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index a804f4a1..dd2bd73f 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE TypeFamilies #-} ---------------------------------------------------------------------------- -- | -- Module : Haddock.Interface.Rename @@ -20,6 +21,8 @@ import Haddock.Types import Bag (emptyBag) import GHC hiding (NoLink) import Name +import NameSet +import Coercion import Control.Applicative import Control.Monad hiding (mapM) @@ -177,6 +180,7 @@ renameLKind = renameLType renameMaybeLKind :: Maybe (LHsKind Name) -> RnM (Maybe (LHsKind DocName)) renameMaybeLKind = traverse renameLKind + renameType :: HsType Name -> RnM (HsType DocName) renameType t = case t of HsForAllTy expl tyvars lcontext ltype -> do @@ -303,17 +307,17 @@ renameTyClD d = case d of decl' <- renameFamilyDecl decl return (FamDecl { tcdFam = decl' }) - SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdRhs = rhs, tcdFVs = fvs } -> do + SynDecl { tcdLName = lname, tcdTyVars = tyvars, tcdRhs = rhs, tcdFVs = _fvs } -> do lname' <- renameL lname tyvars' <- renameLTyVarBndrs tyvars rhs' <- renameLType rhs - return (SynDecl { tcdLName = lname', tcdTyVars = tyvars', tcdRhs = rhs', tcdFVs = fvs }) + return (SynDecl { tcdLName = lname', tcdTyVars = tyvars', tcdRhs = rhs', tcdFVs = placeHolderNames }) - DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdDataDefn = defn, tcdFVs = fvs } -> do + DataDecl { tcdLName = lname, tcdTyVars = tyvars, tcdDataDefn = defn, tcdFVs = _fvs } -> do lname' <- renameL lname tyvars' <- renameLTyVarBndrs tyvars defn' <- renameDataDefn defn - return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdFVs = fvs }) + return (DataDecl { tcdLName = lname', tcdTyVars = tyvars', tcdDataDefn = defn', tcdFVs = placeHolderNames }) ClassDecl { tcdCtxt = lcontext, tcdLName = lname, tcdTyVars = ltyvars , tcdFDs = lfundeps, tcdSigs = lsigs, tcdATs = ats, tcdATDefs = at_defs } -> do @@ -466,7 +470,7 @@ renameLTyFamInstEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = pats_w_bndrs, ; pats' <- mapM renameLType (hswb_cts pats_w_bndrs) ; rhs' <- renameLType rhs ; return (L loc (TyFamEqn { tfe_tycon = tc' - , tfe_pats = pats_w_bndrs { hswb_cts = pats' } + , tfe_pats = HsWB pats' PlaceHolder PlaceHolder , tfe_rhs = rhs' })) } renameLTyFamDefltEqn :: LTyFamDefltEqn Name -> RnM (LTyFamDefltEqn DocName) @@ -483,7 +487,9 @@ renameDataFamInstD (DataFamInstDecl { dfid_tycon = tc, dfid_pats = pats_w_bndrs, = do { tc' <- renameL tc ; pats' <- mapM renameLType (hswb_cts pats_w_bndrs) ; defn' <- renameDataDefn defn - ; return (DataFamInstDecl { dfid_tycon = tc', dfid_pats = pats_w_bndrs { hswb_cts = pats' } + ; return (DataFamInstDecl { dfid_tycon = tc' + , dfid_pats + = HsWB pats' PlaceHolder PlaceHolder , dfid_defn = defn', dfid_fvs = placeHolderNames }) } renameExportItem :: ExportItem Name -> RnM (ExportItem DocName) @@ -518,3 +524,12 @@ renameSub (n,doc) = do n' <- rename n doc' <- renameDocForDecl doc return (n', doc') + +type instance PostRn DocName NameSet = PlaceHolder +type instance PostRn DocName Fixity = PlaceHolder +type instance PostRn DocName Bool = PlaceHolder +type instance PostRn DocName [Name] = PlaceHolder + +type instance PostTc DocName Kind = PlaceHolder +type instance PostTc DocName Type = PlaceHolder +type instance PostTc DocName Coercion = PlaceHolder |