Commit cb906a12 authored by Ian Lynagh's avatar Ian Lynagh
Browse files

Follow Cabal changes

parent e47ddd4e
{-# OPTIONS -cpp #-}
#include "Cabal/Distribution/ModuleName.hs"
-- dummy comment
......@@ -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 \
......
......@@ -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
......@@ -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}
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 ->
......
......@@ -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
......
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