Commit 33316d37 authored by Mikhail Glushenkov's avatar Mikhail Glushenkov
Browse files

Merge pull request #2197 from ezyang/ezyang-exposed-modules

Consolidate exposed-modules and reexported-modules in InstalledPackageInfo
parents 438220b2 1f8a0a20
......@@ -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