Commit 62450f9a authored by Edward Z. Yang's avatar Edward Z. Yang

Implement "reexported-modules" field, towards fixing GHC bug #8407.

Re-exported modules allow packages to reexport modules from their
dependencies without having to create stub files.  Reexports of the same
original module don't count as ambiguous imports when module finding
occurs.  The syntax is:

    "orig-pkg" OrigName as NewName

You can omit 'as NewName', in which case it is reexported as the same
name.  Self referential aliases work too; however, they're only visible
to packages which depend on this package.

Left to future work: just provide a module name 'OrigName', where ghc-pkg
figures out what the source package is.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent bd5f7c26
......@@ -154,6 +154,7 @@ library
Distribution.License
Distribution.Make
Distribution.ModuleName
Distribution.ModuleExport
Distribution.Package
Distribution.PackageDescription
Distribution.PackageDescription.Check
......
......@@ -82,6 +82,8 @@ import qualified Distribution.Package as Package
( Package(..) )
import Distribution.ModuleName
( ModuleName )
import Distribution.ModuleExport
( ModuleExport(..) )
import Distribution.Version
( Version(..) )
import Distribution.Text
......@@ -90,6 +92,7 @@ import Distribution.Text
-- -----------------------------------------------------------------------------
-- The InstalledPackageInfo type
data InstalledPackageInfo_ m
= InstalledPackageInfo {
-- these parts are exactly the same as PackageDescription
......@@ -108,6 +111,7 @@ data InstalledPackageInfo_ m
-- these parts are required by an installed package only:
exposed :: Bool,
exposedModules :: [m],
reexportedModules :: [ModuleExport m],
hiddenModules :: [m],
trusted :: Bool,
importDirs :: [FilePath], -- contain sources in case of Hugs
......@@ -150,6 +154,7 @@ emptyInstalledPackageInfo
category = "",
exposed = False,
exposedModules = [],
reexportedModules = [],
hiddenModules = [],
trusted = False,
importDirs = [],
......@@ -247,6 +252,9 @@ installedFieldDescrs = [
, listField "exposed-modules"
disp parseModuleNameQ
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})
......
{-# 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 }
......@@ -109,6 +109,7 @@ 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(..) )
......@@ -269,6 +270,7 @@ instance Text BuildType where
data Library = Library {
exposedModules :: [ModuleName],
reexportedModules :: [ModuleExport ModuleName],
libExposed :: Bool, -- ^ Is the lib to be exposed by default?
libBuildInfo :: BuildInfo
}
......@@ -277,11 +279,13 @@ data Library = Library {
instance Monoid Library where
mempty = Library {
exposedModules = mempty,
reexportedModules = mempty,
libExposed = True,
libBuildInfo = mempty
}
mappend a b = Library {
exposedModules = combine exposedModules,
reexportedModules = combine reexportedModules,
libExposed = libExposed a && libExposed b, -- so False propagates
libBuildInfo = combine libBuildInfo
}
......@@ -308,6 +312,8 @@ withLib pkg_descr f =
maybe (return ()) f (maybeHasLibs pkg_descr)
-- | Get all the module names from the library (exposed and internal modules)
-- which need to be compiled. (This does not include reexports, which
-- do not need to be compiled.)
libModules :: Library -> [ModuleName]
libModules lib = exposedModules lib
++ otherModules (libBuildInfo lib)
......
......@@ -65,6 +65,8 @@ import Distribution.Version
import Distribution.Package
( PackageName(PackageName), packageName, packageVersion
, Dependency(..), pkgName )
import Distribution.ModuleExport
( ModuleExport(..) )
import Distribution.Text
( display, disp )
......@@ -221,7 +223,8 @@ checkLibrary _pkg lib =
]
where
moduleDuplicates = dups (libModules lib)
moduleDuplicates = dups (libModules lib ++
map exportName (reexportedModules lib))
checkExecutable :: PackageDescription -> Executable -> [PackageCheck]
checkExecutable pkg exe =
......@@ -903,6 +906,12 @@ checkCabalVersion pkg =
++ "different modules then list the other ones in the "
++ "'other-languages' field."
-- check use of reexported-modules sections
, checkVersion [1,21] (maybe False (not.null.reexportedModules) (library pkg)) $
PackageDistInexcusable $
"To use the 'reexported-module' field the package needs to specify "
++ "at least 'cabal-version: >= 1.21'."
-- check use of default-extensions field
-- don't need to do the equivalent check for other-extensions
, checkVersion [1,10] (any (not . null) (buildInfoField defaultExtensions)) $
......
......@@ -181,6 +181,9 @@ libFieldDescrs =
[ listFieldWithSep vcat "exposed-modules" disp parseModuleNameQ
exposedModules (\mods lib -> lib{exposedModules=mods})
, commaListFieldWithSep vcat "reexported-modules" disp parse
reexportedModules (\mods lib -> lib{reexportedModules=mods})
, boolField "exposed"
libExposed (\val lib -> lib{libExposed=val})
] ++ map biToLib binfoFieldDescrs
......
......@@ -356,6 +356,7 @@ testSuiteLibV09AsLibAndExe pkg_descr lbi
bi = testBuildInfo test
lib = Library {
exposedModules = [ m ],
reexportedModules = [],
libExposed = True,
libBuildInfo = bi
}
......
......@@ -41,7 +41,8 @@ module Distribution.Simple.Compiler (
unsupportedLanguages,
extensionsToFlags,
unsupportedExtensions,
parmakeSupported
parmakeSupported,
reexportedModulesSupported
) where
import Distribution.Compiler
......@@ -189,9 +190,17 @@ extensionToFlag comp ext = lookup ext (compilerExtensions comp)
-- | Does this compiler support parallel --make mode?
parmakeSupported :: Compiler -> Bool
parmakeSupported comp =
parmakeSupported = ghcSupported "Support parallel --make"
-- | Does this compiler support reexported-modules?
reexportedModulesSupported :: Compiler -> Bool
reexportedModulesSupported = ghcSupported "Support reexported-modules"
-- | Utility function for GHC only features
ghcSupported :: String -> Compiler -> Bool
ghcSupported key comp =
case compilerFlavor comp of
GHC -> case M.lookup "Support parallel --make" (compilerProperties comp) of
GHC -> case M.lookup key (compilerProperties comp) of
Just "YES" -> True
_ -> False
_ -> False
......@@ -47,7 +47,7 @@ import Distribution.Compiler
import Distribution.Simple.Compiler
( CompilerFlavor(..), Compiler(compilerId), compilerFlavor, compilerVersion
, showCompilerId, unsupportedLanguages, unsupportedExtensions
, PackageDB(..), PackageDBStack )
, PackageDB(..), PackageDBStack, reexportedModulesSupported )
import Distribution.Simple.PreProcess ( platformDefines )
import Distribution.Package
( PackageName(PackageName), PackageIdentifier(..), PackageId
......@@ -385,6 +385,11 @@ configure (pkg_descr0, pbi) cfg
++ intercalate ", " [ name ++ "=" ++ display value
| (FlagName name, value) <- flags ]
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"
++ "this feature you probably must use GHC 7.9 or later."
checkPackageProblems verbosity pkg_descr0
(updatePackageDescription pbi pkg_descr)
......
......@@ -65,7 +65,8 @@ mkInstalledPackageId :: Current.PackageIdentifier -> Current.InstalledPackageId
mkInstalledPackageId = Current.InstalledPackageId . display
toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
toCurrent ipi@InstalledPackageInfo{} = Current.InstalledPackageInfo {
toCurrent ipi@InstalledPackageInfo{} =
Current.InstalledPackageInfo {
Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)),
Current.sourcePackageId = convertPackageId (package ipi),
Current.license = convertLicense (license ipi),
......@@ -80,6 +81,7 @@ toCurrent ipi@InstalledPackageInfo{} = Current.InstalledPackageInfo {
Current.category = category ipi,
Current.exposed = exposed ipi,
Current.exposedModules = map convertModuleName (exposedModules ipi),
Current.reexportedModules = [],
Current.hiddenModules = map convertModuleName (hiddenModules ipi),
Current.trusted = Current.trusted Current.emptyInstalledPackageInfo,
Current.importDirs = importDirs ipi,
......
......@@ -100,7 +100,8 @@ convertLicense AllRightsReserved = Current.AllRightsReserved
convertLicense OtherLicense = Current.OtherLicense
toCurrent :: InstalledPackageInfo -> Current.InstalledPackageInfo
toCurrent ipi@InstalledPackageInfo{} = Current.InstalledPackageInfo {
toCurrent ipi@InstalledPackageInfo{} =
Current.InstalledPackageInfo {
Current.installedPackageId = mkInstalledPackageId (convertPackageId (package ipi)),
Current.sourcePackageId = convertPackageId (package ipi),
Current.license = convertLicense (license ipi),
......@@ -115,6 +116,7 @@ toCurrent ipi@InstalledPackageInfo{} = Current.InstalledPackageInfo {
Current.category = category ipi,
Current.exposed = exposed ipi,
Current.exposedModules = map convertModuleName (exposedModules ipi),
Current.reexportedModules = [],
Current.hiddenModules = map convertModuleName (hiddenModules ipi),
Current.trusted = Current.trusted Current.emptyInstalledPackageInfo,
Current.importDirs = importDirs ipi,
......
......@@ -84,6 +84,8 @@ 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.
......@@ -568,9 +570,20 @@ dependencyInconsistencies index =
reallyIsInconsistent _ = True
-- | A rough approximation of GHC's module finder, takes a 'PackageIndex' and
-- turns it into a map from module names to their source packages. It's used to
-- initialize the @build-deps@ field in @cabal init@.
moduleNameIndex :: PackageIndex -> Map ModuleName [InstalledPackageInfo]
moduleNameIndex index =
Map.fromListWith (++)
[ (moduleName, [pkg])
| pkg <- allPackages index
, moduleName <- IPI.exposedModules pkg ]
Map.fromListWith (++) . concat $
[ [(m, [pkg]) | m <- IPI.exposedModules pkg ] ++
[(m', [pkg]) | ModuleExport{ exportOrigName = m
, exportName = m'
} <- IPI.reexportedModules pkg
, m /= m' ]
-- 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 ]
......@@ -274,6 +274,7 @@ generalInstalledPackageInfo adjustRelIncDirs pkg lib clbi installDirs =
IPI.category = category pkg,
IPI.exposed = libExposed lib,
IPI.exposedModules = exposedModules lib,
IPI.reexportedModules = reexportedModules lib,
IPI.hiddenModules = otherModules bi,
IPI.trusted = IPI.trusted IPI.emptyInstalledPackageInfo,
IPI.importDirs = [ libdir installDirs | hasModules ],
......
......@@ -945,6 +945,21 @@ The library section should contain the following fields:
use a flat module namespace or where it is known that the exposed
modules would clash with other common modules.
`reexported-modules:` _exportlist _
: Supported only in GHC 7.10 and later. A list of modules to _reexport_ from
this package. The syntax of this field is `orig-pkg:Name as NewName` to
reexport module `Name` from `orig-pkg` with the new name `NewName`. We also
support abbreviated versions of the syntax: if you omit `as NewName`,
we'll reexport without renaming; if you omit `orig-pkg`, then we will
automatically figure out which package to reexport from, if it's
unambiguous.
Reexported modules are useful for compatibility shims when a package has
been split into multiple packages, and they have the useful property that
if a package provides a module, and another package reexports it under
the same name, these are not considered a conflict (as would be the case
with a stub module.) They can also be used to resolve name conflicts.
The library section may also contain build information fields (see the
section on [build information](#build-information)).
......
......@@ -34,6 +34,7 @@ import PackageTests.TestOptions.Check
import PackageTests.TestStanza.Check
import PackageTests.TestSuiteExeV10.Check
import PackageTests.OrderFlags.Check
import PackageTests.ReexportedModules.Check
import Distribution.Simple.LocalBuildInfo (LocalBuildInfo(..))
import Distribution.Simple.Program.Types (programPath)
......@@ -101,6 +102,8 @@ tests version inplaceSpec ghcPath ghcPkgPath =
(PackageTests.OrderFlags.Check.suite ghcPath)
, hunit "TemplateHaskell/dynamic"
(PackageTests.TemplateHaskell.Check.dynamic ghcPath)
, hunit "ReexportedModules"
(PackageTests.ReexportedModules.Check.suite ghcPath)
] ++
-- These tests are only required to pass on cabal version >= 1.7
(if version >= Version [1, 7] []
......
module PackageTests.ReexportedModules.Check where
import Data.Version
import PackageTests.PackageTester
import System.FilePath
import Test.HUnit
import Data.Maybe
import Data.List
import Control.Monad
import Data.Char
import Text.ParserCombinators.ReadP
orFail :: String -> [(a, String)] -> a
orFail err r = case find (all isSpace . snd) r of
Nothing -> error err
Just (i, _) -> i
suite :: FilePath -> Test
suite ghcPath = TestCase $ do
-- ToDo: Turn this into a utility function
(_, _, xs) <- run Nothing ghcPath ["--info"]
let compat = (>= Version [7,9] [])
. orFail "could not parse version"
. readP_to_S parseVersion
. snd
. fromJust
. find ((=="Project version").fst)
. orFail "could not parse ghc --info output"
. reads
$ xs
when compat $ do
let spec = PackageSpec ("PackageTests" </> "ReexportedModules") []
result <- cabal_build spec ghcPath
assertBuildSucceeded result
name: ReexportedModules
version: 0.1.0.0
license-file: LICENSE
author: Edward Z. Yang
maintainer: ezyang@cs.stanford.edu
build-type: Simple
cabal-version: >=1.21
library
build-depends: base, containers
reexported-modules: containers:Data.Map as DataMap
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