From cb906a124e36cb5054784a5bc44eb9d099d20709 Mon Sep 17 00:00:00 2001 From: Ian Lynagh Date: Sun, 29 Jun 2008 21:16:33 +0000 Subject: [PATCH] Follow Cabal changes --- compat/Distribution/ModuleName.hs | 3 +++ compat/compat.mk | 1 + compiler/main/PackageConfig.hs | 26 ++++++++++++++++++++++++-- compiler/main/Packages.lhs | 10 ++++------ libraries/installPackage.hs | 5 ++++- utils/ghc-pkg/Main.hs | 24 +++++++++++++++++++++--- 6 files changed, 57 insertions(+), 12 deletions(-) create mode 100644 compat/Distribution/ModuleName.hs diff --git a/compat/Distribution/ModuleName.hs b/compat/Distribution/ModuleName.hs new file mode 100644 index 0000000..24db2a0 --- /dev/null +++ b/compat/Distribution/ModuleName.hs @@ -0,0 +1,3 @@ +{-# OPTIONS -cpp #-} +#include "Cabal/Distribution/ModuleName.hs" +-- dummy comment diff --git a/compat/compat.mk b/compat/compat.mk index efd35b6..c2bfeb1 100644 --- a/compat/compat.mk +++ b/compat/compat.mk @@ -43,6 +43,7 @@ SRC_MKDEPENDHS_OPTS += \ -optdep--exclude-module=Distribution.GetOpt \ -optdep--exclude-module=Distribution.InstalledPackageInfo \ -optdep--exclude-module=Distribution.License \ + -optdep--exclude-module=Distribution.ModuleName \ -optdep--exclude-module=Distribution.Package \ -optdep--exclude-module=Distribution.ParseUtils \ -optdep--exclude-module=Distribution.Compiler \ diff --git a/compiler/main/PackageConfig.hs b/compiler/main/PackageConfig.hs index d5569c4..a93a7e5 100644 --- a/compiler/main/PackageConfig.hs +++ b/compiler/main/PackageConfig.hs @@ -12,22 +12,26 @@ module PackageConfig ( Version(..), PackageIdentifier(..), defaultPackageConfig, + packageConfigToInstalledPackageInfo, + installedPackageInfoToPackageConfig, ) where #include "HsVersions.h" +import Data.Maybe import Module import Distribution.InstalledPackageInfo +import Distribution.ModuleName import Distribution.Package import Distribution.Text import Distribution.Version -import Distribution.Compat.ReadP ( readP_to_S ) +import Distribution.Compat.ReadP -- ----------------------------------------------------------------------------- -- Our PackageConfig type is just InstalledPackageInfo from Cabal. Later we -- might need to extend it with some GHC-specific stuff, but for now it's fine. -type PackageConfig = InstalledPackageInfo_ ModuleName +type PackageConfig = InstalledPackageInfo_ Module.ModuleName defaultPackageConfig :: PackageConfig defaultPackageConfig = emptyInstalledPackageInfo @@ -57,3 +61,21 @@ unpackPackageId p [] -> Nothing (pid:_) -> Just pid where str = packageIdString p + +packageConfigToInstalledPackageInfo :: PackageConfig -> InstalledPackageInfo +packageConfigToInstalledPackageInfo + (pkgconf@(InstalledPackageInfo { exposedModules = e, + hiddenModules = h })) = + pkgconf{ exposedModules = map convert e, + hiddenModules = map convert h } + where convert :: Module.ModuleName -> Distribution.ModuleName.ModuleName + convert = fromJust . simpleParse . moduleNameString + +installedPackageInfoToPackageConfig :: InstalledPackageInfo -> PackageConfig +installedPackageInfoToPackageConfig + (pkgconf@(InstalledPackageInfo { exposedModules = e, + hiddenModules = h })) = + pkgconf{ exposedModules = map convert e, + hiddenModules = map convert h } + where convert :: Distribution.ModuleName.ModuleName -> Module.ModuleName + convert = mkModuleName . display diff --git a/compiler/main/Packages.lhs b/compiler/main/Packages.lhs index 41a760a..d468b79 100644 --- a/compiler/main/Packages.lhs +++ b/compiler/main/Packages.lhs @@ -49,6 +49,7 @@ import Outputable import System.Environment ( getEnv ) import Distribution.InstalledPackageInfo hiding (depends) import Distribution.Package hiding (depends) +import Distribution.Text import Distribution.Version import FastString import ErrUtils ( debugTraceMsg, putMsg, Message ) @@ -723,10 +724,7 @@ dumpPackages :: DynFlags -> IO () dumpPackages dflags = do let pkg_map = pkgIdMap (pkgState dflags) putMsg dflags $ - vcat (map (text.showInstalledPackageInfo.to_ipi) (eltsUFM pkg_map)) - where - to_ipi pkgconf@(InstalledPackageInfo { exposedModules = e, - hiddenModules = h }) = - pkgconf{ exposedModules = map moduleNameString e, - hiddenModules = map moduleNameString h } + vcat (map (text . showInstalledPackageInfo + . packageConfigToInstalledPackageInfo) + (eltsUFM pkg_map)) \end{code} diff --git a/libraries/installPackage.hs b/libraries/installPackage.hs index 8c66009..65eab56 100644 --- a/libraries/installPackage.hs +++ b/libraries/installPackage.hs @@ -1,4 +1,5 @@ +import Data.Maybe import Distribution.PackageDescription import Distribution.PackageDescription.Parse import Distribution.ReadE @@ -8,6 +9,7 @@ import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program import Distribution.Simple.Setup import Distribution.Simple.Utils +import Distribution.Text import Distribution.Verbosity import System.Environment @@ -63,7 +65,8 @@ doInstall verbosity ghcpkg ghcpkgconf destdir topdir pd_reg = if packageName pd == PackageName "ghc-prim" then case library pd of Just lib -> - let ems = "GHC.Prim" : exposedModules lib + let ems = fromJust (simpleParse "GHC.Prim") + : exposedModules lib lib' = lib { exposedModules = ems } in pd { library = Just lib' } Nothing -> diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs index 91c8ade..a876243 100644 --- a/utils/ghc-pkg/Main.hs +++ b/utils/ghc-pkg/Main.hs @@ -445,7 +445,7 @@ getPkgDatabases modify flags = do readParseDatabase :: PackageDBName -> IO (PackageDBName,PackageDB) readParseDatabase filename = do str <- readFile filename `Exception.catch` \_ -> return emptyPackageConfig - let packages = read str + let packages = map convertPackageInfoIn $ read str Exception.evaluate packages `Exception.catch` \e-> die ("error while parsing " ++ filename ++ ": " ++ show e) @@ -555,7 +555,7 @@ listPackages flags mPackageName mModuleName = do EQ -> pkgVersion p1 `compare` pkgVersion p2 where (p1,p2) = (package pkg1, package pkg2) - match `exposedInPkg` pkg = any match (exposedModules pkg) + match `exposedInPkg` pkg = any match (map display $ exposedModules pkg) pkg_map = map (\p -> (package p, p)) $ concatMap snd db_stack show_func = if simple_output then show_simple else mapM_ (show_normal pkg_map) @@ -735,6 +735,23 @@ isBrokenPackage pkg pkg_map -- ----------------------------------------------------------------------------- -- Manipulating package.conf files +type InstalledPackageInfoString = InstalledPackageInfo_ String + +convertPackageInfoOut :: InstalledPackageInfo -> InstalledPackageInfoString +convertPackageInfoOut + (pkgconf@(InstalledPackageInfo { exposedModules = e, + hiddenModules = h })) = + pkgconf{ exposedModules = map display e, + hiddenModules = map display h } + +convertPackageInfoIn :: InstalledPackageInfoString -> InstalledPackageInfo +convertPackageInfoIn + (pkgconf@(InstalledPackageInfo { exposedModules = e, + hiddenModules = h })) = + pkgconf{ exposedModules = map convert e, + hiddenModules = map convert h } + where convert = fromJust . simpleParse + writeNewConfig :: FilePath -> [InstalledPackageInfo] -> IO () writeNewConfig filename packages = do hPutStr stdout "Writing new package config file... " @@ -743,7 +760,8 @@ writeNewConfig filename packages = do if isPermissionError e then die (filename ++ ": you don't have permission to modify this file") else ioError e - let shown = concat $ intersperse ",\n " $ map show packages + let shown = concat $ intersperse ",\n " + $ map (show . convertPackageInfoOut) packages fileContents = "[" ++ shown ++ "\n]" hPutStrLn h fileContents hClose h -- 1.7.10.4