Commit a3d3273a authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Change rep of module re-exports, and do resolution ourselves

The initial support for module re-exports relied on ghc-pkg to resolve
user-specified re-exports to references to specific installed packages.
This resolution is something that can fail so it's better for Cabal to
do it during the package configure phase.

In addition, it is inconvenient in ghc-pkg to be doing this resolution,
and it just seems fishy as a design. Also, the same ModuleExport type
was being used both for user-specified source re-exports and also for
the specific re-exports in the package db.

This patch splits the type into two: one for source level, and one for
resolved ones for use in the package db. The configure phase resolves
one to the other.

One minor change: it is now possible to re-export a module defined in
the same package that is not itself exported (ie it's in other-modules,
rather than exposed-modules). Previously for modules definied in the
same package they had to be themselves exported. Of course for
re-exports from other packages they have to be exposed.
parent 20e35704
......@@ -154,7 +154,6 @@ library
Distribution.License
Distribution.Make
Distribution.ModuleName
Distribution.ModuleExport
Distribution.Package
Distribution.PackageDescription
Distribution.PackageDescription.Check
......
......@@ -56,6 +56,7 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.InstalledPackageInfo (
InstalledPackageInfo_(..), InstalledPackageInfo,
ModuleReexport(..),
ParseResult(..), PError(..), PWarning,
emptyInstalledPackageInfo,
parseInstalledPackageInfo,
......@@ -82,12 +83,12 @@ import qualified Distribution.Package as Package
( Package(..) )
import Distribution.ModuleName
( ModuleName )
import Distribution.ModuleExport
( ModuleExport(..) )
import Distribution.Version
( Version(..) )
import Distribution.Text
( Text(disp, parse) )
import Text.PrettyPrint as Disp
import qualified Distribution.Compat.ReadP as Parse
-- -----------------------------------------------------------------------------
-- The InstalledPackageInfo type
......@@ -112,7 +113,7 @@ data InstalledPackageInfo_ m
-- these parts are required by an installed package only:
exposed :: Bool,
exposedModules :: [m],
reexportedModules :: [ModuleExport m],
reexportedModules :: [ModuleReexport],
hiddenModules :: [m],
trusted :: Bool,
importDirs :: [FilePath], -- contain sources in case of Hugs
......@@ -180,6 +181,31 @@ emptyInstalledPackageInfo
noVersion :: Version
noVersion = Version{ versionBranch=[], versionTags=[] }
-- -----------------------------------------------------------------------------
-- Module re-exports
data ModuleReexport = ModuleReexport {
moduleReexportDefiningPackage :: InstalledPackageId,
moduleReexportDefiningName :: ModuleName,
moduleReexportName :: ModuleName
}
deriving (Read, Show)
instance Text ModuleReexport where
disp (ModuleReexport pkgid origname newname) =
disp pkgid <> Disp.char ':' <> disp origname
<+> Disp.text "as" <+> disp newname
parse = do
pkgid <- parse
_ <- Parse.char ':'
origname <- parse
Parse.skipSpaces
_ <- Parse.string "as"
Parse.skipSpaces
newname <- parse
return (ModuleReexport pkgid origname newname)
-- -----------------------------------------------------------------------------
-- Parsing
......
{-# LANGUAGE DeriveDataTypeable #-}
module Distribution.ModuleExport(ModuleExport(..)) where
import Distribution.Text
( Text(disp, parse) )
import Distribution.Compat.ReadP
( (+++) )
import Distribution.Package
( PackageName, InstalledPackageId )
import qualified Distribution.Compat.ReadP as Parse
import qualified Text.PrettyPrint as Disp
import Text.PrettyPrint ((<+>),(<>))
import Data.Data
-- | Defines a reexport of module 'exportOrigName' from package
-- 'exportOrigPackageId' as new module name 'exportName'. This data type has an
-- interesting invariant: in the installed package database, a ModuleExport is
-- guaranteed to point to the original module which defined the module. Of
-- course, when a user writes a ModuleExport, it may not have this property.
-- ghc-pkg is responsible for enforcing this invariant.
data ModuleExport m = ModuleExport {
-- | Original package name of the reexported module, or Nothing if
-- the user wants us to figure it out automatically. (Note: this package
-- could have reexported the module itself.)
exportOrigPackageName :: Maybe PackageName,
-- | Original module name of reexported module.
exportOrigName :: m,
-- | New module name of reexported module, available to clients
-- of this package.
exportName :: m,
-- | A hack! When ghc-pkg processes 'ModuleExport', it is able to resolve
-- the true, original location an identifier lived in (this cannot be done
-- without consulting the package database), it fills it in here so that
-- GHC can use it. When we get GHC to stop using 'InstalledPackageInfo',
-- this hack can go away.
exportCachedTrueOrig :: Maybe (InstalledPackageId, m)
} deriving (Read, Show, Eq, Data, Typeable)
-- Handy when we need to convert from one ModuleName representation to
-- another (it's used in GHC.)
instance Functor ModuleExport where
fmap f (ModuleExport pnm m m' c) = ModuleExport pnm (f m) (f m')
(fmap (\(x,y)->(x,f y)) c)
instance (Eq m, Text m) => Text (ModuleExport m) where
disp ModuleExport{ exportOrigPackageName = mpnm
, exportOrigName = m
, exportName = m'
, exportCachedTrueOrig = c }
= (maybe Disp.empty (\pnm -> disp pnm <> Disp.char ':') mpnm)
<> disp m
<+> (if m == m'
then Disp.empty
else Disp.text "as" <+> disp m')
<+> (maybe Disp.empty (\(c_ipid, c_m) ->
Disp.parens (disp c_m <> Disp.char '@' <> disp c_ipid)) c)
parse = do Parse.skipSpaces
mpnm <- (do pnm <- parse
_ <- Parse.char ':'
return (Just pnm)
+++ return Nothing)
m <- parse
m' <- (do Parse.skipSpaces
_ <- Parse.string "as"
Parse.skipSpaces
parse)
+++ return m
c <- (do Parse.skipSpaces
_ <- Parse.char '('
c_m <- parse
_ <- Parse.char '@'
c_ipid <- parse
_ <- Parse.char ')'
return (Just (c_ipid, c_m))
+++ return Nothing)
return ModuleExport{ exportOrigPackageName = mpnm
, exportOrigName = m
, exportName = m'
, exportCachedTrueOrig = c }
......@@ -113,7 +113,7 @@ instance Text InstalledPackageId where
disp (InstalledPackageId str) = text str
parse = InstalledPackageId `fmap` Parse.munch1 abi_char
where abi_char c = Char.isAlphaNum c || c `elem` ":-_."
where abi_char c = Char.isAlphaNum c || c `elem` "-_."
-- ------------------------------------------------------------
-- * Package Keys
......
......@@ -33,6 +33,7 @@ module Distribution.PackageDescription (
-- ** Libraries
Library(..),
ModuleReexport(..),
emptyLibrary,
withLib,
hasLibs,
......@@ -109,7 +110,6 @@ import Distribution.Package
( PackageName(PackageName), PackageIdentifier(PackageIdentifier)
, Dependency, Package(..) )
import Distribution.ModuleName ( ModuleName )
import Distribution.ModuleExport ( ModuleExport )
import Distribution.Version
( Version(Version), VersionRange, anyVersion, orLaterVersion
, asVersionIntervals, LowerBound(..) )
......@@ -270,7 +270,7 @@ instance Text BuildType where
data Library = Library {
exposedModules :: [ModuleName],
reexportedModules :: [ModuleExport ModuleName],
reexportedModules :: [ModuleReexport],
libExposed :: Bool, -- ^ Is the lib to be exposed by default?
libBuildInfo :: BuildInfo
}
......@@ -318,6 +318,37 @@ libModules :: Library -> [ModuleName]
libModules lib = exposedModules lib
++ otherModules (libBuildInfo lib)
-- -----------------------------------------------------------------------------
-- Module re-exports
data ModuleReexport = ModuleReexport {
moduleReexportOriginalPackage :: Maybe PackageName,
moduleReexportOriginalName :: ModuleName,
moduleReexportName :: ModuleName
}
deriving (Eq, Read, Show, Typeable, Data)
instance Text ModuleReexport where
disp (ModuleReexport mpkgname origname newname) =
maybe Disp.empty (\pkgname -> disp pkgname <> Disp.char ':') mpkgname
<> disp origname
<+> if newname == origname
then Disp.empty
else Disp.text "as" <+> disp newname
parse = do
mpkgname <- Parse.option Nothing $ do
pkgname <- parse
_ <- Parse.char ':'
return (Just pkgname)
origname <- parse
newname <- Parse.option origname $ do
Parse.skipSpaces
_ <- Parse.string "as"
Parse.skipSpaces
parse
return (ModuleReexport mpkgname origname newname)
-- ---------------------------------------------------------------------------
-- The Executable type
......
......@@ -65,8 +65,6 @@ import Distribution.Version
import Distribution.Package
( PackageName(PackageName), packageName, packageVersion
, Dependency(..), pkgName )
import Distribution.ModuleExport
( ModuleExport(..) )
import Distribution.Text
( display, disp )
......@@ -224,7 +222,7 @@ checkLibrary _pkg lib =
where
moduleDuplicates = dups (libModules lib ++
map exportName (reexportedModules lib))
map moduleReexportName (reexportedModules lib))
checkExecutable :: PackageDescription -> Executable -> [PackageCheck]
checkExecutable pkg exe =
......
......@@ -199,12 +199,11 @@ buildComponent verbosity numJobs pkg_descr lbi suffixes
-- Register the library in-place, so exes can depend
-- on internally defined libraries.
pwd <- getCurrentDirectory
let installedPkgInfo =
(inplaceInstalledPackageInfo pwd distPref pkg_descr lib lbi clbi) {
-- The in place registration uses the "-inplace" suffix,
-- not an ABI hash.
IPI.installedPackageId = inplacePackageId (packageId installedPkgInfo)
}
let -- The in place registration uses the "-inplace" suffix, not an ABI hash
ipkgid = inplacePackageId (packageId installedPkgInfo)
installedPkgInfo = inplaceInstalledPackageInfo pwd distPref pkg_descr
ipkgid lib lbi clbi
registerPackage verbosity
installedPkgInfo pkg_descr lbi True -- True meaning in place
(withPackageDB lbi)
......@@ -364,6 +363,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
libClbi = LibComponentLocalBuildInfo
{ componentPackageDeps = componentPackageDeps clbi
, componentLibraries = [LibraryName (testName test)]
, componentModuleReexports = []
}
pkg = pkg_descr {
package = (package pkg_descr) {
......@@ -382,9 +382,8 @@ testSuiteLibV09AsLibAndExe pkg_descr
pkgKey = mkPackageKey (packageKeySupported (compiler lbi))
(package pkg) []
}
ipi = (inplaceInstalledPackageInfo pwd distPref pkg lib lbi libClbi) {
IPI.installedPackageId = inplacePackageId $ packageId ipi
}
ipkgid = inplacePackageId (packageId pkg)
ipi = inplaceInstalledPackageInfo pwd distPref pkg ipkgid lib lbi libClbi
testDir = buildDir lbi </> stubName test
</> stubName test ++ "-tmp"
testLibDep = thisPackageVersion $ package pkg
......
......@@ -59,13 +59,18 @@ import Distribution.Package
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 (PackageIndex)
import Distribution.PackageDescription as PD
( PackageDescription(..), specVersion, GenericPackageDescription(..)
, Library(..), hasLibs, Executable(..), BuildInfo(..), allExtensions
, HookedBuildInfo, updatePackageDescription, allBuildInfo
, Flag(flagName), FlagName(..), TestSuite(..), Benchmark(..) )
, Flag(flagName), FlagName(..), TestSuite(..), Benchmark(..)
, ModuleReexport(..) )
import Distribution.ModuleName
( ModuleName )
import Distribution.PackageDescription.Configuration
( finalizePackageDescription, mapTreeData )
import Distribution.PackageDescription.Check
......@@ -120,10 +125,13 @@ import Data.List
( (\\), nub, partition, isPrefixOf, inits )
import Data.Maybe
( isNothing, catMaybes, fromMaybe )
import Data.Either
( partitionEithers )
import Data.Monoid
( Monoid(..) )
import qualified Data.Map as Map
import Data.Map (Map)
import qualified Data.Set as Set
import Data.Traversable
( mapM )
import System.Directory
......@@ -393,7 +401,7 @@ configure (pkg_descr0, pbi) cfg
when (maybe False (not.null.PD.reexportedModules) (PD.library pkg_descr)
&& not (reexportedModulesSupported comp)) $ do
die $ "Your compiler does not support module reexports. To use"
die $ "Your compiler does not support module re-exports. To use "
++ "this feature you probably must use GHC 7.9 or later."
checkPackageProblems verbosity pkg_descr0
......@@ -468,10 +476,14 @@ configure (pkg_descr0, pbi) cfg
-- internal component graph
buildComponents <-
case mkComponentsLocalBuildInfo pkg_descr
internalPkgDeps externalPkgDeps pkg_key of
case mkComponentsGraph pkg_descr internalPkgDeps of
Left componentCycle -> reportComponentCycle componentCycle
Right components -> return components
Right components ->
case mkComponentsLocalBuildInfo packageDependsIndex pkg_descr
internalPkgDeps externalPkgDeps
pkg_key components of
Left problems -> reportModuleReexportProblems problems
Right components' -> return components'
-- installation directories
defaultDirs <- defaultInstallDirs flavor userInstall (hasLibs pkg_descr)
......@@ -1025,20 +1037,16 @@ configCompilerAux = fmap (\(a,_,b) -> (a,b)) . configCompilerAuxEx
-- Making the internal component graph
mkComponentsLocalBuildInfo :: PackageDescription
-> [PackageId] -> [InstalledPackageInfo]
-> PackageKey
-> Either [ComponentName]
[(ComponentName,
ComponentLocalBuildInfo, [ComponentName])]
mkComponentsLocalBuildInfo pkg_descr internalPkgDeps externalPkgDeps pkg_key =
mkComponentsGraph :: PackageDescription
-> [PackageId]
-> Either [ComponentName]
[(Component, [ComponentName])]
mkComponentsGraph pkg_descr internalPkgDeps =
let graph = [ (c, componentName c, componentDeps c)
| c <- pkgEnabledComponents pkg_descr ]
in case checkComponentsCyclic graph of
Just ccycle -> Left [ cname | (_,cname,_) <- ccycle ]
Nothing -> Right [ (cname, clbi, cdeps)
| (c, cname, cdeps) <- graph
, let clbi = componentLocalBuildInfo c ]
Nothing -> Right [ (c, cdeps) | (c, _, cdeps) <- graph ]
where
-- The dependencies for the given component
componentDeps component =
......@@ -1052,6 +1060,28 @@ mkComponentsLocalBuildInfo pkg_descr internalPkgDeps externalPkgDeps pkg_key =
where
bi = componentBuildInfo component
reportComponentCycle :: [ComponentName] -> IO a
reportComponentCycle cnames =
die $ "Components in the package depend on each other in a cyclic way:\n "
++ intercalate " depends on "
[ "'" ++ showComponentName cname ++ "'"
| cname <- cnames ++ [head cnames] ]
mkComponentsLocalBuildInfo :: PackageIndex
-> PackageDescription
-> [PackageId] -> [InstalledPackageInfo]
-> PackageKey
-> [(Component, [ComponentName])]
-> Either [(ModuleReexport, String)] -- errors
[(ComponentName, ComponentLocalBuildInfo,
[ComponentName])] -- ok
mkComponentsLocalBuildInfo installedPackages pkg_descr
internalPkgDeps externalPkgDeps pkg_key graph =
sequence
[ do clbi <- componentLocalBuildInfo c
return (componentName c, clbi, cdeps)
| (c, cdeps) <- graph ]
where
-- The allPkgDeps contains all the package deps for the whole package
-- but we need to select the subset for this specific component.
-- we just take the subset for the package names this component
......@@ -1059,22 +1089,25 @@ mkComponentsLocalBuildInfo pkg_descr internalPkgDeps externalPkgDeps pkg_key =
-- versions of the same package.
componentLocalBuildInfo component =
case component of
CLib _ ->
LibComponentLocalBuildInfo {
CLib lib -> do
reexports <- resolveModuleReexports installedPackages
(packageId pkg_descr)
externalPkgDeps lib
return LibComponentLocalBuildInfo {
componentPackageDeps = cpds,
componentLibraries = [LibraryName
("HS" ++ display pkg_key)]
componentLibraries = [LibraryName ("HS" ++ display pkg_key)],
componentModuleReexports = reexports
}
CExe _ ->
ExeComponentLocalBuildInfo {
return ExeComponentLocalBuildInfo {
componentPackageDeps = cpds
}
CTest _ ->
TestComponentLocalBuildInfo {
return TestComponentLocalBuildInfo {
componentPackageDeps = cpds
}
CBench _ ->
BenchComponentLocalBuildInfo {
return BenchComponentLocalBuildInfo {
componentPackageDeps = cpds
}
where
......@@ -1093,13 +1126,134 @@ mkComponentsLocalBuildInfo pkg_descr internalPkgDeps externalPkgDeps pkg_key =
where
names = [ name | Dependency name _ <- targetBuildDepends bi ]
reportComponentCycle :: [ComponentName] -> IO a
reportComponentCycle cnames =
die $ "Components in the package depend on each other in a cyclic way:\n "
++ intercalate " depends on "
[ "'" ++ showComponentName cname ++ "'"
| cname <- cnames ++ [head cnames] ]
-- | Given the author-specified re-export declarations from the .cabal file,
-- resolve them to the form that we need for the package database.
--
-- An invariant of the package database is that we always link the re-export
-- directly to its original defining location (rather than indirectly via a
-- chain of re-exporting packages).
--
resolveModuleReexports :: PackageIndex
-> PackageId
-> [InstalledPackageInfo]
-> Library
-> Either [(ModuleReexport, String)] -- errors
[Installed.ModuleReexport] -- 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)]
visibleModules =
Map.fromListWith (++) $
[ (visibleModuleName, [(exportingPackageName,
definingModuleName,
definingPackageId)])
-- 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
]
++ [ (visibleModuleName, [(exportingPackageName,
definingModuleName,
definingPackageId)])
| visibleModuleName <- PD.exposedModules lib
++ otherModules (libBuildInfo lib)
, let exportingPackageName = packageName srcpkgid
definingModuleName = visibleModuleName
-- we don't know the InstalledPackageId of this package yet
-- we will fill it in later, before registration.
definingPackageId = InstalledPackageId ""
]
-- 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 =
-- 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
]
-- 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
]
resolveModuleReexport reexport@ModuleReexport {
moduleReexportOriginalPackage = moriginalPackageName,
moduleReexportOriginalName = originalName,
moduleReexportName = newName
} =
let filterForSpecificPackage =
case moriginalPackageName of
Nothing -> id
Just originalPackageName ->
filter (\(pkgname, _, _) -> pkgname == originalPackageName)
matches = filterForSpecificPackage
(Map.findWithDefault [] originalName visibleModules)
in
case (matches, moriginalPackageName) of
([(_, definingModuleName, definingPackageId)], _)
-> Right Installed.ModuleReexport {
Installed.moduleReexportDefiningName = definingModuleName,
Installed.moduleReexportDefiningPackage = definingPackageId,
Installed.moduleReexportName = newName
}
([], Just originalPackageName)
-> Left $ (,) reexport
$ "The package " ++ display originalPackageName
++ " does not export a module " ++ display originalName
([], Nothing)
-> Left $ (,) reexport
$ "The module " ++ display originalName
++ " is not exported by any suitable package (this package "
++ "itself nor any of its 'build-depends' dependencies)."
(ms, _)
-> Left $ (,) reexport
$ "The module " ++ display originalName ++ " is exported "
++ "by more than one package ("
++ 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]'."
-- Note: if in future Cabal allows directly depending on multiple
-- instances of the same package (e.g. backpack) then an additional
-- ambiguity case is possible here: (_, Just originalPackageName)
-- with the module being ambigious despite being qualified by a
-- package name. Presumably by that time we'll have a mechanism to
-- qualify the instance we're referring to.
reportModuleReexportProblems :: [(ModuleReexport, String)] -> IO a
reportModuleReexportProblems reexportProblems =
die $ unlines
[ "Problem with the module re-export '" ++ display reexport ++ "': " ++ msg
| (reexport, msg) <- reexportProblems ]
-- -----------------------------------------------------------------------------
-- Testing C lib and header dependencies
......
......@@ -64,6 +64,8 @@ import Distribution.PackageDescription
( PackageDescription(..), withLib, Library(libBuildInfo), withExe
, Executable(exeName, buildInfo), withTest, TestSuite(..)
, BuildInfo(buildable), Benchmark(..) )
import qualified Distribution.InstalledPackageInfo as Installed
( ModuleReexport(..) )
import Distribution.Package
( PackageId, Package(..), InstalledPackageId(..), PackageKey )
import Distribution.Simple.Compiler
......@@ -182,7 +184,8 @@ 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)],
componentLibraries :: [LibraryName]
componentLibraries :: [LibraryName],
componentModuleReexports :: [Installed.ModuleReexport]
}
| ExeComponentLocalBuildInfo {
componentPackageDeps :: [(InstalledPackageId, PackageId)]
......
......@@ -84,8 +84,6 @@ import qualified Distribution.InstalledPackageInfo as IPI
import Distribution.Version
( Version, withinRange )
import Distribution.Simple.Utils (lowercase, comparing, equating)
import Distribution.ModuleExport
( ModuleExport(..) )
-- | The collection of information about packages from one or more 'PackageDB's.
......@@ -577,9 +575,10 @@ moduleNameIndex :: PackageIndex -> Map ModuleName [InstalledPackageInfo]
moduleNameIndex index =
Map.fromListWith (++) . concat $
[ [(m, [pkg]) | m <- IPI.exposedModules pkg ] ++