aboutsummaryrefslogtreecommitdiff
path: root/src/Haddock/Interface
diff options
context:
space:
mode:
authorMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2014-08-14 20:27:34 +0100
committerMateusz Kowalczyk <fuuzetsu@fuuzetsu.co.uk>2014-08-14 20:27:34 +0100
commit5c93cc347773c7634321edd5f808d5b55b46301f (patch)
tree68ea86252d22e06c744d779770a3557000abbad6 /src/Haddock/Interface
parent5b81a9e53894d2ae591ca0c6c96199632d39eb06 (diff)
parent6b00a11733a8ae02c11e57a75265abd2dc77ecb0 (diff)
Merge branch 'reverts'
This reverts any changes that were made to have Haddock compile with 7.9. When 7.10 release comes, we can simply re-apply all the patches and any patches that occur on ghc-head branch from now on. This allows us to build master with 7.8.3
Diffstat (limited to 'src/Haddock/Interface')
-rw-r--r--src/Haddock/Interface/Create.hs16
-rw-r--r--src/Haddock/Interface/Rename.hs32
2 files changed, 18 insertions, 30 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs
index ad6a1e98..bc615cde 100644
--- a/src/Haddock/Interface/Create.hs
+++ b/src/Haddock/Interface/Create.hs
@@ -157,7 +157,7 @@ mkAliasMap dflags mRenamedSource =
alias <- ideclAs impDecl
return $
(lookupModuleDyn dflags
- (fmap Module.fsToPackageKey $
+ (fmap Module.fsToPackageId $
ideclPkgQual impDecl)
(case ideclName impDecl of SrcLoc.L _ name -> name),
alias))
@@ -165,13 +165,15 @@ mkAliasMap dflags mRenamedSource =
-- similar to GHC.lookupModule
lookupModuleDyn ::
- DynFlags -> Maybe PackageKey -> ModuleName -> Module
+ DynFlags -> Maybe PackageId -> ModuleName -> Module
lookupModuleDyn _ (Just pkgId) mdlName =
Module.mkModule pkgId mdlName
lookupModuleDyn dflags Nothing mdlName =
- case Packages.lookupModuleInAllPackages dflags mdlName of
- (m,_):_ -> m
- [] -> Module.mkModule Module.mainPackageKey mdlName
+ flip Module.mkModule mdlName $
+ case filter snd $
+ Packages.lookupModuleInAllPackages dflags mdlName of
+ (pkgId,_):_ -> Packages.packageConfigId pkgId
+ [] -> Module.mainPackageId
-------------------------------------------------------------------------------
@@ -676,8 +678,8 @@ moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfa
"documentation for exported module: " ++ pretty dflags expMod]
return []
where
- m = mkModule packageKey expMod
- packageKey = modulePackageKey thisMod
+ m = mkModule packageId expMod
+ packageId = modulePackageId thisMod
-- Note [1]:
diff --git a/src/Haddock/Interface/Rename.hs b/src/Haddock/Interface/Rename.hs
index a804f4a1..748e0210 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)
@@ -442,41 +442,27 @@ renameInstD (DataFamInstD { dfid_inst = d }) = do
return (DataFamInstD { dfid_inst = d' })
renameClsInstD :: ClsInstDecl Name -> RnM (ClsInstDecl DocName)
-renameClsInstD (ClsInstDecl { cid_overlap_mode = omode
- , cid_poly_ty =ltype, cid_tyfam_insts = lATs
- , cid_datafam_insts = lADTs }) = do
+renameClsInstD (ClsInstDecl { cid_poly_ty =ltype, cid_tyfam_insts = lATs, cid_datafam_insts = lADTs }) = do
ltype' <- renameLType ltype
lATs' <- mapM (mapM renameTyFamInstD) lATs
lADTs' <- mapM (mapM renameDataFamInstD) lADTs
- return (ClsInstDecl { cid_overlap_mode = omode
- , cid_poly_ty = ltype', cid_binds = emptyBag
- , cid_sigs = []
+ return (ClsInstDecl { cid_poly_ty = ltype', cid_binds = emptyBag, cid_sigs = []
, cid_tyfam_insts = lATs', cid_datafam_insts = lADTs' })
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 })