Commit 1f8a0a20 authored by Edward Z. Yang's avatar Edward Z. Yang

Consolidate exposed-modules and reexported-modules in InstalledPackageInfo.

A note first: this patch does NOT modify the user-facing experience in Cabal
files; it only changes how we register information in the installed package
database.

This patch takes the exposed-modules and reexported-modules fields in
the InstalledPackageInfo structure and consolidates them into just the
exposed module fields, which now has a Maybe flag indicating if a
module is reexported and, if it is, what the original module was.  I've
also added in a field for signatures although it is currently unused.

The big benefit of this change is that it will make processing at the GHC level
much more uniform when we add signatures: signatures can also be reexported
and the new representation means we can share the code.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 438220b2
......@@ -28,7 +28,7 @@
module Distribution.InstalledPackageInfo (
InstalledPackageInfo_(..), InstalledPackageInfo,
ModuleReexport(..),
OriginalModule(..), ExposedModule(..),
ParseResult(..), PError(..), PWarning,
emptyInstalledPackageInfo,
parseInstalledPackageInfo,
......@@ -45,7 +45,7 @@ import Distribution.ParseUtils
, parseFieldsFlat
, parseFilePathQ, parseTokenQ, parseModuleNameQ, parsePackageNameQ
, showFilePath, showToken, boolField, parseOptVersion
, parseFreeText, showFreeText )
, parseFreeText, showFreeText, parseOptCommaList )
import Distribution.License ( License(..) )
import Distribution.Package
( PackageName(..), PackageIdentifier(..)
......@@ -86,8 +86,7 @@ data InstalledPackageInfo_ m
category :: String,
-- these parts are required by an installed package only:
exposed :: Bool,
exposedModules :: [m],
reexportedModules :: [ModuleReexport],
exposedModules :: [ExposedModule],
hiddenModules :: [m],
trusted :: Bool,
importDirs :: [FilePath],
......@@ -137,7 +136,6 @@ emptyInstalledPackageInfo
category = "",
exposed = False,
exposedModules = [],
reexportedModules = [],
hiddenModules = [],
trusted = False,
importDirs = [],
......@@ -160,31 +158,75 @@ noVersion :: Version
noVersion = Version [] []
-- -----------------------------------------------------------------------------
-- Module re-exports
-- Exposed modules
data ModuleReexport = ModuleReexport {
moduleReexportDefiningPackage :: InstalledPackageId,
moduleReexportDefiningName :: ModuleName,
moduleReexportName :: ModuleName
}
deriving (Generic, Read, Show)
data OriginalModule
= OriginalModule {
originalPackageId :: InstalledPackageId,
originalModuleName :: ModuleName
}
deriving (Generic, Eq, Read, Show)
instance Binary ModuleReexport
data ExposedModule
= ExposedModule {
exposedName :: ModuleName,
exposedReexport :: Maybe OriginalModule,
exposedSignature :: Maybe OriginalModule
}
deriving (Generic, Read, Show)
instance Text ModuleReexport where
disp (ModuleReexport pkgid origname newname) =
disp pkgid <> Disp.char ':' <> disp origname
<+> Disp.text "as" <+> disp newname
instance Text OriginalModule where
disp (OriginalModule ipi m) =
disp ipi <> Disp.char ':' <> disp m
parse = do
ipi <- parse
_ <- Parse.char ':'
m <- parse
return (OriginalModule ipi m)
instance Text ExposedModule where
disp (ExposedModule m reexport signature) =
Disp.sep [ disp m
, case reexport of
Just m' -> Disp.sep [Disp.text "from", disp m']
Nothing -> Disp.empty
, case signature of
Just m' -> Disp.sep [Disp.text "is", disp m']
Nothing -> Disp.empty
]
parse = do
pkgid <- parse
_ <- Parse.char ':'
origname <- parse
Parse.skipSpaces
_ <- Parse.string "as"
Parse.skipSpaces
newname <- parse
return (ModuleReexport pkgid origname newname)
m <- parseModuleNameQ
Parse.skipSpaces
reexport <- Parse.option Nothing $ do
_ <- Parse.string "from"
Parse.skipSpaces
fmap Just parse
Parse.skipSpaces
signature <- Parse.option Nothing $ do
_ <- Parse.string "is"
Parse.skipSpaces
fmap Just parse
return (ExposedModule m reexport signature)
instance Binary OriginalModule
instance Binary ExposedModule
-- To maintain backwards-compatibility, we accept both comma/non-comma
-- separated variants of this field. You SHOULD use the comma syntax if you
-- use any new functions, although actually it's unambiguous due to a quirk
-- of the fact that modules must start with capital letters.
showExposedModules :: [ExposedModule] -> Disp.Doc
showExposedModules xs
| all isExposedModule xs = fsep (map disp xs)
| otherwise = fsep (Disp.punctuate comma (map disp xs))
where isExposedModule (ExposedModule _ Nothing Nothing) = True
isExposedModule _ = False
parseExposedModules :: Parse.ReadP r [ExposedModule]
parseExposedModules = parseOptCommaList parse
-- -----------------------------------------------------------------------------
-- Parsing
......@@ -262,12 +304,9 @@ installedFieldDescrs :: [FieldDescr InstalledPackageInfo]
installedFieldDescrs = [
boolField "exposed"
exposed (\val pkg -> pkg{exposed=val})
, listField "exposed-modules"
disp parseModuleNameQ
, simpleField "exposed-modules"
showExposedModules parseExposedModules
exposedModules (\xs pkg -> pkg{exposedModules=xs})
, listField "reexported-modules"
disp parse
reexportedModules (\xs pkg -> pkg{reexportedModules=xs})
, listField "hidden-modules"
disp parseModuleNameQ
hiddenModules (\xs pkg -> pkg{hiddenModules=xs})
......
......@@ -367,7 +367,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
{ componentPackageDeps = componentPackageDeps clbi
, componentPackageRenaming = componentPackageRenaming clbi
, componentLibraries = [LibraryName (testName test)]
, componentModuleReexports = []
, componentExposedModules = [IPI.ExposedModule m Nothing Nothing]
}
pkg = pkg_descr {
package = (package pkg_descr) {
......
......@@ -61,7 +61,6 @@ import Distribution.InstalledPackageInfo as Installed
( InstalledPackageInfo, InstalledPackageInfo_(..)
, emptyInstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as Installed
( ModuleReexport(..) )
import qualified Distribution.Simple.PackageIndex as PackageIndex
import Distribution.Simple.PackageIndex (InstalledPackageIndex)
import Distribution.PackageDescription as PD
......@@ -1129,6 +1128,7 @@ mkComponentsLocalBuildInfo installedPackages pkg_descr
componentLocalBuildInfo component =
case component of
CLib lib -> do
let exports = map (\n -> Installed.ExposedModule n Nothing Nothing) (PD.exposedModules lib)
reexports <- resolveModuleReexports installedPackages
(packageId pkg_descr)
externalPkgDeps lib
......@@ -1136,7 +1136,7 @@ mkComponentsLocalBuildInfo installedPackages pkg_descr
componentPackageDeps = cpds,
componentLibraries = [LibraryName ("HS" ++ display pkg_key)],
componentPackageRenaming = cprns,
componentModuleReexports = reexports
componentExposedModules = exports ++ reexports
}
CExe _ ->
return ExeComponentLocalBuildInfo {
......@@ -1190,32 +1190,30 @@ resolveModuleReexports :: InstalledPackageIndex
-> [InstalledPackageInfo]
-> Library
-> Either [(ModuleReexport, String)] -- errors
[Installed.ModuleReexport] -- ok
[Installed.ExposedModule] -- ok
resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
case partitionEithers (map resolveModuleReexport (PD.reexportedModules lib)) of
([], ok) -> Right ok
(errs, _) -> Left errs
where
-- A mapping from visible module names to their original defining
-- module name and package.
visibleModules :: Map ModuleName [(PackageName, ModuleName, InstalledPackageId)]
-- module name. We also record the package name of the package which
-- *immediately* provided the module (not the original) to handle if the
-- user explicitly says which build-depends they want to reexport from.
visibleModules :: Map ModuleName [(PackageName, Installed.ExposedModule)]
visibleModules =
Map.fromListWith (++) $
[ (visibleModuleName, [(exportingPackageName,
definingModuleName,
definingPackageId)])
[ (Installed.exposedName exposedModule, [(exportingPackageName,
exposedModule)])
-- The package index here contains all the indirect deps of the
-- package we're configuring, but we want just the direct deps
| let directDeps = Set.fromList (map installedPackageId externalPkgDeps)
, pkg <- PackageIndex.allPackages installedPackages
, installedPackageId pkg `Set.member` directDeps
, let exportingPackageName = packageName pkg
, (visibleModuleName, definingModuleName, definingPackageId)
<- visibleModuleDetails pkg
, exposedModule <- visibleModuleDetails pkg
]
++ [ (visibleModuleName, [(exportingPackageName,
definingModuleName,
definingPackageId)])
++ [ (visibleModuleName, [(exportingPackageName, exposedModule)])
| visibleModuleName <- PD.exposedModules lib
++ otherModules (libBuildInfo lib)
, let exportingPackageName = packageName srcpkgid
......@@ -1223,33 +1221,31 @@ resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
-- we don't know the InstalledPackageId of this package yet
-- we will fill it in later, before registration.
definingPackageId = InstalledPackageId ""
originalModule = Installed.OriginalModule definingPackageId
definingModuleName
exposedModule = Installed.ExposedModule visibleModuleName
(Just originalModule)
Nothing
]
-- All the modules exported from this package and their defining name and
-- package (either defined here in this package or re-exported from some
-- other package)
visibleModuleDetails :: InstalledPackageInfo
-> [(ModuleName, ModuleName, InstalledPackageId)]
visibleModuleDetails pkg =
-- other package). Return an ExposedModule because we want to hold onto
-- signature information.
visibleModuleDetails :: InstalledPackageInfo -> [Installed.ExposedModule]
visibleModuleDetails pkg = do
exposedModule <- Installed.exposedModules pkg
case Installed.exposedReexport exposedModule of
-- The first case is the modules actually defined in this package.
-- In this case the visible and original names are the same, and the
-- defining package is this one.
[ (visibleModuleName, definingModuleName, definingPackageId)
| visibleModuleName <- Installed.exposedModules pkg
, let definingModuleName = visibleModuleName
definingPackageId = installedPackageId pkg
]
-- In this case the reexport will point to this package.
Nothing -> return exposedModule { Installed.exposedReexport =
Just (Installed.OriginalModule (installedPackageId pkg)
(Installed.exposedName exposedModule)) }
-- On the other hand, a visible module might actually be itself
-- a re-export! In this case, the re-export info for the package
-- doing the re-export will point us to the original defining
-- module name and package.
++ [ (visibleModuleName, definingModuleName, definingPackageId)
| Installed.ModuleReexport {
Installed.moduleReexportName = visibleModuleName,
Installed.moduleReexportDefiningName = definingModuleName,
Installed.moduleReexportDefiningPackage = definingPackageId
} <- Installed.reexportedModules pkg
]
-- module name and package, so we can reuse the entry.
Just _ -> return exposedModule
resolveModuleReexport reexport@ModuleReexport {
moduleReexportOriginalPackage = moriginalPackageName,
......@@ -1261,19 +1257,17 @@ resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
case moriginalPackageName of
Nothing -> id
Just originalPackageName ->
filter (\(pkgname, _, _) -> pkgname == originalPackageName)
filter (\(pkgname, _) -> pkgname == originalPackageName)
matches = filterForSpecificPackage
(Map.findWithDefault [] originalName visibleModules)
in
case (matches, moriginalPackageName) of
((_, definingModuleName, definingPackageId):rest, _)
| all (\(_, n, p) -> n == definingModuleName && p == definingPackageId) rest
-> Right Installed.ModuleReexport {
Installed.moduleReexportDefiningName = definingModuleName,
Installed.moduleReexportDefiningPackage = definingPackageId,
Installed.moduleReexportName = newName
}
((_, exposedModule):rest, _)
-- TODO: Refine this check for signatures
| all (\(_, exposedModule') -> Installed.exposedReexport exposedModule
== Installed.exposedReexport exposedModule') rest
-> Right exposedModule { Installed.exposedName = newName }
([], Just originalPackageName)
-> Left $ (,) reexport
......@@ -1290,7 +1284,7 @@ resolveModuleReexports installedPackages srcpkgid externalPkgDeps lib =
-> Left $ (,) reexport
$ "The module " ++ display originalName ++ " is exported "
++ "by more than one package ("
++ intercalate ", " [ display pkgname | (pkgname,_,_) <- ms ]
++ intercalate ", " [ display pkgname | (pkgname,_) <- ms ]
++ ") and so the re-export is ambiguous. The ambiguity can "
++ "be resolved by qualifying by the package name. The "
++ "syntax is 'packagename:moduleName [as newname]'."
......
......@@ -67,6 +67,7 @@ mkInstalledPackageId = Current.InstalledPackageId . display
toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
toCurrent ipi@InstalledPackageInfo{} =
let pid = convertPackageId (package ipi)
mkExposedModule m = Current.ExposedModule m Nothing Nothing
in Current.InstalledPackageInfo {
Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)),
Current.sourcePackageId = pid,
......@@ -82,8 +83,7 @@ toCurrent ipi@InstalledPackageInfo{} =
Current.description = description ipi,
Current.category = category ipi,
Current.exposed = exposed ipi,
Current.exposedModules = map convertModuleName (exposedModules ipi),
Current.reexportedModules = [],
Current.exposedModules = map (mkExposedModule . convertModuleName) (exposedModules ipi),
Current.hiddenModules = map convertModuleName (hiddenModules ipi),
Current.trusted = Current.trusted Current.emptyInstalledPackageInfo,
Current.importDirs = importDirs ipi,
......
......@@ -102,6 +102,7 @@ convertLicense OtherLicense = Current.OtherLicense
toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
toCurrent ipi@InstalledPackageInfo{} =
let pid = convertPackageId (package ipi)
mkExposedModule m = Current.ExposedModule m Nothing Nothing
in Current.InstalledPackageInfo {
Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)),
Current.sourcePackageId = pid,
......@@ -117,8 +118,7 @@ toCurrent ipi@InstalledPackageInfo{} =
Current.description = description ipi,
Current.category = category ipi,
Current.exposed = exposed ipi,
Current.exposedModules = map convertModuleName (exposedModules ipi),
Current.reexportedModules = [],
Current.exposedModules = map (mkExposedModule . convertModuleName) (exposedModules ipi),
Current.hiddenModules = map convertModuleName (hiddenModules ipi),
Current.trusted = Current.trusted Current.emptyInstalledPackageInfo,
Current.importDirs = importDirs ipi,
......
......@@ -67,7 +67,6 @@ import Distribution.PackageDescription
, Executable(exeName, buildInfo), withTest, TestSuite(..)
, BuildInfo(buildable), Benchmark(..), ModuleRenaming(..) )
import qualified Distribution.InstalledPackageInfo as Installed
( ModuleReexport(..) )
import Distribution.Package
( PackageId, Package(..), InstalledPackageId(..), PackageKey
, PackageName )
......@@ -192,7 +191,7 @@ data ComponentLocalBuildInfo
-- satisfied in terms of version ranges. This field fixes those dependencies
-- to the specific versions available on this machine for this compiler.
componentPackageDeps :: [(InstalledPackageId, PackageId)],
componentModuleReexports :: [Installed.ModuleReexport],
componentExposedModules :: [Installed.ExposedModule],
componentPackageRenaming :: Map PackageName ModuleRenaming,
componentLibraries :: [LibraryName]
}
......
......@@ -678,16 +678,15 @@ fakeInstalledDepends fakeMap = map (\pid -> Map.findWithDefault pid pid fakeMap)
-- initialize the @build-deps@ field in @cabal init@.
moduleNameIndex :: InstalledPackageIndex -> Map ModuleName [InstalledPackageInfo]
moduleNameIndex index =
Map.fromListWith (++) . concat $
[ [(m, [pkg]) | m <- IPI.exposedModules pkg ] ++
[(m', [pkg]) | IPI.ModuleReexport {
IPI.moduleReexportDefiningName = m,
IPI.moduleReexportName = m'
} <- IPI.reexportedModules pkg
, m /= m' ]
Map.fromListWith (++) $ do
pkg <- allPackages index
IPI.ExposedModule m reexport _ <- IPI.exposedModules pkg
case reexport of
Nothing -> return (m, [pkg])
Just (IPI.OriginalModule _ m') | m == m' -> []
| otherwise -> return (m', [pkg])
-- The heuristic is this: we want to prefer the original package
-- which originally exported a module. However, if a reexport
-- also *renamed* the module (m /= m'), then we have to use the
-- downstream package, since the upstream package has the wrong
-- module name!
| pkg <- allPackages index ]
......@@ -65,7 +65,7 @@ import Distribution.Package
( Package(..), packageName, InstalledPackageId(..) )
import Distribution.InstalledPackageInfo
( InstalledPackageInfo, InstalledPackageInfo_(InstalledPackageInfo)
, showInstalledPackageInfo, ModuleReexport(..) )
, showInstalledPackageInfo )
import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Simple.Utils
( writeUTF8File, writeFileAtomic, setFileExecutable
......@@ -272,8 +272,7 @@ generalInstalledPackageInfo adjustRelIncDirs pkg ipid lib lbi clbi installDirs =
IPI.description = description pkg,
IPI.category = category pkg,
IPI.exposed = libExposed lib,
IPI.exposedModules = exposedModules lib,
IPI.reexportedModules = map fixupSelfReexport (componentModuleReexports clbi),
IPI.exposedModules = map fixupSelf (componentExposedModules clbi),
IPI.hiddenModules = otherModules bi,
IPI.trusted = IPI.trusted IPI.emptyInstalledPackageInfo,
IPI.importDirs = [ libdir installDirs | hasModules ],
......@@ -305,16 +304,15 @@ generalInstalledPackageInfo adjustRelIncDirs pkg ipid lib lbi clbi installDirs =
hasLibrary = hasModules || not (null (cSources bi))
-- Since we currently don't decide the InstalledPackageId of our package
-- until just before we register, we didn't have one for the re-exports
-- of modules definied within this package, so we used an empty one that
-- of modules defined within this package, so we used an empty one that
-- we fill in here now that we know what it is. It's a bit of a hack,
-- we ought really to decide the InstalledPackageId ahead of time.
fixupSelfReexport mre@ModuleReexport {
moduleReexportDefiningPackage = InstalledPackageId []
}
= mre {
moduleReexportDefiningPackage = ipid
}
fixupSelfReexport mre = mre
fixupSelf (IPI.ExposedModule n o o') =
IPI.ExposedModule n (fmap fixupOriginalModule o)
(fmap fixupOriginalModule o')
fixupOriginalModule (IPI.OriginalModule i m) = IPI.OriginalModule (fixupIpid i) m
fixupIpid (InstalledPackageId []) = ipid
fixupIpid x = x
-- | Construct 'InstalledPackageInfo' for a library that is in place in the
-- build tree.
......
......@@ -450,9 +450,10 @@ mergePackageInfo versionPref installedPkgs sourcePkgs selectedPkg showVer =
hasExe = fromMaybe False
(fmap (not . null . Source.condExecutables) sourceGeneric),
executables = map fst (maybe [] Source.condExecutables sourceGeneric),
modules = combine Installed.exposedModules installed
(maybe [] Source.exposedModules
. Source.library) source,
modules = combine (map Installed.exposedName . Installed.exposedModules)
installed
(maybe [] getListOfExposedModules . Source.library)
source,
dependencies =
combine (map (SourceDependency . simplifyDependency)
. Source.buildDepends) source
......@@ -467,6 +468,10 @@ mergePackageInfo versionPref installedPkgs sourcePkgs selectedPkg showVer =
installed :: Maybe Installed.InstalledPackageInfo
installed = latestWithPref versionPref installedPkgs
getListOfExposedModules lib = Source.exposedModules lib
++ map Source.moduleReexportName
(Source.reexportedModules lib)
sourceSelected
| isJust selectedPkg = selectedPkg
| otherwise = latestWithPref versionPref sourcePkgs
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment