diff options
author | Henning Thielemann <git@henning-thielemann.de> | 2012-04-02 00:19:36 +0200 |
---|---|---|
committer | Henning Thielemann <git@henning-thielemann.de> | 2012-04-02 00:19:36 +0200 |
commit | c3d370ad042eeeb9f8afc3bf3e99cbbcb9407d60 (patch) | |
tree | 561d545ec0688573a7bc9274957e6634c74c7f1d /src/Haddock/Interface/Create.hs | |
parent | 979ada5bc63cba38bf570f943a3666298879bdc9 (diff) |
abbreviated qualification: use Packages.lookupModuleInAllPackages for finding the package that a module belongs to
Diffstat (limited to 'src/Haddock/Interface/Create.hs')
-rw-r--r-- | src/Haddock/Interface/Create.hs | 41 |
1 files changed, 31 insertions, 10 deletions
diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index 9f183432..b9ca6d8c 100644 --- a/src/Haddock/Interface/Create.hs +++ b/src/Haddock/Interface/Create.hs @@ -30,6 +30,8 @@ import Control.Applicative import Control.Monad import qualified Data.Traversable as T +import qualified Packages +import qualified Module import qualified SrcLoc import GHC hiding (flags) import HscTypes @@ -108,16 +110,7 @@ createInterface tm flags modMap instIfaceMap = do | otherwise = exportItems let abbrevs = - case tm_renamed_source tm of - Nothing -> M.empty - Just (_,impDecls,_,_) -> - M.fromList $ - mapMaybe (\(SrcLoc.L _ impDecl) -> do - abbrev <- ideclAs impDecl - return - (case ideclName impDecl of SrcLoc.L _ name -> name, - abbrev)) - impDecls + mkAbbrevMap dflags $ tm_renamed_source tm return Interface { ifaceMod = mdl, @@ -141,6 +134,34 @@ createInterface tm flags modMap instIfaceMap = do ifaceHaddockCoverage = coverage } +mkAbbrevMap :: DynFlags -> Maybe RenamedSource -> M.Map Module ModuleName +mkAbbrevMap dflags mRenamedSource = + case mRenamedSource of + Nothing -> M.empty + Just (_,impDecls,_,_) -> + M.fromList $ + mapMaybe (\(SrcLoc.L _ impDecl) -> do + abbrev <- ideclAs impDecl + return $ + (lookupModuleDyn dflags + (fmap Module.fsToPackageId $ + ideclPkgQual impDecl) + (case ideclName impDecl of SrcLoc.L _ name -> name), + abbrev)) + impDecls + +-- similar to GHC.lookupModule +lookupModuleDyn :: + DynFlags -> Maybe PackageId -> ModuleName -> Module +lookupModuleDyn _ (Just pkgId) mdlName = + Module.mkModule pkgId mdlName +lookupModuleDyn dflags Nothing mdlName = + flip Module.mkModule mdlName $ + case filter snd $ + Packages.lookupModuleInAllPackages dflags mdlName of + (pkgId,_):_ -> Packages.packageConfigId pkgId + [] -> Module.mainPackageId + ------------------------------------------------------------------------------- -- Warnings |