aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorEdward Z. Yang <ezyang@cs.stanford.edu>2014-07-19 17:11:01 +0100
committerEdward Z. Yang <ezyang@cs.stanford.edu>2014-07-21 08:14:19 -0700
commit8ac42d3327473939c013551750425cac191ff0fd (patch)
tree2bae383f059f5d22194307fa83b7717a7983dbe6
parentcb96b4f1ed0462b4a394b9fda6612c3bea9886bd (diff)
Track GHC PackageId to PackageKey renaming.
Signed-off-by: Edward Z. Yang <ezyang@cs.stanford.edu> Conflicts: src/Haddock/Interface/Create.hs
-rw-r--r--src/Haddock.hs10
-rw-r--r--src/Haddock/Backends/Xhtml.hs2
-rw-r--r--src/Haddock/Backends/Xhtml/Layout.hs2
-rw-r--r--src/Haddock/Backends/Xhtml/Types.hs2
-rw-r--r--src/Haddock/GhcUtils.hs14
-rw-r--r--src/Haddock/Interface/Create.hs10
-rw-r--r--src/Haddock/InterfaceFile.hs12
-rw-r--r--src/Haddock/ModuleTree.hs6
-rw-r--r--src/Haddock/Types.hs2
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