aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Haddock/Backends/Xhtml/Decl.hs4
-rw-r--r--src/Haddock/Convert.hs12
-rw-r--r--src/Haddock/GhcUtils.hs2
-rw-r--r--src/Haddock/Interface/Rename.hs24
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 })