--- /dev/null
+{-# OPTIONS -cpp #-}
+#include "Cabal/Distribution/ModuleName.hs"
+-- dummy comment
-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 \
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
[] -> 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
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 )
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
import Distribution.Simple.Program
import Distribution.Simple.Setup
import Distribution.Simple.Utils
+import Distribution.Text
import Distribution.Verbosity
import System.Environment
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 ->
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)
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)
-- -----------------------------------------------------------------------------
-- 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... "
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