Commit d94ddc0e authored by Edward Z. Yang's avatar Edward Z. Yang
Browse files

Refactor LocalBuildInfo interface.



This is an omnibus patch, with the overall goal of making
LocalBuildInfo Great Again.  The essential ideas:

* New type 'TargetInfo' which bundles together 'ComponentLocalBuildInfo'
  and 'Component'.  Eventually, it will also record file paths / module
  targets.  This data structure is basically what you want; a lot of
  old Cabal code did lots of gyrations converting from
  'ComponentLocalBuildInfo' to 'Component' and vice versa, now
  it's all centralized.

* The "new" API for 'LocalBuildInfo' is in
  "Distribution.Types.LocalBuildInfo".  The general principle
  is, where we previous dealt in 'ComponentLocalBuildInfo',
  we now deal in 'TargetInfo'.  There are shockingly few
  functions we need!

* I've restored 'componentsConfigs' to its Cabal 1.24 signature
  for BC.

* I killed a number of unused functions from "Distribution.Simple.LocalBuildInfo":
  'getLocalComponent', 'maybeGetDefaultLibraryLocalBuildInfo',
  'maybeGetComponentLocalBuildInfo', 'checkComponentsCyclic' and
  'enabledComponents'.  For each I checked on Hackage that they were
  not used.

* 'getComponentLocalBuildInfo', 'withComponentsInBuildOrder' and
  'componentsInBuildOrder' are deprecated to encourage people
  to instead use the 'TargetInfo's to finger which components
  they want built.

* 'ComponentLocalBuildInfo' now stores internally the computed
  'componentInternalDeps', so that 'LocalBuildInfo' can simply store
  a graph of 'ComponentLocalBuildInfo'.

* The code in Configure has been streamlined to use our new Graph
  data type to great success.

* The type of 'runTest' changed to take a 'ComponentLocalBuildInfo',
  bringing it more in line with everything else.

* New function 'readTargetInfos' which combines 'readBuildTargets'
  and 'checkBuildTargets', which is what you really wanted anyway.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent 6305156f
...@@ -370,6 +370,7 @@ library ...@@ -370,6 +370,7 @@ library
Distribution.Types.ComponentLocalBuildInfo Distribution.Types.ComponentLocalBuildInfo
Distribution.Types.LocalBuildInfo Distribution.Types.LocalBuildInfo
Distribution.Types.ComponentEnabledSpec Distribution.Types.ComponentEnabledSpec
Distribution.Types.TargetInfo
Distribution.Utils.NubList Distribution.Utils.NubList
Distribution.Verbosity Distribution.Verbosity
Distribution.Version Distribution.Version
......
...@@ -23,6 +23,9 @@ module Distribution.Simple.Build ( ...@@ -23,6 +23,9 @@ module Distribution.Simple.Build (
writeAutogenFiles, writeAutogenFiles,
) where ) where
import Distribution.Types.LocalBuildInfo
import Distribution.Types.TargetInfo
import Distribution.Package import Distribution.Package
import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS import qualified Distribution.Simple.GHCJS as GHCJS
...@@ -56,12 +59,14 @@ import Distribution.System ...@@ -56,12 +59,14 @@ import Distribution.System
import Distribution.Text import Distribution.Text
import Distribution.Verbosity import Distribution.Verbosity
import Distribution.Compat.Graph (IsNode(..))
import qualified Data.Map as Map import qualified Data.Map as Map
import qualified Data.Set as Set import qualified Data.Set as Set
import Data.List import Data.List
( intersect ) ( intersect )
import Control.Monad import Control.Monad
( when, unless ) ( when, unless, forM_ )
import System.FilePath import System.FilePath
( (</>), (<.>) ) ( (</>), (<.>) )
import System.Directory import System.Directory
...@@ -80,18 +85,17 @@ build pkg_descr lbi flags suffixes ...@@ -80,18 +85,17 @@ build pkg_descr lbi flags suffixes
-- TODO: if checkBuildTargets ignores a target we may accept -- TODO: if checkBuildTargets ignores a target we may accept
-- a --assume-deps-up-to-date with multiple arguments. Arguably, we should -- a --assume-deps-up-to-date with multiple arguments. Arguably, we should
-- error early in this case. -- error early in this case.
targets <- readBuildTargets pkg_descr (buildArgs flags) target <- readTargetInfos verbosity lbi (buildArgs flags) >>= \r -> case r of
(cname, _) <- checkBuildTargets verbosity pkg_descr lbi targets >>= \r -> case r of [] -> die "In --assume-deps-up-to-date mode you must specify a target"
[] -> die "In --assume-deps-up-to-date mode you must specify a target" [target] -> return target
[target'] -> return target' _ -> die "In --assume-deps-up-to-date mode you can only build a single target"
_ -> die "In --assume-deps-up-to-date mode you can only build a single target"
-- NB: do NOT 'createInternalPackageDB'; we don't want to delete it. -- NB: do NOT 'createInternalPackageDB'; we don't want to delete it.
-- But this means we have to be careful about unregistering -- But this means we have to be careful about unregistering
-- ourselves. -- ourselves.
let dbPath = internalPackageDBPath lbi distPref let dbPath = internalPackageDBPath lbi distPref
internalPackageDB = SpecificPackageDB dbPath internalPackageDB = SpecificPackageDB dbPath
clbi = getComponentLocalBuildInfo lbi cname clbi = targetCLBI target
comp = getComponent pkg_descr cname comp = targetComponent target
-- TODO: do we need to unregister libraries? In any case, this would -- TODO: do we need to unregister libraries? In any case, this would
-- need to be done in the buildLib functionality. -- need to be done in the buildLib functionality.
-- Do the build -- Do the build
...@@ -105,11 +109,12 @@ build pkg_descr lbi flags suffixes ...@@ -105,11 +109,12 @@ build pkg_descr lbi flags suffixes
buildComponent verbosity (buildNumJobs flags) pkg_descr buildComponent verbosity (buildNumJobs flags) pkg_descr
lbi' suffixes comp clbi distPref lbi' suffixes comp clbi distPref
| otherwise = do | otherwise = do
targets <- readBuildTargets pkg_descr (buildArgs flags) targets <- readTargetInfos verbosity lbi (buildArgs flags)
targets' <- checkBuildTargets verbosity pkg_descr lbi targets let componentsToBuild = neededTargetsInBuildOrder lbi (map nodeKey targets)
let componentsToBuild = componentsInBuildOrder lbi (map fst targets')
info verbosity $ "Component build order: " info verbosity $ "Component build order: "
++ intercalate ", " (map (showComponentName . componentLocalName) componentsToBuild) ++ intercalate ", "
(map (showComponentName . componentLocalName . targetCLBI)
componentsToBuild)
when (null targets) $ when (null targets) $
-- Only bother with this message if we're building the whole package -- Only bother with this message if we're building the whole package
...@@ -117,8 +122,9 @@ build pkg_descr lbi flags suffixes ...@@ -117,8 +122,9 @@ build pkg_descr lbi flags suffixes
internalPackageDB <- createInternalPackageDB verbosity lbi distPref internalPackageDB <- createInternalPackageDB verbosity lbi distPref
-- TODO: we're computing this twice, do it once! forM_ componentsToBuild $ \target -> do
withComponentsInBuildOrder pkg_descr lbi (map fst targets') $ \comp clbi -> do let comp = targetComponent target
clbi = targetCLBI target
initialBuildSteps distPref pkg_descr lbi clbi verbosity initialBuildSteps distPref pkg_descr lbi clbi verbosity
let bi = componentBuildInfo comp let bi = componentBuildInfo comp
progs' = addInternalBuildTools pkg_descr lbi bi (withPrograms lbi) progs' = addInternalBuildTools pkg_descr lbi bi (withPrograms lbi)
...@@ -143,18 +149,16 @@ repl pkg_descr lbi flags suffixes args = do ...@@ -143,18 +149,16 @@ repl pkg_descr lbi flags suffixes args = do
let distPref = fromFlag (replDistPref flags) let distPref = fromFlag (replDistPref flags)
verbosity = fromFlag (replVerbosity flags) verbosity = fromFlag (replVerbosity flags)
targets <- readBuildTargets pkg_descr args target <- readTargetInfos verbosity lbi args >>= \r -> case r of
targets' <- case targets of
-- This seems DEEPLY questionable. -- This seems DEEPLY questionable.
[] -> return $ take 1 [ componentName c [] -> return (head (allTargetsInBuildOrder lbi))
| c <- pkgBuildableComponents pkg_descr ] [target] -> return target
[target] -> fmap (map fst) (checkBuildTargets verbosity pkg_descr lbi [target])
_ -> die $ "The 'repl' command does not support multiple targets at once." _ -> die $ "The 'repl' command does not support multiple targets at once."
let componentsToBuild = componentsInBuildOrder lbi targets' let componentsToBuild = neededTargetsInBuildOrder lbi [nodeKey target]
componentForRepl = last componentsToBuild
debug verbosity $ "Component build order: " debug verbosity $ "Component build order: "
++ intercalate ", " ++ intercalate ", "
[ showComponentName (componentLocalName clbi) | clbi <- componentsToBuild ] (map (showComponentName . componentLocalName . targetCLBI)
componentsToBuild)
internalPackageDB <- createInternalPackageDB verbosity lbi distPref internalPackageDB <- createInternalPackageDB verbosity lbi distPref
...@@ -167,18 +171,17 @@ repl pkg_descr lbi flags suffixes args = do ...@@ -167,18 +171,17 @@ repl pkg_descr lbi flags suffixes args = do
-- build any dependent components -- build any dependent components
sequence_ sequence_
[ do let cname = componentLocalName clbi [ do let clbi = targetCLBI subtarget
comp = getComponent pkg_descr cname comp = targetComponent subtarget
lbi' = lbiForComponent comp lbi lbi' = lbiForComponent comp lbi
initialBuildSteps distPref pkg_descr lbi clbi verbosity initialBuildSteps distPref pkg_descr lbi clbi verbosity
buildComponent verbosity NoFlag buildComponent verbosity NoFlag
pkg_descr lbi' suffixes comp clbi distPref pkg_descr lbi' suffixes comp clbi distPref
| clbi <- init componentsToBuild ] | subtarget <- init componentsToBuild ]
-- REPL for target components -- REPL for target components
let clbi = componentForRepl let clbi = targetCLBI target
cname = componentLocalName clbi comp = targetComponent target
comp = getComponent pkg_descr cname
lbi' = lbiForComponent comp lbi lbi' = lbiForComponent comp lbi
initialBuildSteps distPref pkg_descr lbi clbi verbosity initialBuildSteps distPref pkg_descr lbi clbi verbosity
replComponent verbosity pkg_descr lbi' suffixes comp clbi distPref replComponent verbosity pkg_descr lbi' suffixes comp clbi distPref
...@@ -423,6 +426,7 @@ testSuiteLibV09AsLibAndExe pkg_descr ...@@ -423,6 +426,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
compat_key = computeCompatPackageKey (compiler lbi) compat_name pkg_ver (componentUnitId clbi) compat_key = computeCompatPackageKey (compiler lbi) compat_name pkg_ver (componentUnitId clbi)
libClbi = LibComponentLocalBuildInfo libClbi = LibComponentLocalBuildInfo
{ componentPackageDeps = componentPackageDeps clbi { componentPackageDeps = componentPackageDeps clbi
, componentInternalDeps = componentInternalDeps clbi
, componentLocalName = CSubLibName (testName test) , componentLocalName = CSubLibName (testName test)
, componentIsPublic = False , componentIsPublic = False
, componentIncludes = componentIncludes clbi , componentIncludes = componentIncludes clbi
...@@ -462,6 +466,7 @@ testSuiteLibV09AsLibAndExe pkg_descr ...@@ -462,6 +466,7 @@ testSuiteLibV09AsLibAndExe pkg_descr
-- TODO: this is a hack, but as long as this is unique -- TODO: this is a hack, but as long as this is unique
-- (doesn't clobber something) we won't run into trouble -- (doesn't clobber something) we won't run into trouble
componentUnitId = mkUnitId (stubName test), componentUnitId = mkUnitId (stubName test),
componentInternalDeps = [componentUnitId clbi],
componentLocalName = CExeName (stubName test), componentLocalName = CExeName (stubName test),
componentPackageDeps = deps, componentPackageDeps = deps,
componentIncludes = zip (map fst deps) (repeat defaultRenaming) componentIncludes = zip (map fst deps) (repeat defaultRenaming)
...@@ -484,6 +489,7 @@ benchmarkExeV10asExe bm@Benchmark { benchmarkInterface = BenchmarkExeV10 _ f } ...@@ -484,6 +489,7 @@ benchmarkExeV10asExe bm@Benchmark { benchmarkInterface = BenchmarkExeV10 _ f }
exeClbi = ExeComponentLocalBuildInfo { exeClbi = ExeComponentLocalBuildInfo {
componentUnitId = componentUnitId clbi, componentUnitId = componentUnitId clbi,
componentLocalName = CExeName (benchmarkName bm), componentLocalName = CExeName (benchmarkName bm),
componentInternalDeps = componentInternalDeps clbi,
componentPackageDeps = componentPackageDeps clbi, componentPackageDeps = componentPackageDeps clbi,
componentIncludes = componentIncludes clbi componentIncludes = componentIncludes clbi
} }
......
...@@ -10,10 +10,11 @@ ...@@ -10,10 +10,11 @@
-- Handling for user-specified build targets -- Handling for user-specified build targets
----------------------------------------------------------------------------- -----------------------------------------------------------------------------
module Distribution.Simple.BuildTarget ( module Distribution.Simple.BuildTarget (
-- * Main interface
readTargetInfos,
-- * Build targets -- * Build targets
BuildTarget(..), BuildTarget(..),
readBuildTargets,
showBuildTarget, showBuildTarget,
QualLevel(..), QualLevel(..),
buildTargetComponentName, buildTargetComponentName,
...@@ -29,11 +30,11 @@ module Distribution.Simple.BuildTarget ( ...@@ -29,11 +30,11 @@ module Distribution.Simple.BuildTarget (
resolveBuildTargets, resolveBuildTargets,
BuildTargetProblem(..), BuildTargetProblem(..),
reportBuildTargetProblems, reportBuildTargetProblems,
-- * Checking build targets
checkBuildTargets
) where ) where
import Distribution.Types.TargetInfo
import Distribution.Types.LocalBuildInfo
import Distribution.Package import Distribution.Package
import Distribution.PackageDescription import Distribution.PackageDescription
import Distribution.ModuleName import Distribution.ModuleName
...@@ -65,6 +66,13 @@ import System.FilePath as FilePath ...@@ -65,6 +66,13 @@ import System.FilePath as FilePath
import System.Directory import System.Directory
( doesFileExist, doesDirectoryExist ) ( doesFileExist, doesDirectoryExist )
-- | Take a list of 'String' build targets, and parse and validate them
-- into actual 'TargetInfo's to be built/registered/whatever.
readTargetInfos :: Verbosity -> LocalBuildInfo -> [String] -> IO [TargetInfo]
readTargetInfos verbosity lbi args = do
build_targets <- readBuildTargets (localPkgDescr lbi) args
checkBuildTargets verbosity lbi build_targets
-- ------------------------------------------------------------ -- ------------------------------------------------------------
-- * User build targets -- * User build targets
-- ------------------------------------------------------------ -- ------------------------------------------------------------
...@@ -951,17 +959,16 @@ caseFold = lowercase ...@@ -951,17 +959,16 @@ caseFold = lowercase
-- --
-- Also swizzle into a more convenient form. -- Also swizzle into a more convenient form.
-- --
checkBuildTargets :: Verbosity -> PackageDescription -> LocalBuildInfo -> [BuildTarget] checkBuildTargets :: Verbosity -> LocalBuildInfo -> [BuildTarget]
-> IO [(ComponentName, Maybe (Either ModuleName FilePath))] -> IO [TargetInfo]
checkBuildTargets _ pkg lbi [] = checkBuildTargets _ lbi [] =
return [ (componentName c, Nothing) | c <- enabledComponents pkg lbi ] return (allTargetsInBuildOrder lbi)
checkBuildTargets verbosity pkg lbi targets = do checkBuildTargets verbosity lbi targets = do
let (enabled, disabled) = let (enabled, disabled) =
partitionEithers partitionEithers
[ case componentDisabledReason (componentEnabledSpec lbi) [ case componentNameDisabledReason (componentEnabledSpec lbi) cname of
(getComponent pkg cname) of
Nothing -> Left target' Nothing -> Left target'
Just reason -> Right (cname, reason) Just reason -> Right (cname, reason)
| target <- targets | target <- targets
...@@ -976,7 +983,14 @@ checkBuildTargets verbosity pkg lbi targets = do ...@@ -976,7 +983,14 @@ checkBuildTargets verbosity pkg lbi targets = do
++ showComponentName c ++ " will be processed. (Support for " ++ showComponentName c ++ " will be processed. (Support for "
++ "module and file targets has not been implemented yet.)" ++ "module and file targets has not been implemented yet.)"
return enabled -- Pick out the actual CLBIs for each of these cnames
enabled' <- forM enabled $ \(cname, _) -> do
case Map.lookup cname (componentNameMap lbi) of
Nothing -> error "checkBuildTargets: nothing enabled"
Just [clbi] -> return (mkTargetInfo lbi clbi)
Just _clbis -> error "checkBuildTargets: multiple copies enabled"
return enabled'
where where
swizzleTarget (BuildTargetComponent c) = (c, Nothing) swizzleTarget (BuildTargetComponent c) = (c, Nothing)
......
...@@ -77,6 +77,8 @@ import Distribution.Simple.Register (createInternalPackageDB) ...@@ -77,6 +77,8 @@ import Distribution.Simple.Register (createInternalPackageDB)
import Distribution.System import Distribution.System
import Distribution.Version import Distribution.Version
import Distribution.Verbosity import Distribution.Verbosity
import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Graph (Node(..))
import qualified Distribution.Simple.GHC as GHC import qualified Distribution.Simple.GHC as GHC
import qualified Distribution.Simple.GHCJS as GHCJS import qualified Distribution.Simple.GHCJS as GHCJS
...@@ -98,7 +100,7 @@ import Data.ByteString.Lazy (ByteString) ...@@ -98,7 +100,7 @@ import Data.ByteString.Lazy (ByteString)
import qualified Data.ByteString as BS import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy.Char8 as BLC8 import qualified Data.ByteString.Lazy.Char8 as BLC8
import Data.List import Data.List
( (\\), nub, partition, isPrefixOf, inits, stripPrefix ) ( (\\), nub, partition, isPrefixOf, inits, stripPrefix, foldl' )
import Data.Maybe import Data.Maybe
( isNothing, catMaybes, fromMaybe, mapMaybe, isJust ) ( isNothing, catMaybes, fromMaybe, mapMaybe, isJust )
import Data.Either import Data.Either
...@@ -128,8 +130,6 @@ import Text.PrettyPrint ...@@ -128,8 +130,6 @@ import Text.PrettyPrint
import Distribution.Compat.Environment ( lookupEnv ) import Distribution.Compat.Environment ( lookupEnv )
import Distribution.Compat.Exception ( catchExit, catchIO ) import Distribution.Compat.Exception ( catchExit, catchIO )
import Data.Graph (graphFromEdges, topSort)
-- | The errors that can be thrown when reading the @setup-config@ file. -- | The errors that can be thrown when reading the @setup-config@ file.
data ConfigStateFileError data ConfigStateFileError
= ConfigStateFileNoHeader -- ^ No header found. = ConfigStateFileNoHeader -- ^ No header found.
...@@ -673,6 +673,10 @@ configure (pkg_descr0', pbi) cfg = do ...@@ -673,6 +673,10 @@ configure (pkg_descr0', pbi) cfg = do
then return False then return False
else return True else return True
let buildComponentsMap =
foldl' (\m clbi -> Map.insertWith (++) (componentLocalName clbi) [clbi] m)
Map.empty buildComponents
let lbi = LocalBuildInfo { let lbi = LocalBuildInfo {
configFlags = cfg', configFlags = cfg',
flagAssignment = flags, flagAssignment = flags,
...@@ -684,7 +688,8 @@ configure (pkg_descr0', pbi) cfg = do ...@@ -684,7 +688,8 @@ configure (pkg_descr0', pbi) cfg = do
compiler = comp, compiler = comp,
hostPlatform = compPlatform, hostPlatform = compPlatform,
buildDir = buildDir, buildDir = buildDir,
componentsConfigs = buildComponents, componentGraph = Graph.fromList buildComponents,
componentNameMap = buildComponentsMap,
installedPkgs = packageDependsIndex, installedPkgs = packageDependsIndex,
pkgDescrFile = Nothing, pkgDescrFile = Nothing,
localPkgDescr = pkg_descr', localPkgDescr = pkg_descr',
...@@ -1449,12 +1454,12 @@ mkComponentsGraph :: ComponentEnabledSpec ...@@ -1449,12 +1454,12 @@ mkComponentsGraph :: ComponentEnabledSpec
-> Either [ComponentName] -> Either [ComponentName]
[(Component, [ComponentName])] [(Component, [ComponentName])]
mkComponentsGraph enabled pkg_descr internalPkgDeps = mkComponentsGraph enabled pkg_descr internalPkgDeps =
let graph = [ (c, componentName c, componentDeps c) let g = Graph.fromList [ N c (componentName c) (componentDeps c)
| c <- pkgBuildableComponents pkg_descr | c <- pkgBuildableComponents pkg_descr
, componentEnabled enabled c ] , componentEnabled enabled c ]
in case checkComponentsCyclic graph of in case Graph.cycles g of
Just ccycle -> Left [ cname | (_,cname,_) <- ccycle ] [] -> Right (map (\(N c _ cs) -> (c, cs)) (Graph.revTopSort g))
Nothing -> Right [ (c, cdeps) | (c, _, cdeps) <- topSortFromEdges graph ] ccycles -> Left [ componentName c | N c _ _ <- concat ccycles ]
where where
-- The dependencies for the given component -- The dependencies for the given component
componentDeps component = componentDeps component =
...@@ -1640,13 +1645,6 @@ computeCompatPackageKey comp pkg_name pkg_version (SimpleUnitId (ComponentId str ...@@ -1640,13 +1645,6 @@ computeCompatPackageKey comp pkg_name pkg_version (SimpleUnitId (ComponentId str
in fromMaybe rehashed_key (mb_verbatim_key `mplus` mb_truncated_key) in fromMaybe rehashed_key (mb_verbatim_key `mplus` mb_truncated_key)
| otherwise = str | otherwise = str
topSortFromEdges :: Ord key => [(node, key, [key])]
-> [(node, key, [key])]
topSortFromEdges es =
let (graph, vertexToNode, _) = graphFromEdges es
in reverse (map vertexToNode (topSort graph))
mkComponentsLocalBuildInfo :: ConfigFlags mkComponentsLocalBuildInfo :: ConfigFlags
-> Compiler -> Compiler
-> InstalledPackageIndex -> InstalledPackageIndex
...@@ -1655,32 +1653,32 @@ mkComponentsLocalBuildInfo :: ConfigFlags ...@@ -1655,32 +1653,32 @@ mkComponentsLocalBuildInfo :: ConfigFlags
-> [InstalledPackageInfo] -- external package deps -> [InstalledPackageInfo] -- external package deps
-> [(Component, [ComponentName])] -> [(Component, [ComponentName])]
-> FlagAssignment -> FlagAssignment
-> IO [(ComponentLocalBuildInfo, -> IO [ComponentLocalBuildInfo]
[UnitId])]
mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr
internalPkgDeps externalPkgDeps internalPkgDeps externalPkgDeps
graph flagAssignment = graph flagAssignment =
foldM go [] graph foldM go [] graph
where where
go z (component, dep_cnames) = do go z (component, dep_cnames) = do
clbi <- componentLocalBuildInfo z component
-- NB: We want to preserve cdeps because it contains extra -- NB: We want to preserve cdeps because it contains extra
-- information like build-tools ordering -- information like build-tools ordering
let dep_uids = [ componentUnitId dep_clbi let dep_uids = [ componentUnitId dep_clbi
| cname <- dep_cnames | cname <- dep_cnames
-- Being in z relies on topsort! -- Being in z relies on topsort!
, (dep_clbi, _) <- z , dep_clbi <- z
, componentLocalName dep_clbi == cname ] , componentLocalName dep_clbi == cname ]
return ((clbi, dep_uids):z) clbi <- componentLocalBuildInfo z component dep_uids
return (clbi:z)
-- The allPkgDeps contains all the package deps for the whole package -- The allPkgDeps contains all the package deps for the whole package
-- but we need to select the subset for this specific component. -- but we need to select the subset for this specific component.
-- we just take the subset for the package names this component -- we just take the subset for the package names this component
-- needs. Note, this only works because we cannot yet depend on two -- needs. Note, this only works because we cannot yet depend on two
-- versions of the same package. -- versions of the same package.
componentLocalBuildInfo :: [(ComponentLocalBuildInfo, [UnitId])] componentLocalBuildInfo :: [ComponentLocalBuildInfo]
-> Component -> IO ComponentLocalBuildInfo -> Component -> [UnitId] -> IO ComponentLocalBuildInfo
componentLocalBuildInfo internalComps component = componentLocalBuildInfo internalComps component dep_uids =
-- (putStrLn $ "configuring " ++ display (componentName component)) >>
case component of case component of
CLib lib -> do CLib lib -> do
let exports = map (\n -> Installed.ExposedModule n Nothing) let exports = map (\n -> Installed.ExposedModule n Nothing)
...@@ -1695,6 +1693,7 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr ...@@ -1695,6 +1693,7 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr
return LibComponentLocalBuildInfo { return LibComponentLocalBuildInfo {
componentPackageDeps = cpds, componentPackageDeps = cpds,
componentInternalDeps = dep_uids,
componentUnitId = uid, componentUnitId = uid,
componentLocalName = componentName component, componentLocalName = componentName component,
componentIsPublic = libName lib == Nothing, componentIsPublic = libName lib == Nothing,
...@@ -1706,6 +1705,7 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr ...@@ -1706,6 +1705,7 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr
CExe _ -> CExe _ ->
return ExeComponentLocalBuildInfo { return ExeComponentLocalBuildInfo {
componentUnitId = uid, componentUnitId = uid,
componentInternalDeps = dep_uids,
componentLocalName = componentName component, componentLocalName = componentName component,
componentPackageDeps = cpds, componentPackageDeps = cpds,
componentIncludes = includes componentIncludes = includes
...@@ -1713,6 +1713,7 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr ...@@ -1713,6 +1713,7 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr
CTest _ -> CTest _ ->
return TestComponentLocalBuildInfo { return TestComponentLocalBuildInfo {
componentUnitId = uid, componentUnitId = uid,
componentInternalDeps = dep_uids,
componentLocalName = componentName component, componentLocalName = componentName component,
componentPackageDeps = cpds, componentPackageDeps = cpds,
componentIncludes = includes componentIncludes = includes
...@@ -1720,6 +1721,7 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr ...@@ -1720,6 +1721,7 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr
CBench _ -> CBench _ ->
return BenchComponentLocalBuildInfo { return BenchComponentLocalBuildInfo {
componentUnitId = uid, componentUnitId = uid,
componentInternalDeps = dep_uids,
componentLocalName = componentName component, componentLocalName = componentName component,
componentPackageDeps = cpds, componentPackageDeps = cpds,
componentIncludes = includes componentIncludes = includes
...@@ -1740,7 +1742,7 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr ...@@ -1740,7 +1742,7 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr
lookupInternalPkg :: PackageId -> UnitId lookupInternalPkg :: PackageId -> UnitId
lookupInternalPkg pkgid = do lookupInternalPkg pkgid = do
let matcher (clbi, _) let matcher clbi
| CLibName <- componentLocalName clbi | CLibName <- componentLocalName clbi
, pkgName pkgid == packageName pkg_descr , pkgName pkgid == packageName pkg_descr
= Just (componentUnitId clbi) = Just (componentUnitId clbi)
...@@ -1750,7 +1752,9 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr ...@@ -1750,7 +1752,9 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr
matcher _ = Nothing matcher _ = Nothing
case catMaybes (map matcher internalComps) of case catMaybes (map matcher internalComps) of
[x] -> x [x] -> x
_ -> error "lookupInternalPkg" _ -> error $ "lookupInternalPkg " ++ display pkgid
++ " " ++ intercalate ", "
(map (display . componentUnitId) internalComps)
cpds = if newPackageDepsBehaviour pkg_descr cpds = if newPackageDepsBehaviour pkg_descr
then dedup $ then dedup $
......
...@@ -16,6 +16,9 @@ module Distribution.Simple.Install ( ...@@ -16,6 +16,9 @@ module Distribution.Simple.Install (
install, install,
) where ) where
import Distribution.Types.TargetInfo
import Distribution.Types.LocalBuildInfo
import Distribution.PackageDescription import Distribution.PackageDescription
import Distribution.Package (Package(..)) import Distribution.Package (Package(..))
import Distribution.Simple.LocalBuildInfo