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

As much as possible, expunge uses of localPkgDescr.



The big change here is that most of the functions in
Distribution.Types.HookedBuildInfo have to take a
PackageDescription explicitly.  I hate the new type,
so I primed these new functions, and added functions
which use 'localPkgDescr'.  Presently those have WARNINGs
attached to them so people don't accidentally use them;
once we fix 'HookedBuildInfo' we can change this.
Signed-off-by: default avatarEdward Z. Yang <ezyang@cs.stanford.edu>
parent ab5cd566
......@@ -85,7 +85,7 @@ build pkg_descr lbi flags suffixes
-- TODO: if checkBuildTargets ignores a target we may accept
-- a --assume-deps-up-to-date with multiple arguments. Arguably, we should
-- error early in this case.
target <- readTargetInfos verbosity lbi (buildArgs flags) >>= \r -> case r of
target <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags) >>= \r -> case r of
[] -> die "In --assume-deps-up-to-date mode you must specify a target"
[target] -> return target
_ -> die "In --assume-deps-up-to-date mode you can only build a single target"
......@@ -109,8 +109,8 @@ build pkg_descr lbi flags suffixes
buildComponent verbosity (buildNumJobs flags) pkg_descr
lbi' suffixes comp clbi distPref
| otherwise = do
targets <- readTargetInfos verbosity lbi (buildArgs flags)
let componentsToBuild = neededTargetsInBuildOrder lbi (map nodeKey targets)
targets <- readTargetInfos verbosity pkg_descr lbi (buildArgs flags)
let componentsToBuild = neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets)
info verbosity $ "Component build order: "
++ intercalate ", "
(map (showComponentName . componentLocalName . targetCLBI)
......@@ -149,12 +149,12 @@ repl pkg_descr lbi flags suffixes args = do
let distPref = fromFlag (replDistPref flags)
verbosity = fromFlag (replVerbosity flags)
target <- readTargetInfos verbosity lbi args >>= \r -> case r of
target <- readTargetInfos verbosity pkg_descr lbi args >>= \r -> case r of
-- This seems DEEPLY questionable.
[] -> return (head (allTargetsInBuildOrder lbi))
[] -> return (head (allTargetsInBuildOrder' pkg_descr lbi))
[target] -> return target
_ -> die $ "The 'repl' command does not support multiple targets at once."
let componentsToBuild = neededTargetsInBuildOrder lbi [nodeKey target]
let componentsToBuild = neededTargetsInBuildOrder' pkg_descr lbi [nodeKey target]
debug verbosity $ "Component build order: "
++ intercalate ", "
(map (showComponentName . componentLocalName . targetCLBI)
......
......@@ -68,10 +68,10 @@ import System.Directory
-- | 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
readTargetInfos :: Verbosity -> PackageDescription -> LocalBuildInfo -> [String] -> IO [TargetInfo]
readTargetInfos verbosity pkg_descr lbi args = do
build_targets <- readBuildTargets pkg_descr args
checkBuildTargets verbosity pkg_descr lbi build_targets
-- ------------------------------------------------------------
-- * User build targets
......@@ -959,12 +959,12 @@ caseFold = lowercase
--
-- Also swizzle into a more convenient form.
--
checkBuildTargets :: Verbosity -> LocalBuildInfo -> [BuildTarget]
checkBuildTargets :: Verbosity -> PackageDescription -> LocalBuildInfo -> [BuildTarget]
-> IO [TargetInfo]
checkBuildTargets _ lbi [] =
return (allTargetsInBuildOrder lbi)
checkBuildTargets _ pkg_descr lbi [] =
return (allTargetsInBuildOrder' pkg_descr lbi)
checkBuildTargets verbosity lbi targets = do
checkBuildTargets verbosity pkg_descr lbi targets = do
let (enabled, disabled) =
partitionEithers
......@@ -985,10 +985,10 @@ checkBuildTargets verbosity lbi targets = do
-- 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"
case componentNameTargets' pkg_descr lbi cname of
[] -> error "checkBuildTargets: nothing enabled"
[target] -> return target
_targets -> error "checkBuildTargets: multiple copies enabled"
return enabled'
......
......@@ -72,6 +72,7 @@ import Distribution.Simple.Program
import Distribution.Simple.Setup as Setup
import qualified Distribution.Simple.InstallDirs as InstallDirs
import Distribution.Simple.LocalBuildInfo
import Distribution.Types.LocalBuildInfo
import Distribution.Simple.Utils
import Distribution.Simple.Register (createInternalPackageDB)
import Distribution.System
......@@ -237,7 +238,7 @@ writePersistBuildConfig distPref lbi = do
writeFileAtomic (localBuildInfoFile distPref) $
BLC8.unlines [showHeader pkgId, encode lbi]
where
pkgId = packageId $ localPkgDescr lbi
pkgId = localPackage lbi
-- | Identifier of the current Cabal package.
currentCabalId :: PackageIdentifier
......
......@@ -518,7 +518,7 @@ buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
-- has the package name. I'm going to avoid changing this for
-- now, but it would probably be better for this to be the
-- component ID instead...
pkg_name = display $ PD.package $ localPkgDescr lbi
pkg_name = display (PD.package pkg_descr)
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
| forRepl = Mon.mempty -- HPC is not supported in ghci
......
......@@ -266,7 +266,7 @@ replLib = buildOrReplLib True
buildOrReplLib :: Bool -> Verbosity -> Cabal.Flag (Maybe Int)
-> PackageDescription -> LocalBuildInfo
-> Library -> ComponentLocalBuildInfo -> IO ()
buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do
buildOrReplLib forRepl verbosity numJobs pkg_descr lbi lib clbi = do
let uid = componentUnitId clbi
libTargetDir = buildDir lbi
whenVanillaLib forceVanilla =
......@@ -294,7 +294,7 @@ buildOrReplLib forRepl verbosity numJobs _pkg_descr lbi lib clbi = do
-- Determine if program coverage should be enabled and if so, what
-- '-hpcdir' should be.
let isCoverageEnabled = fromFlag $ configCoverage $ configFlags lbi
pkg_name = display $ PD.package $ localPkgDescr lbi
pkg_name = display $ PD.package pkg_descr
distPref = fromFlag $ configDistPref $ configFlags lbi
hpcdir way
| isCoverageEnabled = toFlag $ Hpc.mixDir distPref way pkg_name
......
......@@ -64,7 +64,7 @@ install :: PackageDescription -- ^information from the .cabal file
install pkg_descr lbi flags
| fromFlag (copyAssumeDepsUpToDate flags) = do
checkHasLibsOrExes
targets <- readTargetInfos verbosity lbi (copyArgs flags)
targets <- readTargetInfos verbosity pkg_descr lbi (copyArgs flags)
case targets of
_ | null (copyArgs flags)
-> copyPackage verbosity pkg_descr lbi distPref copydest
......@@ -76,12 +76,12 @@ install pkg_descr lbi flags
| otherwise = do
checkHasLibsOrExes
targets <- readTargetInfos verbosity lbi (copyArgs flags)
targets <- readTargetInfos verbosity pkg_descr lbi (copyArgs flags)
copyPackage verbosity pkg_descr lbi distPref copydest
-- It's not necessary to do these in build-order, but it's harmless
withNeededTargetsInBuildOrder lbi (map nodeKey targets) $ \target ->
withNeededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets) $ \target ->
let comp = targetComponent target
clbi = targetCLBI target
in copyComponent verbosity pkg_descr lbi comp clbi copydest
......
......@@ -93,7 +93,6 @@ import Distribution.Simple.PackageIndex
import Distribution.Simple.Utils
import Distribution.Text
import qualified Distribution.Compat.Graph as Graph
import Distribution.Compat.Graph (IsNode(..))
import Data.List (stripPrefix)
import Data.Maybe
......@@ -120,22 +119,22 @@ componentBuildDir lbi clbi
{-# DEPRECATED getComponentLocalBuildInfo "This function is not well-defined, because a 'ComponentName' does not uniquely identify a 'ComponentLocalBuildInfo'. If you have a 'TargetInfo', you should use 'targetCLBI' to get the 'ComponentLocalBuildInfo'. Otherwise, use 'componentNameTargets' to get all possible 'ComponentLocalBuildInfo's. This will be removed in Cabal 2.2." #-}
getComponentLocalBuildInfo :: LocalBuildInfo -> ComponentName -> ComponentLocalBuildInfo
getComponentLocalBuildInfo lbi cname =
case componentNameTargets lbi cname of
[target] -> targetCLBI target
case componentNameCLBIs lbi cname of
[clbi] -> clbi
[] ->
error $ "internal error: there is no configuration data "
++ "for component " ++ show cname
targets ->
clbis ->
error $ "internal error: the component name " ++ show cname
++ "is ambiguous. Refers to: "
++ intercalate ", " (map (display . nodeKey) targets)
++ intercalate ", " (map (display . componentUnitId) clbis)
-- | Perform the action on each enabled 'library' in the package
-- description with the 'ComponentLocalBuildInfo'.
withLibLBI :: PackageDescription -> LocalBuildInfo
-> (Library -> ComponentLocalBuildInfo -> IO ()) -> IO ()
withLibLBI _pkg lbi f =
withAllTargetsInBuildOrder lbi $ \target ->
withLibLBI pkg lbi f =
withAllTargetsInBuildOrder' pkg lbi $ \target ->
case targetComponent target of
CLib lib -> f lib (targetCLBI target)
_ -> return ()
......@@ -145,8 +144,8 @@ withLibLBI _pkg lbi f =
-- build info.
withExeLBI :: PackageDescription -> LocalBuildInfo
-> (Executable -> ComponentLocalBuildInfo -> IO ()) -> IO ()
withExeLBI _pkg lbi f =
withAllTargetsInBuildOrder lbi $ \target ->
withExeLBI pkg lbi f =
withAllTargetsInBuildOrder' pkg lbi $ \target ->
case targetComponent target of
CExe exe -> f exe (targetCLBI target)
_ -> return ()
......@@ -165,16 +164,16 @@ withTestLBI pkg lbi f =
enabledTestLBIs :: PackageDescription -> LocalBuildInfo
-> [(TestSuite, ComponentLocalBuildInfo)]
enabledTestLBIs _pkg lbi =
enabledTestLBIs pkg lbi =
[ (test, targetCLBI target)
| target <- allTargetsInBuildOrder lbi
| target <- allTargetsInBuildOrder' pkg lbi
, CTest test <- [targetComponent target] ]
enabledBenchLBIs :: PackageDescription -> LocalBuildInfo
-> [(Benchmark, ComponentLocalBuildInfo)]
enabledBenchLBIs _pkg lbi =
enabledBenchLBIs pkg lbi =
[ (bench, targetCLBI target)
| target <- allTargetsInBuildOrder lbi
| target <- allTargetsInBuildOrder' pkg lbi
, CBench bench <- [targetComponent target] ]
{-# DEPRECATED withComponentsLBI "Use withAllComponentsInBuildOrder" #-}
......@@ -189,8 +188,8 @@ withComponentsLBI = withAllComponentsInBuildOrder
withAllComponentsInBuildOrder :: PackageDescription -> LocalBuildInfo
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withAllComponentsInBuildOrder _pkg lbi f =
withAllTargetsInBuildOrder lbi $ \target ->
withAllComponentsInBuildOrder pkg lbi f =
withAllTargetsInBuildOrder' pkg lbi $ \target ->
f (targetComponent target) (targetCLBI target)
{-# DEPRECATED withComponentsInBuildOrder "You have got a 'TargetInfo' right? Use 'withNeededTargetsInBuildOrder' on the 'UnitId's you can 'nodeKey' out." #-}
......@@ -198,8 +197,8 @@ withComponentsInBuildOrder :: PackageDescription -> LocalBuildInfo
-> [ComponentName]
-> (Component -> ComponentLocalBuildInfo -> IO ())
-> IO ()
withComponentsInBuildOrder _pkg lbi cnames f =
withNeededTargetsInBuildOrder lbi uids $ \target ->
withComponentsInBuildOrder pkg lbi cnames f =
withNeededTargetsInBuildOrder' pkg lbi uids $ \target ->
f (targetComponent target) (targetCLBI target)
where uids = concatMap (componentNameToUnitIds lbi) cnames
......@@ -218,7 +217,10 @@ componentNameToUnitIds lbi cname =
{-# DEPRECATED componentsInBuildOrder "You've got 'TargetInfo' right? Use 'neededTargetsInBuildOrder' on the 'UnitId's you can 'nodeKey' out." #-}
componentsInBuildOrder :: LocalBuildInfo -> [ComponentName]
-> [ComponentLocalBuildInfo]
componentsInBuildOrder lbi cnames = map targetCLBI (neededTargetsInBuildOrder lbi uids)
componentsInBuildOrder lbi cnames
-- NB: use of localPkgDescr here is safe because we throw out the
-- result immediately afterwards
= map targetCLBI (neededTargetsInBuildOrder' (localPkgDescr lbi) lbi uids)
where uids = concatMap (componentNameToUnitIds lbi) cnames
-- -----------------------------------------------------------------------------
......@@ -246,11 +248,11 @@ depLibraryPaths inplace relative lbi clbi = do
internalDeps = [ uid
| (uid, _) <- componentPackageDeps clbi
-- Test that it's internal
, sub_target <- allTargetsInBuildOrder lbi
, sub_target <- allTargetsInBuildOrder' pkgDescr lbi
, componentUnitId (targetCLBI (sub_target)) == uid ]
internalLibs = [ getLibDir (targetCLBI sub_target)
| sub_target <- neededTargetsInBuildOrder
lbi internalDeps ]
| sub_target <- neededTargetsInBuildOrder'
pkgDescr lbi internalDeps ]
{-
-- This is better, but it doesn't work, because we may be passed a
-- CLBI which doesn't actually exist, and was faked up when we
......
......@@ -94,7 +94,7 @@ register pkg_descr lbi flags = when (hasPublicLib pkg_descr) doRegister
-- usefully (they're not public.) If we start supporting scoped
-- packages, we'll have to relax this.
doRegister = do
targets <- readTargetInfos verbosity lbi (regArgs flags)
targets <- readTargetInfos verbosity pkg_descr lbi (regArgs flags)
-- It's important to register in build order, because ghc-pkg
-- will complain if a dependency is not registered.
......@@ -117,7 +117,7 @@ register pkg_descr lbi flags = when (hasPublicLib pkg_descr) doRegister
_ -> die "In --assume-deps-up-to-date mode you can only register a single target"
else fmap catMaybes
. mapM maybeGenerateOne
$ neededTargetsInBuildOrder lbi (map nodeKey targets)
$ neededTargetsInBuildOrder' pkg_descr lbi (map nodeKey targets)
registerAll pkg_descr lbi flags ipis
return ()
where
......
......@@ -36,15 +36,16 @@ import Distribution.Types.BuildInfo
-- 'sanityCheckHookedBuildInfo'.
-- 3. We update our 'PackageDescription' (either freshly read
-- or cached from 'LocalBuildInfo') with 'updatePackageDescription'.
-- In doing so, we must be careful to also update it in
-- 'localPkgDescr' in 'LocalBuildInfo', where a user can
-- also get to it. In practice the code also passes around
-- the updated 'PackageDescription' around explicitly (redundantly)
-- which is what everyone used to get the actual 'Component'.
-- And that's a good thing because up until recently
-- 'localPkgDescr' was NOT updated. Although, it doesn't
-- look like anyone saw a bug because of this, thanks to
-- 1c20a6328579af9e37677d507e2e9836ef70ab9d.
--
-- In principle, we are also supposed to update the copy of
-- the 'PackageDescription' stored in 'LocalBuildInfo'
-- at 'localPkgDescr'. Unfortunately, in practice, there
-- are lots of Custom setup scripts which fail to update
-- 'localPkgDescr' so you really shouldn't rely on it.
-- It's not DEPRECATED because there are legitimate uses
-- for it, but... yeah. Sharp knife. See
-- <https://github.com/haskell/cabal/issues/3606>
-- for more information on the issue.
--
-- It is not well-specified whether or not a 'HookedBuildInfo' applied
-- at configure time is persistent to the 'LocalBuildInfo'. The
......
......@@ -11,10 +11,31 @@ module Distribution.Types.LocalBuildInfo (
localComponentId,
localUnitId,
localCompatPackageKey,
localPackage,
-- * Build targets of the 'LocalBuildInfo'.
mkTargetInfo,
componentNameCLBIs,
-- NB: the primes mean that they take a 'PackageDescription'
-- which may not match 'localPkgDescr' in 'LocalBuildInfo'.
-- More logical types would drop this argument, but
-- at the moment, this is the ONLY supported function, because
-- 'localPkgDescr' is not guaranteed to match. At some point
-- we will fix it and then we can use the (free) unprimed
-- namespace for the correct commands.
--
-- See https://github.com/haskell/cabal/issues/3606 for more
-- details.
componentNameTargets',
allTargetsInBuildOrder',
withAllTargetsInBuildOrder',
neededTargetsInBuildOrder',
withNeededTargetsInBuildOrder',
-- * Functions you SHOULD NOT USE (yet), but are defined here to
-- prevent someone from accidentally defining them
componentNameTargets,
allTargetsInBuildOrder,
......@@ -93,8 +114,18 @@ data LocalBuildInfo = LocalBuildInfo {
pkgDescrFile :: Maybe FilePath,
-- ^ the filename containing the .cabal file, if available
localPkgDescr :: PackageDescription,
-- ^ The resolved package description, that does not contain
-- any conditionals.
-- ^ WARNING WARNING WARNING Be VERY careful about using
-- this function; we haven't deprecated it but using it
-- could introduce subtle bugs related to
-- 'HookedBuildInfo'.
--
-- In principle, this is supposed to contain the
-- resolved package description, that does not contain
-- any conditionals. However, it MAY NOT contain
-- the description wtih a 'HookedBuildInfo' applied
-- to it; see 'HookedBuildInfo' for the whole sordid saga.
-- As much as possible, Cabal library should avoid using
-- this parameter.
withPrograms :: ProgramConfiguration, -- ^Location and args for all programs
withPackageDB :: PackageDBStack, -- ^What package database to use, global\/user
withVanillaLib:: Bool, -- ^Whether to build normal libs.
......@@ -131,74 +162,116 @@ localComponentId lbi
= case localUnitId lbi of
SimpleUnitId cid -> cid
-- | Extract the 'PackageIdentifier' of a 'LocalBuildInfo'.
-- This is a "safe" use of 'localPkgDescr'
localPackage :: LocalBuildInfo -> PackageId
localPackage lbi = package (localPkgDescr lbi)
-- | Extract the 'UnitId' from the library component of a
-- 'LocalBuildInfo' if it exists, or make a fake unit ID based on
-- the package ID.
localUnitId :: LocalBuildInfo -> UnitId
localUnitId lbi =
case componentNameTargets lbi CLibName of
[target] | LibComponentLocalBuildInfo { componentUnitId = uid }
<- targetCLBI target
-> uid
_ -> mkLegacyUnitId (package (localPkgDescr lbi))
localUnitId lbi =
case componentNameCLBIs lbi CLibName of
[LibComponentLocalBuildInfo { componentUnitId = uid }]
-> uid
_ -> mkLegacyUnitId (localPackage lbi)
-- | Extract the compatibility package key from the public library component of a
-- 'LocalBuildInfo' if it exists, or make a fake package key based
-- on the package ID.
localCompatPackageKey :: LocalBuildInfo -> String
localCompatPackageKey lbi =
case componentNameTargets lbi CLibName of
[target] | LibComponentLocalBuildInfo { componentCompatPackageKey = pk }
<- targetCLBI target
-> pk
_ -> display (package (localPkgDescr lbi))
-- | Generate a default 'TargetInfo' from a 'ComponentLocalBuildInfo'.
-- The idea is to call this once, and then use 'TargetInfo' everywhere
-- else.
mkTargetInfo :: LocalBuildInfo -> ComponentLocalBuildInfo -> TargetInfo
mkTargetInfo lbi clbi =
case componentNameCLBIs lbi CLibName of
[LibComponentLocalBuildInfo { componentCompatPackageKey = pk }]
-> pk
_ -> display (localPackage lbi)
-- | Convenience function to generate a default 'TargetInfo' from a
-- 'ComponentLocalBuildInfo'. The idea is to call this once, and then
-- use 'TargetInfo' everywhere else. Private to this module.
mkTargetInfo :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> TargetInfo
mkTargetInfo pkg_descr _lbi clbi =
TargetInfo {
targetCLBI = clbi,
targetComponent = getComponent (localPkgDescr lbi)
-- NB: @pkg_descr@, not @localPkgDescr lbi@!
targetComponent = getComponent pkg_descr
(componentLocalName clbi)
}
-- | Return all 'TargetInfo's associated with 'ComponentName'.
-- In the presence of Backpack there may be more than one!
componentNameTargets :: LocalBuildInfo -> ComponentName -> [TargetInfo]
componentNameTargets lbi cname =
-- Has a prime because it takes a 'PackageDescription' argument
-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
componentNameTargets' :: PackageDescription -> LocalBuildInfo -> ComponentName -> [TargetInfo]
componentNameTargets' pkg_descr lbi cname =
case Map.lookup cname (componentNameMap lbi) of
Just clbis -> map (mkTargetInfo lbi) clbis
Just clbis -> map (mkTargetInfo pkg_descr lbi) clbis
Nothing -> []
-- | Return all 'ComponentLocalBuildInfo's associated with 'ComponentName'.
-- In the presence of Backpack there may be more than one!
componentNameCLBIs :: LocalBuildInfo -> ComponentName -> [ComponentLocalBuildInfo]
componentNameCLBIs lbi cname =
case Map.lookup cname (componentNameMap lbi) of
Just clbis -> clbis
Nothing -> []
-- TODO: Maybe cache topsort (Graph can do this)
-- | Return the list of default 'TargetInfo's associated with a
-- configured package, in the order they need to be built.
allTargetsInBuildOrder :: LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder lbi
= map (mkTargetInfo lbi) (Graph.revTopSort (componentGraph lbi))
-- Has a prime because it takes a 'PackageDescription' argument
-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
allTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder' pkg_descr lbi
= map (mkTargetInfo pkg_descr lbi) (Graph.revTopSort (componentGraph lbi))
-- | Execute @f@ for every 'TargetInfo' in the package, respecting the
-- build dependency order. (TODO: We should use Shake!)
withAllTargetsInBuildOrder :: LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder lbi f
= sequence_ [ f target | target <- allTargetsInBuildOrder lbi ]
-- Has a prime because it takes a 'PackageDescription' argument
-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
withAllTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder' pkg_descr lbi f
= sequence_ [ f target | target <- allTargetsInBuildOrder' pkg_descr lbi ]
-- | Return the list of all targets needed to build the @uids@, in
-- the order they need to be built.
neededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder lbi uids =
-- Has a prime because it takes a 'PackageDescription' argument
-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
neededTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder' pkg_descr lbi uids =
case Graph.closure (componentGraph lbi) uids of
Nothing -> error $ "localBuildPlan: missing uids " ++ intercalate ", " (map display uids)
Just clos -> map (mkTargetInfo lbi) (Graph.revTopSort (Graph.fromList clos))
Just clos -> map (mkTargetInfo pkg_descr lbi) (Graph.revTopSort (Graph.fromList clos))
-- | Execute @f@ for every 'TargetInfo' needed to build @uid@s, respecting
-- the build dependency order.
-- Has a prime because it takes a 'PackageDescription' argument
-- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
withNeededTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
withNeededTargetsInBuildOrder' pkg_descr lbi uids f
= sequence_ [ f target | target <- neededTargetsInBuildOrder' pkg_descr lbi uids ]
-------------------------------------------------------------------------------
-- Stub functions to prevent someone from accidentally defining them
{-# WARNING componentNameTargets, allTargetsInBuildOrder, withAllTargetsInBuildOrder, neededTargetsInBuildOrder, withNeededTargetsInBuildOrder "By using this function, you may be introducing a bug where you retrieve a 'Component' which does not have 'HookedBuildInfo' applied to it. See the documentation for 'HookedBuildInfo' for an explanation of the issue. If you have a 'PakcageDescription' handy (NOT from the 'LocalBuildInfo'), try using the primed version of the function, which takes it as an extra argument." #-}
componentNameTargets :: LocalBuildInfo -> ComponentName -> [TargetInfo]
componentNameTargets lbi = componentNameTargets' (localPkgDescr lbi) lbi
allTargetsInBuildOrder :: LocalBuildInfo -> [TargetInfo]
allTargetsInBuildOrder lbi = allTargetsInBuildOrder' (localPkgDescr lbi) lbi
withAllTargetsInBuildOrder :: LocalBuildInfo -> (TargetInfo -> IO ()) -> IO ()
withAllTargetsInBuildOrder lbi = withAllTargetsInBuildOrder' (localPkgDescr lbi) lbi
neededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> [TargetInfo]
neededTargetsInBuildOrder lbi = neededTargetsInBuildOrder' (localPkgDescr lbi) lbi
withNeededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO ()
withNeededTargetsInBuildOrder lbi uids f
= sequence_ [ f target | target <- neededTargetsInBuildOrder lbi uids ]
withNeededTargetsInBuildOrder lbi = withNeededTargetsInBuildOrder' (localPkgDescr lbi) lbi
-------------------------------------------------------------------------------
-- Backwards compatibility
......
......@@ -7,9 +7,9 @@ import System.FilePath
import Test.Tasty.HUnit (testCase)
import Distribution.Compiler (CompilerFlavor(..), CompilerId(..))
import Distribution.PackageDescription (package)
import Distribution.Simple.Compiler (compilerId)
import Distribution.Simple.LocalBuildInfo (compiler, localPkgDescr, localCompatPackageKey)
import Distribution.Types.LocalBuildInfo (localPackage)
import Distribution.Simple.LocalBuildInfo (compiler, localCompatPackageKey)
import Distribution.Simple.Hpc
import Distribution.Simple.Program.Builtin (hpcProgram)
import Distribution.Simple.Program.Db
......@@ -98,7 +98,7 @@ hpcTestMatrix config = forM_ (choose4 [True, False]) $
subdir
| comp == GHC && version >= Version [7, 10] [] =
localCompatPackageKey lbi
| otherwise = display (package $ localPkgDescr lbi)
| otherwise = display (localPackage lbi)
mapM_ shouldExist
[ mixDir dist_dir way "my-0.1" </> subdir </> "Foo.mix"
, mixDir dist_dir way "test-Short" </> "Main.mix"
......
......@@ -569,7 +569,7 @@ tests config = do
let pkg_descr = localPkgDescr lbi
compiler_id = compilerId (compiler lbi)
cname = CSubLibName "foo-internal"
[target] = componentNameTargets lbi cname
[target] = componentNameTargets' pkg_descr lbi cname
uid = componentUnitId (targetCLBI target)
dir = libdir (absoluteComponentInstallDirs pkg_descr lbi uid
NoCopyDest)
......
......@@ -12,7 +12,7 @@ module Distribution.Client.Run ( run, splitRunArgs )
where
import Distribution.Types.TargetInfo (targetCLBI)
import Distribution.Types.LocalBuildInfo (componentNameTargets)
import Distribution.Types.LocalBuildInfo (componentNameTargets')
import Distribution.Client.Utils (tryCanonicalizePath)
......@@ -132,7 +132,7 @@ run verbosity lbi exe exeArgs = do
-- Add (DY)LD_LIBRARY_PATH if needed
env' <- if withDynExe lbi
then do let (Platform _ os) = hostPlatform lbi
clbi <- case componentNameTargets lbi (CExeName (exeName exe)) of
clbi <- case componentNameTargets' pkg_descr lbi (CExeName (exeName exe)) of
[target] -> return (targetCLBI target)
[] -> die "run: Could not find executable in LocalBuildInfo"
_ -> die "run: Found multiple matching exes in LocalBuildInfo"
......
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