Commit 61997812 authored by Simon Marlow's avatar Simon Marlow

follow changes in Distribution.Simple.PackageIndex API

parent 8f95c6c8
...@@ -223,15 +223,15 @@ doInstall ghc ghcpkg topdir directory distDir ...@@ -223,15 +223,15 @@ doInstall ghc ghcpkg topdir directory distDir
progs' = updateProgram ghcProg progs' = updateProgram ghcProg
$ updateProgram ghcPkgProg progs $ updateProgram ghcPkgProg progs
instInfos <- dump verbosity ghcPkgProg GlobalPackageDB instInfos <- dump verbosity ghcPkgProg GlobalPackageDB
let installedPkgs' = PackageIndex.listToInstalledPackageIndex let installedPkgs' = PackageIndex.fromList instInfos
instInfos
let mlc = libraryConfig lbi let mlc = libraryConfig lbi
mlc' = case mlc of mlc' = case mlc of
Just lc -> Just lc ->
let cipds = componentInstalledPackageDeps lc let cipds = componentPackageDeps lc
cipds' = map (fixupPackageId instInfos) cipds cipds' = [ (fixupPackageId instInfos ipid, pid)
| (ipid,pid) <- cipds ]
in Just $ lc { in Just $ lc {
componentInstalledPackageDeps = cipds' componentPackageDeps = cipds'
} }
Nothing -> Nothing Nothing -> Nothing
lbi' = lbi { lbi' = lbi {
...@@ -335,12 +335,11 @@ generate config_args distdir directory ...@@ -335,12 +335,11 @@ generate config_args distdir directory
-- stricter than gnu ld). Thus we remove the ldOptions for -- stricter than gnu ld). Thus we remove the ldOptions for
-- GHC's rts package: -- GHC's rts package:
hackRtsPackage index = hackRtsPackage index =
case PackageIndex.lookupInstalledPackageByName index (PackageName "rts") of case PackageIndex.lookupPackageName index (PackageName "rts") of
[rts] -> PackageIndex.addToInstalledPackageIndex rts { Installed.ldOptions = [] } index [(_,[rts])] -> PackageIndex.insert rts{ Installed.ldOptions = [] } index
_ -> error "No (or multiple) ghc rts package is registered!!" _ -> error "No (or multiple) ghc rts package is registered!!"
dep_ids = map (packageId.getLocalPackageInfo lbi) $ dep_ids = map snd (externalPackageDeps lbi)
externalPackageDeps lbi
let variablePrefix = directory ++ '_':distdir let variablePrefix = directory ++ '_':distdir
let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)), let xs = [variablePrefix ++ "_VERSION = " ++ display (pkgVersion (package pd)),
......
...@@ -890,7 +890,7 @@ showPackageDot verbosity myflags = do ...@@ -890,7 +890,7 @@ showPackageDot verbosity myflags = do
getPkgDatabases verbosity False True{-use cache-} myflags getPkgDatabases verbosity False True{-use cache-} myflags
let all_pkgs = allPackagesInStack flag_db_stack let all_pkgs = allPackagesInStack flag_db_stack
ipix = PackageIndex.listToInstalledPackageIndex all_pkgs ipix = PackageIndex.fromList all_pkgs
putStrLn "digraph {" putStrLn "digraph {"
let quote s = '"':s ++ "\"" let quote s = '"':s ++ "\""
...@@ -898,7 +898,7 @@ showPackageDot verbosity myflags = do ...@@ -898,7 +898,7 @@ showPackageDot verbosity myflags = do
| p <- all_pkgs, | p <- all_pkgs,
let from = display (sourcePackageId p), let from = display (sourcePackageId p),
depid <- depends p, depid <- depends p,
Just dep <- [PackageIndex.lookupInstalledPackage ipix depid], Just dep <- [PackageIndex.lookupInstalledPackageId ipix depid],
let to = display (sourcePackageId dep) let to = display (sourcePackageId dep)
] ]
putStrLn "}" putStrLn "}"
......
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