diff options
author | Edward Z. Yang <ezyang@cs.stanford.edu> | 2014-07-19 17:11:01 +0100 |
---|---|---|
committer | Edward Z. Yang <ezyang@cs.stanford.edu> | 2014-07-21 08:14:19 -0700 |
commit | 8ac42d3327473939c013551750425cac191ff0fd (patch) | |
tree | 2bae383f059f5d22194307fa83b7717a7983dbe6 /src | |
parent | cb96b4f1ed0462b4a394b9fda6612c3bea9886bd (diff) |
Track GHC PackageId to PackageKey renaming.
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu>
Conflicts:
src/Haddock/Interface/Create.hs
Diffstat (limited to 'src')
-rw-r--r-- | src/Haddock.hs | 10 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml.hs | 2 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Layout.hs | 2 | ||||
-rw-r--r-- | src/Haddock/Backends/Xhtml/Types.hs | 2 | ||||
-rw-r--r-- | src/Haddock/GhcUtils.hs | 14 | ||||
-rw-r--r-- | src/Haddock/Interface/Create.hs | 10 | ||||
-rw-r--r-- | src/Haddock/InterfaceFile.hs | 12 | ||||
-rw-r--r-- | src/Haddock/ModuleTree.hs | 6 | ||||
-rw-r--r-- | src/Haddock/Types.hs | 2 |
9 files changed, 30 insertions, 30 deletions
diff --git a/src/Haddock.hs b/src/Haddock.hs index 3d049b18..024b1098 100644 --- a/src/Haddock.hs +++ b/src/Haddock.hs @@ -215,7 +215,7 @@ renderStep dflags flags qual pkgs interfaces = do let ifaceFiles = map snd pkgs installedIfaces = concatMap ifInstalledIfaces ifaceFiles - srcMap = Map.fromList [ (ifPackageId if_, x) | ((_, Just x), if_) <- pkgs ] + srcMap = Map.fromList [ (ifPackageKey if_, x) | ((_, Just x), if_) <- pkgs ] render dflags flags qual interfaces installedIfaces srcMap @@ -240,14 +240,14 @@ render dflags flags qual ifaces installedIfaces srcMap = do allVisibleIfaces = [ i | i <- allIfaces, OptHide `notElem` instOptions i ] pkgMod = ifaceMod (head ifaces) - pkgId = modulePackageId pkgMod - pkgStr = Just (packageIdString pkgId) + pkgKey = modulePackageKey pkgMod + pkgStr = Just (packageKeyString pkgKey) (pkgName,pkgVer) = modulePackageInfo pkgMod (srcBase, srcModule, srcEntity, srcLEntity) = sourceUrls flags - srcMap' = maybe srcMap (\path -> Map.insert pkgId path srcMap) srcEntity + srcMap' = maybe srcMap (\path -> Map.insert pkgKey path srcMap) srcEntity -- TODO: Get these from the interface files as with srcMap - srcLMap' = maybe Map.empty (\path -> Map.singleton pkgId path) srcLEntity + srcLMap' = maybe Map.empty (\path -> Map.singleton pkgKey path) srcLEntity sourceUrls' = (srcBase, srcModule, srcMap', srcLMap') libDir <- getHaddockLibDir flags diff --git a/src/Haddock/Backends/Xhtml.hs b/src/Haddock/Backends/Xhtml.hs index 9628a33d..192c708a 100644 --- a/src/Haddock/Backends/Xhtml.hs +++ b/src/Haddock/Backends/Xhtml.hs @@ -306,7 +306,7 @@ mkNode qual ss p (Node s leaf pkg short ts) = htmlModule = thespan ! modAttrs << (cBtn +++ if leaf - then ppModule (mkModule (stringToPackageId (fromMaybe "" pkg)) + then ppModule (mkModule (stringToPackageKey (fromMaybe "" pkg)) (mkModuleName mdl)) else toHtml s ) diff --git a/src/Haddock/Backends/Xhtml/Layout.hs b/src/Haddock/Backends/Xhtml/Layout.hs index e84a57b3..253854c8 100644 --- a/src/Haddock/Backends/Xhtml/Layout.hs +++ b/src/Haddock/Backends/Xhtml/Layout.hs @@ -224,7 +224,7 @@ topDeclElem ((_,_,sourceMap,lineMap), (_,_,maybe_wiki_url)) loc splice names htm -- TODO: do something about type instances. They will point to -- the module defining the type family, which is wrong. origMod = nameModule n - origPkg = modulePackageId origMod + origPkg = modulePackageKey origMod -- Name must be documented, otherwise we wouldn't get here Documented n mdl = head names diff --git a/src/Haddock/Backends/Xhtml/Types.hs b/src/Haddock/Backends/Xhtml/Types.hs index 122861c3..3d1db887 100644 --- a/src/Haddock/Backends/Xhtml/Types.hs +++ b/src/Haddock/Backends/Xhtml/Types.hs @@ -23,7 +23,7 @@ import GHC -- the base, module and entity URLs for the source code and wiki links. -type SourceURLs = (Maybe FilePath, Maybe FilePath, Map PackageId FilePath, Map PackageId FilePath) +type SourceURLs = (Maybe FilePath, Maybe FilePath, Map PackageKey FilePath, Map PackageKey FilePath) type WikiURLs = (Maybe FilePath, Maybe FilePath, Maybe FilePath) diff --git a/src/Haddock/GhcUtils.hs b/src/Haddock/GhcUtils.hs index 8ea5485b..33d92131 100644 --- a/src/Haddock/GhcUtils.hs +++ b/src/Haddock/GhcUtils.hs @@ -44,23 +44,23 @@ moduleString = moduleNameString . moduleName -- return the (name,version) of the package modulePackageInfo :: Module -> (String, [Char]) -modulePackageInfo modu = case unpackPackageId pkg of - Nothing -> (packageIdString pkg, "") +modulePackageInfo modu = case unpackPackageKey pkg of + Nothing -> (packageKeyString pkg, "") Just x -> (display $ pkgName x, showVersion (pkgVersion x)) - where pkg = modulePackageId modu + where pkg = modulePackageKey modu -- This was removed from GHC 6.11 -- XXX we shouldn't be using it, probably --- | Try and interpret a GHC 'PackageId' as a cabal 'PackageIdentifer'. Returns @Nothing@ if +-- | Try and interpret a GHC 'PackageKey' as a cabal 'PackageIdentifer'. Returns @Nothing@ if -- we could not parse it as such an object. -unpackPackageId :: PackageId -> Maybe PackageIdentifier -unpackPackageId p +unpackPackageKey :: PackageKey -> Maybe PackageIdentifier +unpackPackageKey p = case [ pid | (pid,"") <- readP_to_S parse str ] of [] -> Nothing (pid:_) -> Just pid - where str = packageIdString p + where str = packageKeyString p lookupLoadedHomeModuleGRE :: GhcMonad m => ModuleName -> m (Maybe GlobalRdrEnv) diff --git a/src/Haddock/Interface/Create.hs b/src/Haddock/Interface/Create.hs index bc615cde..abc65f12 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.fsToPackageId $ + (fmap Module.fsToPackageKey $ ideclPkgQual impDecl) (case ideclName impDecl of SrcLoc.L _ name -> name), alias)) @@ -165,7 +165,7 @@ mkAliasMap dflags mRenamedSource = -- similar to GHC.lookupModule lookupModuleDyn :: - DynFlags -> Maybe PackageId -> ModuleName -> Module + DynFlags -> Maybe PackageKey -> ModuleName -> Module lookupModuleDyn _ (Just pkgId) mdlName = Module.mkModule pkgId mdlName lookupModuleDyn dflags Nothing mdlName = @@ -173,7 +173,7 @@ lookupModuleDyn dflags Nothing mdlName = case filter snd $ Packages.lookupModuleInAllPackages dflags mdlName of (pkgId,_):_ -> Packages.packageConfigId pkgId - [] -> Module.mainPackageId + [] -> Module.mainPackageKey ------------------------------------------------------------------------------- @@ -678,8 +678,8 @@ moduleExports thisMod expMod dflags warnings gre _exports decls ifaceMap instIfa "documentation for exported module: " ++ pretty dflags expMod] return [] where - m = mkModule packageId expMod - packageId = modulePackageId thisMod + m = mkModule packageKey expMod + packageKey = modulePackageKey thisMod -- Note [1]: diff --git a/src/Haddock/InterfaceFile.hs b/src/Haddock/InterfaceFile.hs index 7e4f6c10..4673f868 100644 --- a/src/Haddock/InterfaceFile.hs +++ b/src/Haddock/InterfaceFile.hs @@ -14,7 +14,7 @@ -- Reading and writing the .haddock interface file ----------------------------------------------------------------------------- module Haddock.InterfaceFile ( - InterfaceFile(..), ifPackageId, + InterfaceFile(..), ifPackageKey, readInterfaceFile, nameCacheFromGhc, freshNameCache, NameCacheAccessor, writeInterfaceFile, binaryInterfaceVersion, binaryInterfaceVersionCompatibility ) where @@ -52,11 +52,11 @@ data InterfaceFile = InterfaceFile { } -ifPackageId :: InterfaceFile -> PackageId -ifPackageId if_ = +ifPackageKey :: InterfaceFile -> PackageKey +ifPackageKey if_ = case ifInstalledIfaces if_ of [] -> error "empty InterfaceFile" - iface:_ -> modulePackageId $ instMod iface + iface:_ -> modulePackageKey $ instMod iface binaryInterfaceMagic :: Word32 @@ -310,7 +310,7 @@ getSymbolTable bh namecache = do return (namecache', arr) -type OnDiskName = (PackageId, ModuleName, OccName) +type OnDiskName = (PackageKey, ModuleName, OccName) fromOnDiskName @@ -340,7 +340,7 @@ fromOnDiskName _ nc (pid, mod_name, occ) = serialiseName :: BinHandle -> Name -> UniqFM (Int,Name) -> IO () serialiseName bh name _ = do let modu = nameModule name - put_ bh (modulePackageId modu, moduleName modu, nameOccName name) + put_ bh (modulePackageKey modu, moduleName modu, nameOccName name) ------------------------------------------------------------------------------- diff --git a/src/Haddock/ModuleTree.hs b/src/Haddock/ModuleTree.hs index 2a7fbfcc..28c5c06d 100644 --- a/src/Haddock/ModuleTree.hs +++ b/src/Haddock/ModuleTree.hs @@ -15,8 +15,8 @@ module Haddock.ModuleTree ( ModuleTree(..), mkModuleTree ) where import Haddock.Types ( Doc ) import GHC ( Name ) -import Module ( Module, moduleNameString, moduleName, modulePackageId, - packageIdString ) +import Module ( Module, moduleNameString, moduleName, modulePackageKey, + packageKeyString ) data ModuleTree = Node String Bool (Maybe String) (Maybe (Doc Name)) [ModuleTree] @@ -26,7 +26,7 @@ mkModuleTree :: Bool -> [(Module, Maybe (Doc Name))] -> [ModuleTree] mkModuleTree showPkgs mods = foldr fn [] [ (splitModule mdl, modPkg mdl, short) | (mdl, short) <- mods ] where - modPkg mod_ | showPkgs = Just (packageIdString (modulePackageId mod_)) + modPkg mod_ | showPkgs = Just (packageKeyString (modulePackageKey mod_)) | otherwise = Nothing fn (mod_,pkg,short) = addToTrees mod_ pkg short diff --git a/src/Haddock/Types.hs b/src/Haddock/Types.hs index 85b3a592..1f44fde4 100644 --- a/src/Haddock/Types.hs +++ b/src/Haddock/Types.hs @@ -50,7 +50,7 @@ type SubMap = Map Name [Name] type DeclMap = Map Name [LHsDecl Name] type InstMap = Map SrcSpan Name type FixMap = Map Name Fixity -type SrcMap = Map PackageId FilePath +type SrcMap = Map PackageKey FilePath type DocPaths = (FilePath, Maybe FilePath) -- paths to HTML and sources |