[commit: ghc] wip/cabal-head-updates: Update to Cabal head, update ghc-pkg to use new module re-export types (74e7770)
git at git.haskell.org
git at git.haskell.org
Fri Aug 29 13:26:15 UTC 2014
Repository : ssh://git@git.haskell.org/ghc
On branch : wip/cabal-head-updates
Link : http://ghc.haskell.org/trac/ghc/changeset/74e777023482ad6ab3ce493ae5467c8b98aefdeb/ghc
>---------------------------------------------------------------
commit 74e777023482ad6ab3ce493ae5467c8b98aefdeb
Author: Duncan Coutts <duncan at well-typed.com>
Date: Fri Aug 29 13:53:52 2014 +0100
Update to Cabal head, update ghc-pkg to use new module re-export types
The main change is that Cabal changed the representation of module
re-exports to distinguish reexports in source .cabal files versus
re-exports in installed package registraion files.
Cabal now also does the resolution of re-exports to specific installed
packages itself, so ghc-pkg no longer has to do this. This is a cleaner
design overall because re-export resolution can fail so it is better to
do it during package configuration rather than package registration.
It also simplifies the re-export representation that ghc-pkg has to use.
>---------------------------------------------------------------
74e777023482ad6ab3ce493ae5467c8b98aefdeb
libraries/Cabal | 2 +-
utils/ghc-cabal/Main.hs | 12 +++-----
utils/ghc-pkg/Main.hs | 82 +++++++++++++------------------------------------
3 files changed, 28 insertions(+), 68 deletions(-)
diff --git a/libraries/Cabal b/libraries/Cabal
index 8d59dc9..2ce3838 160000
--- a/libraries/Cabal
+++ b/libraries/Cabal
@@ -1 +1 @@
-Subproject commit 8d59dc9fba584a9fdb810f4d84f7f3ccb089dd08
+Subproject commit 2ce3838f97f66f03e952333f8c23129f00ebf6cb
diff --git a/utils/ghc-cabal/Main.hs b/utils/ghc-cabal/Main.hs
index 47eb1de..fc97111 100644
--- a/utils/ghc-cabal/Main.hs
+++ b/utils/ghc-cabal/Main.hs
@@ -346,13 +346,11 @@ generate directory distdir dll0Modules config_args
withLibLBI pd lbi $ \lib clbi ->
do cwd <- getCurrentDirectory
let ipid = InstalledPackageId (display (packageId pd) ++ "-inplace")
- let installedPkgInfo = inplaceInstalledPackageInfo cwd distdir
- pd lib lbi clbi
- final_ipi = installedPkgInfo {
- Installed.installedPackageId = ipid,
- Installed.haddockHTMLs = []
- }
- content = Installed.showInstalledPackageInfo final_ipi ++ "\n"
+ let installedPkgInfo = (inplaceInstalledPackageInfo cwd distdir
+ pd ipid lib lbi clbi)
+ { Installed.haddockHTMLs = [] }
+ content = Installed.showInstalledPackageInfo installedPkgInfo
+ ++ "\n"
writeFileAtomic (distdir </> "inplace-pkg-config") (BS.pack $ toUTF8 content)
let
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index ac958da..4d4f8e9 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -20,8 +20,7 @@ import Distribution.InstalledPackageInfo as Cabal
import Distribution.License
import Distribution.Compat.ReadP hiding (get)
import Distribution.ParseUtils
-import Distribution.ModuleExport
-import Distribution.Package hiding (depends)
+import Distribution.Package hiding (depends, installedPackageId)
import Distribution.Text
import Distribution.Version
import Distribution.Simple.Utils (fromUTF8, toUTF8)
@@ -38,8 +37,6 @@ import System.Console.GetOpt
import qualified Control.Exception as Exception
import Data.Maybe
-import qualified Data.Set as Set
-
import Data.Char ( isSpace, toLower )
import Data.Ord (comparing)
import Control.Applicative (Applicative(..))
@@ -899,9 +896,6 @@ registerPackage input verbosity my_flags auto_ghci_libs multi_instance
validatePackageConfig pkg_expanded verbosity truncated_stack
auto_ghci_libs multi_instance update force
- -- postprocess the package
- pkg' <- resolveReexports truncated_stack pkg
-
let
-- In the normal mode, we only allow one version of each package, so we
-- remove all instances with the same source package id as the one we're
@@ -912,7 +906,7 @@ registerPackage input verbosity my_flags auto_ghci_libs multi_instance
p <- packages db_to_operate_on,
sourcePackageId p == sourcePackageId pkg ]
--
- changeDB verbosity (removes ++ [AddPackage pkg']) db_to_operate_on
+ changeDB verbosity (removes ++ [AddPackage pkg]) db_to_operate_on
parsePackageInfo
:: String
@@ -935,47 +929,6 @@ mungePackageInfo ipi = ipi { packageKey = packageKey' }
= OldPackageKey (sourcePackageId ipi)
| otherwise = packageKey ipi
--- | Takes the "reexported-modules" field of an InstalledPackageInfo
--- and resolves the references so they point to the original exporter
--- of a module (i.e. the module is in exposed-modules, not
--- reexported-modules). This is done by maintaining an invariant on
--- the installed package database that a reexported-module field always
--- points to the original exporter.
-resolveReexports :: PackageDBStack
- -> InstalledPackageInfo
- -> IO InstalledPackageInfo
-resolveReexports db_stack pkg = do
- let dep_mask = Set.fromList (depends pkg)
- deps = filter (flip Set.member dep_mask . installedPackageId)
- (allPackagesInStack db_stack)
- matchExposed pkg_dep m = map ((,) (installedPackageId pkg_dep))
- (filter (==m) (exposedModules pkg_dep))
- worker ModuleExport{ exportOrigPackageName = Just pnm } pkg_dep
- | pnm /= packageName (sourcePackageId pkg_dep) = []
- -- Now, either the package matches, *or* we were asked to search the
- -- true location ourselves.
- worker ModuleExport{ exportOrigName = m } pkg_dep =
- matchExposed pkg_dep m ++
- map (fromMaybe (error $ "Impossible! Missing true location in " ++
- display (installedPackageId pkg_dep))
- . exportCachedTrueOrig)
- (filter ((==m) . exportName) (reexportedModules pkg_dep))
- self_reexports ModuleExport{ exportOrigPackageName = Just pnm }
- | pnm /= packageName (sourcePackageId pkg) = []
- self_reexports ModuleExport{ exportName = m', exportOrigName = m }
- -- Self-reexport without renaming doesn't make sense
- | m == m' = []
- -- *Only* match against exposed modules!
- | otherwise = matchExposed pkg m
-
- r <- forM (reexportedModules pkg) $ \me -> do
- case nub (concatMap (worker me) deps ++ self_reexports me) of
- [c] -> return me { exportCachedTrueOrig = Just c }
- [] -> die $ "Couldn't resolve reexport " ++ display me
- cs -> die $ "Found multiple possible ways to resolve reexport " ++
- display me ++ ": " ++ show cs
- return (pkg { reexportedModules = r })
-
-- -----------------------------------------------------------------------------
-- Making changes to a package database
@@ -1068,16 +1021,25 @@ convertPackageInfoToCacheFormat pkg =
GhcPkg.haddockHTMLs = haddockHTMLs pkg,
GhcPkg.exposedModules = exposedModules pkg,
GhcPkg.hiddenModules = hiddenModules pkg,
- GhcPkg.reexportedModules = [ GhcPkg.ModuleExport m ipid' m'
- | ModuleExport {
- exportName = m,
- exportCachedTrueOrig =
- Just (InstalledPackageId ipid', m')
- } <- reexportedModules pkg
- ],
+ GhcPkg.reexportedModules = map convertModuleReexport
+ (reexportedModules pkg),
GhcPkg.exposed = exposed pkg,
GhcPkg.trusted = trusted pkg
}
+ where
+ convertModuleReexport :: ModuleReexport
+ -> GhcPkg.ModuleExport String ModuleName
+ convertModuleReexport
+ ModuleReexport {
+ moduleReexportName = m,
+ moduleReexportDefiningPackage = ipid',
+ moduleReexportDefiningName = m'
+ }
+ = GhcPkg.ModuleExport {
+ exportModuleName = m,
+ exportOriginalPackageId = display ipid',
+ exportOriginalModuleName = m'
+ }
instance GhcPkg.BinaryStringRep ModuleName where
fromStringRep = ModuleName.fromString . fromUTF8 . BS.unpack
@@ -2128,10 +2090,10 @@ instance Binary ModuleName where
put = put . display
get = fmap ModuleName.fromString get
-instance Binary m => Binary (ModuleExport m) where
- put (ModuleExport a b c d) = do put a; put b; put c; put d
- get = do a <- get; b <- get; c <- get; d <- get;
- return (ModuleExport a b c d)
+instance Binary ModuleReexport where
+ put (ModuleReexport a b c) = do put a; put b; put c
+ get = do a <- get; b <- get; c <- get
+ return (ModuleReexport a b c)
instance Binary PackageKey where
put (PackageKey a b c) = do putWord8 0; put a; put b; put c
More information about the ghc-commits
mailing list