From c6b477566fc397d9fbe9eaf4995ea92dac8a5f4f Mon Sep 17 00:00:00 2001 From: sheaf Date: Mon, 27 Nov 2023 12:54:36 +0100 Subject: [PATCH] Modularise configure step This commit modularises the configure phase (i.e. the function Distribution.Simple.Configure.configure). The aim of this change is to make explicit the control flow of the function: it starts off with a package-wide phase, and then componentwise configuration. --- Cabal/src/Distribution/Backpack/Configure.hs | 4 +- Cabal/src/Distribution/Simple/BuildTarget.hs | 4 +- Cabal/src/Distribution/Simple/Configure.hs | 1043 ++++++++++------- .../src/Distribution/Simple/LocalBuildInfo.hs | 30 +- .../src/Distribution/Types/LocalBuildInfo.hs | 43 +- 5 files changed, 651 insertions(+), 473 deletions(-) diff --git a/Cabal/src/Distribution/Backpack/Configure.hs b/Cabal/src/Distribution/Backpack/Configure.hs index 54a66833715..8e9eb18ae6a 100644 --- a/Cabal/src/Distribution/Backpack/Configure.hs +++ b/Cabal/src/Distribution/Backpack/Configure.hs @@ -85,7 +85,7 @@ configureComponentLocalBuildInfos cid_flag pkg_descr (prePkgDeps, promisedPkgDeps) - flagAssignment + flags instantiate_with installedPackageSet comp = do @@ -123,7 +123,7 @@ configureComponentLocalBuildInfos graph1 <- toConfiguredComponents use_external_internal_deps - flagAssignment + flags deterministic ipid_flag cid_flag diff --git a/Cabal/src/Distribution/Simple/BuildTarget.hs b/Cabal/src/Distribution/Simple/BuildTarget.hs index 803abc4c043..06b387c04ae 100644 --- a/Cabal/src/Distribution/Simple/BuildTarget.hs +++ b/Cabal/src/Distribution/Simple/BuildTarget.hs @@ -1046,11 +1046,11 @@ checkBuildTargets _ pkg_descr lbi [] = checkBuildTargets verbosity pkg_descr - lbi@(LocalBuildInfo{componentEnabledSpec}) + lbi@(LocalBuildInfo{componentEnabledSpec = enabledComps}) targets = do let (enabled, disabled) = partitionEithers - [ case componentDisabledReason componentEnabledSpec comp of + [ case componentDisabledReason enabledComps comp of Nothing -> Left target' Just reason -> Right (cname, reason) | target <- targets diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index a97c4391d9b..fb9ccc99fc1 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -1,5 +1,6 @@ {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE RecordWildCards #-} @@ -89,6 +90,7 @@ import Distribution.Simple.Utils import Distribution.System import Distribution.Types.ComponentRequestedSpec import Distribution.Types.GivenComponent +import qualified Distribution.Types.LocalBuildConfig as LBC import Distribution.Types.LocalBuildInfo import Distribution.Types.PackageVersionConstraint import Distribution.Utils.LogProgress @@ -408,14 +410,33 @@ configure :: (GenericPackageDescription, HookedBuildInfo) -> ConfigFlags -> IO LocalBuildInfo -configure (pkg_descr0, pbi) cfg = do +configure (g_pkg_descr, hookedBuildInfo) cfg = do + + -- Cabal pre-configure + (lbc1, comp, platform, enabledComps) <- preConfigurePackage cfg g_pkg_descr + + -- Cabal package-wide configure + (lbc2, pbd2, pkg_info) <- + finalizeAndConfigurePackage cfg lbc1 g_pkg_descr comp platform enabledComps + + -- Cabal per-component configure + externalPkgDeps <- finalCheckPackage g_pkg_descr pbd2 hookedBuildInfo pkg_info + configureComponents lbc2 pbd2 pkg_info externalPkgDeps + +preConfigurePackage + :: ConfigFlags + -> GenericPackageDescription + -> IO (LBC.LocalBuildConfig, Compiler, Platform, ComponentRequestedSpec) +preConfigurePackage cfg g_pkg_descr = do + let verbosity = fromFlag (configVerbosity cfg) + -- Determine the component we are configuring, if a user specified -- one on the command line. We use a fake, flattened version of -- the package since at this point, we're not really sure what -- components we *can* configure. @Nothing@ means that we should -- configure everything (the old behavior). (mb_cname :: Maybe ComponentName) <- do - let flat_pkg_descr = flattenPackageDescription pkg_descr0 + let flat_pkg_descr = flattenPackageDescription g_pkg_descr targets <- readBuildTargets verbosity flat_pkg_descr (configArgs cfg) -- TODO: bleat if you use the module/file syntax let targets' = [cname | BuildTargetComponent cname <- targets] @@ -425,14 +446,13 @@ configure (pkg_descr0, pbi) cfg = do [] -> dieWithException verbosity NoValidComponent _ -> dieWithException verbosity ConfigureEitherSingleOrAll - let use_external_internal_deps = isJust mb_cname case mb_cname of - Nothing -> setupMessage verbosity "Configuring" (packageId pkg_descr0) + Nothing -> setupMessage verbosity "Configuring" (packageId g_pkg_descr) Just cname -> setupMessage' verbosity "Configuring" - (packageId pkg_descr0) + (packageId g_pkg_descr) cname (Just (configInstantiateWith cfg)) @@ -440,51 +460,6 @@ configure (pkg_descr0, pbi) cfg = do when (isJust (flagToMaybe (configCID cfg)) && isNothing mb_cname) $ dieWithException verbosity ConfigCIDValidForPreComponent - checkDeprecatedFlags verbosity cfg - checkExactConfiguration verbosity pkg_descr0 cfg - - -- Where to build the package - let build_dir :: FilePath -- e.g. dist/build - -- fromFlag OK due to Distribution.Simple calling - -- findDistPrefOrDefault to fill it in - build_dir = fromFlag (configDistPref cfg) "build" - createDirectoryIfMissingVerbose (lessVerbose verbosity) True build_dir - - -- What package database(s) to use - let packageDbs :: PackageDBStack - packageDbs = - interpretPackageDbFlags - (fromFlag (configUserInstall cfg)) - (configPackageDBs cfg) - - -- comp: the compiler we're building with - -- compPlatform: the platform we're building for - -- programDb: location and args of all programs we're - -- building with - ( comp :: Compiler - , compPlatform :: Platform - , programDb :: ProgramDb - ) <- - configCompilerEx - (flagToMaybe (configHcFlavor cfg)) - (flagToMaybe (configHcPath cfg)) - (flagToMaybe (configHcPkg cfg)) - (mkProgramDb cfg (configPrograms cfg)) - (lessVerbose verbosity) - - -- The InstalledPackageIndex of all installed packages - installedPackageSet :: InstalledPackageIndex <- - getInstalledPackages - (lessVerbose verbosity) - comp - packageDbs - programDb - - -- The set of package names which are "shadowed" by internal - -- packages, and which component they map to - let internalPackageSet :: Set LibraryName - internalPackageSet = getInternalLibraries pkg_descr0 - -- Make a data structure describing what components are enabled. let enabled :: ComponentRequestedSpec enabled = case mb_cname of @@ -509,221 +484,42 @@ configure (pkg_descr0, pbi) cfg = do ) $ dieWithException verbosity SanityCheckForEnableComponents - -- Some sanity checks related to dynamic/static linking. - when (fromFlag (configDynExe cfg) && fromFlag (configFullyStaticExe cfg)) $ - dieWithException verbosity SanityCheckForDynamicStaticLinking - - -- allConstraints: The set of all 'Dependency's we have. Used ONLY - -- to 'configureFinalizedPackage'. - -- requiredDepsMap: A map from 'PackageName' to the specifically - -- required 'InstalledPackageInfo', due to --dependency - -- - -- NB: These constraints are to be applied to ALL components of - -- a package. Thus, it's not an error if allConstraints contains - -- more constraints than is necessary for a component (another - -- component might need it.) - -- - -- NB: The fact that we bundle all the constraints together means - -- that is not possible to configure a test-suite to use one - -- version of a dependency, and the executable to use another. - ( allConstraints :: [PackageVersionConstraint] - , requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo - ) <- - either (dieWithException verbosity) return $ - combinedConstraints - (configConstraints cfg) - (configDependencies cfg) - installedPackageSet - - let promisedDepsSet = mkPromisedDepsSet (configPromisedDependencies cfg) + checkDeprecatedFlags verbosity cfg + checkExactConfiguration verbosity g_pkg_descr cfg - -- pkg_descr: The resolved package description, that does not contain any - -- conditionals, because we have an assignment for - -- every flag, either picking them ourselves using a - -- simple naive algorithm, or having them be passed to - -- us by 'configConfigurationsFlags') - -- flags: The 'FlagAssignment' that the conditionals were - -- resolved with. - -- - -- NB: Why doesn't finalizing a package also tell us what the - -- dependencies are (e.g. when we run the naive algorithm, - -- we are checking if dependencies are satisfiable)? The - -- primary reason is that we may NOT have done any solving: - -- if the flags are all chosen for us, this step is a simple - -- matter of flattening according to that assignment. It's - -- cleaner to then configure the dependencies afterwards. - ( pkg_descr :: PackageDescription - , flags :: FlagAssignment + -- comp: the compiler we're building with + -- compPlatform: the platform we're building for + -- programDb: location and args of all programs we're + -- building with + ( comp :: Compiler + , compPlatform :: Platform + , programDb00 :: ProgramDb ) <- - configureFinalizedPackage - verbosity - cfg - enabled - allConstraints - ( dependencySatisfiable - use_external_internal_deps - (fromFlagOrDefault False (configExactConfiguration cfg)) - (fromFlagOrDefault False (configAllowDependingOnPrivateLibs cfg)) - (packageName pkg_descr0) - installedPackageSet - internalPackageSet - promisedDepsSet - requiredDepsMap - ) - comp - compPlatform - pkg_descr0 - - debug verbosity $ - "Finalized package description:\n" - ++ showPackageDescription pkg_descr - - let cabalFileDir = - maybe "." takeDirectory $ - flagToMaybe (configCabalFilePath cfg) - checkCompilerProblems verbosity comp pkg_descr enabled - checkPackageProblems - verbosity - cabalFileDir - pkg_descr0 - (updatePackageDescription pbi pkg_descr) - - -- The list of 'InstalledPackageInfo' recording the selected - -- dependencies on external packages. - -- - -- Invariant: For any package name, there is at most one package - -- in externalPackageDeps which has that name. - -- - -- NB: The dependency selection is global over ALL components - -- in the package (similar to how allConstraints and - -- requiredDepsMap are global over all components). In particular, - -- if *any* component (post-flag resolution) has an unsatisfiable - -- dependency, we will fail. This can sometimes be undesirable - -- for users, see #1786 (benchmark conflicts with executable), - -- - -- In the presence of Backpack, these package dependencies are - -- NOT complete: they only ever include the INDEFINITE - -- dependencies. After we apply an instantiation, we'll get - -- definite references which constitute extra dependencies. - -- (Why not have cabal-install pass these in explicitly? - -- For one it's deterministic; for two, we need to associate - -- them with renamings which would require a far more complicated - -- input scheme than what we have today.) - externalPkgDeps :: ([PreExistingComponent], [PromisedComponent]) <- - configureDependencies - verbosity - use_external_internal_deps - internalPackageSet - promisedDepsSet - installedPackageSet - requiredDepsMap - pkg_descr - enabled - - -- Compute installation directory templates, based on user - -- configuration. - -- - -- TODO: Move this into a helper function. - defaultDirs :: InstallDirTemplates <- - defaultInstallDirs' - use_external_internal_deps - (compilerFlavor comp) - (fromFlag (configUserInstall cfg)) - (hasLibs pkg_descr) - let installDirs :: InstallDirTemplates - installDirs = - combineInstallDirs - fromFlagOrDefault - defaultDirs - (configInstallDirs cfg) - - -- Check languages and extensions - -- TODO: Move this into a helper function. - let langlist = - nub $ - catMaybes $ - map - defaultLanguage - (enabledBuildInfos pkg_descr enabled) - let langs = unsupportedLanguages comp langlist - when (not (null langs)) $ - dieWithException verbosity $ - UnsupportedLanguages (packageId pkg_descr0) (compilerId comp) (map prettyShow langs) - let extlist = - nub $ - concatMap - allExtensions - (enabledBuildInfos pkg_descr enabled) - let exts = unsupportedExtensions comp extlist - when (not (null exts)) $ - dieWithException verbosity $ - UnsupportedLanguageExtension (packageId pkg_descr0) (compilerId comp) (map prettyShow exts) - - -- Check foreign library build requirements - let flibs = [flib | CFLib flib <- enabledComponents pkg_descr enabled] - let unsupportedFLibs = unsupportedForeignLibs comp compPlatform flibs - when (not (null unsupportedFLibs)) $ - dieWithException verbosity $ - CantFindForeignLibraries unsupportedFLibs - - -- Configure certain external build tools, see below for which ones. - let requiredBuildTools = do - bi <- enabledBuildInfos pkg_descr enabled - -- First, we collect any tool dep that we know is external. This is, - -- in practice: - -- - -- 1. `build-tools` entries on the whitelist - -- - -- 2. `build-tool-depends` that aren't from the current package. - let externBuildToolDeps = - [ LegacyExeDependency (unUnqualComponentName eName) versionRange - | buildTool@(ExeDependency _ eName versionRange) <- - getAllToolDependencies pkg_descr bi - , not $ isInternal pkg_descr buildTool - ] - -- Second, we collect any build-tools entry we don't know how to - -- desugar. We'll never have any idea how to build them, so we just - -- hope they are already on the PATH. - let unknownBuildTools = - [ buildTool - | buildTool <- buildTools bi - , Nothing == desugarBuildTool pkg_descr buildTool - ] - externBuildToolDeps ++ unknownBuildTools - - programDb' <- - configureAllKnownPrograms (lessVerbose verbosity) programDb - >>= configureRequiredPrograms verbosity requiredBuildTools + configCompilerEx + (flagToMaybe (configHcFlavor cfg)) + (flagToMaybe (configHcPath cfg)) + (flagToMaybe (configHcPkg cfg)) + (mkProgramDb cfg (configPrograms cfg)) + (lessVerbose verbosity) - (pkg_descr', programDb'') <- - configurePkgconfigPackages verbosity pkg_descr programDb' enabled + -- Where to build the package + let build_dir :: FilePath -- e.g. dist/build + build_dir = configFlagsBuildDir cfg + -- NB: create this directory now so that all configure hooks get + -- to see it. (In practice, the Configure build-type needs it before + -- the postConfPackageHook runs.) + createDirectoryIfMissingVerbose (lessVerbose verbosity) True build_dir - -- Compute internal component graph - -- - -- The general idea is that we take a look at all the source level - -- components (which may build-depends on each other) and form a graph. - -- From there, we build a ComponentLocalBuildInfo for each of the - -- components, which lets us actually build each component. - -- internalPackageSet - -- use_external_internal_deps - ( buildComponents :: [ComponentLocalBuildInfo] - , packageDependsIndex :: InstalledPackageIndex - ) <- - runLogProgress verbosity $ - configureComponentLocalBuildInfos - verbosity - use_external_internal_deps - enabled - (fromFlagOrDefault False (configDeterministic cfg)) - (configIPID cfg) - (configCID cfg) - pkg_descr - externalPkgDeps - (configConfigurationsFlags cfg) - (configInstantiateWith cfg) - installedPackageSet - comp + lbc <- computeLocalBuildConfig cfg comp programDb00 + return (lbc, comp, compPlatform, enabled) +computeLocalBuildConfig + :: ConfigFlags + -> Compiler + -> ProgramDb + -> IO LBC.LocalBuildConfig +computeLocalBuildConfig cfg comp programDb = do + let verbosity = fromFlag (configVerbosity cfg) -- Decide if we're going to compile with split sections. split_sections :: Bool <- if not (fromFlag $ configSplitSections cfg) @@ -771,7 +567,7 @@ configure (pkg_descr0, pbi) cfg = do -- Basically yes/no/unknown. let linkerSupportsRelocations :: Maybe Bool linkerSupportsRelocations = - case lookupProgramByName "ld" programDb'' of + case lookupProgramByName "ld" programDb of Nothing -> Nothing Just ld -> case Map.lookup "Supports relocatable output" $ programProperties ld of @@ -840,9 +636,9 @@ configure (pkg_descr0, pbi) cfg = do ++ "is not being built. Linking will fail if any executables " ++ "depend on the library." - setProfLBI <- configureProfiling verbosity cfg comp + setProfiling <- configureProfiling verbosity cfg comp - setCoverageLBI <- configureCoverage verbosity cfg comp + setCoverage <- configureCoverage verbosity cfg comp -- Turn off library and executable stripping when `debug-info` is set -- to anything other than zero. @@ -863,40 +659,10 @@ configure (pkg_descr0, pbi) cfg = do strip_lib <- strip_libexe "library" configStripLibs strip_exe <- strip_libexe "executable" configStripExes - let reloc = fromFlagOrDefault False $ configRelocatable cfg - - let buildComponentsMap = - foldl' - ( \m clbi -> - Map.insertWith - (++) - (componentLocalName clbi) - [clbi] - m - ) - Map.empty - buildComponents - - let lbi = - (setCoverageLBI . setProfLBI) - LocalBuildInfo - { configFlags = cfg - , flagAssignment = flags - , componentEnabledSpec = enabled - , extraConfigArgs = [] -- Currently configure does not - -- take extra args, but if it - -- did they would go here. - , installDirTemplates = installDirs - , compiler = comp - , hostPlatform = compPlatform - , componentGraph = Graph.fromDistinctList buildComponents - , componentNameMap = buildComponentsMap - , installedPkgs = packageDependsIndex - , promisedPkgs = promisedDepsSet - , pkgDescrFile = Nothing - , localPkgDescr = pkg_descr' - , withPrograms = programDb'' - , withVanillaLib = fromFlag $ configVanillaLib cfg + let buildOptions = + setCoverage . setProfiling $ + LBC.BuildOptions + { withVanillaLib = fromFlag $ configVanillaLib cfg , withSharedLib = withSharedLib_ , withStaticLib = withStaticLib_ , withDynExe = withDynExe_ @@ -914,76 +680,535 @@ configure (pkg_descr0, pbi) cfg = do , stripLibs = strip_lib , exeCoverage = False , libCoverage = False - , withPackageDB = packageDbs - , relocatable = reloc + , relocatable = fromFlagOrDefault False $ configRelocatable cfg } - when reloc (checkRelocatable verbosity pkg_descr lbi) + return $ + LBC.LocalBuildConfig + { extraConfigArgs = [] -- Currently configure does not + -- take extra args, but if it + -- did they would go here. + , withPrograms = programDb + , withBuildOptions = buildOptions + } + +data PackageInfo = PackageInfo + { internalPackageSet :: Set LibraryName + , promisedDepsSet :: Map (PackageName, ComponentName) ComponentId + , installedPackageSet :: InstalledPackageIndex + , requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo + } + +configurePackage + :: ConfigFlags + -> LBC.LocalBuildConfig + -> PackageDescription + -> FlagAssignment + -> ComponentRequestedSpec + -> Compiler + -> Platform + -> ProgramDb + -> PackageDBStack + -> IO (LBC.LocalBuildConfig, LBC.PackageBuildDescr) +configurePackage cfg lbc0 pkg_descr00 flags enabled comp platform programDb0 packageDbs = do + let verbosity = fromFlag (configVerbosity cfg) + + -- add extra include/lib dirs as specified in cfg + pkg_descr0 = addExtraIncludeLibDirsFromConfigFlags pkg_descr00 cfg + -- TODO: it is not clear whether this adding these dirs is necessary + -- when we are directly stating from a PackageDescription (e.g. when + -- cabal-install has determined a PackageDescription, instead of rediscovering + -- when working with a GenericPackageDescription). + -- Could this function call be moved to the end of finalizeAndConfigurePackage + -- right before calling configurePackage? + + -- Configure certain external build tools, see below for which ones. + let requiredBuildTools = do + bi <- enabledBuildInfos pkg_descr0 enabled + -- First, we collect any tool dep that we know is external. This is, + -- in practice: + -- + -- 1. `build-tools` entries on the whitelist + -- + -- 2. `build-tool-depends` that aren't from the current package. + let externBuildToolDeps = + [ LegacyExeDependency (unUnqualComponentName eName) versionRange + | buildTool@(ExeDependency _ eName versionRange) <- + getAllToolDependencies pkg_descr0 bi + , not $ isInternal pkg_descr0 buildTool + ] + -- Second, we collect any build-tools entry we don't know how to + -- desugar. We'll never have any idea how to build them, so we just + -- hope they are already on the PATH. + let unknownBuildTools = + [ buildTool + | buildTool <- buildTools bi + , Nothing == desugarBuildTool pkg_descr0 buildTool + ] + externBuildToolDeps ++ unknownBuildTools + + programDb1 <- + configureAllKnownPrograms (lessVerbose verbosity) programDb0 + >>= configureRequiredPrograms verbosity requiredBuildTools + + (pkg_descr2, programDb2) <- + configurePkgconfigPackages verbosity pkg_descr0 programDb1 enabled - -- TODO: This is not entirely correct, because the dirs may vary - -- across libraries/executables - let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest - relative = prefixRelativeInstallDirs (packageId pkg_descr) lbi + let use_external_internal_deps = + case enabled of + OneComponentRequestedSpec{} -> True + ComponentRequestedSpec{} -> False - -- PKGROOT: allowing ${pkgroot} to be passed as --prefix to - -- cabal configure, is only a hidden option. It allows packages - -- to be relocatable with their package database. This however - -- breaks when the Paths_* or other includes are used that - -- contain hard coded paths. This is still an open TODO. + -- Compute installation directory templates, based on user + -- configuration. -- - -- Allowing ${pkgroot} here, however requires less custom hooks - -- in scripts that *really* want ${pkgroot}. See haskell/cabal/#4872 - unless - ( isAbsolute (prefix dirs) - || "${pkgroot}" `isPrefixOf` prefix dirs + -- TODO: Move this into a helper function. + defaultDirs :: InstallDirTemplates <- + defaultInstallDirs' + use_external_internal_deps + (compilerFlavor comp) + (fromFlag (configUserInstall cfg)) + (hasLibs pkg_descr2) + let + installDirs = + combineInstallDirs + fromFlagOrDefault + defaultDirs + (configInstallDirs cfg) + lbc = lbc0{LBC.withPrograms = programDb2} + pbd = + LBC.PackageBuildDescr + { configFlags = cfg + , flagAssignment = flags + , componentEnabledSpec = enabled + , compiler = comp + , hostPlatform = platform + , localPkgDescr = pkg_descr2 + , installDirTemplates = installDirs + , withPackageDB = packageDbs + , pkgDescrFile = Nothing + } + + debug verbosity $ + "Finalized package description:\n" + ++ showPackageDescription pkg_descr2 + + return (lbc, pbd) + +finalizeAndConfigurePackage + :: ConfigFlags + -> LBC.LocalBuildConfig + -> GenericPackageDescription + -> Compiler + -> Platform + -> ComponentRequestedSpec + -> IO (LBC.LocalBuildConfig, LBC.PackageBuildDescr, PackageInfo) +finalizeAndConfigurePackage cfg lbc0 g_pkg_descr comp platform enabled = do + let verbosity = fromFlag (configVerbosity cfg) + + let programDb0 = LBC.withPrograms lbc0 + -- What package database(s) to use + packageDbs :: PackageDBStack + packageDbs = + interpretPackageDbFlags + (fromFlag (configUserInstall cfg)) + (configPackageDBs cfg) + + -- The InstalledPackageIndex of all installed packages + installedPackageSet :: InstalledPackageIndex <- + getInstalledPackages + (lessVerbose verbosity) + comp + packageDbs + programDb0 + + -- The set of package names which are "shadowed" by internal + -- packages, and which component they map to + let internalPackageSet :: Set LibraryName + internalPackageSet = getInternalLibraries g_pkg_descr + + -- Some sanity checks related to dynamic/static linking. + when (fromFlag (configDynExe cfg) && fromFlag (configFullyStaticExe cfg)) $ + dieWithException verbosity SanityCheckForDynamicStaticLinking + + -- allConstraints: The set of all 'Dependency's we have. Used ONLY + -- to 'configureFinalizedPackage'. + -- requiredDepsMap: A map from 'PackageName' to the specifically + -- required 'InstalledPackageInfo', due to --dependency + -- + -- NB: These constraints are to be applied to ALL components of + -- a package. Thus, it's not an error if allConstraints contains + -- more constraints than is necessary for a component (another + -- component might need it.) + -- + -- NB: The fact that we bundle all the constraints together means + -- that is not possible to configure a test-suite to use one + -- version of a dependency, and the executable to use another. + ( allConstraints :: [PackageVersionConstraint] + , requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo + ) <- + either (dieWithException verbosity) return $ + combinedConstraints + (configConstraints cfg) + (configDependencies cfg) + installedPackageSet + + let + promisedDepsSet = mkPromisedDepsSet (configPromisedDependencies cfg) + pkg_info = + PackageInfo + { internalPackageSet + , promisedDepsSet + , installedPackageSet + , requiredDepsMap + } + + -- pkg_descr: The resolved package description, that does not contain any + -- conditionals, because we have an assignment for + -- every flag, either picking them ourselves using a + -- simple naive algorithm, or having them be passed to + -- us by 'configConfigurationsFlags') + -- flags: The 'FlagAssignment' that the conditionals were + -- resolved with. + -- + -- NB: Why doesn't finalizing a package also tell us what the + -- dependencies are (e.g. when we run the naive algorithm, + -- we are checking if dependencies are satisfiable)? The + -- primary reason is that we may NOT have done any solving: + -- if the flags are all chosen for us, this step is a simple + -- matter of flattening according to that assignment. It's + -- cleaner to then configure the dependencies afterwards. + let use_external_internal_deps = case enabled of + OneComponentRequestedSpec{} -> True + ComponentRequestedSpec{} -> False + ( pkg_descr0 :: PackageDescription + , flags :: FlagAssignment + ) <- + configureFinalizedPackage + verbosity + cfg + enabled + allConstraints + ( dependencySatisfiable + use_external_internal_deps + (fromFlagOrDefault False (configExactConfiguration cfg)) + (fromFlagOrDefault False (configAllowDependingOnPrivateLibs cfg)) + (packageName g_pkg_descr) + installedPackageSet + internalPackageSet + promisedDepsSet + requiredDepsMap + ) + comp + platform + g_pkg_descr + + (lbc, pbd) <- + configurePackage + cfg + lbc0 + pkg_descr0 + flags + enabled + comp + platform + programDb0 + packageDbs + return (lbc, pbd, pkg_info) + +addExtraIncludeLibDirsFromConfigFlags + :: PackageDescription -> ConfigFlags -> PackageDescription +addExtraIncludeLibDirsFromConfigFlags pkg_descr cfg = + let extraBi = + mempty + { extraLibDirs = configExtraLibDirs cfg + , extraLibDirsStatic = configExtraLibDirsStatic cfg + , extraFrameworkDirs = configExtraFrameworkDirs cfg + , includeDirs = configExtraIncludeDirs cfg + } + modifyLib l = + l + { libBuildInfo = + libBuildInfo l + `mappend` extraBi + } + modifyExecutable e = + e + { buildInfo = + buildInfo e + `mappend` extraBi + } + modifyForeignLib f = + f + { foreignLibBuildInfo = + foreignLibBuildInfo f + `mappend` extraBi + } + modifyTestsuite t = + t + { testBuildInfo = + testBuildInfo t + `mappend` extraBi + } + modifyBenchmark b = + b + { benchmarkBuildInfo = + benchmarkBuildInfo b + `mappend` extraBi + } + in pkg_descr + { library = modifyLib `fmap` library pkg_descr + , subLibraries = modifyLib `map` subLibraries pkg_descr + , executables = modifyExecutable `map` executables pkg_descr + , foreignLibs = modifyForeignLib `map` foreignLibs pkg_descr + , testSuites = modifyTestsuite `map` testSuites pkg_descr + , benchmarks = modifyBenchmark `map` benchmarks pkg_descr + } + +finalCheckPackage + :: GenericPackageDescription + -> LBC.PackageBuildDescr + -> HookedBuildInfo + -> PackageInfo + -> IO ([PreExistingComponent], [PromisedComponent]) +finalCheckPackage + g_pkg_descr + ( LBC.PackageBuildDescr + { configFlags = cfg + , localPkgDescr = pkg_descr + , compiler = comp + , hostPlatform = compPlatform + , componentEnabledSpec = enabled + } ) - $ dieWithException verbosity - $ ExpectedAbsoluteDirectory (prefix dirs) + hookedBuildInfo + (PackageInfo{internalPackageSet, promisedDepsSet, installedPackageSet, requiredDepsMap}) = + do + let verbosity = fromFlag (configVerbosity cfg) + use_external_internal_deps = + case enabled of + OneComponentRequestedSpec{} -> True + ComponentRequestedSpec{} -> False + + let cabalFileDir = + maybe "." takeDirectory $ + flagToMaybe (configCabalFilePath cfg) + checkCompilerProblems verbosity comp pkg_descr enabled + checkPackageProblems + verbosity + cabalFileDir + g_pkg_descr + (updatePackageDescription hookedBuildInfo pkg_descr) + -- NB: we apply the HookedBuildInfo to check it is valid, + -- but we don't propagate it. + -- Other UserHooks must separately return it again, and we + -- will re-apply it each time. + + -- Check languages and extensions + -- TODO: Move this into a helper function. + let langlist = + nub $ + catMaybes $ + map + defaultLanguage + (enabledBuildInfos pkg_descr enabled) + let langs = unsupportedLanguages comp langlist + when (not (null langs)) $ + dieWithException verbosity $ + UnsupportedLanguages (packageId g_pkg_descr) (compilerId comp) (map prettyShow langs) + let extlist = + nub $ + concatMap + allExtensions + (enabledBuildInfos pkg_descr enabled) + let exts = unsupportedExtensions comp extlist + when (not (null exts)) $ + dieWithException verbosity $ + UnsupportedLanguageExtension (packageId g_pkg_descr) (compilerId comp) (map prettyShow exts) - when ("${pkgroot}" `isPrefixOf` prefix dirs) $ - warn verbosity $ - "Using ${pkgroot} in prefix " - ++ prefix dirs - ++ " will not work if you rely on the Path_* module " - ++ " or other hard coded paths. Cabal does not yet " - ++ " support fully relocatable builds! " - ++ " See #462 #2302 #2994 #3305 #3473 #3586 #3909" - ++ " #4097 #4291 #4872" + -- Check foreign library build requirements + let flibs = [flib | CFLib flib <- enabledComponents pkg_descr enabled] + let unsupportedFLibs = unsupportedForeignLibs comp compPlatform flibs + when (not (null unsupportedFLibs)) $ + dieWithException verbosity $ + CantFindForeignLibraries unsupportedFLibs + + -- The list of 'InstalledPackageInfo' recording the selected + -- dependencies on external packages. + -- + -- Invariant: For any package name, there is at most one package + -- in externalPackageDeps which has that name. + -- + -- NB: The dependency selection is global over ALL components + -- in the package (similar to how allConstraints and + -- requiredDepsMap are global over all components). In particular, + -- if *any* component (post-flag resolution) has an unsatisfiable + -- dependency, we will fail. This can sometimes be undesirable + -- for users, see #1786 (benchmark conflicts with executable), + -- + -- In the presence of Backpack, these package dependencies are + -- NOT complete: they only ever include the INDEFINITE + -- dependencies. After we apply an instantiation, we'll get + -- definite references which constitute extra dependencies. + -- (Why not have cabal-install pass these in explicitly? + -- For one it's deterministic; for two, we need to associate + -- them with renamings which would require a far more complicated + -- input scheme than what we have today.) + configureDependencies + verbosity + use_external_internal_deps + internalPackageSet + promisedDepsSet + installedPackageSet + requiredDepsMap + pkg_descr + enabled - info verbosity $ - "Using " - ++ prettyShow currentCabalId - ++ " compiled by " - ++ prettyShow currentCompilerId - info verbosity $ "Using compiler: " ++ showCompilerId comp - info verbosity $ "Using install prefix: " ++ prefix dirs - - let dirinfo name dir isPrefixRelative = - info verbosity $ name ++ " installed in: " ++ dir ++ relNote - where - relNote = case buildOS of - Windows - | not (hasLibs pkg_descr) - && isNothing isPrefixRelative -> - " (fixed location)" - _ -> "" - - dirinfo "Executables" (bindir dirs) (bindir relative) - dirinfo "Libraries" (libdir dirs) (libdir relative) - dirinfo "Dynamic Libraries" (dynlibdir dirs) (dynlibdir relative) - dirinfo "Private executables" (libexecdir dirs) (libexecdir relative) - dirinfo "Data files" (datadir dirs) (datadir relative) - dirinfo "Documentation" (docdir dirs) (docdir relative) - dirinfo "Configuration files" (sysconfdir dirs) (sysconfdir relative) +configureComponents + :: LBC.LocalBuildConfig + -> LBC.PackageBuildDescr + -> PackageInfo + -> ([PreExistingComponent], [PromisedComponent]) + -> IO LocalBuildInfo +configureComponents + lbc@(LBC.LocalBuildConfig{withPrograms = programDb}) + pbd@( LBC.PackageBuildDescr + { configFlags = cfg + , localPkgDescr = pkg_descr + , compiler = comp + , componentEnabledSpec = enabled + } + ) + (PackageInfo{promisedDepsSet, installedPackageSet}) + externalPkgDeps = + do + let verbosity = fromFlag (configVerbosity cfg) + use_external_internal_deps = + case enabled of + OneComponentRequestedSpec{} -> True + ComponentRequestedSpec{} -> False + + -- Compute internal component graph + -- + -- The general idea is that we take a look at all the source level + -- components (which may build-depends on each other) and form a graph. + -- From there, we build a ComponentLocalBuildInfo for each of the + -- components, which lets us actually build each component. + ( buildComponents :: [ComponentLocalBuildInfo] + , packageDependsIndex :: InstalledPackageIndex + ) <- + runLogProgress verbosity $ + configureComponentLocalBuildInfos + verbosity + use_external_internal_deps + enabled + (fromFlagOrDefault False (configDeterministic cfg)) + (configIPID cfg) + (configCID cfg) + pkg_descr + externalPkgDeps + (configConfigurationsFlags cfg) + (configInstantiateWith cfg) + installedPackageSet + comp + + let buildComponentsMap = + foldl' + ( \m clbi -> + Map.insertWith + (++) + (componentLocalName clbi) + [clbi] + m + ) + Map.empty + buildComponents + + let cbd = + LBC.ComponentBuildDescr + { componentGraph = Graph.fromDistinctList buildComponents + , componentNameMap = buildComponentsMap + , promisedPkgs = promisedDepsSet + , installedPkgs = packageDependsIndex + } - sequence_ - [ reportProgram verbosity prog configuredProg - | (prog, configuredProg) <- knownPrograms programDb'' - ] + lbd = + LBC.LocalBuildDescr + { packageBuildDescr = pbd + , componentBuildDescr = cbd + } - return lbi - where - verbosity = fromFlag (configVerbosity cfg) + lbi = + NewLocalBuildInfo + { localBuildDescr = lbd + , localBuildConfig = lbc + } + + when (LBC.relocatable $ LBC.withBuildOptions lbc) $ + checkRelocatable verbosity pkg_descr lbi + + -- TODO: This is not entirely correct, because the dirs may vary + -- across libraries/executables + let dirs = absoluteInstallDirs pkg_descr lbi NoCopyDest + relative = prefixRelativeInstallDirs (packageId pkg_descr) lbi + + -- PKGROOT: allowing ${pkgroot} to be passed as --prefix to + -- cabal configure, is only a hidden option. It allows packages + -- to be relocatable with their package database. This however + -- breaks when the Paths_* or other includes are used that + -- contain hard coded paths. This is still an open TODO. + -- + -- Allowing ${pkgroot} here, however requires less custom hooks + -- in scripts that *really* want ${pkgroot}. See haskell/cabal/#4872 + unless + ( isAbsolute (prefix dirs) + || "${pkgroot}" `isPrefixOf` prefix dirs + ) + $ dieWithException verbosity + $ ExpectedAbsoluteDirectory (prefix dirs) + + when ("${pkgroot}" `isPrefixOf` prefix dirs) $ + warn verbosity $ + "Using ${pkgroot} in prefix " + ++ prefix dirs + ++ " will not work if you rely on the Path_* module " + ++ " or other hard coded paths. Cabal does not yet " + ++ " support fully relocatable builds! " + ++ " See #462 #2302 #2994 #3305 #3473 #3586 #3909" + ++ " #4097 #4291 #4872" + + info verbosity $ + "Using " + ++ prettyShow currentCabalId + ++ " compiled by " + ++ prettyShow currentCompilerId + info verbosity $ "Using compiler: " ++ showCompilerId comp + info verbosity $ "Using install prefix: " ++ prefix dirs + + let dirinfo name dir isPrefixRelative = + info verbosity $ name ++ " installed in: " ++ dir ++ relNote + where + relNote = case buildOS of + Windows + | not (hasLibs pkg_descr) + && isNothing isPrefixRelative -> + " (fixed location)" + _ -> "" + + dirinfo "Executables" (bindir dirs) (bindir relative) + dirinfo "Libraries" (libdir dirs) (libdir relative) + dirinfo "Dynamic Libraries" (dynlibdir dirs) (dynlibdir relative) + dirinfo "Private executables" (libexecdir dirs) (libexecdir relative) + dirinfo "Data files" (datadir dirs) (datadir relative) + dirinfo "Documentation" (docdir dirs) (docdir relative) + dirinfo "Configuration files" (sysconfdir dirs) (sysconfdir relative) + + sequence_ + [ reportProgram verbosity prog configuredProg + | (prog, configuredProg) <- knownPrograms programDb + ] + + return lbi mkPromisedDepsSet :: [GivenComponent] -> Map (PackageName, ComponentName) ComponentId mkPromisedDepsSet comps = Map.fromList [((pn, CLibName ln), cid) | GivenComponent pn ln cid <- comps] @@ -1175,12 +1400,9 @@ dependencySatisfiable maybeIPI = Map.lookup (depName, CLibName lib) requiredDepsMap promised = isJust $ Map.lookup (depName, CLibName lib) promisedDeps --- | Finalize a generic package description. The workhorse is --- 'finalizePD' but there's a bit of other nattering --- about necessary. +-- | Finalize a generic package description. -- --- TODO: what exactly is the business with @flaggedTests@ and --- @flaggedBenchmarks@? +-- The workhorse is 'finalizePD'. configureFinalizedPackage :: Verbosity -> ConfigFlags @@ -1202,7 +1424,7 @@ configureFinalizedPackage comp compPlatform pkg_descr0 = do - (pkg_descr0', flags) <- + (pkg_descr, flags) <- case finalizePD (configConfigurationsFlags cfg) enabled @@ -1215,10 +1437,6 @@ configureFinalizedPackage Left missing -> dieWithException verbosity $ EncounteredMissingDependency missing - -- add extra include/lib dirs as specified in cfg - -- we do it here so that those get checked too - let pkg_descr = addExtraIncludeLibDirs pkg_descr0' - unless (nullFlagAssignment flags) $ info verbosity $ "Flags chosen: " @@ -1229,53 +1447,6 @@ configureFinalizedPackage ] return (pkg_descr, flags) - where - addExtraIncludeLibDirs pkg_descr = - let extraBi = - mempty - { extraLibDirs = configExtraLibDirs cfg - , extraLibDirsStatic = configExtraLibDirsStatic cfg - , extraFrameworkDirs = configExtraFrameworkDirs cfg - , includeDirs = configExtraIncludeDirs cfg - } - modifyLib l = - l - { libBuildInfo = - libBuildInfo l - `mappend` extraBi - } - modifyExecutable e = - e - { buildInfo = - buildInfo e - `mappend` extraBi - } - modifyForeignLib f = - f - { foreignLibBuildInfo = - foreignLibBuildInfo f - `mappend` extraBi - } - modifyTestsuite t = - t - { testBuildInfo = - testBuildInfo t - `mappend` extraBi - } - modifyBenchmark b = - b - { benchmarkBuildInfo = - benchmarkBuildInfo b - `mappend` extraBi - } - in pkg_descr - { library = modifyLib `fmap` library pkg_descr - , subLibraries = modifyLib `map` subLibraries pkg_descr - , executables = modifyExecutable `map` executables pkg_descr - , foreignLibs = modifyForeignLib `map` foreignLibs pkg_descr - , testSuites = modifyTestsuite `map` testSuites pkg_descr - , benchmarks = modifyBenchmark `map` benchmarks pkg_descr - } -- | Check for use of Cabal features which require compiler support checkCompilerProblems @@ -1373,7 +1544,7 @@ configureCoverage :: Verbosity -> ConfigFlags -> Compiler - -> IO (LocalBuildInfo -> LocalBuildInfo) + -> IO (LBC.BuildOptions -> LBC.BuildOptions) configureCoverage verbosity cfg comp = do let tryExeCoverage = fromFlagOrDefault False (configCoverage cfg) tryLibCoverage = @@ -1382,17 +1553,17 @@ configureCoverage verbosity cfg comp = do (mappend (configCoverage cfg) (configLibCoverage cfg)) if coverageSupported comp then do - let apply lbi = - lbi - { libCoverage = tryLibCoverage - , exeCoverage = tryExeCoverage + let apply buildOptions = + buildOptions + { LBC.libCoverage = tryLibCoverage + , LBC.exeCoverage = tryExeCoverage } return apply else do - let apply lbi = - lbi - { libCoverage = False - , exeCoverage = False + let apply buildOptions = + buildOptions + { LBC.libCoverage = False + , LBC.exeCoverage = False } when (tryExeCoverage || tryLibCoverage) $ warn @@ -1438,7 +1609,7 @@ configureProfiling :: Verbosity -> ConfigFlags -> Compiler - -> IO (LocalBuildInfo -> LocalBuildInfo) + -> IO (LBC.BuildOptions -> LBC.BuildOptions) configureProfiling verbosity cfg comp = do let (tryLibProfiling, tryExeProfiling) = computeEffectiveProfiling cfg @@ -1472,21 +1643,21 @@ configureProfiling verbosity cfg comp = do then do exeLevel <- checkProfileLevel tryExeProfileLevel libLevel <- checkProfileLevel tryLibProfileLevel - let apply lbi = - lbi - { withProfLib = tryLibProfiling - , withProfLibDetail = libLevel - , withProfExe = tryExeProfiling - , withProfExeDetail = exeLevel + let apply buildOptions = + buildOptions + { LBC.withProfLib = tryLibProfiling + , LBC.withProfLibDetail = libLevel + , LBC.withProfExe = tryExeProfiling + , LBC.withProfExeDetail = exeLevel } return (tryExeProfiling && not tryLibProfiling, apply) else do - let apply lbi = - lbi - { withProfLib = False - , withProfLibDetail = ProfDetailNone - , withProfExe = False - , withProfExeDetail = ProfDetailNone + let apply buildOptions = + buildOptions + { LBC.withProfLib = False + , LBC.withProfLibDetail = ProfDetailNone + , LBC.withProfExe = False + , LBC.withProfExeDetail = ProfDetailNone } when (tryExeProfiling || tryLibProfiling) $ warn diff --git a/Cabal/src/Distribution/Simple/LocalBuildInfo.hs b/Cabal/src/Distribution/Simple/LocalBuildInfo.hs index 58d2460e90f..8659764d0c4 100644 --- a/Cabal/src/Distribution/Simple/LocalBuildInfo.hs +++ b/Cabal/src/Distribution/Simple/LocalBuildInfo.hs @@ -208,8 +208,8 @@ withAllComponentsInBuildOrder pkg lbi f = allComponentsInBuildOrder :: LocalBuildInfo -> [ComponentLocalBuildInfo] -allComponentsInBuildOrder (LocalBuildInfo{componentGraph}) = - Graph.topSort componentGraph +allComponentsInBuildOrder (LocalBuildInfo{componentGraph = compGraph}) = + Graph.topSort compGraph -- ----------------------------------------------------------------------------- -- A random function that has no business in this module @@ -232,7 +232,7 @@ depLibraryPaths relative lbi@( LocalBuildInfo { localPkgDescr = pkgDescr - , installedPkgs + , installedPkgs = installed } ) clbi = do @@ -284,7 +284,7 @@ depLibraryPaths -- is a moot point if you are using a per-component build, -- because you never have any internal libraries in this case; -- they're all external. - let external_ipkgs = filter is_external (allPackages installedPkgs) + let external_ipkgs = filter is_external (allPackages installed) is_external ipkg = not (installedUnitId ipkg `elem` internalDeps) -- First look for dynamic libraries in `dynamic-library-dirs`, and use -- `library-dirs` as a fall back. @@ -358,16 +358,16 @@ absoluteComponentInstallDirs -> InstallDirs FilePath absoluteComponentInstallDirs pkg - (LocalBuildInfo{compiler, hostPlatform, installDirTemplates}) + (LocalBuildInfo{compiler = comp, hostPlatform = plat, installDirTemplates = installDirs}) uid copydest = InstallDirs.absoluteInstallDirs (packageId pkg) uid - (compilerInfo compiler) + (compilerInfo comp) copydest - hostPlatform - installDirTemplates + plat + installDirs absoluteInstallCommandDirs :: PackageDescription @@ -418,14 +418,14 @@ prefixRelativeComponentInstallDirs -> InstallDirs (Maybe FilePath) prefixRelativeComponentInstallDirs pkg_descr - (LocalBuildInfo{compiler, hostPlatform, installDirTemplates}) + (LocalBuildInfo{compiler = comp, hostPlatform = plat, installDirTemplates = installDirs}) uid = InstallDirs.prefixRelativeInstallDirs (packageId pkg_descr) uid - (compilerInfo compiler) - hostPlatform - installDirTemplates + (compilerInfo comp) + plat + installDirs substPathTemplate :: PackageId @@ -435,7 +435,7 @@ substPathTemplate -> FilePath substPathTemplate pkgid - (LocalBuildInfo{compiler, hostPlatform}) + (LocalBuildInfo{compiler = comp, hostPlatform = plat}) uid = fromPathTemplate . (InstallDirs.substPathTemplate env) @@ -444,5 +444,5 @@ substPathTemplate initialPathTemplateEnv pkgid uid - (compilerInfo compiler) - hostPlatform + (compilerInfo comp) + plat diff --git a/Cabal/src/Distribution/Types/LocalBuildInfo.hs b/Cabal/src/Distribution/Types/LocalBuildInfo.hs index 4285a983a29..ddec078b6ab 100644 --- a/Cabal/src/Distribution/Types/LocalBuildInfo.hs +++ b/Cabal/src/Distribution/Types/LocalBuildInfo.hs @@ -306,7 +306,7 @@ localComponentId lbi = -- | Extract the 'PackageIdentifier' of a 'LocalBuildInfo'. -- This is a "safe" use of 'localPkgDescr' localPackage :: LocalBuildInfo -> PackageId -localPackage (LocalBuildInfo{localPkgDescr}) = package localPkgDescr +localPackage (LocalBuildInfo{localPkgDescr = pkg}) = package pkg -- | Extract the 'UnitId' from the library component of a -- 'LocalBuildInfo' if it exists, or make a fake unit ID based on @@ -347,22 +347,22 @@ mkTargetInfo pkg_descr _lbi clbi = -- 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@(LocalBuildInfo{componentNameMap}) cname = - case Map.lookup cname componentNameMap of +componentNameTargets' pkg_descr lbi@(LocalBuildInfo{componentNameMap = comps}) cname = + case Map.lookup cname comps of Just clbis -> map (mkTargetInfo pkg_descr lbi) clbis Nothing -> [] unitIdTarget' :: PackageDescription -> LocalBuildInfo -> UnitId -> Maybe TargetInfo -unitIdTarget' pkg_descr lbi@(LocalBuildInfo{componentGraph}) uid = - case Graph.lookup uid componentGraph of +unitIdTarget' pkg_descr lbi@(LocalBuildInfo{componentGraph = compsGraph}) uid = + case Graph.lookup uid compsGraph of Just clbi -> Just (mkTargetInfo pkg_descr lbi clbi) Nothing -> Nothing -- | Return all 'ComponentLocalBuildInfo's associated with 'ComponentName'. -- In the presence of Backpack there may be more than one! componentNameCLBIs :: LocalBuildInfo -> ComponentName -> [ComponentLocalBuildInfo] -componentNameCLBIs (LocalBuildInfo{componentNameMap}) cname = - case Map.lookup cname componentNameMap of +componentNameCLBIs (LocalBuildInfo{componentNameMap = comps}) cname = + case Map.lookup cname comps of Just clbis -> clbis Nothing -> [] @@ -373,8 +373,8 @@ componentNameCLBIs (LocalBuildInfo{componentNameMap}) cname = -- Has a prime because it takes a 'PackageDescription' argument -- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'. allTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [TargetInfo] -allTargetsInBuildOrder' pkg_descr lbi@(LocalBuildInfo{componentGraph}) = - map (mkTargetInfo pkg_descr lbi) (Graph.revTopSort componentGraph) +allTargetsInBuildOrder' pkg_descr lbi@(LocalBuildInfo{componentGraph = compsGraph}) = + map (mkTargetInfo pkg_descr lbi) (Graph.revTopSort compsGraph) -- | Execute @f@ for every 'TargetInfo' in the package, respecting the -- build dependency order. (TODO: We should use Shake!) @@ -389,8 +389,8 @@ withAllTargetsInBuildOrder' pkg_descr lbi f = -- 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@(LocalBuildInfo{componentGraph}) uids = - case Graph.closure componentGraph uids of +neededTargetsInBuildOrder' pkg_descr lbi@(LocalBuildInfo{componentGraph = compsGraph}) uids = + case Graph.closure compsGraph uids of Nothing -> error $ "localBuildPlan: missing uids " ++ intercalate ", " (map prettyShow uids) Just clos -> map (mkTargetInfo pkg_descr lbi) (Graph.revTopSort (Graph.fromDistinctList clos)) @@ -405,21 +405,28 @@ withNeededTargetsInBuildOrder' pkg_descr lbi uids f = -- | Is coverage enabled for test suites? In practice, this requires library -- and executable profiling to be enabled. testCoverage :: LocalBuildInfo -> Bool -testCoverage (LocalBuildInfo{exeCoverage, libCoverage}) = exeCoverage && libCoverage +testCoverage (LocalBuildInfo{exeCoverage = exes, libCoverage = libs}) = + exes && libs ------------------------------------------------------------------------------- -- Stub functions to prevent someone from accidentally defining them {-# WARNING componentNameTargets, unitIdTarget, 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 'PackageDescription' 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@(LocalBuildInfo{localPkgDescr}) = componentNameTargets' localPkgDescr lbi +componentNameTargets lbi@(LocalBuildInfo{localPkgDescr = pkg}) = + componentNameTargets' pkg lbi unitIdTarget :: LocalBuildInfo -> UnitId -> Maybe TargetInfo -unitIdTarget lbi@(LocalBuildInfo{localPkgDescr}) = unitIdTarget' localPkgDescr lbi +unitIdTarget lbi@(LocalBuildInfo{localPkgDescr = pkg}) = + unitIdTarget' pkg lbi allTargetsInBuildOrder :: LocalBuildInfo -> [TargetInfo] -allTargetsInBuildOrder lbi@(LocalBuildInfo{localPkgDescr}) = allTargetsInBuildOrder' localPkgDescr lbi +allTargetsInBuildOrder lbi@(LocalBuildInfo{localPkgDescr = pkg}) = + allTargetsInBuildOrder' pkg lbi withAllTargetsInBuildOrder :: LocalBuildInfo -> (TargetInfo -> IO ()) -> IO () -withAllTargetsInBuildOrder lbi@(LocalBuildInfo{localPkgDescr}) = withAllTargetsInBuildOrder' localPkgDescr lbi +withAllTargetsInBuildOrder lbi@(LocalBuildInfo{localPkgDescr = pkg}) = + withAllTargetsInBuildOrder' pkg lbi neededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> [TargetInfo] -neededTargetsInBuildOrder lbi@(LocalBuildInfo{localPkgDescr}) = neededTargetsInBuildOrder' localPkgDescr lbi +neededTargetsInBuildOrder lbi@(LocalBuildInfo{localPkgDescr = pkg}) = + neededTargetsInBuildOrder' pkg lbi withNeededTargetsInBuildOrder :: LocalBuildInfo -> [UnitId] -> (TargetInfo -> IO ()) -> IO () -withNeededTargetsInBuildOrder lbi@(LocalBuildInfo{localPkgDescr}) = withNeededTargetsInBuildOrder' localPkgDescr lbi +withNeededTargetsInBuildOrder lbi@(LocalBuildInfo{localPkgDescr = pkg}) = + withNeededTargetsInBuildOrder' pkg lbi