diff options
Diffstat (limited to 'src/Haddock/Interface')
| -rw-r--r-- | src/Haddock/Interface/Create.hs | 16 | ||||
| -rw-r--r-- | src/Haddock/Interface/Rename.hs | 32 | 
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 })  | 
