diff options
| -rw-r--r-- | src/Haddock/Backends/Xhtml/Decl.hs | 4 | ||||
| -rw-r--r-- | src/Haddock/Convert.hs | 12 | ||||
| -rw-r--r-- | src/Haddock/GhcUtils.hs | 2 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rename.hs | 24 |
4 files changed, 16 insertions, 26 deletions
diff --git a/src/Haddock/Backends/Xhtml/Decl.hs b/src/Haddock/Backends/Xhtml/Decl.hs index 0429580c..8884f69f 100644 --- a/src/Haddock/Backends/Xhtml/Decl.hs +++ b/src/Haddock/Backends/Xhtml/Decl.hs @@ -280,8 +280,8 @@ ppTyFam summary associated links instances fixities loc doc decl splice unicode = ppInstances instances docname unicode qual -- Individual equation of a closed type family - ppTyFamEqn TyFamEqn { tfe_tycon = n, tfe_rhs = rhs - , tfe_pats = HsWB { hswb_cts = ts }} + ppTyFamEqn TyFamInstEqn { tfie_tycon = n, tfie_rhs = rhs + , tfie_pats = HsWB { hswb_cts = ts }} = ( ppAppNameTypes (unLoc n) [] (map unLoc ts) unicode qual <+> equals <+> ppType unicode qual (unLoc rhs) , Nothing, [] ) diff --git a/src/Haddock/Convert.hs b/src/Haddock/Convert.hs index dfb0f14f..405bf204 100644 --- a/src/Haddock/Convert.hs +++ b/src/Haddock/Convert.hs @@ -64,7 +64,7 @@ tyThingToLHsDecl t = noLoc $ case t of extractFamilyDecl _ = error "tyThingToLHsDecl: impossible associated tycon" - atTyClDecls = [synifyTyCon Nothing at_tc | ATI at_tc _ <- classATItems cl] + atTyClDecls = [synifyTyCon Nothing at_tc | (at_tc, _) <- classATItems cl] atFamDecls = map extractFamilyDecl atTyClDecls in TyClD $ ClassDecl { tcdCtxt = synifyCtx (classSCTheta cl) @@ -107,11 +107,11 @@ synifyAxBranch tc (CoAxBranch { cab_tvs = tkvs, cab_lhs = args, cab_rhs = rhs }) typats = map (synifyType WithinType) args hs_rhs = synifyType WithinType rhs (kvs, tvs) = partition isKindVar tkvs - in TyFamEqn { tfe_tycon = name - , tfe_pats = HsWB { hswb_cts = typats - , hswb_kvs = map tyVarName kvs - , hswb_tvs = map tyVarName tvs } - , tfe_rhs = hs_rhs } + in TyFamInstEqn { tfie_tycon = name + , tfie_pats = HsWB { hswb_cts = typats + , hswb_kvs = map tyVarName kvs + , hswb_tvs = map tyVarName tvs } + , tfie_rhs = hs_rhs } synifyAxiom :: CoAxiom br -> HsDecl Name synifyAxiom ax@(CoAxiom { co_ax_tc = tc }) diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs index 8ea5485b..c06b34a6 100644 --- a/src/Haddock/GhcUtils.hs +++ b/src/Haddock/GhcUtils.hs @@ -102,7 +102,7 @@ getInstLoc (TyFamInstD (TyFamInstDecl -- Since CoAxioms' Names refer to the whole line for type family instances -- in particular, we need to dig a bit deeper to pull out the entire -- equation. This does not happen for data family instances, for some reason. - { tfid_eqn = L _ (TyFamEqn { tfe_rhs = L l _ })})) = l + { tfid_eqn = L _ (TyFamInstEqn { tfie_rhs = L l _ })})) = l -- Useful when there is a signature with multiple names, e.g. -- foo, bar :: Types.. diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs index a804f4a1..2eb2cc01 100644 --- a/src/Haddock/Interface/Rename.hs +++ b/src/Haddock/Interface/Rename.hs @@ -323,7 +323,7 @@ renameTyClD d = case d of lfundeps' <- mapM renameLFunDep lfundeps lsigs' <- mapM renameLSig lsigs ats' <- mapM (renameLThing renameFamilyDecl) ats - at_defs' <- mapM renameLTyFamDefltEqn at_defs + at_defs' <- mapM (mapM renameTyFamInstD) at_defs -- we don't need the default methods or the already collected doc entities return (ClassDecl { tcdCtxt = lcontext', tcdLName = lname', tcdTyVars = ltyvars' , tcdFDs = lfundeps', tcdSigs = lsigs', tcdMeths= emptyBag @@ -351,7 +351,7 @@ renameFamilyInfo :: FamilyInfo Name -> RnM (FamilyInfo DocName) renameFamilyInfo DataFamily = return DataFamily renameFamilyInfo OpenTypeFamily = return OpenTypeFamily renameFamilyInfo (ClosedTypeFamily eqns) - = do { eqns' <- mapM renameLTyFamInstEqn eqns + = do { eqns' <- mapM (renameLThing renameTyFamInstEqn) eqns ; return $ ClosedTypeFamily eqns' } renameDataDefn :: HsDataDefn Name -> RnM (HsDataDefn DocName) @@ -456,27 +456,17 @@ renameClsInstD (ClsInstDecl { cid_overlap_mode = omode renameTyFamInstD :: TyFamInstDecl Name -> RnM (TyFamInstDecl DocName) renameTyFamInstD (TyFamInstDecl { tfid_eqn = eqn }) - = do { eqn' <- renameLTyFamInstEqn eqn + = do { eqn' <- renameLThing renameTyFamInstEqn eqn ; return (TyFamInstDecl { tfid_eqn = eqn' , tfid_fvs = placeHolderNames }) } -renameLTyFamInstEqn :: LTyFamInstEqn Name -> RnM (LTyFamInstEqn DocName) -renameLTyFamInstEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = pats_w_bndrs, tfe_rhs = rhs })) +renameTyFamInstEqn :: TyFamInstEqn Name -> RnM (TyFamInstEqn DocName) +renameTyFamInstEqn (TyFamInstEqn { tfie_tycon = tc, tfie_pats = pats_w_bndrs, tfie_rhs = rhs }) = do { tc' <- renameL tc ; 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_rhs = rhs' })) } - -renameLTyFamDefltEqn :: LTyFamDefltEqn Name -> RnM (LTyFamDefltEqn DocName) -renameLTyFamDefltEqn (L loc (TyFamEqn { tfe_tycon = tc, tfe_pats = tvs, tfe_rhs = rhs })) - = do { tc' <- renameL tc - ; tvs' <- renameLTyVarBndrs tvs - ; rhs' <- renameLType rhs - ; return (L loc (TyFamEqn { tfe_tycon = tc' - , tfe_pats = tvs' - , tfe_rhs = rhs' })) } + ; return (TyFamInstEqn { tfie_tycon = tc', tfie_pats = pats_w_bndrs { hswb_cts = pats' } + , tfie_rhs = rhs' }) } renameDataFamInstD :: DataFamInstDecl Name -> RnM (DataFamInstDecl DocName) renameDataFamInstD (DataFamInstDecl { dfid_tycon = tc, dfid_pats = pats_w_bndrs, dfid_defn = defn }) |