Follow Cabal changes
authorIan Lynagh <igloo@earth.li>
Sun, 29 Jun 2008 21:16:33 +0000 (21:16 +0000)
committerIan Lynagh <igloo@earth.li>
Sun, 29 Jun 2008 21:16:33 +0000 (21:16 +0000)
compat/Distribution/ModuleName.hs [new file with mode: 0644]
compat/compat.mk
compiler/main/PackageConfig.hs
compiler/main/Packages.lhs
libraries/installPackage.hs
utils/ghc-pkg/Main.hs

diff --git a/compat/Distribution/ModuleName.hs b/compat/Distribution/ModuleName.hs
new file mode 100644 (file)
index 0000000..24db2a0
--- /dev/null
@@ -0,0 +1,3 @@
+{-# OPTIONS -cpp #-}
+#include "Cabal/Distribution/ModuleName.hs"
+-- dummy comment
index efd35b6..c2bfeb1 100644 (file)
@@ -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 \
index d5569c4..a93a7e5 100644 (file)
@@ -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
index 41a760a..d468b79 100644 (file)
@@ -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}
index 8c66009..65eab56 100644 (file)
@@ -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 ->
index 91c8ade..a876243 100644 (file)
@@ -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