From a06460c378783818d692a74a4d0130af0fe411d1 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Sun, 10 Jul 2016 14:44:20 -0400 Subject: [PATCH 01/23] Add configArgs parameter to ConfigFlags. Signed-off-by: Edward Z. Yang --- Cabal/Distribution/Simple.hs | 3 ++- Cabal/Distribution/Simple/Setup.hs | 6 ++++++ cabal-install/Distribution/Client/Config.hs | 1 + cabal-install/Distribution/Client/ProjectConfig/Legacy.hs | 2 ++ cabal-install/Distribution/Client/ProjectPlanning.hs | 1 + 5 files changed, 12 insertions(+), 1 deletion(-) diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs index 3bce554fb53..b0acbde5e8e 100644 --- a/Cabal/Distribution/Simple.hs +++ b/Cabal/Distribution/Simple.hs @@ -187,7 +187,8 @@ allSuffixHandlers hooks configureAction :: UserHooks -> ConfigFlags -> Args -> IO LocalBuildInfo configureAction hooks flags args = do distPref <- findDistPrefOrDefault (configDistPref flags) - let flags' = flags { configDistPref = toFlag distPref } + let flags' = flags { configDistPref = toFlag distPref + , configArgs = args } -- See docs for 'HookedBuildInfo' pbi <- preConf hooks args flags' diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index fbadd5d635d..ddd7fc8da32 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -347,6 +347,10 @@ relaxDepsPrinter (Just (RelaxDepsSome pkgs)) = map (Just . display) $ pkgs -- IMPORTANT: every time a new flag is added, 'D.C.Setup.filterConfigureFlags' -- should be updated. data ConfigFlags = ConfigFlags { + -- This is the same hack as in 'buildArgs' and 'copyArgs'. + -- TODO: Stop using this eventually when 'UserHooks' gets changed + configArgs :: [String], + --FIXME: the configPrograms is only here to pass info through to configure -- because the type of configure is constrained by the UserHooks. -- when we change UserHooks next we should pass the initial @@ -435,6 +439,7 @@ configAbsolutePaths f = defaultConfigFlags :: ProgramConfiguration -> ConfigFlags defaultConfigFlags progConf = emptyConfigFlags { + configArgs = [], configPrograms_ = pure progConf, configHcFlavor = maybe NoFlag Flag defaultCompilerFlavor, configVanillaLib = Flag True, @@ -875,6 +880,7 @@ data CopyFlags = CopyFlags { copyAssumeDepsUpToDate :: Flag Bool, -- This is the same hack as in 'buildArgs'. But I (ezyang) don't -- think it's a hack, it's the right way to make hooks more robust + -- TODO: Stop using this eventually when 'UserHooks' gets changed copyArgs :: [String] } deriving (Show, Generic) diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index 84ff09053cb..3b222f64a9b 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/cabal-install/Distribution/Client/Config.hs @@ -266,6 +266,7 @@ instance Semigroup SavedConfig where lastNonEmptyNL = lastNonEmptyNL' savedInstallFlags combinedSavedConfigureFlags = ConfigFlags { + configArgs = lastNonEmpty configArgs, configPrograms_ = configPrograms_ . savedConfigureFlags $ b, -- TODO: NubListify configProgramPaths = lastNonEmpty configProgramPaths, diff --git a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs index 2059e0c3c5b..6fb99cb911e 100644 --- a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs @@ -532,6 +532,7 @@ convertToLegacyAllPackageConfig } where configFlags = ConfigFlags { + configArgs = mempty, configPrograms_ = mempty, configProgramPaths = mempty, configProgramArgs = mempty, @@ -595,6 +596,7 @@ convertToLegacyPerPackageConfig PackageConfig {..} = } where configFlags = ConfigFlags { + configArgs = mempty, configPrograms_ = configPrograms_ mempty, configProgramPaths = Map.toList (getMapLast packageConfigProgramPaths), configProgramArgs = Map.toList (getMapMappend packageConfigProgramArgs), diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 970b7dea990..0665c0bb93b 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -1935,6 +1935,7 @@ setupHsConfigureFlags (ReadyPackage sanityCheckElaboratedConfiguredPackage sharedConfig pkg (Cabal.ConfigFlags {..}) where + configArgs = [] configDistPref = toFlag builddir configCabalFilePath = mempty configVerbosity = toFlag verbosity From a090a4941977527ecd6ec6eda4f0792271f90b73 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Tue, 12 Jul 2016 17:21:25 -0700 Subject: [PATCH 02/23] One-component configure, fixes #2802. Described in: https://github.com/ghc-proposals/ghc-proposals/pull/4 ./Setup configure now takes an argument to specify a specific component name that should solely be configured. Most of the gyrations in Configure are all about making it so that we can feed in internal dependencies via --dependency. I dropped the package name match sanity check to handle convenience library package name munging. Consider an internal library named 'q' in package 'p'. When we install it to the package database, we munged the package name into 'z-p-z-q', so that it doesn't conflict with the actual package named 'q'. Now consider when we feed it in with --dependency q=p-0.1-hash-q. Previously, Cabal checked that the 'q' in --dependency matched the package name in the database... which it doesn't. So I dropped the check. I also had to make register/copy unconditionally install internal libraries; otherwise you can't refer to them from later builds. Also a miscellaneous refactor: convenience libraries are printed with a "header" stanza now (not really a stanza header). Signed-off-by: Edward Z. Yang --- Cabal/Cabal.cabal | 11 + .../PackageDescription/Configuration.hs | 13 +- Cabal/Distribution/Simple.hs | 2 - Cabal/Distribution/Simple/BuildTarget.hs | 5 + Cabal/Distribution/Simple/Configure.hs | 265 +++++++++++------- Cabal/Distribution/Simple/GHC.hs | 30 +- Cabal/Distribution/Simple/InstallDirs.hs | 13 +- Cabal/Distribution/Simple/Register.hs | 11 +- Cabal/Distribution/Simple/Setup.hs | 6 + Cabal/Distribution/Simple/UserHooks.hs | 2 +- .../Types/ComponentEnabledSpec.hs | 24 +- Cabal/changelog | 4 + Cabal/doc/installing-packages.markdown | 54 ++++ .../ConfigureComponent/Exe/Bad.hs | 4 + .../ConfigureComponent/Exe/Exe.cabal | 18 ++ .../ConfigureComponent/Exe/Good.hs | 4 + .../ConfigureComponent/SubLib/Lib.cabal | 18 ++ .../ConfigureComponent/SubLib/Lib.hs | 2 + .../ConfigureComponent/SubLib/exe/Exe.hs | 2 + .../ConfigureComponent/Test/Lib.hs | 2 + .../ConfigureComponent/Test/Test.cabal | 18 ++ .../Test/testlib/TestLib.hs | 3 + .../Test/testlib/testlib.cabal | 12 + .../ConfigureComponent/Test/tests/Test.hs | 2 + Cabal/tests/PackageTests/Tests.hs | 31 +- cabal-install/Distribution/Client/Config.hs | 1 + .../Distribution/Client/InstallPlan.hs | 1 + .../Client/ProjectConfig/Legacy.hs | 2 + .../Distribution/Client/ProjectPlanning.hs | 1 + 29 files changed, 417 insertions(+), 144 deletions(-) create mode 100644 Cabal/tests/PackageTests/ConfigureComponent/Exe/Bad.hs create mode 100644 Cabal/tests/PackageTests/ConfigureComponent/Exe/Exe.cabal create mode 100644 Cabal/tests/PackageTests/ConfigureComponent/Exe/Good.hs create mode 100644 Cabal/tests/PackageTests/ConfigureComponent/SubLib/Lib.cabal create mode 100644 Cabal/tests/PackageTests/ConfigureComponent/SubLib/Lib.hs create mode 100644 Cabal/tests/PackageTests/ConfigureComponent/SubLib/exe/Exe.hs create mode 100644 Cabal/tests/PackageTests/ConfigureComponent/Test/Lib.hs create mode 100644 Cabal/tests/PackageTests/ConfigureComponent/Test/Test.cabal create mode 100644 Cabal/tests/PackageTests/ConfigureComponent/Test/testlib/TestLib.hs create mode 100644 Cabal/tests/PackageTests/ConfigureComponent/Test/testlib/testlib.cabal create mode 100644 Cabal/tests/PackageTests/ConfigureComponent/Test/tests/Test.hs diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 8d5b583f222..98f10df1d7f 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -108,6 +108,17 @@ extra-source-files: tests/PackageTests/Configure/include/HsZlibConfig.h.in tests/PackageTests/Configure/zlib.buildinfo.in tests/PackageTests/Configure/zlib.cabal + tests/PackageTests/ConfigureComponent/Exe/Bad.hs + tests/PackageTests/ConfigureComponent/Exe/Exe.cabal + tests/PackageTests/ConfigureComponent/Exe/Good.hs + tests/PackageTests/ConfigureComponent/SubLib/Lib.cabal + tests/PackageTests/ConfigureComponent/SubLib/Lib.hs + tests/PackageTests/ConfigureComponent/SubLib/exe/Exe.hs + tests/PackageTests/ConfigureComponent/Test/Lib.hs + tests/PackageTests/ConfigureComponent/Test/Test.cabal + tests/PackageTests/ConfigureComponent/Test/testlib/TestLib.hs + tests/PackageTests/ConfigureComponent/Test/testlib/testlib.cabal + tests/PackageTests/ConfigureComponent/Test/tests/Test.hs tests/PackageTests/CopyAssumeDepsUpToDate/CopyAssumeDepsUpToDate.cabal tests/PackageTests/CopyAssumeDepsUpToDate/Main.hs tests/PackageTests/CopyAssumeDepsUpToDate/P.hs diff --git a/Cabal/Distribution/PackageDescription/Configuration.hs b/Cabal/Distribution/PackageDescription/Configuration.hs index 74d5c03b4db..e72f5d67135 100644 --- a/Cabal/Distribution/PackageDescription/Configuration.hs +++ b/Cabal/Distribution/PackageDescription/Configuration.hs @@ -421,11 +421,14 @@ overallDependencies enabled (TargetSet targets) = mconcat depss where (depss, _) = unzip $ filter (removeDisabledSections . snd) targets removeDisabledSections :: PDTagged -> Bool - removeDisabledSections (Lib l) = componentEnabled enabled (CLib l) - removeDisabledSections (SubLib _ l) = componentEnabled enabled (CLib l) - removeDisabledSections (Exe _ e) = componentEnabled enabled (CExe e) - removeDisabledSections (Test _ t) = componentEnabled enabled (CTest t) - removeDisabledSections (Bench _ b) = componentEnabled enabled (CBench b) + -- UGH. The embedded componentName in the 'Component's here is + -- BLANK. I don't know whose fault this is but I'll use the tag + -- instead. -- ezyang + removeDisabledSections (Lib _) = componentNameEnabled enabled CLibName + removeDisabledSections (SubLib t _) = componentNameEnabled enabled (CSubLibName t) + removeDisabledSections (Exe t _) = componentNameEnabled enabled (CExeName t) + removeDisabledSections (Test t _) = componentNameEnabled enabled (CTestName t) + removeDisabledSections (Bench t _) = componentNameEnabled enabled (CBenchName t) removeDisabledSections PDNull = True -- Apply extra constraints to a dependency map. diff --git a/Cabal/Distribution/Simple.hs b/Cabal/Distribution/Simple.hs index b0acbde5e8e..90d3b04f8fa 100644 --- a/Cabal/Distribution/Simple.hs +++ b/Cabal/Distribution/Simple.hs @@ -579,7 +579,6 @@ defaultUserHooks = autoconfUserHooks { -- https://github.com/haskell/cabal/issues/158 where oldCompatPostConf args flags pkg_descr lbi = do let verbosity = fromFlag (configVerbosity flags) - noExtraFlags args confExists <- doesFileExist "configure" when confExists $ runConfigureScript verbosity @@ -610,7 +609,6 @@ autoconfUserHooks where defaultPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO () defaultPostConf args flags pkg_descr lbi = do let verbosity = fromFlag (configVerbosity flags) - noExtraFlags args confExists <- doesFileExist "configure" if confExists then runConfigureScript verbosity diff --git a/Cabal/Distribution/Simple/BuildTarget.hs b/Cabal/Distribution/Simple/BuildTarget.hs index f0508680872..4b89bbfb3c3 100644 --- a/Cabal/Distribution/Simple/BuildTarget.hs +++ b/Cabal/Distribution/Simple/BuildTarget.hs @@ -12,6 +12,7 @@ module Distribution.Simple.BuildTarget ( -- * Main interface readTargetInfos, + readBuildTargets, -- in case you don't have LocalBuildInfo -- * Build targets BuildTarget(..), @@ -998,3 +999,7 @@ checkBuildTargets verbosity pkg_descr lbi targets = do formatReason cn DisabledAllBenchmarks = "Cannot process the " ++ cn ++ " because benchmarks are not " ++ "enabled. Re-run configure with the flag --enable-benchmarks" + formatReason cn (DisabledAllButOne cn') = + "Cannot process the " ++ cn ++ " because this package was " + ++ "configured only to build " ++ cn' ++ ". Re-run configure " + ++ "with the argument " ++ cn diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 72bfd89eaa3..55ab9e9f523 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -69,10 +69,12 @@ import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.PackageIndex (InstalledPackageIndex) import Distribution.PackageDescription as PD hiding (Flag) import Distribution.ModuleName +import Distribution.PackageDescription.PrettyPrint import Distribution.PackageDescription.Configuration import Distribution.PackageDescription.Check hiding (doesFileExist) import Distribution.Simple.Program import Distribution.Simple.Setup as Setup +import Distribution.Simple.BuildTarget import qualified Distribution.Simple.InstallDirs as InstallDirs import Distribution.Simple.LocalBuildInfo import Distribution.Types.LocalBuildInfo @@ -104,6 +106,7 @@ import Data.Either ( partitionEithers ) import qualified Data.Set as Set import qualified Data.Map as Map +import qualified Data.Maybe as Maybe import Numeric ( showIntAtBase ) import System.Directory ( doesFileExist, createDirectoryIfMissing, getTemporaryDirectory ) @@ -320,7 +323,32 @@ configure (pkg_descr0', pbi) cfg = do (maybe RelaxDepsNone unAllowNewer $ configAllowNewer cfg) pkg_descr0' - setupMessage verbosity "Configuring" (packageId pkg_descr0) + -- 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 + targets <- readBuildTargets flat_pkg_descr (configArgs cfg) + -- TODO: bleat if you use the module/file syntax + let targets' = [ cname | BuildTargetComponent cname <- targets ] + case targets' of + _ | null (configArgs cfg) -> return Nothing + [cname] -> return (Just cname) + [] -> die "No valid component targets found" + _ -> die "Can only configure either single component or all of them" + + let use_external_internal_deps = isJust mb_cname + case mb_cname of + Nothing -> setupMessage verbosity "Configuring" (packageId pkg_descr0) + Just cname -> notice verbosity + ("Configuring component " ++ display cname ++ + " from " ++ display (packageId pkg_descr0)) + + -- configCID is only valid for per-component configure + when (isJust (flagToMaybe (configCID cfg)) && isNothing mb_cname) $ + die "--cid is only supported for per-component configure" checkDeprecatedFlags verbosity cfg checkExactConfiguration pkg_descr0 cfg @@ -360,17 +388,22 @@ configure (pkg_descr0', pbi) cfg = do <- getInstalledPackages (lessVerbose verbosity) comp packageDbs programsConfig - -- An approximate InstalledPackageIndex of all (possible) internal libraries. - -- This database is used to bootstrap the process before we know precisely - -- what these libraries are supposed to be. - let internalPackageSet :: InstalledPackageIndex + -- The set of package names which are "shadowed" by internal + -- packages, and which component they map to + let internalPackageSet :: Map PackageName ComponentName internalPackageSet = getInternalPackages pkg_descr0 -- Make a data structure describing what components are enabled. let enabled :: ComponentEnabledSpec - enabled = ComponentEnabledSpec - { testsEnabled = fromFlag (configTests cfg) - , benchmarksEnabled = fromFlag (configBenchmarks cfg) } + enabled = case mb_cname of + Just cname -> OneComponentEnabledSpec cname + Nothing -> ComponentEnabledSpec + { testsEnabled = fromFlag (configTests cfg) + , benchmarksEnabled = fromFlag (configBenchmarks cfg) } + -- Some sanity checks related to enabling components. + when (isJust mb_cname && (fromFlag (configTests cfg) || fromFlag (configBenchmarks cfg))) $ + die $ "--enable-tests/--enable-benchmarks are incompatible with" ++ + " explicitly specifying a component to configure." -- allConstraints: The set of all 'Dependency's we have. Used ONLY -- to 'configureFinalizedPackage'. @@ -413,6 +446,7 @@ configure (pkg_descr0', pbi) cfg = do allConstraints (dependencySatisfiable (fromFlagOrDefault False (configExactConfiguration cfg)) + (packageVersion pkg_descr0) installedPackageSet internalPackageSet requiredDepsMap) @@ -420,13 +454,25 @@ configure (pkg_descr0', pbi) cfg = do compPlatform pkg_descr0 + debug verbosity $ "Finalized package description:\n" + ++ showPackageDescription pkg_descr + -- NB: showPackageDescription does not display the AWFUL HACK GLOBAL + -- buildDepends, so we have to display it separately. See #2066 + -- Some day, we should eliminate this, so that + -- configureFinalizedPackage returns the set of overall dependencies + -- separately. Then 'configureDependencies' and + -- 'Distribution.PackageDescription.Check' need to be adjusted + -- accordingly. + debug verbosity $ "Finalized build-depends: " + ++ intercalate ", " (map display (buildDepends pkg_descr)) + checkCompilerProblems comp pkg_descr checkPackageProblems verbosity pkg_descr0 (updatePackageDescription pbi pkg_descr) -- The list of 'InstalledPackageInfo' recording the selected -- dependencies... - -- internalPkgDeps: ...on internal packages (these are fake!) + -- internalPkgDeps: ...on internal packages -- externalPkgDeps: ...on external packages -- -- Invariant: For any package name, there is at most one package @@ -442,6 +488,7 @@ configure (pkg_descr0', pbi) cfg = do externalPkgDeps :: [InstalledPackageInfo]) <- configureDependencies verbosity + use_external_internal_deps internalPackageSet installedPackageSet requiredDepsMap @@ -514,7 +561,8 @@ configure (pkg_descr0', pbi) cfg = do -- -- TODO: Move this into a helper function. defaultDirs :: InstallDirTemplates - <- defaultInstallDirs (compilerFlavor comp) + <- defaultInstallDirs' use_external_internal_deps + (compilerFlavor comp) (fromFlag (configUserInstall cfg)) (hasLibs pkg_descr) let installDirs :: InstallDirTemplates @@ -570,10 +618,11 @@ configure (pkg_descr0', pbi) cfg = do -- From there, we build a ComponentLocalBuildInfo for each of the -- components, which lets us actually build each component. buildComponents <- - case mkComponentsGraph enabled pkg_descr internalPkgDeps of + case mkComponentsGraph enabled pkg_descr internalPackageSet of Left componentCycle -> reportComponentCycle componentCycle Right comps -> - mkComponentsLocalBuildInfo cfg comp packageDependsIndex pkg_descr + mkComponentsLocalBuildInfo cfg use_external_internal_deps comp + packageDependsIndex pkg_descr internalPkgDeps externalPkgDeps comps (configConfigurationsFlags cfg) @@ -780,40 +829,29 @@ checkExactConfiguration pkg_descr0 cfg = do -- does the resolution of conditionals, and it takes internalPackageSet -- as part of its input. getInternalPackages :: GenericPackageDescription - -> InstalledPackageIndex + -> Map PackageName ComponentName getInternalPackages pkg_descr0 = + -- TODO: some day, executables will be fair game here too! let pkg_descr = flattenPackageDescription pkg_descr0 - mkInternalPackage lib = emptyInstalledPackageInfo { - --TODO: should use a per-compiler method to map the source - -- package ID into an installed package id we can use - -- for the internal package set. What we do here - -- is skeevy, but we're highly unlikely to accidentally - -- shadow something legitimate. - Installed.installedUnitId = mkUnitId n, - -- NB: we TEMPORARILY set the package name to be the - -- library name. When we actually register, it won't - -- look like this; this is just so that internal - -- build-depends get resolved correctly. - Installed.sourcePackageId = PackageIdentifier (PackageName n) - (pkgVersion (package pkg_descr)) - } - where n = case libName lib of - Nothing -> display (packageName pkg_descr) - Just n' -> n' - in PackageIndex.fromList (map mkInternalPackage (allLibraries pkg_descr)) - - --- | Returns true if a dependency is satisfiable. This is to be passed + f lib = case libName lib of + Nothing -> (packageName pkg_descr, CLibName) + Just n' -> (PackageName n', CSubLibName n') + in Map.fromList (map f (allLibraries pkg_descr)) + +-- | Returns true if a dependency is satisfiable. This function +-- may report a dependency satisfiable even when it is not, +-- but not vice versa. This is to be passed -- to finalizePD. dependencySatisfiable :: Bool + -> Version -> InstalledPackageIndex -- ^ installed set - -> InstalledPackageIndex -- ^ internal set + -> Map PackageName ComponentName -- ^ internal set -> Map PackageName InstalledPackageInfo -- ^ required dependencies -> (Dependency -> Bool) dependencySatisfiable - exact_config installedPackageSet internalPackageSet requiredDepsMap - d@(Dependency depName _) + exact_config pkg_ver installedPackageSet internalPackageSet requiredDepsMap + d@(Dependency depName verRange) | exact_config = -- When we're given '--exact-configuration', we assume that all -- dependencies and flags are exactly specified on the command @@ -827,17 +865,31 @@ dependencySatisfiable -- -- (However, note that internal deps don't have to be -- specified!) + -- + -- NB: Just like the case below, we might incorrectly + -- determine an external internal dep is satisfiable + -- when it actually isn't. (depName `Map.member` requiredDepsMap) || isInternalDep + | isInternalDep + , pkg_ver `withinRange` verRange = + -- If a 'PackageName' is defined by an internal component, + -- and the user didn't specify a version range which is + -- incompatible with the package version, the dep is + -- satisfiable (and we are going to use the internal + -- dependency.) Note that this doesn't mean we are + -- actually going to SUCCEED when we configure the package, + -- if UseExternalInternalDeps is True. NB: if + -- the version bound fails we want to fall through to the + -- next case. + True + | otherwise = - -- Normal operation: just look up dependency in the combined + -- Normal operation: just look up dependency in the -- package index. - not . null . PackageIndex.lookupDependency pkgs $ d + not . null . PackageIndex.lookupDependency installedPackageSet $ d where - -- NB: Prefer the INTERNAL package set - pkgs = PackageIndex.merge installedPackageSet internalPackageSet - isInternalDep = not . null - $ PackageIndex.lookupDependency internalPackageSet d + isInternalDep = Map.member depName internalPackageSet -- | Relax the dependencies of this package if needed. relaxPackageDeps :: (VersionRange -> VersionRange) @@ -939,22 +991,26 @@ checkCompilerProblems comp pkg_descr = do die $ "Your compiler does not support module re-exports. To use " ++ "this feature you probably must use GHC 7.9 or later." +type UseExternalInternalDeps = Bool + -- | Select dependencies for the package. configureDependencies :: Verbosity - -> InstalledPackageIndex -- ^ internal packages + -> UseExternalInternalDeps + -> Map PackageName ComponentName -- ^ internal packages -> InstalledPackageIndex -- ^ installed packages -> Map PackageName InstalledPackageInfo -- ^ required deps -> PackageDescription -> IO ([PackageId], [InstalledPackageInfo]) -configureDependencies verbosity +configureDependencies verbosity use_external_internal_deps internalPackageSet installedPackageSet requiredDepsMap pkg_descr = do let selectDependencies :: [Dependency] -> ([FailedDependency], [ResolvedDependency]) selectDependencies = partitionEithers - . map (selectDependency internalPackageSet installedPackageSet - requiredDepsMap) + . map (selectDependency (package pkg_descr) + internalPackageSet installedPackageSet + requiredDepsMap use_external_internal_deps) (failedDeps, allPkgDeps) = selectDependencies (buildDepends pkg_descr) @@ -1079,23 +1135,34 @@ reportProgram verbosity prog (Just configuredProg) hackageUrl :: String hackageUrl = "http://hackage.haskell.org/package/" -data ResolvedDependency = ExternalDependency Dependency InstalledPackageInfo - | InternalDependency Dependency PackageId -- should be a - -- lib name +data ResolvedDependency + -- | An external dependency from the package database, OR an + -- internal dependency which we are getting from the package + -- database. + = ExternalDependency Dependency InstalledPackageInfo + -- | An internal dependency ('PackageId' should be a library name) + -- which we are going to have to build. (The + -- 'PackageId' here is a hack to get a modest amount of + -- polymorphism out of the 'Package' typeclass.) + | InternalDependency Dependency PackageId data FailedDependency = DependencyNotExists PackageName + | DependencyMissingInternal PackageName PackageName | DependencyNoVersion Dependency -- | Test for a package dependency and record the version we have installed. -selectDependency :: InstalledPackageIndex -- ^ Internally defined packages +selectDependency :: PackageId -- ^ Package id of current package + -> Map PackageName ComponentName -> InstalledPackageIndex -- ^ Installed packages -> Map PackageName InstalledPackageInfo -- ^ Packages for which we have been given specific deps to -- use + -> UseExternalInternalDeps -- ^ Are we configuring a single component? -> Dependency -> Either FailedDependency ResolvedDependency -selectDependency internalIndex installedIndex requiredDepsMap - dep@(Dependency pkgname vr) = +selectDependency pkgid internalIndex installedIndex requiredDepsMap + use_external_internal_deps + dep@(Dependency dep_pkgname vr) = -- If the dependency specification matches anything in the internal package -- index, then we prefer that match to anything in the second. -- For example: @@ -1110,19 +1177,32 @@ selectDependency internalIndex installedIndex requiredDepsMap -- We want "build-depends: MyLibrary" always to match the internal library -- even if there is a newer installed library "MyLibrary-0.2". -- However, "build-depends: MyLibrary >= 0.2" should match the installed one. - case PackageIndex.lookupPackageName internalIndex pkgname of - [(_,[pkg])] | packageVersion pkg `withinRange` vr - -> Right $ InternalDependency dep (packageId pkg) - - _ -> case Map.lookup pkgname requiredDepsMap of + case Map.lookup dep_pkgname internalIndex of + Just cname | packageVersion pkgid `withinRange` vr + -> if use_external_internal_deps + then do_external (Just cname) + else do_internal + _ -> do_external Nothing + where + do_internal = Right (InternalDependency dep + (PackageIdentifier dep_pkgname (packageVersion pkgid))) + do_external is_internal = case Map.lookup dep_pkgname requiredDepsMap of -- If we know the exact pkg to use, then use it. Just pkginstance -> Right (ExternalDependency dep pkginstance) -- Otherwise we just pick an arbitrary instance of the latest version. - Nothing -> case PackageIndex.lookupDependency installedIndex dep of - [] -> Left $ DependencyNotExists pkgname + Nothing -> case PackageIndex.lookupDependency installedIndex dep' of + [] -> Left $ + case is_internal of + Just cname -> DependencyMissingInternal dep_pkgname + (computeCompatPackageName (packageName pkgid) cname) + Nothing -> DependencyNotExists dep_pkgname pkgs -> Right $ ExternalDependency dep $ case last pkgs of (_ver, pkginstances) -> head pkginstances + where + dep' | Just cname <- is_internal + = Dependency (computeCompatPackageName (packageName pkgid) cname) vr + | otherwise = dep reportSelectedDependencies :: Verbosity -> [ResolvedDependency] -> IO () @@ -1146,6 +1226,11 @@ reportFailedDependencies failed = ++ "Perhaps you need to download and install it from\n" ++ hackageUrl ++ display pkgname ++ "?" + reportFailedDependency (DependencyMissingInternal pkgname real_pkgname) = + "internal dependency " ++ display pkgname ++ " not installed.\n" + ++ "Perhaps you need to configure and install it first?\n" + ++ "(Munged package name we searched for was " ++ display real_pkgname ++ ")" + reportFailedDependency (DependencyNoVersion dep) = "cannot satisfy dependency " ++ display (simplifyDependency dep) ++ "\n" @@ -1256,12 +1341,6 @@ combinedConstraints constraints dependencies installedPackages = do $+$ nest 4 (dispDependencies badUnitIds) $+$ text "however the given installed package instance does not exist." - when (not (null badNames)) $ - Left $ render $ text "The following package dependencies were requested" - $+$ nest 4 (dispDependencies badNames) - $+$ text ("however the installed package's name does not match " - ++ "the name given.") - --TODO: we don't check that all dependencies are used! return (allConstraints, idConstraintMap) @@ -1294,15 +1373,6 @@ combinedConstraints constraints dependencies installedPackages = do [ (pkgname, ipkgid) | (pkgname, ipkgid, Nothing) <- dependenciesPkgInfo ] - -- If someone has written e.g. - -- --dependency="foo=MyOtherLib-1.0-07...5bf30" then they have - -- probably made a mistake. - badNames = - [ (requestedPkgName, ipkgid) - | (requestedPkgName, ipkgid, Just pkg) <- dependenciesPkgInfo - , let foundPkgName = packageName pkg - , requestedPkgName /= foundPkgName ] - dispDependencies deps = hsep [ text "--dependency=" <<>> quotes (disp pkgname <<>> char '=' <<>> disp ipkgid) @@ -1492,14 +1562,12 @@ configCompilerAux = fmap (\(a,_,b) -> (a,b)) . configCompilerAuxEx -- libraries are considered internal), create a graph of dependencies -- between the components. This is NOT necessarily the build order -- (although it is in the absence of Backpack.) --- --- TODO: tighten up the type of 'internalPkgDeps' mkComponentsGraph :: ComponentEnabledSpec -> PackageDescription - -> [PackageId] + -> Map PackageName ComponentName -> Either [ComponentName] [(Component, [ComponentName])] -mkComponentsGraph enabled pkg_descr internalPkgDeps = +mkComponentsGraph enabled pkg_descr internalPackageSet = let g = Graph.fromList [ N c (componentName c) (componentDeps c) | c <- pkgBuildableComponents pkg_descr , componentEnabled enabled c ] @@ -1514,12 +1582,9 @@ mkComponentsGraph enabled pkg_descr internalPkgDeps = , toolname `elem` map exeName (executables pkg_descr) ] - ++ [ if pkgname == packageName pkg_descr - then CLibName - else CSubLibName toolname - | Dependency pkgname@(PackageName toolname) _ - <- targetBuildDepends bi - , pkgname `elem` map packageName internalPkgDeps ] + ++ [ cname + | Dependency pkgname _ <- targetBuildDepends bi + , cname <- Maybe.maybeToList (Map.lookup pkgname internalPackageSet) ] where bi = componentBuildInfo component @@ -1535,13 +1600,14 @@ reportComponentCycle cnames = -- specify a more detailed IPID via the @--ipid@ flag if necessary. computeComponentId :: Flag String + -> Flag ComponentId -> PackageIdentifier -> ComponentName -- TODO: careful here! -> [ComponentId] -- IPIDs of the component dependencies -> FlagAssignment -> ComponentId -computeComponentId mb_explicit pid cname dep_ipids flagAssignment = do +computeComponentId mb_ipid mb_cid pid cname dep_ipids flagAssignment = -- show is found to be faster than intercalate and then replacement of -- special character used in intercalating. We cannot simply hash by -- doubly concating list, as it just flatten out the nested list, so @@ -1559,13 +1625,15 @@ computeComponentId mb_explicit pid cname dep_ipids flagAssignment = do -- Hack to reuse install dirs machinery -- NB: no real IPID available at this point where env = packageTemplateEnv pid (mkUnitId "") - actual_base = case mb_explicit of - Flag cid0 -> explicit_base cid0 + actual_base = case mb_ipid of + Flag ipid0 -> explicit_base ipid0 NoFlag -> generated_base - ComponentId $ actual_base - ++ (case componentNameString cname of - Nothing -> "" - Just s -> "-" ++ s) + in case mb_cid of + Flag cid -> cid + NoFlag -> ComponentId $ actual_base + ++ (case componentNameString cname of + Nothing -> "" + Just s -> "-" ++ s) hashToBase62 :: String -> String hashToBase62 s = showFingerprint $ fingerprintString s @@ -1692,6 +1760,7 @@ computeCompatPackageKey comp pkg_name pkg_version (SimpleUnitId (ComponentId str | otherwise = str mkComponentsLocalBuildInfo :: ConfigFlags + -> UseExternalInternalDeps -> Compiler -> InstalledPackageIndex -> PackageDescription @@ -1700,7 +1769,7 @@ mkComponentsLocalBuildInfo :: ConfigFlags -> [(Component, [ComponentName])] -> FlagAssignment -> IO [ComponentLocalBuildInfo] -mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr +mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_descr internalPkgDeps externalPkgDeps graph flagAssignment = foldM go [] graph @@ -1774,8 +1843,7 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr } where - -- TODO configIPID should have name changed - cid = computeComponentId (configIPID cfg) (package pkg_descr) + cid = computeComponentId (configIPID cfg) (configCID cfg) (package pkg_descr) (componentName component) (getDeps (componentName component)) flagAssignment @@ -1818,6 +1886,7 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr dedup = Map.toList . Map.fromList -- TODO: this should include internal deps too + -- NB: This works correctly in per-component mode getDeps :: ComponentName -> [ComponentId] getDeps cname = let externalPkgs @@ -1827,7 +1896,11 @@ mkComponentsLocalBuildInfo cfg comp installedPackages pkg_descr in map Installed.installedComponentId externalPkgs selectSubset :: Package pkg => BuildInfo -> [pkg] -> [pkg] - selectSubset bi pkgs = + selectSubset bi pkgs + -- No need to subset for one-component config: deps + -- is precisely what we want + | use_external_internal = pkgs + | otherwise = [ pkg | pkg <- pkgs, packageName pkg `elem` names bi ] names :: BuildInfo -> [PackageName] diff --git a/Cabal/Distribution/Simple/GHC.hs b/Cabal/Distribution/Simple/GHC.hs index 3e7cd634197..af2309315b3 100644 --- a/Cabal/Distribution/Simple/GHC.hs +++ b/Cabal/Distribution/Simple/GHC.hs @@ -1138,20 +1138,17 @@ installLib :: Verbosity -> Library -> ComponentLocalBuildInfo -> IO () -installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do +installLib verbosity lbi targetDir dynlibTargetDir _builtDir _pkg lib clbi = do -- copy .hi files over: - whenRegistered $ do - whenVanilla $ copyModuleFiles "hi" - whenProf $ copyModuleFiles "p_hi" - whenShared $ copyModuleFiles "dyn_hi" + whenVanilla $ copyModuleFiles "hi" + whenProf $ copyModuleFiles "p_hi" + whenShared $ copyModuleFiles "dyn_hi" -- copy the built library files over: - whenRegistered $ do - whenVanilla $ installOrdinary builtDir targetDir vanillaLibName - whenProf $ installOrdinary builtDir targetDir profileLibName - whenGHCi $ installOrdinary builtDir targetDir ghciLibName - whenRegisteredOrDynExecutable $ do - whenShared $ installShared builtDir dynlibTargetDir sharedLibName + whenVanilla $ installOrdinary builtDir targetDir vanillaLibName + whenProf $ installOrdinary builtDir targetDir profileLibName + whenGHCi $ installOrdinary builtDir targetDir ghciLibName + whenShared $ installShared builtDir dynlibTargetDir sharedLibName where builtDir = componentBuildDir lbi clbi @@ -1189,17 +1186,6 @@ installLib verbosity lbi targetDir dynlibTargetDir _builtDir pkg lib clbi = do whenGHCi = when (hasLib && withGHCiLib lbi) whenShared = when (hasLib && withSharedLib lbi) - -- Some files (e.g. interface files) are completely unnecessary when - -- we are not actually going to register the library. A library is - -- not registered if there is no "public library", e.g. in the case - -- that we have an internal library and executables, but no public - -- library. - whenRegistered = when (hasPublicLib pkg) - - -- However, we must always install dynamic libraries when linking - -- dynamic executables, because we'll try to load them! - whenRegisteredOrDynExecutable = when (hasPublicLib pkg || (hasExes pkg && withDynExe lbi)) - -- ----------------------------------------------------------------------------- -- Registering diff --git a/Cabal/Distribution/Simple/InstallDirs.hs b/Cabal/Distribution/Simple/InstallDirs.hs index 46a91307b08..fe282407071 100644 --- a/Cabal/Distribution/Simple/InstallDirs.hs +++ b/Cabal/Distribution/Simple/InstallDirs.hs @@ -25,6 +25,7 @@ module Distribution.Simple.InstallDirs ( InstallDirs(..), InstallDirTemplates, defaultInstallDirs, + defaultInstallDirs', combineInstallDirs, absoluteInstallDirs, CopyDest(..), @@ -156,7 +157,17 @@ type InstallDirTemplates = InstallDirs PathTemplate -- Default installation directories defaultInstallDirs :: CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates -defaultInstallDirs comp userInstall _hasLibs = do +defaultInstallDirs = defaultInstallDirs' False + +defaultInstallDirs' :: Bool {- use external internal deps -} + -> CompilerFlavor -> Bool -> Bool -> IO InstallDirTemplates +defaultInstallDirs' True comp userInstall hasLibs = do + dflt <- defaultInstallDirs' False comp userInstall hasLibs + -- Be a bit more hermetic about per-component installs + return dflt { datasubdir = toPathTemplate $ "$abi" "$libname", + docdir = toPathTemplate $ "$datadir" "doc" "$abi" "$libname" + } +defaultInstallDirs' False comp userInstall _hasLibs = do installPrefix <- if userInstall then getAppUserDataDirectory "cabal" diff --git a/Cabal/Distribution/Simple/Register.hs b/Cabal/Distribution/Simple/Register.hs index 8425be81874..d3f7702205d 100644 --- a/Cabal/Distribution/Simple/Register.hs +++ b/Cabal/Distribution/Simple/Register.hs @@ -88,12 +88,13 @@ import qualified Data.ByteString.Lazy.Char8 as BS.Char8 register :: PackageDescription -> LocalBuildInfo -> RegisterFlags -- ^Install in the user's database?; verbose -> IO () -register pkg_descr lbi flags = when (hasPublicLib pkg_descr) doRegister +register pkg_descr lbi flags = + -- Duncan originally asked for us to not register/install files + -- when there was no public library. But with per-component + -- configure, we legitimately need to install internal libraries + -- so that we can get them. So just unconditionally install. + doRegister where - -- We do NOT register libraries outside of the inplace database - -- if there is no public library, since no one else can use it - -- usefully (they're not public.) If we start supporting scoped - -- packages, we'll have to relax this. doRegister = do targets <- readTargetInfos verbosity pkg_descr lbi (regArgs flags) diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index ddd7fc8da32..39667819be4 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -391,6 +391,7 @@ data ConfigFlags = ConfigFlags { -- frameworks (OS X only) configExtraIncludeDirs :: [FilePath], -- ^ path to search for header files configIPID :: Flag String, -- ^ explicit IPID to be used + configCID :: Flag ComponentId, -- ^ explicit CID to be used configDistPref :: Flag FilePath, -- ^"dist" prefix configCabalFilePath :: Flag FilePath, -- ^ Cabal file to use @@ -677,6 +678,11 @@ configureOptions showOrParseArgs = configIPID (\v flags -> flags {configIPID = v}) (reqArgFlag "IPID") + ,option "" ["cid"] + "Installed component ID to compile this component as" + (fmap display . configCID) (\v flags -> flags {configCID = fmap ComponentId v}) + (reqArgFlag "CID") + ,option "" ["extra-lib-dirs"] "A list of directories to search for external libraries" configExtraLibDirs (\v flags -> flags {configExtraLibDirs = v}) diff --git a/Cabal/Distribution/Simple/UserHooks.hs b/Cabal/Distribution/Simple/UserHooks.hs index 5f0fd21ed10..b3ba6cf9b99 100644 --- a/Cabal/Distribution/Simple/UserHooks.hs +++ b/Cabal/Distribution/Simple/UserHooks.hs @@ -164,7 +164,7 @@ emptyUserHooks readDesc = return Nothing, hookedPreProcessors = [], hookedPrograms = [], - preConf = rn, + preConf = rn', confHook = (\_ _ -> return (error "No local build info generated during configure. Over-ride empty configure hook.")), postConf = ru, preBuild = rn', diff --git a/Cabal/Distribution/Types/ComponentEnabledSpec.hs b/Cabal/Distribution/Types/ComponentEnabledSpec.hs index 78227cd1779..b78259cddfb 100644 --- a/Cabal/Distribution/Types/ComponentEnabledSpec.hs +++ b/Cabal/Distribution/Types/ComponentEnabledSpec.hs @@ -15,6 +15,7 @@ module Distribution.Types.ComponentEnabledSpec ( import Prelude () import Distribution.Compat.Prelude +import Distribution.Text import Distribution.Types.Component -- TODO: maybe remove me? import Distribution.Types.ComponentName @@ -50,10 +51,9 @@ import Distribution.Types.ComponentName -- -- @since 2.0.0.0 data ComponentEnabledSpec - = ComponentEnabledSpec { - testsEnabled :: Bool, - benchmarksEnabled :: Bool - } + = ComponentEnabledSpec { testsEnabled :: Bool, + benchmarksEnabled :: Bool } + | OneComponentEnabledSpec ComponentName deriving (Generic, Read, Show) instance Binary ComponentEnabledSpec @@ -91,11 +91,16 @@ componentDisabledReason enabled comp -- @since 2.0.0.0 componentNameDisabledReason :: ComponentEnabledSpec -> ComponentName -> Maybe ComponentDisabledReason -componentNameDisabledReason enabled (CTestName _) - | not (testsEnabled enabled) = Just DisabledAllTests -componentNameDisabledReason enabled (CBenchName _) - | not (benchmarksEnabled enabled) = Just DisabledAllBenchmarks -componentNameDisabledReason _ _ = Nothing +componentNameDisabledReason + ComponentEnabledSpec{ testsEnabled = False } (CTestName _) + = Just DisabledAllTests +componentNameDisabledReason + ComponentEnabledSpec{ benchmarksEnabled = False } (CBenchName _) + = Just DisabledAllBenchmarks +componentNameDisabledReason ComponentEnabledSpec{} _ = Nothing +componentNameDisabledReason (OneComponentEnabledSpec cname) c + | c == cname = Nothing + | otherwise = Just (DisabledAllButOne (display cname)) -- | A reason explaining why a component is disabled. -- @@ -103,3 +108,4 @@ componentNameDisabledReason _ _ = Nothing data ComponentDisabledReason = DisabledComponent | DisabledAllTests | DisabledAllBenchmarks + | DisabledAllButOne String diff --git a/Cabal/changelog b/Cabal/changelog index 1965a5fc597..c4a01c2dc72 100644 --- a/Cabal/changelog +++ b/Cabal/changelog @@ -66,6 +66,10 @@ internal use. * Macros in 'cabal_macros.h' are now ifndef'd, so that they don't cause an error if the macro is already defined. (#3041) + * './Setup configure' now accepts a single argument specifying + the component to be configured. The semantics of this mode + of operation are described in + 1.24.0.0 Ryan Thomas March 2016 * Support GHC 8. diff --git a/Cabal/doc/installing-packages.markdown b/Cabal/doc/installing-packages.markdown index c95037f56d7..e1996429fe0 100644 --- a/Cabal/doc/installing-packages.markdown +++ b/Cabal/doc/installing-packages.markdown @@ -410,6 +410,35 @@ is passed the `--with-hc-pkg`, `--prefix`, `--bindir`, `--libdir`, value of the `--with-compiler` option is passed in a `--with-hc` option and all options specified with `--configure-option=` are passed on. +In Cabal 2.0, support for a single positional argument was added to `setup configure` +This makes Cabal configure a the specific component to be +configured. Specified names can be qualified with `lib:` or +`exe:` in case just a name is ambiguous (as would be the case +for a package named `p` which has a library and an executable +named `p`.) This has the following effects: + +* Subsequent invocations of `build`, `register`, etc. operate only + on the configured component. + +* Cabal requires all "internal" dependencies (e.g., an executable + depending on a library defined in the same package) must be + found in the set of databases via `--package-db` (and related flags): + these dependencies are assumed to be up-to-date. A dependency can + be explicitly specified using `--dependency` simply by giving + the name of the internal library; e.g., the dependency for an + internal library named `foo` is given as `--dependency=pkg-internal=pkg-1.0-internal-abcd`. + +* Only the dependencies needed for the requested component are + required. Similarly, when `--exact-configuration` is specified, + it's only necessary to specify `--dependency` for the component. + (As mentioned previously, you *must* specify internal dependencies + as well.) + +* Internal `build-tools` dependencies are expected to be in the `PATH` + upon subsequent invocations of `setup`. + +Full details can be found in the [Componentized Cabal proposal](https://github.com/ezyang/ghc-proposals/blob/master/proposals/0000-componentized-cabal.rst). + ### Programs used for building ### The following options govern the programs used to process the source @@ -753,6 +782,19 @@ be controlled with the following command line options. To reset the stack, use `--package-db=clear`. +`--ipid=`_ipid_ +: Specifies the _installed package identifier_ of the package to be + built; this identifier is passed on to GHC and serves as the basis + for linker symbols and the `id` field in a `ghc-pkg` registration. + When a package has multiple components, the actual component + identifiers are derived off of this identifier (e.g., an + internal library `foo` from package `p-0.1-abcd` will get the + identifier `p-0.1-abcd-foo`. + +`--cid=`_cid_ +: Specifies the _component identifier_ of the component being built; + this is only valid if you are configuring a single component. + `--default-user-config=` _file_ : Allows a "default" `cabal.config` freeze file to be passed in manually. This file will only be used if one does not exist in the @@ -954,6 +996,18 @@ be controlled with the following command line options. for libraries it is also saved in the package registration information and used when compiling modules that use the library. +`--dependency`[=_pkgname_=_ipid_] +: Specify that a particular dependency should used for a particular + package name. In particular, it declares that any reference to + _pkgname_ in a `build-depends` should be resolved to _ipid_. + +`--exact-configuration` +: This changes Cabal to require every dependency be explicitly + specified using `--dependency`, rather than use Cabal's + (very simple) dependency solver. This is useful for programmatic + use of Cabal's API, where you want to error if you didn't + specify enough `--dependency` flags. + `--allow-newer`[=_pkgs_], `--allow-older`[=_pkgs_] : Selectively relax upper or lower bounds in dependencies without editing the package description respectively. diff --git a/Cabal/tests/PackageTests/ConfigureComponent/Exe/Bad.hs b/Cabal/tests/PackageTests/ConfigureComponent/Exe/Bad.hs new file mode 100644 index 00000000000..65ae4a05d5d --- /dev/null +++ b/Cabal/tests/PackageTests/ConfigureComponent/Exe/Bad.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "Hello, Haskell!" diff --git a/Cabal/tests/PackageTests/ConfigureComponent/Exe/Exe.cabal b/Cabal/tests/PackageTests/ConfigureComponent/Exe/Exe.cabal new file mode 100644 index 00000000000..5c2822092fe --- /dev/null +++ b/Cabal/tests/PackageTests/ConfigureComponent/Exe/Exe.cabal @@ -0,0 +1,18 @@ +name: Exe +version: 0.1.0.0 +license: BSD3 +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=1.10 + +executable goodexe + main-is: Good.hs + build-depends: base + default-language: Haskell2010 + +-- We deliberately don't configure badexe, so that we can build ONLY goodexe +executable badexe + main-is: Bad.hs + build-depends: totally-impossible-dependency-to-fill == 10000.25.6 + default-language: Haskell2010 diff --git a/Cabal/tests/PackageTests/ConfigureComponent/Exe/Good.hs b/Cabal/tests/PackageTests/ConfigureComponent/Exe/Good.hs new file mode 100644 index 00000000000..e8efe592d0c --- /dev/null +++ b/Cabal/tests/PackageTests/ConfigureComponent/Exe/Good.hs @@ -0,0 +1,4 @@ +module Main where + +main :: IO () +main = putStrLn "OK" diff --git a/Cabal/tests/PackageTests/ConfigureComponent/SubLib/Lib.cabal b/Cabal/tests/PackageTests/ConfigureComponent/SubLib/Lib.cabal new file mode 100644 index 00000000000..85f5d879a9d --- /dev/null +++ b/Cabal/tests/PackageTests/ConfigureComponent/SubLib/Lib.cabal @@ -0,0 +1,18 @@ +name: Lib +version: 0.1.0.0 +license: BSD3 +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=1.10 + +library sublib + build-depends: base + exposed-modules: Lib + default-language: Haskell2010 + +executable exe + main-is: Exe.hs + build-depends: base, sublib + hs-source-dirs: exe + default-language: Haskell2010 diff --git a/Cabal/tests/PackageTests/ConfigureComponent/SubLib/Lib.hs b/Cabal/tests/PackageTests/ConfigureComponent/SubLib/Lib.hs new file mode 100644 index 00000000000..1d7d07d5cba --- /dev/null +++ b/Cabal/tests/PackageTests/ConfigureComponent/SubLib/Lib.hs @@ -0,0 +1,2 @@ +module Lib where +lib = "OK" diff --git a/Cabal/tests/PackageTests/ConfigureComponent/SubLib/exe/Exe.hs b/Cabal/tests/PackageTests/ConfigureComponent/SubLib/exe/Exe.hs new file mode 100644 index 00000000000..6ee3fb933aa --- /dev/null +++ b/Cabal/tests/PackageTests/ConfigureComponent/SubLib/exe/Exe.hs @@ -0,0 +1,2 @@ +import Lib +main = putStrLn lib diff --git a/Cabal/tests/PackageTests/ConfigureComponent/Test/Lib.hs b/Cabal/tests/PackageTests/ConfigureComponent/Test/Lib.hs new file mode 100644 index 00000000000..1d7d07d5cba --- /dev/null +++ b/Cabal/tests/PackageTests/ConfigureComponent/Test/Lib.hs @@ -0,0 +1,2 @@ +module Lib where +lib = "OK" diff --git a/Cabal/tests/PackageTests/ConfigureComponent/Test/Test.cabal b/Cabal/tests/PackageTests/ConfigureComponent/Test/Test.cabal new file mode 100644 index 00000000000..e1b1eca8182 --- /dev/null +++ b/Cabal/tests/PackageTests/ConfigureComponent/Test/Test.cabal @@ -0,0 +1,18 @@ +name: test-for-cabal +version: 0.1.0.0 +license: BSD3 +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: Lib + build-depends: base + default-language: Haskell2010 + +test-suite testsuite + build-depends: test-for-cabal, testlib, base + type: exitcode-stdio-1.0 + main-is: Test.hs + hs-source-dirs: tests diff --git a/Cabal/tests/PackageTests/ConfigureComponent/Test/testlib/TestLib.hs b/Cabal/tests/PackageTests/ConfigureComponent/Test/testlib/TestLib.hs new file mode 100644 index 00000000000..d3104869944 --- /dev/null +++ b/Cabal/tests/PackageTests/ConfigureComponent/Test/testlib/TestLib.hs @@ -0,0 +1,3 @@ +module TestLib where +import Lib +testlib = lib diff --git a/Cabal/tests/PackageTests/ConfigureComponent/Test/testlib/testlib.cabal b/Cabal/tests/PackageTests/ConfigureComponent/Test/testlib/testlib.cabal new file mode 100644 index 00000000000..7ea7e7e3a8a --- /dev/null +++ b/Cabal/tests/PackageTests/ConfigureComponent/Test/testlib/testlib.cabal @@ -0,0 +1,12 @@ +name: testlib +version: 0.1.0.0 +license: BSD3 +author: Edward Z. Yang +maintainer: ezyang@cs.stanford.edu +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: TestLib + build-depends: test-for-cabal, base + default-language: Haskell2010 diff --git a/Cabal/tests/PackageTests/ConfigureComponent/Test/tests/Test.hs b/Cabal/tests/PackageTests/ConfigureComponent/Test/tests/Test.hs new file mode 100644 index 00000000000..63654821ba5 --- /dev/null +++ b/Cabal/tests/PackageTests/ConfigureComponent/Test/tests/Test.hs @@ -0,0 +1,2 @@ +import TestLib +main = putStrLn testlib diff --git a/Cabal/tests/PackageTests/Tests.hs b/Cabal/tests/PackageTests/Tests.hs index 9ebe68fbfb3..8cee8ce5dc6 100644 --- a/Cabal/tests/PackageTests/Tests.hs +++ b/Cabal/tests/PackageTests/Tests.hs @@ -439,6 +439,31 @@ tests config = do _ <- shell "autoreconf" ["-i"] cabal_build [] + tc "ConfigureComponent/Exe" $ do + withPackageDb $ do + cabal_install ["goodexe"] + runExe' "goodexe" [] >>= assertOutputContains "OK" + + tcs "ConfigureComponent/SubLib" "sublib-explicit" $ do + withPackageDb $ do + cabal_install ["sublib", "--cid", "sublib-0.1-abc"] + cabal_install ["exe", "--dependency", "sublib=sublib-0.1-abc"] + runExe' "exe" [] >>= assertOutputContains "OK" + + tcs "ConfigureComponent/SubLib" "sublib" $ do + withPackageDb $ do + cabal_install ["sublib"] + cabal_install ["exe"] + runExe' "exe" [] >>= assertOutputContains "OK" + + tcs "ConfigureComponent/Test" "test" $ do + withPackageDb $ do + cabal_install ["test-for-cabal"] + withPackage "testlib" $ cabal_install [] + cabal "configure" ["testsuite"] + cabal "build" [] + cabal "test" [] + -- Test that per-component copy works, when only building library tc "CopyComponent/Lib" $ withPackageDb $ do @@ -580,9 +605,9 @@ tests config = do uid = componentUnitId (targetCLBI target) dir = libdir (absoluteComponentInstallDirs pkg_descr lbi uid NoCopyDest) - assertBool "interface files should NOT be installed" . not + assertBool "interface files should be installed" =<< liftIO (doesFileExist (dir "Foo.hi")) - assertBool "static library should NOT be installed" . not + assertBool "static library should be installed" =<< liftIO (doesFileExist (dir mkLibName uid)) if is_dynamic then @@ -590,7 +615,7 @@ tests config = do =<< liftIO (doesFileExist (dir mkSharedLibName compiler_id uid)) else - assertBool "dynamic library should NOT be installed" . not + assertBool "dynamic library should be installed" =<< liftIO (doesFileExist (dir mkSharedLibName compiler_id uid)) shouldFail $ ghcPkg "describe" ["foo"] diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs index 3b222f64a9b..5545a7dedda 100644 --- a/cabal-install/Distribution/Client/Config.hs +++ b/cabal-install/Distribution/Client/Config.hs @@ -302,6 +302,7 @@ instance Semigroup SavedConfig where -- TODO: NubListify configExtraIncludeDirs = lastNonEmpty configExtraIncludeDirs, configIPID = combine configIPID, + configCID = combine configCID, configDistPref = combine configDistPref, configCabalFilePath = combine configCabalFilePath, configVerbosity = combine configVerbosity, diff --git a/cabal-install/Distribution/Client/InstallPlan.hs b/cabal-install/Distribution/Client/InstallPlan.hs index ce1289e23ab..73132986cab 100644 --- a/cabal-install/Distribution/Client/InstallPlan.hs +++ b/cabal-install/Distribution/Client/InstallPlan.hs @@ -489,6 +489,7 @@ configureInstallPlan solverPlan = ConfiguredPackage { confPkgId = SimpleUnitId $ Configure.computeComponentId + Cabal.NoFlag Cabal.NoFlag (packageId spkg) PD.CLibName diff --git a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs index 6fb99cb911e..e5be5281613 100644 --- a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs +++ b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs @@ -569,6 +569,7 @@ convertToLegacyAllPackageConfig configDependencies = mempty, configExtraIncludeDirs = mempty, configIPID = mempty, + configCID = mempty, configConfigurationsFlags = mempty, configTests = mempty, configCoverage = mempty, --TODO: don't merge @@ -633,6 +634,7 @@ convertToLegacyPerPackageConfig PackageConfig {..} = configDependencies = mempty, configExtraIncludeDirs = packageConfigExtraIncludeDirs, configIPID = mempty, + configCID = mempty, configConfigurationsFlags = packageConfigFlagAssignment, configTests = packageConfigTests, configCoverage = packageConfigCoverage, --TODO: don't merge diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 0665c0bb93b..704c88da992 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -1941,6 +1941,7 @@ setupHsConfigureFlags (ReadyPackage configVerbosity = toFlag verbosity configIPID = toFlag (display (installedUnitId pkg)) + configCID = mempty configProgramPaths = Map.toList pkgProgramPaths configProgramArgs = Map.toList pkgProgramArgs From 058997423bfceae5793cc67827030075fd450d14 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Thu, 11 Aug 2016 22:05:25 -0700 Subject: [PATCH 03/23] Fix pretty-printing PackageDescription for good. Signed-off-by: Edward Z. Yang --- .../Distribution/PackageDescription/Parse.hs | 14 +-- .../PackageDescription/PrettyPrint.hs | 118 ++++++++++++++---- 2 files changed, 98 insertions(+), 34 deletions(-) diff --git a/Cabal/Distribution/PackageDescription/Parse.hs b/Cabal/Distribution/PackageDescription/Parse.hs index 3ee906b245e..75bdf20753e 100644 --- a/Cabal/Distribution/PackageDescription/Parse.hs +++ b/Cabal/Distribution/PackageDescription/Parse.hs @@ -24,6 +24,10 @@ module Distribution.PackageDescription.Parse ( FieldDescr(..), LineNo, + -- ** Private, but needed for pretty-printer + TestSuiteStanza(..), + BenchmarkStanza(..), + -- ** Supplementary build information readHookedBuildInfo, parseHookedBuildInfo, @@ -34,6 +38,7 @@ module Distribution.PackageDescription.Parse ( binfoFieldDescrs, sourceRepoFieldDescrs, testSuiteFieldDescrs, + benchmarkFieldDescrs, flagFieldDescrs ) where @@ -189,12 +194,7 @@ storeXFieldsLib _ _ = Nothing executableFieldDescrs :: [FieldDescr Executable] executableFieldDescrs = - [ -- note ordering: configuration must come first, for - -- showPackageDescription. - simpleField "executable" - showToken parseTokenQ - exeName (\xs exe -> exe{exeName=xs}) - , simpleField "main-is" + [ simpleField "main-is" showFilePath parseFilePathQ modulePath (\xs exe -> exe{modulePath=xs}) ] @@ -1094,7 +1094,7 @@ parsePackageDescription file = do -- Note: we don't parse the "executable" field here, hence the tail hack. parseExeFields :: [Field] -> PM Executable - parseExeFields = lift . parseFields (tail executableFieldDescrs) + parseExeFields = lift . parseFields executableFieldDescrs storeXFieldsExe emptyExecutable parseTestFields :: LineNo -> [Field] -> PM TestSuite diff --git a/Cabal/Distribution/PackageDescription/PrettyPrint.hs b/Cabal/Distribution/PackageDescription/PrettyPrint.hs index 7cbf726bfa4..5c54d286a1b 100644 --- a/Cabal/Distribution/PackageDescription/PrettyPrint.hs +++ b/Cabal/Distribution/PackageDescription/PrettyPrint.hs @@ -35,6 +35,7 @@ import Distribution.ParseUtils import Distribution.PackageDescription.Parse import Distribution.Package import Distribution.Text +import Distribution.ModuleName import Text.PrettyPrint (hsep, space, parens, char, nest, isEmpty, ($$), (<+>), @@ -58,11 +59,11 @@ ppGenericPackageDescription :: GenericPackageDescription -> Doc ppGenericPackageDescription gpd = ppPackageDescription (packageDescription gpd) $+$ ppGenPackageFlags (genPackageFlags gpd) - $+$ ppLibrary (condLibrary gpd) - $+$ ppSubLibraries (condSubLibraries gpd) - $+$ ppExecutables (condExecutables gpd) - $+$ ppTestSuites (condTestSuites gpd) - $+$ ppBenchmarks (condBenchmarks gpd) + $+$ ppCondLibrary (condLibrary gpd) + $+$ ppCondSubLibraries (condSubLibraries gpd) + $+$ ppCondExecutables (condExecutables gpd) + $+$ ppCondTestSuites (condTestSuites gpd) + $+$ ppCondBenchmarks (condBenchmarks gpd) ppPackageDescription :: PackageDescription -> Doc ppPackageDescription pd = ppFields pkgDescrFieldDescrs pd @@ -119,14 +120,14 @@ ppFlag flag@(MkFlag name _ _ _) = where fields = ppFieldsFiltered flagDefaults flagFieldDescrs flag -ppLibrary :: Maybe (CondTree ConfVar [Dependency] Library) -> Doc -ppLibrary Nothing = mempty -ppLibrary (Just condTree) = +ppCondLibrary :: Maybe (CondTree ConfVar [Dependency] Library) -> Doc +ppCondLibrary Nothing = mempty +ppCondLibrary (Just condTree) = emptyLine $ text "library" $+$ nest indentWith (ppCondTree condTree Nothing ppLib) -ppSubLibraries :: [(String, CondTree ConfVar [Dependency] Library)] -> Doc -ppSubLibraries libs = +ppCondSubLibraries :: [(String, CondTree ConfVar [Dependency] Library)] -> Doc +ppCondSubLibraries libs = vcat [emptyLine $ text ("library " ++ n) $+$ nest indentWith (ppCondTree condTree Nothing ppLib)| (n,condTree) <- libs] @@ -136,8 +137,8 @@ ppLib lib Nothing = ppFieldsFiltered libDefaults libFieldDescrs lib ppLib lib (Just plib) = ppDiffFields libFieldDescrs lib plib $$ ppCustomFields (customFieldsBI (libBuildInfo lib)) -ppExecutables :: [(String, CondTree ConfVar [Dependency] Executable)] -> Doc -ppExecutables exes = +ppCondExecutables :: [(String, CondTree ConfVar [Dependency] Executable)] -> Doc +ppCondExecutables exes = vcat [emptyLine $ text ("executable " ++ n) $+$ nest indentWith (ppCondTree condTree Nothing ppExe)| (n,condTree) <- exes] where @@ -152,8 +153,8 @@ ppExecutables exes = $+$ ppDiffFields binfoFieldDescrs buildInfo' buildInfo2 $+$ ppCustomFields (customFieldsBI buildInfo') -ppTestSuites :: [(String, CondTree ConfVar [Dependency] TestSuite)] -> Doc -ppTestSuites suites = +ppCondTestSuites :: [(String, CondTree ConfVar [Dependency] TestSuite)] -> Doc +ppCondTestSuites suites = emptyLine $ vcat [ text ("test-suite " ++ n) $+$ nest indentWith (ppCondTree condTree Nothing ppTestSuite) | (n,condTree) <- suites] @@ -184,8 +185,8 @@ ppTestSuites suites = TestSuiteLibV09 _ m -> Just m _ -> Nothing -ppBenchmarks :: [(String, CondTree ConfVar [Dependency] Benchmark)] -> Doc -ppBenchmarks suites = +ppCondBenchmarks :: [(String, CondTree ConfVar [Dependency] Benchmark)] -> Doc +ppCondBenchmarks suites = emptyLine $ vcat [ text ("benchmark " ++ n) $+$ nest indentWith (ppCondTree condTree Nothing ppBenchmark) | (n,condTree) <- suites] @@ -280,17 +281,80 @@ writePackageDescription fpath pkg = writeUTF8File fpath (showPackageDescription -- | @since 1.26.0.0@ showPackageDescription :: PackageDescription -> String showPackageDescription pkg = render $ - ppPackage pkg - $$ ppCustomFields (customFieldsPD pkg) - $$ (case library pkg of - Nothing -> mempty - Just lib -> ppLibrary' lib) - $$ vcat [ space $$ ppLibrary' lib | lib <- subLibraries pkg ] - $$ vcat [ space $$ ppExecutable exe | exe <- executables pkg ] - where - ppPackage = ppFields pkgDescrFieldDescrs - ppLibrary' = ppFields libFieldDescrs - ppExecutable = ppFields executableFieldDescrs + ppPackageDescription pkg + $+$ ppMaybeLibrary (library pkg) + $+$ ppSubLibraries (subLibraries pkg) + $+$ ppExecutables (executables pkg) + $+$ ppTestSuites (testSuites pkg) + $+$ ppBenchmarks (benchmarks pkg) + +ppMaybeLibrary :: Maybe Library -> Doc +ppMaybeLibrary Nothing = mempty +ppMaybeLibrary (Just lib) = + emptyLine $ text "library" + $+$ nest indentWith (ppFields libFieldDescrs lib) + +ppSubLibraries :: [Library] -> Doc +ppSubLibraries libs = vcat [ + emptyLine $ text "library" <+> text libname + $+$ nest indentWith (ppFields libFieldDescrs lib) + | lib@Library{ libName = Just libname } <- libs ] + +ppExecutables :: [Executable] -> Doc +ppExecutables exes = vcat [ + emptyLine $ text "executable" <+> text (exeName exe) + $+$ nest indentWith (ppFields executableFieldDescrs exe) + | exe <- exes ] + +ppTestSuites :: [TestSuite] -> Doc +ppTestSuites tests = vcat [ + emptyLine $ text "test-suite" <+> text (testName test) + $+$ nest indentWith (ppFields testSuiteFieldDescrs test_stanza) + | test <- tests + , let test_stanza + = TestSuiteStanza { + testStanzaTestType = Just (testSuiteInterfaceToTestType (testInterface test)), + testStanzaMainIs = testSuiteInterfaceToMaybeMainIs (testInterface test), + testStanzaTestModule = testSuiteInterfaceToMaybeModule (testInterface test), + testStanzaBuildInfo = testBuildInfo test + } + ] + +testSuiteInterfaceToTestType :: TestSuiteInterface -> TestType +testSuiteInterfaceToTestType (TestSuiteExeV10 ver _) = TestTypeExe ver +testSuiteInterfaceToTestType (TestSuiteLibV09 ver _) = TestTypeLib ver +testSuiteInterfaceToTestType (TestSuiteUnsupported ty) = ty + +testSuiteInterfaceToMaybeMainIs :: TestSuiteInterface -> Maybe FilePath +testSuiteInterfaceToMaybeMainIs (TestSuiteExeV10 _ fp) = Just fp +testSuiteInterfaceToMaybeMainIs TestSuiteLibV09{} = Nothing +testSuiteInterfaceToMaybeMainIs TestSuiteUnsupported{} = Nothing + +testSuiteInterfaceToMaybeModule :: TestSuiteInterface -> Maybe ModuleName +testSuiteInterfaceToMaybeModule (TestSuiteLibV09 _ mod_name) = Just mod_name +testSuiteInterfaceToMaybeModule TestSuiteExeV10{} = Nothing +testSuiteInterfaceToMaybeModule TestSuiteUnsupported{} = Nothing + +ppBenchmarks :: [Benchmark] -> Doc +ppBenchmarks benchs = vcat [ + emptyLine $ text "benchmark" <+> text (benchmarkName bench) + $+$ nest indentWith (ppFields benchmarkFieldDescrs bench_stanza) + | bench <- benchs + , let bench_stanza = BenchmarkStanza { + benchmarkStanzaBenchmarkType = Just (benchmarkInterfaceToBenchmarkType (benchmarkInterface bench)), + benchmarkStanzaMainIs = benchmarkInterfaceToMaybeMainIs (benchmarkInterface bench), + benchmarkStanzaBenchmarkModule = Nothing, + benchmarkStanzaBuildInfo = benchmarkBuildInfo bench + }] + +benchmarkInterfaceToBenchmarkType :: BenchmarkInterface -> BenchmarkType +benchmarkInterfaceToBenchmarkType (BenchmarkExeV10 ver _) = BenchmarkTypeExe ver +benchmarkInterfaceToBenchmarkType (BenchmarkUnsupported ty) = ty + +benchmarkInterfaceToMaybeMainIs :: BenchmarkInterface -> Maybe FilePath +benchmarkInterfaceToMaybeMainIs (BenchmarkExeV10 _ fp) = Just fp +benchmarkInterfaceToMaybeMainIs BenchmarkUnsupported{} = Nothing + -- | @since 1.26.0.0@ writeHookedBuildInfo :: FilePath -> HookedBuildInfo -> IO () From e6b6167da7eb92be2ccf3bc6c099708b2286f56f Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Sun, 31 Jul 2016 01:46:25 -0700 Subject: [PATCH 04/23] Undo new-build support for convenience libraries. The previous approach I took, though correct, was quite confusing. If I refactor InstallPlan to operate on a per-component basis, then we'll automatically get support for convenience libraries, which will ultimately cleaner. (While we won't be able to get rid of support for whole package installs, it will be safe to assume packages using convenience libraries also support one-shot configure.) I didn't revert the support in cabal install; I'm not planning on componentizing it. Signed-off-by: Edward Z. Yang --- cabal-install/Distribution/Client/Install.hs | 7 +- .../Distribution/Client/InstallPlan.hs | 1 + .../Distribution/Client/ProjectBuilding.hs | 160 +++++------------- cabal-install/Distribution/Client/Types.hs | 2 +- .../internal-libs/new_build.sh | 3 +- 5 files changed, 52 insertions(+), 121 deletions(-) diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index dee92c97477..4a3b43eacc8 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -32,7 +32,7 @@ module Distribution.Client.Install ( import Data.Foldable ( traverse_ ) import Data.List - ( isPrefixOf, nub, sort, (\\) ) + ( isPrefixOf, nub, sort, (\\), find ) import qualified Data.Map as Map import qualified Data.Set as S import Data.Maybe @@ -1422,9 +1422,6 @@ installUnpackedPackage verbosity installLock numJobs -- Capture installed package configuration file, so that -- it can be incorporated into the final InstallPlan - -- TODO: This is duplicated with - -- Distribution/Client/ProjectBuilding.hs, search for - -- the Note [Updating installedUnitId]. ipkgs <- genPkgConfs mLogPath let ipkgs' = case ipkgs of [ipkg] -> [ipkg { Installed.installedUnitId = ipid }] @@ -1439,7 +1436,7 @@ installUnpackedPackage verbosity installLock numJobs NoMultiInstance packageDBs ipkg' - return (Right (BuildResult docsResult testsResult ipkgs')) + return (Right (BuildResult docsResult testsResult (find ((==uid).installedUnitId) ipkgs'))) where pkgid = packageId pkg diff --git a/cabal-install/Distribution/Client/InstallPlan.hs b/cabal-install/Distribution/Client/InstallPlan.hs index 73132986cab..429b53ccd28 100644 --- a/cabal-install/Distribution/Client/InstallPlan.hs +++ b/cabal-install/Distribution/Client/InstallPlan.hs @@ -42,6 +42,7 @@ module Distribution.Client.InstallPlan ( -- ** Traversal helpers -- $traversal Processing, + -- NB: these functions are only used by the legacy install-path ready, completed, failed, diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs index 5d3522610eb..a74e8b56164 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/Distribution/Client/ProjectBuilding.hs @@ -179,8 +179,10 @@ data BuildStatusRebuild = -- -- The optional registration info here tells us if we've registered the -- package already, or if we stil need to do that after building. + -- @Just Nothing@ indicates that we know that no registration is + -- necessary (e.g., executable.) -- - | BuildStatusBuild (Maybe [InstalledPackageInfo]) BuildReason + | BuildStatusBuild (Maybe (Maybe InstalledPackageInfo)) BuildReason data BuildReason = -- | The depencencies of this package have been (re)built so the build @@ -349,22 +351,23 @@ improveInstallPlanWithUpToDatePackages :: ElaboratedInstallPlan -> ElaboratedInstallPlan improveInstallPlanWithUpToDatePackages installPlan pkgsBuildStatus = replaceWithPrePreExisting installPlan - [ (installedPackageId pkg, ipkgs) + [ (installedPackageId pkg, mipkg) | InstallPlan.Configured pkg <- InstallPlan.reverseTopologicalOrder installPlan , let ipkgid = installedPackageId pkg Just pkgBuildStatus = Map.lookup ipkgid pkgsBuildStatus - , BuildStatusUpToDate (BuildResult { buildResultLibInfo = ipkgs }) + , BuildStatusUpToDate (BuildResult { buildResultLibInfo = mipkg }) <- [pkgBuildStatus] ] where replaceWithPrePreExisting = - foldl' (\plan (ipkgid, ipkgs) -> - case find (\ipkg -> installedPackageId ipkg == ipkgid) ipkgs of + foldl' (\plan (ipkgid, mipkg) -> + case mipkg of Just ipkg -> InstallPlan.preexisting ipkgid ipkg plan - Nothing -> unexpected) - unexpected = - error "improveInstallPlanWithUpToDatePackages: dep on non lib package" + -- TODO: Maybe this is a little wrong, because + -- pre-installed executables show up in the + -- InstallPlan as source packages. + Nothing -> plan) ----------------------------- @@ -384,7 +387,7 @@ improveInstallPlanWithUpToDatePackages installPlan pkgsBuildStatus = data PackageFileMonitor = PackageFileMonitor { pkgFileMonitorConfig :: FileMonitor ElaboratedConfiguredPackage (), pkgFileMonitorBuild :: FileMonitor (Set ComponentName) BuildResultMisc, - pkgFileMonitorReg :: FileMonitor () [InstalledPackageInfo] + pkgFileMonitorReg :: FileMonitor () (Maybe InstalledPackageInfo) } -- | This is all the components of the 'BuildResult' other than the @@ -504,12 +507,12 @@ checkPackageFileMonitorChanged PackageFileMonitor{..} where buildReason = BuildReasonEphemeralTargets - (MonitorUnchanged buildResult _, MonitorUnchanged ipkgs _) -> + (MonitorUnchanged buildResult _, MonitorUnchanged mipkg _) -> return $ Right BuildResult { buildResultDocs = docsResult, buildResultTests = testsResult, buildResultLogFile = Nothing, - buildResultLibInfo = ipkgs + buildResultLibInfo = mipkg } where (docsResult, testsResult) = buildResult @@ -562,12 +565,12 @@ updatePackageBuildFileMonitor PackageFileMonitor{pkgFileMonitorBuild} updatePackageRegFileMonitor :: PackageFileMonitor -> FilePath - -> [InstalledPackageInfo] + -> Maybe InstalledPackageInfo -> IO () updatePackageRegFileMonitor PackageFileMonitor{pkgFileMonitorReg} - srcdir ipkgs = + srcdir mipkg = updateFileMonitor pkgFileMonitorReg srcdir Nothing - [] () ipkgs + [] () mipkg invalidatePackageRegFileMonitor :: PackageFileMonitor -> IO () invalidatePackageRegFileMonitor PackageFileMonitor{pkgFileMonitorReg} = @@ -593,7 +596,7 @@ data BuildResult = BuildResult { buildResultDocs :: DocsResult, buildResultTests :: TestsResult, buildResultLogFile :: Maybe FilePath, - buildResultLibInfo :: [InstalledPackageInfo] + buildResultLibInfo :: Maybe InstalledPackageInfo } deriving Show @@ -987,7 +990,7 @@ buildAndInstallUnpackedPackage verbosity setup buildCommand buildFlags -- Install phase - ipkgs <- + mipkg <- annotateFailure mlogFile InstallFailed $ do --TODO: [required eventually] need to lock installing this ipkig so other processes don't -- stomp on our files, since we don't have ABI compat, not safe to replace @@ -1013,30 +1016,18 @@ buildAndInstallUnpackedPackage verbosity if pkgRequiresRegistration pkg then do - ipkgs <- generateInstalledPackageInfos -- We register ourselves rather than via Setup.hs. We need to -- grab and modify the InstalledPackageInfo. We decide what -- the installed package id is, not the build system. + ipkg0 <- generateInstalledPackageInfo + let ipkg = ipkg0 { Installed.installedUnitId = ipkgid } - -- See Note [Updating installedUnitId] - let ipkgs' = case ipkgs of - -- Case A and B - [ipkg] -> [ipkg { Installed.installedUnitId = ipkgid }] - -- Case C - _ -> ipkgs - unless (any ((== ipkgid) . Installed.installedUnitId) ipkgs') $ - die $ "the package " ++ display (packageId pkg) ++ " was expected " - ++ " to produce registeration info for the unit Id " - ++ display ipkgid ++ " but it actually produced info for " - ++ intercalate ", " - (map (display . Installed.installedUnitId) ipkgs') criticalSection registerLock $ - forM_ ipkgs' $ \ipkg' -> Cabal.registerPackage verbosity compiler progdb HcPkg.MultiInstance - (pkgRegisterPackageDBStack pkg) ipkg' - return ipkgs' - else return [] + (pkgRegisterPackageDBStack pkg) ipkg + return (Just ipkg) + else return Nothing --TODO: [required feature] docs and test phases let docsResult = DocsNotTried @@ -1046,7 +1037,7 @@ buildAndInstallUnpackedPackage verbosity buildResultDocs = docsResult, buildResultTests = testsResult, buildResultLogFile = mlogFile, - buildResultLibInfo = ipkgs + buildResultLibInfo = mipkg } where @@ -1063,9 +1054,9 @@ buildAndInstallUnpackedPackage verbosity buildCommand = Cabal.buildCommand defaultProgramConfiguration buildFlags _ = setupHsBuildFlags pkg pkgshared verbosity builddir - generateInstalledPackageInfos :: IO [InstalledPackageInfo] - generateInstalledPackageInfos = - withTempInstalledPackageInfoFiles + generateInstalledPackageInfo :: IO InstalledPackageInfo + generateInstalledPackageInfo = + withTempInstalledPackageInfoFile verbosity distTempDirectory $ \pkgConfDest -> do let registerFlags _ = setupHsRegisterFlags pkg pkgshared @@ -1165,78 +1156,26 @@ buildInplaceUnpackedPackage verbosity pkg buildStatus allSrcFiles buildResult - ipkgs <- whenReRegister $ + mipkg <- whenReRegister $ annotateFailureNoLog InstallFailed $ do -- Register locally - ipkgs <- if pkgRequiresRegistration pkg + mipkg <- if pkgRequiresRegistration pkg then do - ipkgs <- generateInstalledPackageInfos + ipkg0 <- generateInstalledPackageInfo -- We register ourselves rather than via Setup.hs. We need to -- grab and modify the InstalledPackageInfo. We decide what -- the installed package id is, not the build system. - - -- Note [Updating installedUnitId] - -- ~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ - -- This is a bit tricky. There are three variables we - -- care about: - -- - -- 1. Does the Setup script we're interfacing with - -- support --ipid? (Only if version >= 1.23) - -- If not, we have to explicitly update the - -- the UID that was recorded. - -- - -- 2. Does the Setup script we're interfacing with - -- support internal libraries? (Only if - -- version >= 1.25). If so, there may be - -- multiple IPIs... and it would be wrong to - -- update them all to the same UID (you need - -- to generate derived UIDs for each - -- subcomponent.) - -- - -- 3. Does GHC require that the IPID be input at - -- configure time? (Only if GHC >= 8.0, which - -- also implies Cabal version >= 1.23, as earlier - -- Cabal's don't know how to do this properly). - -- If so, it is IMPERMISSIBLE to update the - -- UID that was recorded. - -- - -- This means that there are three situations: - -- - -- A. Cabal < 1.23 - -- B. Cabal >= 1.23 && < 1.25 - -- C. Cabal >= 1.25 - -- - -- We consider each in turn: - -- - -- A. There is only ever one IPI, and we must - -- update it. - -- - -- B. There is only ever one IPI, but because - -- --ipid is supported, the installedUnitId of - -- this IPI is ipkgid (so it's harmless to - -- overwrite). - -- - -- C. There may be multiple IPIs, but because - -- --ipid is supported they always have the - -- right installedUnitIds. - -- - let ipkgs' = case ipkgs of - -- Case A and B - [ipkg] -> [ipkg { Installed.installedUnitId = ipkgid }] - -- Case C - _ -> assert (any ((== ipkgid) . Installed.installedUnitId) - ipkgs) ipkgs + let ipkg = ipkg0 { Installed.installedUnitId = ipkgid } criticalSection registerLock $ - forM_ ipkgs' $ \ipkg' -> Cabal.registerPackage verbosity compiler progdb HcPkg.NoMultiInstance (pkgRegisterPackageDBStack pkg) - ipkg' - return ipkgs' + ipkg + return (Just ipkg) - else return [] + else return Nothing - updatePackageRegFileMonitor packageFileMonitor srcdir ipkgs - return ipkgs + updatePackageRegFileMonitor packageFileMonitor srcdir mipkg + return mipkg -- Repl phase -- @@ -1253,7 +1192,7 @@ buildInplaceUnpackedPackage verbosity buildResultDocs = docsResult, buildResultTests = testsResult, buildResultLogFile = Nothing, - buildResultLibInfo = ipkgs + buildResultLibInfo = mipkg } where @@ -1283,7 +1222,7 @@ buildInplaceUnpackedPackage verbosity whenReRegister action = case buildStatus of BuildStatusConfigure _ -> action BuildStatusBuild Nothing _ -> action - BuildStatusBuild (Just ipkgs) _ -> return ipkgs + BuildStatusBuild (Just mipkg) _ -> return mipkg configureCommand = Cabal.configureCommand defaultProgramConfiguration configureFlags v = flip filterConfigureFlags v $ @@ -1315,9 +1254,9 @@ buildInplaceUnpackedPackage verbosity (Just (pkgDescription pkg)) cmd flags args - generateInstalledPackageInfos :: IO [InstalledPackageInfo] - generateInstalledPackageInfos = - withTempInstalledPackageInfoFiles + generateInstalledPackageInfo :: IO InstalledPackageInfo + generateInstalledPackageInfo = + withTempInstalledPackageInfoFile verbosity distTempDirectory $ \pkgConfDest -> do let registerFlags _ = setupHsRegisterFlags pkg pkgshared @@ -1353,10 +1292,10 @@ annotateFailure mlogFile annotate action = handler = throwIO . BuildFailure mlogFile . annotate . toException -withTempInstalledPackageInfoFiles :: Verbosity -> FilePath +withTempInstalledPackageInfoFile :: Verbosity -> FilePath -> (FilePath -> IO ()) - -> IO [InstalledPackageInfo] -withTempInstalledPackageInfoFiles verbosity tempdir action = + -> IO InstalledPackageInfo +withTempInstalledPackageInfoFile verbosity tempdir action = withTempDirectory verbosity tempdir "package-registration-" $ \dir -> do -- make absolute since @action@ will often change directory abs_dir <- canonicalizePath dir @@ -1364,14 +1303,7 @@ withTempInstalledPackageInfoFiles verbosity tempdir action = let pkgConfDest = abs_dir "pkgConf" action pkgConfDest - is_dir <- doesDirectoryExist pkgConfDest - - let notHidden = not . isHidden - isHidden name = "." `isPrefixOf` name - if is_dir - then mapM (readPkgConf pkgConfDest) . sort . filter notHidden - =<< getDirectoryContents pkgConfDest - else fmap (:[]) $ readPkgConf "." pkgConfDest + readPkgConf "." pkgConfDest where pkgConfParseFailed :: Installed.PError -> IO a pkgConfParseFailed perror = diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs index ac3b9bd9cda..1b3a08890a6 100644 --- a/cabal-install/Distribution/Client/Types.hs +++ b/cabal-install/Distribution/Client/Types.hs @@ -288,7 +288,7 @@ data BuildFailure = PlanningFailed instance Exception BuildFailure data BuildResult = BuildResult DocsResult TestsResult - [InstalledPackageInfo] + (Maybe InstalledPackageInfo) deriving (Show, Generic) data DocsResult = DocsNotTried | DocsFailed | DocsOk diff --git a/cabal-install/tests/IntegrationTests/internal-libs/new_build.sh b/cabal-install/tests/IntegrationTests/internal-libs/new_build.sh index 18f708913a5..959c79d079b 100644 --- a/cabal-install/tests/IntegrationTests/internal-libs/new_build.sh +++ b/cabal-install/tests/IntegrationTests/internal-libs/new_build.sh @@ -1,3 +1,4 @@ . ./common.sh -cabal new-build p +cabal new-build p || exit 0 +exit 1 # expect broken From d9bf6788adf6d416d6335fd79c4c1b3fbc7d0ad1 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Sun, 31 Jul 2016 21:17:58 -0700 Subject: [PATCH 05/23] Per-component new-build support (no Custom support yet). A bit of a megapatch. Here's what's in it: * First, a few miscellaneous utility functions and reexports in Cabal. I could have split these into a separate commit but I was too lazy to. * Distribution.Client.Install got refactored: instead of using PackageFixedDeps, it uses IsUnit instead. This is because we weren't using ComponentDeps in a nontrivial way; we just need some graph structure and IsNode (with UnitId keys) fulfills that. I also removed the invariant checking and error reporting because it was being annoying (we check the invariants already in SolverInstallPlan). * Look at Distribution.Client.ProjectPlanning.Types. This contains the primary type change: ElaboratedConfiguredPackage is now EITHER a monolithic ElaboratedPackage, or a per-component ElaboratedComponent (it should get renamed but I didn't do that in this patch.) These are what we're going to store in our plans: if a package we're building has a Setup script which supports per-component builds, we'll explode it into a component. Otherwise we'll keep it as a package. We'll see codepaths for both throughout. * OK, so the expansion happens in ProjectPlanning, mostly in 'elaborateAndExpandSolverPackage'. You should review the package hash computation code closely. When we can separate components, we compute a hash for each INDEPENDENTLY. This is good: we get more sharing. * We need to adjust the target resolution and pruning code in ProjectOrchestration and ProjectPlanning. I did a dumb but easy idea: if a user mentions 'packagename' in a target name, I spray the PackageTarget on every possibly relevant IPID in buildTargets', and then pare it down later. * And of course there's code in ProjectBuilding to actual do a configure and then build. * We change the layout of build directories so that we can track each component separately. While I was doing that, I also added compiler and platform information. Custom doesn't work yet because I need to give them their own separate component, and teach Cabal how to build them specially. Signed-off-by: Edward Z. Yang --- Cabal/Distribution/Package.hs | 5 + Cabal/Distribution/Simple/Configure.hs | 2 + .../Types/ComponentEnabledSpec.hs | 2 +- .../Distribution/Types/PackageDescription.hs | 9 + cabal-install/Distribution/Client/CmdBuild.hs | 1 + .../Distribution/Client/CmdFreeze.hs | 10 +- cabal-install/Distribution/Client/CmdRepl.hs | 1 + .../Distribution/Client/DistDirLayout.hs | 54 +- cabal-install/Distribution/Client/Install.hs | 5 +- .../Distribution/Client/InstallPlan.hs | 275 ++++------- .../Distribution/Client/PackageHash.hs | 5 + .../Distribution/Client/ProjectBuilding.hs | 216 ++++---- .../Client/ProjectOrchestration.hs | 75 ++- .../Distribution/Client/ProjectPlanOutput.hs | 35 +- .../Distribution/Client/ProjectPlanning.hs | 461 +++++++++++++----- .../Client/ProjectPlanning/Types.hs | 184 ++++++- cabal-install/Distribution/Client/Types.hs | 44 +- .../Solver/Types/ComponentDeps.hs | 10 + cabal-install/cabal-install.cabal | 5 + .../internal-libs/new_build.sh | 3 +- .../new-build/executable/Main.hs | 1 + .../new-build/executable/Setup.hs | 2 + .../new-build/executable/Test.hs | 1 + .../new-build/executable/a.cabal | 15 + .../new-build/executable/cabal.project | 1 + cabal-install/tests/IntegrationTests2.hs | 17 +- .../exception/configure/a.cabal | 6 + .../Distribution/Client/InstallPlan.hs | 23 +- 28 files changed, 996 insertions(+), 472 deletions(-) create mode 100644 cabal-install/tests/IntegrationTests/new-build/executable/Main.hs create mode 100644 cabal-install/tests/IntegrationTests/new-build/executable/Setup.hs create mode 100644 cabal-install/tests/IntegrationTests/new-build/executable/Test.hs create mode 100644 cabal-install/tests/IntegrationTests/new-build/executable/a.cabal create mode 100644 cabal-install/tests/IntegrationTests/new-build/executable/cabal.project diff --git a/Cabal/Distribution/Package.hs b/Cabal/Distribution/Package.hs index 0431b3d2809..5e7ff259ae2 100644 --- a/Cabal/Distribution/Package.hs +++ b/Cabal/Distribution/Package.hs @@ -27,6 +27,7 @@ module Distribution.Package ( UnitId(..), mkUnitId, mkLegacyUnitId, + unitIdComponentId, getHSLibraryName, InstalledPackageId, -- backwards compat @@ -176,6 +177,10 @@ mkUnitId = SimpleUnitId . ComponentId mkLegacyUnitId :: PackageId -> UnitId mkLegacyUnitId = SimpleUnitId . ComponentId . display +-- | Extract 'ComponentId' from 'UnitId'. +unitIdComponentId :: UnitId -> ComponentId +unitIdComponentId (SimpleUnitId cid) = cid + -- ------------------------------------------------------------ -- * Package source dependencies -- ------------------------------------------------------------ diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 55ab9e9f523..b9ce2f366bc 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -35,6 +35,8 @@ module Distribution.Simple.Configure (configure, tryGetPersistBuildConfig, maybeGetPersistBuildConfig, findDistPref, findDistPrefOrDefault, + mkComponentsGraph, + getInternalPackages, computeComponentId, computeCompatPackageKey, computeCompatPackageName, diff --git a/Cabal/Distribution/Types/ComponentEnabledSpec.hs b/Cabal/Distribution/Types/ComponentEnabledSpec.hs index b78259cddfb..2ecfb1f15c0 100644 --- a/Cabal/Distribution/Types/ComponentEnabledSpec.hs +++ b/Cabal/Distribution/Types/ComponentEnabledSpec.hs @@ -54,7 +54,7 @@ data ComponentEnabledSpec = ComponentEnabledSpec { testsEnabled :: Bool, benchmarksEnabled :: Bool } | OneComponentEnabledSpec ComponentName - deriving (Generic, Read, Show) + deriving (Generic, Read, Show, Eq) instance Binary ComponentEnabledSpec -- | The default set of enabled components. Historically tests and diff --git a/Cabal/Distribution/Types/PackageDescription.hs b/Cabal/Distribution/Types/PackageDescription.hs index b026d571fdc..734ca3506f3 100644 --- a/Cabal/Distribution/Types/PackageDescription.hs +++ b/Cabal/Distribution/Types/PackageDescription.hs @@ -43,6 +43,7 @@ module Distribution.Types.PackageDescription ( updatePackageDescription, pkgComponents, pkgBuildableComponents, + enabledComponents, lookupComponent, getComponent, ) where @@ -57,6 +58,7 @@ import Distribution.Types.Benchmark import Distribution.Types.Component import Distribution.Types.ComponentName +import Distribution.Types.ComponentEnabledSpec import Distribution.Types.SetupBuildInfo import Distribution.Types.BuildInfo import Distribution.Types.BuildType @@ -346,6 +348,13 @@ pkgComponents pkg = pkgBuildableComponents :: PackageDescription -> [Component] pkgBuildableComponents = filter componentBuildable . pkgComponents +-- | A list of all components in the package that are enabled. +-- +-- @since 2.0.0.0 +-- +enabledComponents :: PackageDescription -> ComponentEnabledSpec -> [Component] +enabledComponents pkg enabled = filter (componentEnabled enabled) $ pkgBuildableComponents pkg + lookupComponent :: PackageDescription -> ComponentName -> Maybe Component lookupComponent pkg CLibName = fmap CLib (library pkg) lookupComponent pkg (CSubLibName name) = diff --git a/cabal-install/Distribution/Client/CmdBuild.hs b/cabal-install/Distribution/Client/CmdBuild.hs index 8a5afe80c86..840ecf9a74c 100644 --- a/cabal-install/Distribution/Client/CmdBuild.hs +++ b/cabal-install/Distribution/Client/CmdBuild.hs @@ -63,6 +63,7 @@ buildAction (configFlags, configExFlags, installFlags, haddockFlags) -- repl targets (as opposed to say repl or haddock targets). selectBuildTargets = selectTargets + verbosity BuildDefaultComponents BuildSpecificComponent diff --git a/cabal-install/Distribution/Client/CmdFreeze.hs b/cabal-install/Distribution/Client/CmdFreeze.hs index 1aa072ecd98..95b41c5a981 100644 --- a/cabal-install/Distribution/Client/CmdFreeze.hs +++ b/cabal-install/Distribution/Client/CmdFreeze.hs @@ -7,13 +7,11 @@ module Distribution.Client.CmdFreeze ( ) where import Distribution.Client.ProjectPlanning - ( ElaboratedInstallPlan, rebuildInstallPlan ) import Distribution.Client.ProjectConfig ( ProjectConfig(..), ProjectConfigShared(..) , commandLineFlagsToProjectConfig, writeProjectLocalFreezeConfig , findProjectRoot ) import Distribution.Client.ProjectPlanning.Types - ( ElaboratedConfiguredPackage(..) ) import Distribution.Client.Targets ( UserConstraint(..) ) import Distribution.Solver.Types.ConstraintSource @@ -149,8 +147,9 @@ projectFreezeConstraints plan = flagAssignments = Map.fromList [ (pkgname, flags) - | InstallPlan.Configured pkg <- InstallPlan.toList plan - , let flags = pkgFlagAssignment pkg + | InstallPlan.Configured pkg_or_comp <- InstallPlan.toList plan + , let pkg = getElaboratedPackage pkg_or_comp + flags = pkgFlagAssignment pkg pkgname = packageName pkg , not (null flags) ] @@ -158,7 +157,8 @@ projectFreezeConstraints plan = localPackages = Map.fromList [ (packageName pkg, ()) - | InstallPlan.Configured pkg <- InstallPlan.toList plan + | InstallPlan.Configured pkg_or_comp <- InstallPlan.toList plan + , let pkg = getElaboratedPackage pkg_or_comp , pkgLocalToProject pkg ] diff --git a/cabal-install/Distribution/Client/CmdRepl.hs b/cabal-install/Distribution/Client/CmdRepl.hs index e277f50147a..3bce9cee581 100644 --- a/cabal-install/Distribution/Client/CmdRepl.hs +++ b/cabal-install/Distribution/Client/CmdRepl.hs @@ -67,6 +67,7 @@ replAction (configFlags, configExFlags, installFlags, haddockFlags) -- repl targets (as opposed to say build or haddock targets). selectReplTargets = selectTargets + verbosity ReplDefaultComponent ReplSpecificComponent diff --git a/cabal-install/Distribution/Client/DistDirLayout.hs b/cabal-install/Distribution/Client/DistDirLayout.hs index 41e8dd25bd3..cdf6f37ec18 100644 --- a/cabal-install/Distribution/Client/DistDirLayout.hs +++ b/cabal-install/Distribution/Client/DistDirLayout.hs @@ -5,17 +5,43 @@ -- The layout of the .\/dist\/ directory where cabal keeps all of it's state -- and build artifacts. -- -module Distribution.Client.DistDirLayout where +module Distribution.Client.DistDirLayout ( + -- 'DistDirLayout' + DistDirLayout(..), + DistDirParams(..), + defaultDistDirLayout, + + -- * 'CabalDirLayout' + CabalDirLayout(..), + defaultCabalDirLayout, +) where import System.FilePath import Distribution.Package - ( PackageId ) + ( PackageId, UnitId(..) ) import Distribution.Compiler import Distribution.Simple.Compiler (PackageDB(..)) import Distribution.Text +import Distribution.Types.ComponentName +import Distribution.System import Distribution.Client.Types ( InstalledPackageId ) +-- | Information which can be used to construct the path to +-- the build directory of a build. This is LESS fine-grained +-- than what goes into the hashed 'InstalledPackageId', +-- and for good reason: we don't want this path to change if +-- the user, say, adds a dependency to their project. +data DistDirParams = DistDirParams { + distParamUnitId :: UnitId, + distParamPackageId :: PackageId, + distParamComponentName :: Maybe ComponentName, + distParamCompilerId :: CompilerId, + distParamPlatform :: Platform + -- TODO (see #3343): + -- Flag assignments + -- Optimization + } -- | The layout of the project state directory. Traditionally this has been @@ -31,11 +57,11 @@ data DistDirLayout = DistDirLayout { -- | The directory under dist where we keep the build artifacts for a -- package we're building from a local directory. -- - -- This uses a 'PackageId' not just a 'PackageName' because technically + -- This uses a 'UnitId' not just a 'PackageName' because technically -- we can have multiple instances of the same package in a solution -- (e.g. setup deps). -- - distBuildDirectory :: PackageId -> FilePath, + distBuildDirectory :: DistDirParams -> FilePath, distBuildRootDirectory :: FilePath, -- | The directory under dist where we put the unpacked sources of @@ -55,8 +81,8 @@ data DistDirLayout = DistDirLayout { -- | The location for package-specific cache files (e.g. state used in -- incremental rebuilds). -- - distPackageCacheFile :: PackageId -> String -> FilePath, - distPackageCacheDirectory :: PackageId -> FilePath, + distPackageCacheFile :: DistDirParams -> String -> FilePath, + distPackageCacheDirectory :: DistDirParams -> FilePath, distTempDirectory :: FilePath, distBinDirectory :: FilePath, @@ -88,7 +114,17 @@ defaultDistDirLayout projectRootDirectory = --TODO: switch to just dist at some point, or some other new name distBuildRootDirectory = distDirectory "build" - distBuildDirectory pkgid = distBuildRootDirectory display pkgid + distBuildDirectory params = + distBuildRootDirectory + display (distParamPlatform params) + display (distParamCompilerId params) + display (distParamPackageId params) + (case fmap componentNameString (distParamComponentName params) of + Nothing -> "" + Just Nothing -> "" + Just (Just str) -> "c" str) + (case distParamUnitId params of -- For Backpack + SimpleUnitId _ -> "") distUnpackedSrcRootDirectory = distDirectory "src" distUnpackedSrcDirectory pkgid = distUnpackedSrcRootDirectory @@ -97,8 +133,8 @@ defaultDistDirLayout projectRootDirectory = distProjectCacheDirectory = distDirectory "cache" distProjectCacheFile name = distProjectCacheDirectory name - distPackageCacheDirectory pkgid = distBuildDirectory pkgid "cache" - distPackageCacheFile pkgid name = distPackageCacheDirectory pkgid name + distPackageCacheDirectory params = distBuildDirectory params "cache" + distPackageCacheFile params name = distPackageCacheDirectory params name distTempDirectory = distDirectory "tmp" diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 4a3b43eacc8..44e717a4a31 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -116,7 +116,6 @@ import Distribution.Solver.Types.ConstraintSource import Distribution.Solver.Types.LabeledPackageConstraint import Distribution.Solver.Types.OptionalStanza import qualified Distribution.Solver.Types.PackageIndex as SourcePackageIndex -import Distribution.Solver.Types.PackageFixedDeps import Distribution.Solver.Types.PkgConfigDb ( PkgConfigDb, readPkgConfigDb ) import Distribution.Solver.Types.SourcePackage as SourcePackage @@ -614,12 +613,12 @@ packageStatus installedPkgIndex cpkg = changes :: Installed.InstalledPackageInfo -> ReadyPackage -> [MergeResult PackageIdentifier PackageIdentifier] - changes pkg pkg' = filter changed $ + changes pkg (ReadyPackage pkg') = filter changed $ mergeBy (comparing packageName) -- deps of installed pkg (resolveInstalledIds $ Installed.depends pkg) -- deps of configured pkg - (resolveInstalledIds $ CD.nonSetupDeps (depends pkg')) + (resolveInstalledIds $ map confInstId (CD.nonSetupDeps (confPkgDeps pkg'))) -- convert to source pkg ids via index resolveInstalledIds :: [UnitId] -> [PackageIdentifier] diff --git a/cabal-install/Distribution/Client/InstallPlan.hs b/cabal-install/Distribution/Client/InstallPlan.hs index 429b53ccd28..25eed68a6e3 100644 --- a/cabal-install/Distribution/Client/InstallPlan.hs +++ b/cabal-install/Distribution/Client/InstallPlan.hs @@ -2,6 +2,7 @@ {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} ----------------------------------------------------------------------------- -- | @@ -21,10 +22,12 @@ module Distribution.Client.InstallPlan ( GenericInstallPlan, PlanPackage, GenericPlanPackage(..), + IsUnit, -- * Operations on 'InstallPlan's new, toList, + planIndepGoals, fromSolverInstallPlan, configureInstallPlan, @@ -42,7 +45,6 @@ module Distribution.Client.InstallPlan ( -- ** Traversal helpers -- $traversal Processing, - -- NB: these functions are only used by the legacy install-path ready, completed, failed, @@ -64,17 +66,16 @@ import qualified Distribution.Simple.Setup as Cabal import Distribution.InstalledPackageInfo ( InstalledPackageInfo ) import Distribution.Package - ( PackageIdentifier(..), Package(..) + ( Package(..) , HasUnitId(..), UnitId(..) ) import Distribution.Solver.Types.SolverPackage import Distribution.Client.JobControl import Distribution.Text - ( display ) +import Text.PrettyPrint import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan import Distribution.Client.SolverInstallPlan (SolverInstallPlan) import qualified Distribution.Solver.Types.ComponentDeps as CD -import Distribution.Solver.Types.PackageFixedDeps import Distribution.Solver.Types.Settings import Distribution.Solver.Types.SolverId @@ -82,9 +83,9 @@ import Distribution.Solver.Types.SolverId -- import qualified Distribution.Simple.Configure as Configure import Data.List - ( foldl', intercalate ) + ( foldl' ) import Data.Maybe - ( fromMaybe, catMaybes, isJust ) + ( fromMaybe, isJust ) import qualified Distribution.Compat.Graph as Graph import Distribution.Compat.Graph (Graph, IsNode(..)) import Distribution.Compat.Binary (Binary(..)) @@ -152,18 +153,23 @@ import Prelude hiding (lookup) -- dependencies in cabal-install should consider what to do with these -- dependencies; if we give a 'PackageInstalled' instance it would be too easy -- to get this wrong (and, for instance, call graph traversal functions from --- Cabal rather than from cabal-install). Instead, see 'PackageFixedDeps'. +-- Cabal rather than from cabal-install). Instead, see 'PackageInstalled'. data GenericPlanPackage ipkg srcpkg = PreExisting ipkg | Configured srcpkg deriving (Eq, Show, Generic) -instance (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) +type IsUnit a = (IsNode a, Key a ~ UnitId) + +-- NB: Expanded constraint synonym here to avoid undecidable +-- instance errors in GHC 7.8 and earlier. +instance (IsNode ipkg, IsNode srcpkg, Key ipkg ~ UnitId, Key srcpkg ~ UnitId) => IsNode (GenericPlanPackage ipkg srcpkg) where - type Key (GenericPlanPackage ipkg srcpkg) = UnitId -- TODO: change me - nodeKey = installedUnitId - nodeNeighbors = CD.flatDeps . depends + type Key (GenericPlanPackage ipkg srcpkg) = UnitId + nodeKey (PreExisting ipkg) = nodeKey ipkg + nodeKey (Configured spkg) = nodeKey spkg + nodeNeighbors (PreExisting ipkg) = nodeNeighbors ipkg + nodeNeighbors (Configured spkg) = nodeNeighbors spkg instance (Binary ipkg, Binary srcpkg) => Binary (GenericPlanPackage ipkg srcpkg) @@ -176,18 +182,17 @@ instance (Package ipkg, Package srcpkg) => packageId (PreExisting ipkg) = packageId ipkg packageId (Configured spkg) = packageId spkg -instance (PackageFixedDeps srcpkg, - PackageFixedDeps ipkg) => - PackageFixedDeps (GenericPlanPackage ipkg srcpkg) where - depends (PreExisting pkg) = depends pkg - depends (Configured pkg) = depends pkg - instance (HasUnitId ipkg, HasUnitId srcpkg) => HasUnitId (GenericPlanPackage ipkg srcpkg) where installedUnitId (PreExisting ipkg) = installedUnitId ipkg installedUnitId (Configured spkg) = installedUnitId spkg +instance (HasConfiguredId ipkg, HasConfiguredId srcpkg) => + HasConfiguredId (GenericPlanPackage ipkg srcpkg) where + configuredId (PreExisting ipkg) = configuredId ipkg + configuredId (Configured pkg) = configuredId pkg + data GenericInstallPlan ipkg srcpkg = GenericInstallPlan { planIndex :: !(PlanIndex ipkg srcpkg), planIndepGoals :: !IndependentGoals @@ -200,13 +205,6 @@ type InstallPlan = GenericInstallPlan type PlanIndex ipkg srcpkg = Graph (GenericPlanPackage ipkg srcpkg) -invariant :: (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) - => GenericInstallPlan ipkg srcpkg -> Bool -invariant plan = - valid (planIndepGoals plan) - (planIndex plan) - -- | Smart constructor that deals with caching the 'Graph' representation. -- mkInstallPlan :: PlanIndex ipkg srcpkg @@ -221,8 +219,7 @@ mkInstallPlan index indepGoals = internalError :: String -> a internalError msg = error $ "InstallPlan: internal error: " ++ msg -instance (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg, +instance (IsNode ipkg, Key ipkg ~ UnitId, IsNode srcpkg, Key srcpkg ~ UnitId, Binary ipkg, Binary srcpkg) => Binary (GenericInstallPlan ipkg srcpkg) where put GenericInstallPlan { @@ -234,16 +231,19 @@ instance (HasUnitId ipkg, PackageFixedDeps ipkg, (index, indepGoals) <- get return $! mkInstallPlan index indepGoals -showPlanIndex :: (HasUnitId ipkg, HasUnitId srcpkg) +showPlanIndex :: (Package ipkg, Package srcpkg, + IsUnit ipkg, IsUnit srcpkg) => PlanIndex ipkg srcpkg -> String -showPlanIndex index = - intercalate "\n" (map showPlanPackage (Graph.toList index)) - where showPlanPackage p = - showPlanPackageTag p ++ " " - ++ display (packageId p) ++ " (" - ++ display (installedUnitId p) ++ ")" - -showInstallPlan :: (HasUnitId ipkg, HasUnitId srcpkg) +showPlanIndex index = renderStyle defaultStyle $ + vcat (map dispPlanPackage (Graph.toList index)) + where dispPlanPackage p = + hang (hsep [ text (showPlanPackageTag p) + , disp (packageId p) + , parens (disp (nodeKey p))]) 2 + (vcat (map disp (nodeNeighbors p))) + +showInstallPlan :: (Package ipkg, Package srcpkg, + IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> String showInstallPlan = showPlanIndex . planIndex @@ -253,16 +253,10 @@ showPlanPackageTag (Configured _) = "Configured" -- | Build an installation plan from a valid set of resolved packages. -- -new :: (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) - => IndependentGoals +new :: IndependentGoals -> PlanIndex ipkg srcpkg - -> Either [PlanProblem ipkg srcpkg] - (GenericInstallPlan ipkg srcpkg) -new indepGoals index = - case problems indepGoals index of - [] -> Right (mkInstallPlan index indepGoals) - probs -> Left probs + -> GenericInstallPlan ipkg srcpkg +new indepGoals index = mkInstallPlan index indepGoals toList :: GenericInstallPlan ipkg srcpkg -> [GenericPlanPackage ipkg srcpkg] @@ -274,12 +268,10 @@ toList = Graph.toList . planIndex -- the dependencies of a package or set of packages without actually -- installing the package itself, as when doing development. -- -remove :: (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) +remove :: (IsUnit ipkg, IsUnit srcpkg) => (GenericPlanPackage ipkg srcpkg -> Bool) -> GenericInstallPlan ipkg srcpkg - -> Either [PlanProblem ipkg srcpkg] - (GenericInstallPlan ipkg srcpkg) + -> GenericInstallPlan ipkg srcpkg remove shouldRemove plan = new (planIndepGoals plan) newIndex where @@ -290,13 +282,13 @@ remove shouldRemove plan = -- must have exactly the same dependencies as the source one was configured -- with. -- -preexisting :: (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) +preexisting :: (IsUnit ipkg, + IsUnit srcpkg) => UnitId -> ipkg -> GenericInstallPlan ipkg srcpkg -> GenericInstallPlan ipkg srcpkg -preexisting pkgid ipkg plan = assert (invariant plan') plan' +preexisting pkgid ipkg plan = plan' where plan' = plan { planIndex = Graph.insert (PreExisting ipkg) @@ -308,8 +300,7 @@ preexisting pkgid ipkg plan = assert (invariant plan') plan' -- | Lookup a package in the plan. -- -lookup :: (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) +lookup :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> UnitId -> Maybe (GenericPlanPackage ipkg srcpkg) @@ -340,70 +331,7 @@ revDirectDeps plan pkgid = Nothing -> internalError "revDirectDeps: package not in graph" --- ------------------------------------------------------------ --- * Checking validity of plans --- ------------------------------------------------------------ - --- | A valid installation plan is a set of packages that is 'acyclic', --- 'closed' and 'consistent'. Also, every 'ConfiguredPackage' in the --- plan has to have a valid configuration (see 'configuredPackageValid'). --- --- * if the result is @False@ use 'problems' to get a detailed list. --- -valid :: (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) - => IndependentGoals - -> PlanIndex ipkg srcpkg - -> Bool -valid indepGoals index = - null $ problems indepGoals index - -data PlanProblem ipkg srcpkg = - PackageMissingDeps (GenericPlanPackage ipkg srcpkg) - [PackageIdentifier] - | PackageCycle [GenericPlanPackage ipkg srcpkg] - | PackageStateInvalid (GenericPlanPackage ipkg srcpkg) - (GenericPlanPackage ipkg srcpkg) - --- | For an invalid plan, produce a detailed list of problems as human readable --- error messages. This is mainly intended for debugging purposes. --- Use 'showPlanProblem' for a human readable explanation. --- -problems :: (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) - => IndependentGoals - -> PlanIndex ipkg srcpkg - -> [PlanProblem ipkg srcpkg] -problems _indepGoals index = - - [ PackageMissingDeps pkg - (catMaybes - (map - (fmap packageId . flip Graph.lookup index) - missingDeps)) - | (pkg, missingDeps) <- Graph.broken index ] - - ++ [ PackageCycle cycleGroup - | cycleGroup <- Graph.cycles index ] - ++ [ PackageStateInvalid pkg pkg' - | pkg <- Graph.toList index - , Just pkg' <- map (flip Graph.lookup index) - (CD.flatDeps (depends pkg)) - , not (stateDependencyRelation pkg pkg') ] - - --- | The states of packages have that depend on each other must respect --- this relation. That is for very case where package @a@ depends on --- package @b@ we require that @dependencyStatesOk a b = True@. --- -stateDependencyRelation :: GenericPlanPackage ipkg srcpkg - -> GenericPlanPackage ipkg srcpkg - -> Bool -stateDependencyRelation (PreExisting _) (PreExisting _) = True -stateDependencyRelation (Configured _) (PreExisting _) = True -stateDependencyRelation (Configured _) (Configured _) = True -stateDependencyRelation (PreExisting _) (Configured _) = False @@ -431,59 +359,66 @@ reverseDependencyClosure plan = fromMaybe [] . Graph.revClosure (planIndex plan) +-- Alert alert! Why does SolverId map to a LIST of plan packages? +-- The sordid story has to do with 'build-depends' on a package +-- with libraries and executables. In an ideal world, we would +-- ONLY depend on the library in this situation. But c.f. #3661 +-- some people rely on the build-depends to ALSO implicitly +-- depend on an executable. +-- +-- I don't want to commit to a strategy yet, so the only possible +-- thing you can do in this case is return EVERYTHING and let +-- the client filter out what they want (executables? libraries? +-- etc). This similarly implies we can't return a 'ConfiguredId' +-- because that's not enough information. + fromSolverInstallPlan :: - (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) - -- Maybe this should be a UnitId not ConfiguredId? - => ( (SolverId -> ConfiguredId) + (IsUnit ipkg, IsUnit srcpkg) + => ( (SolverId -> [GenericPlanPackage ipkg srcpkg]) -> SolverInstallPlan.SolverPlanPackage - -> GenericPlanPackage ipkg srcpkg) + -> [GenericPlanPackage ipkg srcpkg] ) -> SolverInstallPlan -> GenericInstallPlan ipkg srcpkg fromSolverInstallPlan f plan = - mkInstallPlan (Graph.fromList pkgs') + mkInstallPlan (Graph.fromList pkgs'') (SolverInstallPlan.planIndepGoals plan) where - (_, pkgs') = foldl' f' (Map.empty, []) (SolverInstallPlan.reverseTopologicalOrder plan) + (_, _, pkgs'') = foldl' f' (Map.empty, Map.empty, []) + (SolverInstallPlan.reverseTopologicalOrder plan) - f' (pidMap, pkgs) pkg = (pidMap', pkg' : pkgs) + f' (pidMap, ipiMap, pkgs) pkg = (pidMap', ipiMap', pkgs' ++ pkgs) where - pkg' = f (mapDep pidMap) pkg - - pidMap' - = case sid of - PreExistingId _pid uid -> - assert (uid == uid') pidMap - PlannedId pid -> - Map.insert pid uid' pidMap - where - sid = nodeKey pkg - uid' = nodeKey pkg' - - mapDep _ (PreExistingId pid uid) = ConfiguredId pid uid - mapDep pidMap (PlannedId pid) - | Just uid <- Map.lookup pid pidMap - = ConfiguredId pid uid - -- This shouldn't happen, since mapDep should only be called - -- on neighbor SolverId, which must have all been done already - -- by the reverse top-sort (this also assumes that the graph - -- is not broken). - | otherwise - = error ("fromSolverInstallPlan mapDep: " ++ display pid) + pkgs' = f (mapDep pidMap ipiMap) pkg + + (pidMap', ipiMap') + = case nodeKey pkg of + PreExistingId _ uid -> (pidMap, Map.insert uid pkgs' ipiMap) + PlannedId pid -> (Map.insert pid pkgs' pidMap, ipiMap) + + mapDep _ ipiMap (PreExistingId _pid uid) + | Just pkgs <- Map.lookup uid ipiMap = pkgs + | otherwise = error ("fromSolverInstallPlan: PreExistingId " ++ display uid) + mapDep pidMap _ (PlannedId pid) + | Just pkgs <- Map.lookup pid pidMap = pkgs + | otherwise = error ("fromSolverInstallPlan: PlannedId " ++ display pid) + -- This shouldn't happen, since mapDep should only be called + -- on neighbor SolverId, which must have all been done already + -- by the reverse top-sort (we assume the graph is not broken). -- | Conversion of 'SolverInstallPlan' to 'InstallPlan'. -- Similar to 'elaboratedInstallPlan' configureInstallPlan :: SolverInstallPlan -> InstallPlan configureInstallPlan solverPlan = flip fromSolverInstallPlan solverPlan $ \mapDep planpkg -> - case planpkg of + [case planpkg of SolverInstallPlan.PreExisting pkg _ -> PreExisting pkg SolverInstallPlan.Configured pkg -> Configured (configureSolverPackage mapDep pkg) + ] where - configureSolverPackage :: (SolverId -> ConfiguredId) + configureSolverPackage :: (SolverId -> [PlanPackage]) -> SolverPackage UnresolvedPkgLoc -> ConfiguredPackage UnresolvedPkgLoc configureSolverPackage mapDep spkg = @@ -504,7 +439,7 @@ configureInstallPlan solverPlan = confPkgDeps = deps } where - deps = fmap (map mapDep) (solverPkgDeps spkg) + deps = fmap (concatMap (map configuredId . mapDep)) (solverPkgDeps spkg) -- ------------------------------------------------------------ @@ -561,8 +496,7 @@ data Processing = Processing !(Set UnitId) !(Set UnitId) !(Set UnitId) -- all the packages that are ready will now be processed and so we can consider -- them to be in the processing state. -- -ready :: (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) +ready :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> ([GenericReadyPackage srcpkg], Processing) ready plan = @@ -571,13 +505,13 @@ ready plan = where !processing = Processing - (Set.fromList [ installedUnitId pkg | pkg <- readyPackages ]) - (Set.fromList [ installedUnitId pkg | PreExisting pkg <- toList plan ]) + (Set.fromList [ nodeKey pkg | pkg <- readyPackages ]) + (Set.fromList [ nodeKey pkg | PreExisting pkg <- toList plan ]) Set.empty readyPackages = [ ReadyPackage pkg | Configured pkg <- toList plan - , all isPreExisting (directDeps plan (installedUnitId pkg)) + , all isPreExisting (directDeps plan (nodeKey pkg)) ] isPreExisting (PreExisting {}) = True @@ -588,8 +522,7 @@ ready plan = -- and return any packages that are newly in the processing state (ie ready to -- process), along with the updated 'Processing' state. -- -completed :: (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) +completed :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> Processing -> UnitId -> ([GenericReadyPackage srcpkg], Processing) @@ -605,20 +538,19 @@ completed plan (Processing processingSet completedSet failedSet) pkgid = -- each direct reverse dep where all direct deps are completed newlyReady = [ dep | dep <- revDirectDeps plan pkgid - , all ((`Set.member` completedSet') . installedUnitId) - (directDeps plan (installedUnitId dep)) + , all ((`Set.member` completedSet') . nodeKey) + (directDeps plan (nodeKey dep)) ] processingSet' = foldl' (flip Set.insert) (Set.delete pkgid processingSet) - (map installedUnitId newlyReady) + (map nodeKey newlyReady) processing' = Processing processingSet' completedSet' failedSet asReadyPackage (Configured pkg) = ReadyPackage pkg asReadyPackage _ = error "InstallPlan.completed: internal error" -failed :: (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) +failed :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> Processing -> UnitId -> ([srcpkg], Processing) @@ -634,7 +566,7 @@ failed plan (Processing processingSet completedSet failedSet) pkgid = where processingSet' = Set.delete pkgid processingSet failedSet' = failedSet `Set.union` Set.fromList newlyFailedIds - newlyFailedIds = map installedUnitId newlyFailed + newlyFailedIds = map nodeKey newlyFailed newlyFailed = fromMaybe (internalError "package not in graph") $ Graph.revClosure (planIndex plan) [pkgid] processing' = Processing processingSet' completedSet failedSet' @@ -642,8 +574,7 @@ failed plan (Processing processingSet completedSet failedSet) pkgid = asConfiguredPackage (Configured pkg) = pkg asConfiguredPackage _ = internalError "not in configured state" -processingInvariant :: (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) +processingInvariant :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> Processing -> Bool processingInvariant plan (Processing processingSet completedSet failedSet) = @@ -662,7 +593,7 @@ processingInvariant plan (Processing processingSet completedSet failedSet) = | pkgid <- Set.toList processingSet ++ Set.toList failedSet ] where processingClosure = Set.fromList - . map installedUnitId + . map nodeKey . fromMaybe (internalError "processingClosure") . Graph.revClosure (planIndex plan) . Set.toList @@ -683,8 +614,7 @@ processingInvariant plan (Processing processingSet completedSet failedSet) = -- source packages in the dependency graph, albeit not necessarily exactly the -- same ordering as that produced by 'reverseTopologicalOrder'. -- -executionOrder :: (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) +executionOrder :: (IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> [GenericReadyPackage srcpkg] executionOrder plan = @@ -697,7 +627,7 @@ executionOrder plan = waitForTasks processing p todo = p : tryNewTasks processing' (todo++nextpkgs) where - (nextpkgs, processing') = completed plan processing (installedUnitId p) + (nextpkgs, processing') = completed plan processing (nodeKey p) -- ------------------------------------------------------------ @@ -726,8 +656,7 @@ lookupBuildOutcome = Map.lookup . installedUnitId -- can be reversed to keep going and build as many packages as possible. -- execute :: forall m ipkg srcpkg result failure. - (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg, + (IsUnit ipkg, IsUnit srcpkg, Monad m) => JobControl m (UnitId, Either failure result) -> Bool -- ^ Keep going after failure @@ -765,7 +694,7 @@ execute jobCtl keepGoing depFailure plan installPkg = | otherwise = do sequence_ [ spawnJob jobCtl $ do result <- installPkg pkg - return (installedUnitId pkg, result) + return (nodeKey pkg, result) | pkg <- newpkgs ] waitForTasks results tasksFailed processing @@ -797,5 +726,5 @@ execute jobCtl keepGoing depFailure plan installPkg = (depsfailed, processing') = failed plan processing pkgid results' = Map.insert pkgid result results `Map.union` depResults depResults = Map.fromList - [ (installedUnitId deppkg, Left (depFailure deppkg)) + [ (nodeKey deppkg, Left (depFailure deppkg)) | deppkg <- depsfailed ] diff --git a/cabal-install/Distribution/Client/PackageHash.hs b/cabal-install/Distribution/Client/PackageHash.hs index 2f56e5672e6..8468cbcbff4 100644 --- a/cabal-install/Distribution/Client/PackageHash.hs +++ b/cabal-install/Distribution/Client/PackageHash.hs @@ -43,6 +43,7 @@ import Distribution.Text ( display ) import Distribution.Client.Types ( InstalledPackageId ) +import qualified Distribution.Solver.Types.ComponentDeps as CD import qualified Hackage.Security.Client as Sec @@ -133,6 +134,7 @@ hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} = -- data PackageHashInputs = PackageHashInputs { pkgHashPkgId :: PackageId, + pkgHashComponent :: Maybe CD.Component, pkgHashSourceHash :: PackageSourceHash, pkgHashDirectDeps :: Set InstalledPackageId, pkgHashOtherConfig :: PackageHashConfigInputs @@ -188,6 +190,7 @@ hashPackageHashInputs = hashValue . renderPackageHashInputs renderPackageHashInputs :: PackageHashInputs -> LBS.ByteString renderPackageHashInputs PackageHashInputs{ pkgHashPkgId, + pkgHashComponent, pkgHashSourceHash, pkgHashDirectDeps, pkgHashOtherConfig = @@ -209,6 +212,7 @@ renderPackageHashInputs PackageHashInputs{ -- use the config file infrastructure so it can be read back in again. LBS.pack $ unlines $ catMaybes [ entry "pkgid" display pkgHashPkgId + , mentry "component" show pkgHashComponent , entry "src" showHashValue pkgHashSourceHash , entry "deps" (intercalate ", " . map display . Set.toList) pkgHashDirectDeps @@ -239,6 +243,7 @@ renderPackageHashInputs PackageHashInputs{ ] where entry key format value = Just (key ++ ": " ++ format value) + mentry key format value = fmap (\v -> key ++ ": " ++ format v) value opt key def format value | value == def = Nothing | otherwise = entry key format value diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs index a74e8b56164..e1749044b80 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/Distribution/Client/ProjectBuilding.hs @@ -1,12 +1,16 @@ {-# LANGUAGE CPP, BangPatterns, RecordWildCards, NamedFieldPuns, DeriveGeneric, DeriveDataTypeable, GeneralizedNewtypeDeriving, ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE NoMonoLocalBinds #-} +{-# LANGUAGE ConstraintKinds #-} -- | -- module Distribution.Client.ProjectBuilding ( -- * Dry run phase BuildStatus(..), + buildStatusToString, BuildStatusMap, BuildStatusRebuild(..), BuildReason(..), @@ -26,12 +30,13 @@ import Distribution.Client.PackageHash (renderPackageHashInputs) import Distribution.Client.RebuildMonad import Distribution.Client.ProjectConfig import Distribution.Client.ProjectPlanning +import Distribution.Client.ProjectPlanning.Types import Distribution.Client.Types hiding (BuildOutcomes, BuildOutcome, BuildResult(..), BuildFailure(..)) import Distribution.Client.InstallPlan - ( GenericInstallPlan, GenericPlanPackage ) + ( GenericInstallPlan, GenericPlanPackage, IsUnit ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.DistDirLayout import Distribution.Client.FileMonitor @@ -44,10 +49,6 @@ import Distribution.Client.Setup (filterConfigureFlags) import Distribution.Client.SrcDist (allPackageSourceFiles) import Distribution.Client.Utils (removeExistingFile) -import qualified Distribution.Solver.Types.ComponentDeps as CD -import Distribution.Solver.Types.ComponentDeps (ComponentDeps) -import Distribution.Solver.Types.PackageFixedDeps - import Distribution.Package hiding (InstalledPackageId, installedPackageId) import Distribution.InstalledPackageInfo (InstalledPackageInfo) import qualified Distribution.InstalledPackageInfo as Installed @@ -64,6 +65,7 @@ import Distribution.Version import Distribution.Verbosity import Distribution.Text import Distribution.ParseUtils ( showPWarning ) +import Distribution.Compat.Graph (IsNode(..)) import Data.Map (Map) import qualified Data.Map as Map @@ -162,6 +164,13 @@ data BuildStatus = -- and it does not need to be built. | BuildStatusUpToDate BuildResult +buildStatusToString :: BuildStatus -> String +buildStatusToString BuildStatusPreExisting = "BuildStatusPreExisting" +buildStatusToString BuildStatusDownload = "BuildStatusDownload" +buildStatusToString (BuildStatusUnpack fp) = "BuildStatusUnpack " ++ show fp +buildStatusToString (BuildStatusRebuild fp _) = "BuildStatusRebuild " ++ show fp +buildStatusToString (BuildStatusUpToDate _) = "BuildStatusUpToDate" + -- | For a package that is going to be built or rebuilt, the state it's in now. -- -- So again, this tells us why a package needs to be rebuilt and what build @@ -229,10 +238,12 @@ buildStatusRequiresBuild _ = True -- the 'ElaboratedInstallPlan' with packages switched to the -- 'InstallPlan.Installed' state when we find that they're already up to date. -- -rebuildTargetsDryRun :: DistDirLayout +rebuildTargetsDryRun :: Verbosity + -> DistDirLayout + -> ElaboratedSharedConfig -> ElaboratedInstallPlan -> IO (ElaboratedInstallPlan, BuildStatusMap) -rebuildTargetsDryRun distDirLayout@DistDirLayout{..} = \installPlan -> do +rebuildTargetsDryRun verbosity distDirLayout@DistDirLayout{..} shared = \installPlan -> do -- Do the various checks to work out the 'BuildStatus' of each package pkgsBuildStatus <- foldMInstallPlanDepOrder installPlan dryRunPkg @@ -241,17 +252,18 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} = \installPlan -> do -- 'InstallPlan.Installed'. let installPlan' = improveInstallPlanWithUpToDatePackages installPlan pkgsBuildStatus + debugNoWrap verbosity $ InstallPlan.showInstallPlan installPlan' return (installPlan', pkgsBuildStatus) where dryRunPkg :: ElaboratedPlanPackage - -> ComponentDeps [BuildStatus] + -> [BuildStatus] -> IO BuildStatus dryRunPkg (InstallPlan.PreExisting _pkg) _depsBuildStatus = return BuildStatusPreExisting dryRunPkg (InstallPlan.Configured pkg) depsBuildStatus = do - mloc <- checkFetched (pkgSourceLocation pkg) + mloc <- checkFetched (pkgSourceLocation (getElaboratedPackage pkg)) case mloc of Nothing -> return BuildStatusDownload @@ -273,11 +285,11 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} = \installPlan -> do dryRunTarballPkg pkg depsBuildStatus tarball dryRunTarballPkg :: ElaboratedConfiguredPackage - -> ComponentDeps [BuildStatus] + -> [BuildStatus] -> FilePath -> IO BuildStatus dryRunTarballPkg pkg depsBuildStatus tarball = - case pkgBuildStyle pkg of + case pkgBuildStyle (getElaboratedPackage pkg) of BuildAndInstall -> return (BuildStatusUnpack tarball) BuildInplaceOnly -> do -- TODO: [nice to have] use a proper file monitor rather than this dir exists test @@ -289,7 +301,7 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} = \installPlan -> do srcdir = distUnpackedSrcDirectory (packageId pkg) dryRunLocalPkg :: ElaboratedConfiguredPackage - -> ComponentDeps [BuildStatus] + -> [BuildStatus] -> FilePath -> IO BuildStatus dryRunLocalPkg pkg depsBuildStatus srcdir = do @@ -307,7 +319,7 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} = \installPlan -> do return (BuildStatusUpToDate buildResult) where packageFileMonitor = - newPackageFileMonitor distDirLayout (packageId pkg) + newPackageFileMonitor distDirLayout (elabDistDirParams shared pkg) -- | A specialised traversal over the packages in an install plan. @@ -320,12 +332,10 @@ rebuildTargetsDryRun distDirLayout@DistDirLayout{..} = \installPlan -> do -- foldMInstallPlanDepOrder :: forall m ipkg srcpkg b. - (Monad m, - HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) + (Monad m, IsUnit ipkg, IsUnit srcpkg) => GenericInstallPlan ipkg srcpkg -> (GenericPlanPackage ipkg srcpkg -> - ComponentDeps [b] -> m b) + [b] -> m b) -> m (Map InstalledPackageId b) foldMInstallPlanDepOrder plan0 visit = go Map.empty (InstallPlan.reverseTopologicalOrder plan0) @@ -337,13 +347,13 @@ foldMInstallPlanDepOrder plan0 visit = go !results (pkg : pkgs) = do -- we go in the right order so the results map has entries for all deps - let depresults :: ComponentDeps [b] + let depresults :: [b] depresults = - fmap (map (\ipkgid -> let Just result = Map.lookup ipkgid results - in result)) - (depends pkg) + map (\ipkgid -> let Just result = Map.lookup ipkgid results + in result) + (nodeNeighbors pkg) result <- visit pkg depresults - let results' = Map.insert (installedPackageId pkg) result results + let results' = Map.insert (nodeKey pkg) result results go results' pkgs improveInstallPlanWithUpToDatePackages :: ElaboratedInstallPlan @@ -362,12 +372,13 @@ improveInstallPlanWithUpToDatePackages installPlan pkgsBuildStatus = where replaceWithPrePreExisting = foldl' (\plan (ipkgid, mipkg) -> - case mipkg of - Just ipkg -> InstallPlan.preexisting ipkgid ipkg plan - -- TODO: Maybe this is a little wrong, because - -- pre-installed executables show up in the - -- InstallPlan as source packages. - Nothing -> plan) + -- TODO: A grievous hack. Better to have a special type + -- of entry representing pre-existing executables. + let stub_ipkg = Installed.emptyInstalledPackageInfo { + Installed.installedUnitId = ipkgid + } + ipkg = fromMaybe stub_ipkg mipkg + in InstallPlan.preexisting ipkgid ipkg plan) ----------------------------- @@ -398,22 +409,22 @@ data PackageFileMonitor = PackageFileMonitor { -- type BuildResultMisc = (DocsResult, TestsResult) -newPackageFileMonitor :: DistDirLayout -> PackageId -> PackageFileMonitor -newPackageFileMonitor DistDirLayout{distPackageCacheFile} pkgid = +newPackageFileMonitor :: DistDirLayout -> DistDirParams -> PackageFileMonitor +newPackageFileMonitor DistDirLayout{distPackageCacheFile} dparams = PackageFileMonitor { pkgFileMonitorConfig = - newFileMonitor (distPackageCacheFile pkgid "config"), + newFileMonitor (distPackageCacheFile dparams "config"), pkgFileMonitorBuild = FileMonitor { - fileMonitorCacheFile = distPackageCacheFile pkgid "build", + fileMonitorCacheFile = distPackageCacheFile dparams "build", fileMonitorKeyValid = \componentsToBuild componentsAlreadyBuilt -> componentsToBuild `Set.isSubsetOf` componentsAlreadyBuilt, fileMonitorCheckIfOnlyValueChanged = True }, pkgFileMonitorReg = - newFileMonitor (distPackageCacheFile pkgid "registration") + newFileMonitor (distPackageCacheFile dparams "registration") } -- | Helper function for 'checkPackageFileMonitorChanged', @@ -424,8 +435,8 @@ newPackageFileMonitor DistDirLayout{distPackageCacheFile} pkgid = -- packageFileMonitorKeyValues :: ElaboratedConfiguredPackage -> (ElaboratedConfiguredPackage, Set ComponentName) -packageFileMonitorKeyValues pkg = - (pkgconfig, buildComponents) +packageFileMonitorKeyValues pkg_or_comp = + (pkg_or_comp_config, buildComponents) where -- The first part is the value used to guard (re)configuring the package. -- That is, if this value changes then we will reconfigure. @@ -434,17 +445,25 @@ packageFileMonitorKeyValues pkg = -- do not affect the configure step need to be nulled out. Those parts are -- the specific targets that we're going to build. -- - pkgconfig = pkg { - pkgBuildTargets = [], - pkgReplTarget = Nothing, - pkgBuildHaddocks = False - } + pkg_or_comp_config = + case pkg_or_comp of + ElabPackage pkg -> ElabPackage $ pkg { + pkgBuildTargets = [], + pkgReplTarget = Nothing, + pkgBuildHaddocks = False + } + ElabComponent comp -> + ElabComponent $ comp { + elabComponentBuildTargets = [], + elabComponentReplTarget = Nothing, + elabComponentBuildHaddocks = False + } -- The second part is the value used to guard the build step. So this is -- more or less the opposite of the first part, as it's just the info about -- what targets we're going to build. -- - buildComponents = pkgBuildTargetWholeComponents pkg + buildComponents = pkgBuildTargetWholeComponents pkg_or_comp -- | Do all the checks on whether a package has changed and thus needs either -- rebuilding or reconfiguring and rebuilding. @@ -452,7 +471,7 @@ packageFileMonitorKeyValues pkg = checkPackageFileMonitorChanged :: PackageFileMonitor -> ElaboratedConfiguredPackage -> FilePath - -> ComponentDeps [BuildStatus] + -> [BuildStatus] -> IO (Either BuildStatusRebuild BuildResult) checkPackageFileMonitorChanged PackageFileMonitor{..} pkg srcdir depsBuildStatus = do @@ -469,7 +488,7 @@ checkPackageFileMonitorChanged PackageFileMonitor{..} -- The configChanged here includes the identity of the dependencies, -- so depsBuildStatus is just needed for the changes in the content -- of depencencies. - | any buildStatusRequiresBuild (CD.flatDeps depsBuildStatus) -> do + | any buildStatusRequiresBuild depsBuildStatus -> do regChanged <- checkFileMonitorChanged pkgFileMonitorReg srcdir () let mreg = changedToMaybe regChanged return (Left (BuildStatusBuild mreg BuildReasonDepsRebuilt)) @@ -596,6 +615,15 @@ data BuildResult = BuildResult { buildResultDocs :: DocsResult, buildResultTests :: TestsResult, buildResultLogFile :: Maybe FilePath, + -- | If the build was for a library, this field will be @Just@; + -- otherwise, it will be @Nothing@. What about internal + -- libraries? This never occurs, because a build result is either + -- for a per-component build (in which case there won't + -- be multiple libraries), or a package with no internal + -- libraries (internal libraries with Custom setups are NOT + -- supported, and even if they were supported, we could + -- assume the Cabal library version was recent enough to + -- support per-component build.). buildResultLibInfo :: Maybe InstalledPackageInfo } deriving Show @@ -656,8 +684,8 @@ rebuildTargets verbosity cacheLock <- newLock -- serialise access to setup exe cache --TODO: [code cleanup] eliminate setup exe cache - createDirectoryIfMissingVerbose verbosity False distBuildRootDirectory - createDirectoryIfMissingVerbose verbosity False distTempDirectory + createDirectoryIfMissingVerbose verbosity True distBuildRootDirectory + createDirectoryIfMissingVerbose verbosity True distTempDirectory mapM_ (createPackageDBIfMissing verbosity compiler progdb) packageDBsToUse -- Before traversing the install plan, pre-emptively find all packages that @@ -690,7 +718,8 @@ rebuildTargets verbosity packageDBsToUse = -- all the package dbs we may need to create (Set.toList . Set.fromList) [ pkgdb - | InstallPlan.Configured pkg <- InstallPlan.toList installPlan + | InstallPlan.Configured pkg_or_comp <- InstallPlan.toList installPlan + , let pkg = getElaboratedPackage pkg_or_comp , (pkgdb:_) <- map reverse [ pkgBuildPackageDBStack pkg, pkgRegisterPackageDBStack pkg, pkgSetupPackageDBStack pkg ] @@ -726,6 +755,7 @@ rebuildTarget verbosity BuildStatusUpToDate {} -> unexpectedState where unexpectedState = error "rebuildTarget: unexpected package status" + backing_pkg = getElaboratedPackage pkg downloadPhase = do downsrcloc <- annotateFailureNoLog DownloadFailed $ @@ -738,10 +768,10 @@ rebuildTarget verbosity unpackTarballPhase tarball = withTarballLocalDirectory verbosity distDirLayout tarball - (packageId pkg) (pkgBuildStyle pkg) - (pkgDescriptionOverride pkg) $ + (packageId pkg) (elabDistDirParams sharedPackageConfig pkg) (pkgBuildStyle backing_pkg) + (pkgDescriptionOverride backing_pkg) $ - case pkgBuildStyle pkg of + case pkgBuildStyle backing_pkg of BuildAndInstall -> buildAndInstall BuildInplaceOnly -> buildInplace buildStatus where @@ -752,11 +782,11 @@ rebuildTarget verbosity -- would only start from download or unpack phases. -- rebuildPhase buildStatus srcdir = - assert (pkgBuildStyle pkg == BuildInplaceOnly) $ + assert (pkgBuildStyle backing_pkg == BuildInplaceOnly) $ buildInplace buildStatus srcdir builddir where - builddir = distBuildDirectory (packageId pkg) + builddir = distBuildDirectory (elabDistDirParams sharedPackageConfig pkg) buildAndInstall srcdir builddir = buildAndInstallUnpackedPackage @@ -804,10 +834,11 @@ asyncDownloadPackages verbosity withRepoCtx installPlan pkgsBuildStatus body pkgsToDownload body where pkgsToDownload = - [ pkgSourceLocation pkg - | InstallPlan.Configured pkg + ordNub $ + [ pkgSourceLocation (getElaboratedPackage pkg_or_comp) + | InstallPlan.Configured pkg_or_comp <- InstallPlan.reverseTopologicalOrder installPlan - , let ipkgid = installedPackageId pkg + , let ipkgid = installedPackageId pkg_or_comp Just pkgBuildStatus = Map.lookup ipkgid pkgsBuildStatus , BuildStatusDownload <- [pkgBuildStatus] ] @@ -820,9 +851,9 @@ waitAsyncPackageDownload :: Verbosity -> AsyncFetchMap -> ElaboratedConfiguredPackage -> IO DownloadedSourceLocation -waitAsyncPackageDownload verbosity downloadMap pkg = do +waitAsyncPackageDownload verbosity downloadMap pkg_or_comp = do pkgloc <- waitAsyncFetchPackage verbosity downloadMap - (pkgSourceLocation pkg) + (pkgSourceLocation (getElaboratedPackage pkg_or_comp)) case downloadedSourceLocation pkgloc of Just loc -> return loc Nothing -> fail "waitAsyncPackageDownload: unexpected source location" @@ -849,12 +880,15 @@ withTarballLocalDirectory -> DistDirLayout -> FilePath -> PackageId + -> DistDirParams -> BuildStyle -> Maybe CabalFileText - -> (FilePath -> FilePath -> IO a) + -> (FilePath -> -- Source directory + FilePath -> -- Build directory + IO a) -> IO a withTarballLocalDirectory verbosity distDirLayout@DistDirLayout{..} - tarball pkgid buildstyle pkgTextOverride + tarball pkgid dparams buildstyle pkgTextOverride buildPkg = case buildstyle of -- In this case we make a temp dir, unpack the tarball to there and @@ -874,15 +908,15 @@ withTarballLocalDirectory verbosity distDirLayout@DistDirLayout{..} BuildInplaceOnly -> do let srcrootdir = distUnpackedSrcRootDirectory srcdir = distUnpackedSrcDirectory pkgid - builddir = distBuildDirectory pkgid + builddir = distBuildDirectory dparams -- TODO: [nice to have] use a proper file monitor rather than this dir exists test exists <- doesDirectoryExist srcdir unless exists $ do - createDirectoryIfMissingVerbose verbosity False srcrootdir + createDirectoryIfMissingVerbose verbosity True srcrootdir unpackPackageTarball verbosity tarball srcrootdir pkgid pkgTextOverride moveTarballShippedDistDirectory verbosity distDirLayout - srcrootdir pkgid + srcrootdir pkgid dparams buildPkg srcdir builddir @@ -928,9 +962,9 @@ unpackPackageTarball verbosity tarball parentdir pkgid pkgTextOverride = -- system, though we'll still need to keep this hack for older packages. -- moveTarballShippedDistDirectory :: Verbosity -> DistDirLayout - -> FilePath -> PackageId -> IO () + -> FilePath -> PackageId -> DistDirParams -> IO () moveTarballShippedDistDirectory verbosity DistDirLayout{distBuildDirectory} - parentdir pkgid = do + parentdir pkgid dparams = do distDirExists <- doesDirectoryExist tarballDistDir when distDirExists $ do debug verbosity $ "Moving '" ++ tarballDistDir ++ "' to '" @@ -939,7 +973,7 @@ moveTarballShippedDistDirectory verbosity DistDirLayout{distBuildDirectory} renameDirectory tarballDistDir targetDistDir where tarballDistDir = parentdir display pkgid "dist" - targetDistDir = distBuildDirectory pkgid + targetDistDir = distBuildDirectory dparams buildAndInstallUnpackedPackage :: Verbosity @@ -964,7 +998,7 @@ buildAndInstallUnpackedPackage verbosity rpkg@(ReadyPackage pkg) srcdir builddir = do - createDirectoryIfMissingVerbose verbosity False builddir + createDirectoryIfMissingVerbose verbosity True builddir initLogFile --TODO: [code cleanup] deal consistently with talking to older Setup.hs versions, much like @@ -977,15 +1011,20 @@ buildAndInstallUnpackedPackage verbosity --TODO: [required feature] docs and tests --TODO: [required feature] sudo re-exec + let dispname = case pkg of + ElabPackage _ -> display pkgid + ElabComponent comp -> display pkgid ++ " " + ++ maybe "custom" display (elabComponentName comp) + -- Configure phase when isParallelBuild $ - notice verbosity $ "Configuring " ++ display pkgid ++ "..." + notice verbosity $ "Configuring " ++ dispname ++ "..." annotateFailure mlogFile ConfigureFailed $ - setup configureCommand configureFlags + setup' configureCommand configureFlags configureArgs -- Build phase when isParallelBuild $ - notice verbosity $ "Building " ++ display pkgid ++ "..." + notice verbosity $ "Building " ++ dispname ++ "..." annotateFailure mlogFile BuildFailed $ setup buildCommand buildFlags @@ -1003,7 +1042,7 @@ buildAndInstallUnpackedPackage verbosity setup Cabal.copyCommand copyFlags LBS.writeFile - (InstallDirs.prefix (pkgInstallDirs pkg) "cabal-hash.txt") $ + (InstallDirs.prefix (elabInstallDirs pkg) "cabal-hash.txt") $ (renderPackageHashInputs (packageHashInputs pkgshared pkg)) -- here's where we could keep track of the installed files ourselves if @@ -1014,7 +1053,7 @@ buildAndInstallUnpackedPackage verbosity -- then when it's done, move it to its final location, to reduce problems -- with installs failing half-way. Could also register and then move. - if pkgRequiresRegistration pkg + if elabRequiresRegistration pkg then do -- We register ourselves rather than via Setup.hs. We need to -- grab and modify the InstalledPackageInfo. We decide what @@ -1025,7 +1064,7 @@ buildAndInstallUnpackedPackage verbosity criticalSection registerLock $ Cabal.registerPackage verbosity compiler progdb HcPkg.MultiInstance - (pkgRegisterPackageDBStack pkg) ipkg + (pkgRegisterPackageDBStack (getElaboratedPackage pkg)) ipkg return (Just ipkg) else return Nothing @@ -1050,6 +1089,7 @@ buildAndInstallUnpackedPackage verbosity configureFlags v = flip filterConfigureFlags v $ setupHsConfigureFlags rpkg pkgshared verbosity builddir + configureArgs = setupHsConfigureArgs pkg buildCommand = Cabal.buildCommand defaultProgramConfiguration buildFlags _ = setupHsBuildFlags pkg pkgshared verbosity builddir @@ -1070,13 +1110,16 @@ buildAndInstallUnpackedPackage verbosity isParallelBuild cacheLock setup :: CommandUI flags -> (Version -> flags) -> IO () - setup cmd flags = + setup cmd flags = setup' cmd flags [] + + setup' :: CommandUI flags -> (Version -> flags) -> [String] -> IO () + setup' cmd flags args = withLogging $ \mLogFileHandle -> setupWrapper verbosity scriptOptions { useLoggingHandle = mLogFileHandle } - (Just (pkgDescription pkg)) - cmd flags [] + (Just (pkgDescription (getElaboratedPackage pkg))) + cmd flags args mlogFile :: Maybe FilePath mlogFile = @@ -1123,14 +1166,14 @@ buildInplaceUnpackedPackage verbosity --TODO: [code cleanup] there is duplication between the distdirlayout and the builddir here -- builddir is not enough, we also need the per-package cachedir - createDirectoryIfMissingVerbose verbosity False builddir - createDirectoryIfMissingVerbose verbosity False (distPackageCacheDirectory pkgid) + createDirectoryIfMissingVerbose verbosity True builddir + createDirectoryIfMissingVerbose verbosity True (distPackageCacheDirectory dparams) -- Configure phase -- whenReConfigure $ do annotateFailureNoLog ConfigureFailed $ - setup configureCommand configureFlags [] + setup configureCommand configureFlags configureArgs invalidatePackageRegFileMonitor packageFileMonitor updatePackageConfigFileMonitor packageFileMonitor srcdir pkg @@ -1159,7 +1202,7 @@ buildInplaceUnpackedPackage verbosity mipkg <- whenReRegister $ annotateFailureNoLog InstallFailed $ do -- Register locally - mipkg <- if pkgRequiresRegistration pkg + mipkg <- if elabRequiresRegistration pkg then do ipkg0 <- generateInstalledPackageInfo -- We register ourselves rather than via Setup.hs. We need to @@ -1168,7 +1211,7 @@ buildInplaceUnpackedPackage verbosity let ipkg = ipkg0 { Installed.installedUnitId = ipkgid } criticalSection registerLock $ Cabal.registerPackage verbosity compiler progdb HcPkg.NoMultiInstance - (pkgRegisterPackageDBStack pkg) + (pkgRegisterPackageDBStack (getElaboratedPackage pkg)) ipkg return (Just ipkg) @@ -1196,27 +1239,27 @@ buildInplaceUnpackedPackage verbosity } where - pkgid = packageId rpkg - ipkgid = installedPackageId rpkg + ipkgid = installedUnitId pkg + dparams = elabDistDirParams pkgshared pkg isParallelBuild = buildSettingNumJobs >= 2 - packageFileMonitor = newPackageFileMonitor distDirLayout pkgid + packageFileMonitor = newPackageFileMonitor distDirLayout dparams whenReConfigure action = case buildStatus of BuildStatusConfigure _ -> action _ -> return () whenRebuild action - | null (pkgBuildTargets pkg) = return () + | null (elabBuildTargets pkg) = return () | otherwise = action whenRepl action - | isNothing (pkgReplTarget pkg) = return () + | isNothing (elabReplTarget pkg) = return () | otherwise = action whenHaddock action - | pkgBuildHaddocks pkg = action + | elabBuildHaddocks pkg = action | otherwise = return () whenReRegister action = case buildStatus of @@ -1228,6 +1271,7 @@ buildInplaceUnpackedPackage verbosity configureFlags v = flip filterConfigureFlags v $ setupHsConfigureFlags rpkg pkgshared verbosity builddir + configureArgs = setupHsConfigureArgs pkg buildCommand = Cabal.buildCommand defaultProgramConfiguration buildFlags _ = setupHsBuildFlags pkg pkgshared @@ -1251,7 +1295,7 @@ buildInplaceUnpackedPackage verbosity setup cmd flags args = setupWrapper verbosity scriptOptions - (Just (pkgDescription pkg)) + (Just (pkgDescription (getElaboratedPackage pkg))) cmd flags args generateInstalledPackageInfo :: IO InstalledPackageInfo diff --git a/cabal-install/Distribution/Client/ProjectOrchestration.hs b/cabal-install/Distribution/Client/ProjectOrchestration.hs index ea50730a5a7..857c93636a6 100644 --- a/cabal-install/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/Distribution/Client/ProjectOrchestration.hs @@ -58,6 +58,7 @@ module Distribution.Client.ProjectOrchestration ( import Distribution.Client.ProjectConfig import Distribution.Client.ProjectPlanning +import Distribution.Client.ProjectPlanning.Types import Distribution.Client.ProjectBuilding import Distribution.Client.Types @@ -79,7 +80,7 @@ import qualified Distribution.PackageDescription as PD import Distribution.PackageDescription (FlagAssignment) import Distribution.Simple.Setup (HaddockFlags) -import Distribution.Simple.Utils (die, notice) +import Distribution.Simple.Utils (die, notice, debug) import Distribution.Verbosity import Distribution.Text @@ -183,7 +184,7 @@ runProjectPreBuildPhase -- This also gives us more accurate reasons for the --dry-run output. -- (elaboratedPlan'', pkgsBuildStatus) <- - rebuildTargetsDryRun distDirLayout + rebuildTargetsDryRun verbosity distDirLayout elaboratedShared elaboratedPlan' return ProjectBuildContext { @@ -243,14 +244,34 @@ runProjectBuildPhase verbosity ProjectBuildContext {..} = -- | Adjust an 'ElaboratedInstallPlan' by selecting just those parts of it -- required to build the given user targets. -- --- How to get the 'PackageTarget's from the 'UserBuildTarget' is customisable. +-- How to get the 'PackageTarget's from the 'UserBuildTarget' is customisable, +-- so that we can change the meaning of @pkgname@ to target a build or +-- repl depending on which command is calling it. -- -selectTargets :: PackageTarget +-- Conceptually, every target identifies one or more roots in the +-- 'ElaboratedInstallPlan', which we then use to determine the closure +-- of what packages need to be built, dropping everything from +-- 'ElaboratedInstallPlan' that is unnecessary. +-- +-- There is a complication, however: In an ideal world, every +-- possible target would be a node in the graph. However, it is +-- currently not possible (and possibly not even desirable) to invoke a +-- Setup script to build *just* one file. Similarly, it is not possible +-- to invoke a pre Cabal-1.25 custom Setup script and build only one +-- component. In these cases, we want to build the entire package, BUT +-- only actually building some of the files/components. This is what +-- 'pkgBuildTargets', 'pkgReplTarget' and 'pkgBuildHaddock' control. +-- Arguably, these should an out-of-band mechanism rather than stored +-- in 'ElaboratedInstallPlan', but it's what we have. We have +-- to fiddle around with the ElaboratedConfiguredPackage roots to say +-- what it will build. +-- +selectTargets :: Verbosity -> PackageTarget -> (ComponentTarget -> PackageTarget) -> [UserBuildTarget] -> ElaboratedInstallPlan -> IO ElaboratedInstallPlan -selectTargets targetDefaultComponents targetSpecificComponent +selectTargets verbosity targetDefaultComponents targetSpecificComponent userBuildTargets installPlan = do -- Match the user targets against the available targets. If no targets are @@ -277,6 +298,7 @@ selectTargets targetDefaultComponents targetSpecificComponent targetSpecificComponent installPlan buildTargets + debug verbosity ("buildTargets': " ++ show buildTargets') -- Finally, prune the install plan to cover just those target packages -- and their deps. @@ -285,7 +307,8 @@ selectTargets targetDefaultComponents targetSpecificComponent where localPackages = [ (pkgDescription pkg, pkgSourceLocation pkg) - | InstallPlan.Configured pkg <- InstallPlan.toList installPlan ] + | InstallPlan.Configured pkg_or_comp <- InstallPlan.toList installPlan + , let pkg = getElaboratedPackage pkg_or_comp ] --TODO: [code cleanup] is there a better way to identify local packages? @@ -301,7 +324,8 @@ resolveAndCheckTargets targetDefaultComponents installPlan targets = case partitionEithers (map checkTarget targets) of ([], targets') -> Right $ Map.fromListWith (++) - [ (ipkgid, [t]) | (ipkgid, t) <- targets' ] + [ (ipkgid, [t]) | (ipkgids, t) <- targets' + , ipkgid <- ipkgids ] (problems, _) -> Left problems where -- TODO [required eventually] currently all build targets refer to packages @@ -342,16 +366,20 @@ resolveAndCheckTargets targetDefaultComponents = Left (BuildTargetNotInProject (buildTargetPackage t)) - projAllPkgs, projLocalPkgs :: Map PackageName InstalledPackageId + -- NB: It's a list of 'InstalledPackageId', because each component + -- in the install plan from a single package needs to be associated with + -- the same 'PackageName'. + projAllPkgs, projLocalPkgs :: Map PackageName [InstalledPackageId] projAllPkgs = - Map.fromList - [ (packageName pkg, installedPackageId pkg) + Map.fromListWith (++) + [ (packageName pkg, [installedPackageId pkg]) | pkg <- InstallPlan.toList installPlan ] projLocalPkgs = - Map.fromList - [ (packageName pkg, installedPackageId pkg) - | InstallPlan.Configured pkg <- InstallPlan.toList installPlan + Map.fromListWith (++) + [ (packageName pkg, [installedPackageId pkg_or_comp]) + | InstallPlan.Configured pkg_or_comp <- InstallPlan.toList installPlan + , let pkg = getElaboratedPackage pkg_or_comp , case pkgSourceLocation pkg of LocalUnpackedPackage _ -> True; _ -> False --TODO: [code cleanup] is there a better way to identify local packages? @@ -418,18 +446,25 @@ printPlan verbosity wouldWill | buildSettingDryRun = "would" | otherwise = "will" - showPkg pkg = display (packageId pkg) + showPkg (ReadyPackage (ElabPackage pkg)) = display (packageId pkg) + showPkg (ReadyPackage (ElabComponent comp)) = + display (packageId (elabComponentPackage comp)) ++ + " (" ++ maybe "custom" display (elabComponentName comp) ++ ")" showPkgAndReason :: ElaboratedReadyPackage -> String - showPkgAndReason (ReadyPackage pkg) = - display (packageId pkg) ++ - showTargets pkg ++ + showPkgAndReason (ReadyPackage pkg_or_comp) = + display (installedUnitId pkg_or_comp) ++ + (case pkg_or_comp of + ElabPackage _ -> showTargets pkg ++ showStanzas pkg + ElabComponent comp -> + " (" ++ maybe "custom" display (elabComponentName comp) ++ ")") ++ showFlagAssignment (nonDefaultFlags pkg) ++ - showStanzas pkg ++ - let buildStatus = pkgsBuildStatus Map.! installedPackageId pkg in + let buildStatus = pkgsBuildStatus Map.! installedPackageId pkg_or_comp in " (" ++ showBuildStatus buildStatus ++ ")" + where + pkg = getElaboratedPackage pkg_or_comp - nonDefaultFlags :: ElaboratedConfiguredPackage -> FlagAssignment + nonDefaultFlags :: ElaboratedPackage -> FlagAssignment nonDefaultFlags pkg = pkgFlagAssignment pkg \\ pkgFlagDefaults pkg showStanzas pkg = concat diff --git a/cabal-install/Distribution/Client/ProjectPlanOutput.hs b/cabal-install/Distribution/Client/ProjectPlanOutput.hs index 2dc10699c23..0d5e6a141c7 100644 --- a/cabal-install/Distribution/Client/ProjectPlanOutput.hs +++ b/cabal-install/Distribution/Client/ProjectPlanOutput.hs @@ -9,8 +9,6 @@ module Distribution.Client.ProjectPlanOutput ( ) where import Distribution.Client.ProjectPlanning.Types - ( ElaboratedInstallPlan, ElaboratedConfiguredPackage(..) - , ElaboratedSharedConfig(..) ) import Distribution.Client.DistDirLayout import qualified Distribution.Client.InstallPlan as InstallPlan @@ -66,27 +64,46 @@ encodePlanAsJson elaboratedInstallPlan _elaboratedSharedConfig = J.object [ "type" J..= J.String "pre-existing" , "id" J..= jdisplay (installedUnitId ipi) - , "components" J..= J.object - [ "lib" J..= J.object [ "depends" J..= map jdisplay (installedDepends ipi) ] ] + , "depends" J..= map jdisplay (installedDepends ipi) ] - -- ecp :: ElaboratedConfiguredPackage - toJ (InstallPlan.Configured ecp) = + -- pkg :: ElaboratedPackage + toJ (InstallPlan.Configured (ElabPackage pkg)) = J.object [ "type" J..= J.String "configured" - , "id" J..= (jdisplay . installedUnitId) ecp + , "id" J..= (jdisplay . installedUnitId) pkg , "components" J..= components + , "depends" J..= map (jdisplay . confInstId) flat_deps , "flags" J..= J.object [ fn J..= v - | (PD.FlagName fn,v) <- pkgFlagAssignment ecp ] + | (PD.FlagName fn,v) <- + pkgFlagAssignment pkg ] ] where + flat_deps = ordNub (ComponentDeps.flatDeps (pkgDependencies pkg)) components = J.object [ comp2str c J..= J.object [ "depends" J..= map (jdisplay . installedUnitId) v ] - | (c,v) <- ComponentDeps.toList (pkgDependencies ecp) ] + -- NB: does NOT contain order-only dependencies + | (c,v) <- ComponentDeps.toList (pkgDependencies pkg) ] + + -- ecp :: ElaboratedConfiguredPackage + toJ (InstallPlan.Configured (ElabComponent comp)) = + J.object + [ "type" J..= J.String "configured-component" + , "id" J..= (jdisplay . installedUnitId) comp + , "name" J..= J.String (comp2str (elabComponent comp)) + , "flags" J..= J.object [ fn J..= v + | (PD.FlagName fn,v) <- + pkgFlagAssignment pkg ] + -- NB: does NOT contain order-only dependencies + , "depends" J..= map (jdisplay . installedUnitId) (elabComponentDependencies comp) + ] + where + pkg = elabComponentPackage comp -- TODO: maybe move this helper to "ComponentDeps" module? -- Or maybe define a 'Text' instance? + comp2str :: ComponentDeps.Component -> String comp2str c = case c of ComponentDeps.ComponentLib -> "lib" ComponentDeps.ComponentSubLib s -> "lib:" <> s diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 704c88da992..87db0e9ba65 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -1,4 +1,7 @@ {-# LANGUAGE CPP, RecordWildCards, NamedFieldPuns, RankNTypes #-} +{-# LANGUAGE ViewPatterns #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE NoMonoLocalBinds #-} -- | Planning how to build everything in a project. -- @@ -31,6 +34,7 @@ module Distribution.Client.ProjectPlanning ( -- * Setup.hs CLI flags for building setupHsScriptOptions, setupHsConfigureFlags, + setupHsConfigureArgs, setupHsBuildFlags, setupHsBuildArgs, setupHsReplFlags, @@ -71,7 +75,6 @@ import Distribution.Solver.Types.ComponentDeps (ComponentDeps) import Distribution.Solver.Types.ConstraintSource import Distribution.Solver.Types.LabeledPackageConstraint import Distribution.Solver.Types.OptionalStanza -import Distribution.Solver.Types.PackageFixedDeps import Distribution.Solver.Types.PkgConfigDb import Distribution.Solver.Types.Settings import Distribution.Solver.Types.SolverId @@ -108,13 +111,12 @@ import Distribution.Verbosity import Distribution.Text import qualified Distribution.Compat.Graph as Graph +import Distribution.Compat.Graph(IsNode(..)) import Data.Map (Map) import qualified Data.Map as Map import Data.Set (Set) import qualified Data.Set as Set -import qualified Data.Graph as OldGraph -import qualified Data.Tree as Tree #if !MIN_VERSION_base(4,8,0) import Control.Applicative #endif @@ -179,15 +181,18 @@ import System.Directory (doesDirectoryExist) -- data BuildStyle = --- | Check that an 'ElaboratedConfiguredPackage' actually makes +-- | Check that an 'ElaboratedPackage' actually makes -- sense under some 'ElaboratedSharedConfig'. -sanityCheckElaboratedConfiguredPackage :: ElaboratedSharedConfig - -> ElaboratedConfiguredPackage - -> a - -> a -sanityCheckElaboratedConfiguredPackage sharedConfig - pkg@ElaboratedConfiguredPackage{..} - ret = +-- +-- TODO: I guess maybe there's some 'ElaboratedComponent' sanity +-- check one could also do +sanityCheckElaboratedPackage :: ElaboratedSharedConfig + -> ElaboratedPackage + -> a + -> a +sanityCheckElaboratedPackage sharedConfig + pkg@ElaboratedPackage{..} + ret = -- we should only have enabled stanzas that actually can be built -- (according to the solver) @@ -208,7 +213,7 @@ sanityCheckElaboratedConfiguredPackage sharedConfig -- the elaborated configured package . assert (pkgBuildStyle == BuildInplaceOnly || installedPackageId pkg == hashedInstalledPackageId - (packageHashInputs sharedConfig pkg)) + (packageHashInputs sharedConfig (ElabPackage pkg))) -- either a package is built inplace, or we are not attempting to -- build any test suites or benchmarks (we never build these @@ -282,6 +287,7 @@ rebuildInstallPlan verbosity elaboratedShared) <- phaseElaboratePlan projectConfigTransient compilerEtc solverPlan localPackages + return (elaboratedPlan, elaboratedShared, projectConfig) -- The improved plan changes each time we install something, whereas @@ -310,8 +316,8 @@ rebuildInstallPlan verbosity phaseReadProjectConfig = do liftIO $ do info verbosity "Project settings changed, reconfiguring..." - createDirectoryIfMissingVerbose verbosity False distDirectory - createDirectoryIfMissingVerbose verbosity False distProjectCacheDirectory + createDirectoryIfMissingVerbose verbosity True distDirectory + createDirectoryIfMissingVerbose verbosity True distProjectCacheDirectory projectConfig <- readProjectConfig verbosity projectRootDir @@ -517,25 +523,26 @@ rebuildInstallPlan verbosity getPackageSourceHashes verbosity withRepoCtx solverPlan defaultInstallDirs <- liftIO $ userInstallDirTemplates compiler - return $ - elaborateInstallPlan - platform compiler progdb - distDirLayout - cabalDirLayout - solverPlan - localPackages - sourcePackageHashes - defaultInstallDirs - projectConfigShared - projectConfigLocalPackages - (getMapMappend projectConfigSpecificPackage) + let (elaboratedPlan, elaboratedShared) = + elaborateInstallPlan + platform compiler progdb + distDirLayout + cabalDirLayout + solverPlan + localPackages + sourcePackageHashes + defaultInstallDirs + projectConfigShared + projectConfigLocalPackages + (getMapMappend projectConfigSpecificPackage) + liftIO $ debugNoWrap verbosity (InstallPlan.showInstallPlan elaboratedPlan) + return (elaboratedPlan, elaboratedShared) where withRepoCtx = projectConfigWithSolverRepoContext verbosity cabalPackageCacheDirectory projectConfigShared projectConfigBuildOnly - -- Update the files we maintain that reflect our current build environment. -- In particular we maintain a JSON representation of the elaborated -- install plan. @@ -577,6 +584,7 @@ rebuildInstallPlan verbosity let improvedPlan = improveInstallPlanWithPreExistingPackages storePkgIndex elaboratedPlan + liftIO $ debugNoWrap verbosity (InstallPlan.showInstallPlan improvedPlan) return improvedPlan where @@ -658,7 +666,7 @@ createPackageDBIfMissing verbosity compiler progdb (SpecificPackageDB dbPath) = do exists <- liftIO $ Cabal.doesPackageDBExist dbPath unless exists $ do - createDirectoryIfMissingVerbose verbosity False (takeDirectory dbPath) + createDirectoryIfMissingVerbose verbosity True (takeDirectory dbPath) Cabal.createPackageDB verbosity compiler progdb False dbPath createPackageDBIfMissing _ _ _ _ = return () @@ -1011,15 +1019,95 @@ elaborateInstallPlan platform compiler compilerprogdb flip InstallPlan.fromSolverInstallPlan solverPlan $ \mapDep planpkg -> case planpkg of SolverInstallPlan.PreExisting pkg _ -> - InstallPlan.PreExisting pkg + [InstallPlan.PreExisting pkg] SolverInstallPlan.Configured pkg -> - InstallPlan.Configured - (elaborateSolverPackage mapDep pkg) - - elaborateSolverPackage :: (SolverId -> ConfiguredId) + map InstallPlan.Configured (elaborateAndExpandSolverPackage mapDep pkg) + + elaborateAndExpandSolverPackage + :: (SolverId -> [ElaboratedPlanPackage]) + -> SolverPackage UnresolvedPkgLoc + -> [ElaboratedConfiguredPackage] + elaborateAndExpandSolverPackage mapDep spkg + | eligible + , Right g <- comps_graph + = map ElabComponent (snd (mapAccumL buildComponent Map.empty g)) + | otherwise + = [ElabPackage pkg] + where + pkg = elaborateSolverPackage mapDep spkg + pkgid = pkgSourceId pkg + pd = pkgDescription pkg + eligible + -- TODO + -- At this point in time, only non-Custom setup scripts + -- are supported. Implementing per-component builds with + -- Custom would require us to create a new 'ElabSetup' + -- type, and teach all of the code paths how to handle it. + -- Once you've implemented that, delete this guard. + | fromMaybe PD.Custom (PD.buildType pd) == PD.Custom + = False + -- Only non-Custom or sufficiently recent Custom + -- scripts can be expanded. + | otherwise + = (fromMaybe PD.Custom (PD.buildType pd) /= PD.Custom + -- This is when we started distributing dependencies + -- per component (instead of glomming them altogether + -- and distributing to everything.) I didn't feel + -- like implementing the legacy behavior. + && PD.specVersion pd >= Version [1,7,1] [] + ) + || PD.specVersion pd >= Version [2,0,0] [] + internalPkgSet = pkgInternalPackages pkg + comps_graph = Cabal.mkComponentsGraph (pkgEnabled pkg) pd internalPkgSet + + buildComponent :: Map ComponentName ConfiguredId + -> (Cabal.Component, [Cabal.ComponentName]) + -> (Map ComponentName ConfiguredId, ElaboratedComponent) + buildComponent internal_map (comp, cdeps) = + (internal_map', ecomp) + where + cname = Cabal.componentName comp + cname' = CD.componentNameToComponent cname + ecomp = ElaboratedComponent { + elabComponent = cname', + elabComponentName = Just cname, + elabComponentId = cid, + elabComponentPackage = pkg, + elabComponentDependencies = deps, + -- TODO: track dependencies on executables + elabComponentExeDependencies = [], + -- These are filled in later + elabComponentBuildTargets = [], + elabComponentReplTarget = Nothing, + elabComponentBuildHaddocks = False + } + cid = case pkgBuildStyle pkg of + BuildInplaceOnly -> + mkUnitId $ + display pkgid ++ "-inplace" ++ + (case Cabal.componentNameString cname of + Nothing -> "" + Just s -> "-" ++ s) + BuildAndInstall -> + -- TODO: change these types + hashedInstalledPackageId + (packageHashInputs + elaboratedSharedConfig + (ElabComponent ecomp)) -- knot tied + confid = ConfiguredId pkgid cid + external_deps = CD.select (== cname') (pkgDependencies pkg) + internal_map' = Map.insert cname confid internal_map + -- TODO: Custom setup dep. + internal_deps = [ confid' + | cdep <- cdeps + , Just confid' <- [Map.lookup cdep internal_map] ] + deps = external_deps ++ internal_deps + + + elaborateSolverPackage :: (SolverId -> [ElaboratedPlanPackage]) -> SolverPackage UnresolvedPkgLoc - -> ElaboratedConfiguredPackage + -> ElaboratedPackage elaborateSolverPackage mapDep pkg@(SolverPackage (SourcePackage pkgid gdesc srcloc descOverride) @@ -1030,11 +1118,15 @@ elaborateInstallPlan platform compiler compilerprogdb -- pkgInstalledId, which is calculated by hashing many -- of the other fields of the elaboratedPackage. -- - elaboratedPackage = ElaboratedConfiguredPackage {..} + elaboratedPackage = ElaboratedPackage {..} - deps = fmap (map elaborateSolverId) deps0 + deps = fmap (concatMap elaborateSolverId) deps0 - elaborateSolverId = mapDep + elaborateSolverId = map configuredId . filter is_lib . mapDep + where is_lib (InstallPlan.PreExisting _) = True + is_lib (InstallPlan.Configured (ElabPackage _)) = True + is_lib (InstallPlan.Configured (ElabComponent comp)) + = elabComponent comp == CD.ComponentLib pkgInstalledId | shouldBuildInplaceOnly pkg @@ -1045,7 +1137,7 @@ elaborateInstallPlan platform compiler compilerprogdb hashedInstalledPackageId (packageHashInputs elaboratedSharedConfig - elaboratedPackage) -- recursive use of elaboratedPackage + (ElabPackage elaboratedPackage)) -- recursive use of elaboratedPackage | otherwise = error $ "elaborateInstallPlan: non-inplace package " @@ -1056,15 +1148,18 @@ elaborateInstallPlan platform compiler compilerprogdb pkgSourceId = pkgid pkgDescription = let Right (desc, _) = PD.finalizePD - flags enabled (const True) + flags pkgEnabled (const True) platform (compilerInfo compiler) [] gdesc in desc + pkgInternalPackages = Cabal.getInternalPackages gdesc pkgFlagAssignment = flags pkgFlagDefaults = [ (Cabal.flagName flag, Cabal.flagDefault flag) | flag <- PD.genPackageFlags gdesc ] pkgDependencies = deps - enabled = enableStanzas stanzas + -- TODO: add support for dependencies on executables + pkgExeDependencies = CD.empty + pkgEnabled = enableStanzas stanzas pkgStanzasAvailable = Set.fromList stanzas pkgStanzasRequested = -- NB: even if a package stanza is requested, if the package @@ -1306,7 +1401,6 @@ elaborateInstallPlan platform compiler compilerprogdb -- + vanilla libs & exes, exe needs lib, recursive -- + ghci or shared lib needed by TH, recursive, ghc version dependent - --------------------------- -- Build targets -- @@ -1319,9 +1413,9 @@ elaborateInstallPlan platform compiler compilerprogdb --TODO: this needs to report some user target/config errors -elaboratePackageTargets :: ElaboratedConfiguredPackage -> [PackageTarget] +elaboratePackageTargets :: ElaboratedPackage -> [PackageTarget] -> ([ComponentTarget], Maybe ComponentTarget, Bool) -elaboratePackageTargets ElaboratedConfiguredPackage{..} targets = +elaboratePackageTargets ElaboratedPackage{..} targets = let buildTargets = nubComponentTargets . map compatSubComponentTargets . concatMap elaborateBuildTarget @@ -1389,9 +1483,11 @@ elaboratePackageTargets ElaboratedConfiguredPackage{..} targets = (t:_) -> [t] [] -> ts - pkgHasEphemeralBuildTargets :: ElaboratedConfiguredPackage -> Bool -pkgHasEphemeralBuildTargets pkg = +-- TODO: Arguably ElabComponent should have its own notes about +-- subtargets / repl targets rather than cribbing it off +-- ElaboratedPackage. +pkgHasEphemeralBuildTargets (getElaboratedPackage -> pkg) = isJust (pkgReplTarget pkg) || (not . null) [ () | ComponentTarget _ subtarget <- pkgBuildTargets pkg , subtarget /= WholeComponent ] @@ -1402,9 +1498,11 @@ pkgHasEphemeralBuildTargets pkg = -- pkgBuildTargetWholeComponents :: ElaboratedConfiguredPackage -> Set ComponentName -pkgBuildTargetWholeComponents pkg = +pkgBuildTargetWholeComponents (ElabPackage pkg) = Set.fromList [ cname | ComponentTarget cname WholeComponent <- pkgBuildTargets pkg ] +pkgBuildTargetWholeComponents (ElabComponent comp) = + Set.fromList $ maybe [] (:[]) (elabComponentName comp) ------------------------------------------------------------------------------ @@ -1419,14 +1517,43 @@ pkgBuildTargetWholeComponents pkg = pruneInstallPlanToTargets :: Map InstalledPackageId [PackageTarget] -> ElaboratedInstallPlan -> ElaboratedInstallPlan pruneInstallPlanToTargets perPkgTargetsMap = - either (\_ -> assert False undefined) id - . InstallPlan.new (IndependentGoals False) + InstallPlan.new (IndependentGoals False) . Graph.fromList -- We have to do this in two passes . pruneInstallPlanPass2 . pruneInstallPlanPass1 perPkgTargetsMap . InstallPlan.toList +-- | This is a temporary data type, where we temporarily +-- override the graph dependencies of an 'ElaboratedPackage', +-- so we can take a closure over them. We'll throw out the +-- overriden dependencies when we're done so it's strictly temporary. +-- +-- This rigamarole is totally unnecessary for 'ElaboratedComponent', +-- where we don't need to avoid configuring a test suite; it always +-- is configured separately. +data PrunedPackage + = PrunedPackage ElaboratedPackage [InstalledPackageId] + | PrunedComponent ElaboratedComponent + +instance Package PrunedPackage where + packageId (PrunedPackage pkg _) = packageId pkg + packageId (PrunedComponent comp) = packageId comp + +instance HasUnitId PrunedPackage where + installedUnitId = nodeKey + +instance IsNode PrunedPackage where + type Key PrunedPackage = InstalledPackageId + nodeKey (PrunedPackage pkg _) = nodeKey pkg + nodeKey (PrunedComponent comp) = nodeKey comp + nodeNeighbors (PrunedPackage _ deps) = deps + nodeNeighbors (PrunedComponent comp) = nodeNeighbors comp + +fromPrunedPackage :: PrunedPackage -> ElaboratedConfiguredPackage +fromPrunedPackage (PrunedPackage pkg _) = ElabPackage pkg +fromPrunedPackage (PrunedComponent comp) = ElabComponent comp + -- | The first pass does three things: -- -- * Set the build targets based on the user targets (but not rev deps yet). @@ -1440,22 +1567,62 @@ pruneInstallPlanPass1 :: Map InstalledPackageId [PackageTarget] -> [ElaboratedPlanPackage] -> [ElaboratedPlanPackage] pruneInstallPlanPass1 perPkgTargetsMap pkgs = - map fst $ - dependencyClosure - (installedPackageId . fst) -- the pkg id - snd -- the pruned deps - [ (pkg', pruneOptionalDependencies pkg') - | pkg <- pkgs - , let pkg' = mapConfiguredPackage - (pruneOptionalStanzas . setBuildTargets) pkg - ] - (Map.keys perPkgTargetsMap) + map (mapConfiguredPackage fromPrunedPackage) + (fromMaybe [] $ Graph.closure g roots) where + pkgs' = map (mapConfiguredPackage prune) pkgs + g = Graph.fromList pkgs' + + prune (ElabPackage pkg) = + let pkg' = (pruneOptionalStanzas . setPkgBuildTargets) pkg + in PrunedPackage pkg' (pruneOptionalDependencies pkg') + prune (ElabComponent comp) = PrunedComponent (setComponentBuildTargets comp) + + roots = mapMaybe find_root pkgs' + find_root (InstallPlan.Configured (PrunedPackage pkg _)) = + if not (null (pkgBuildTargets pkg) + && isNothing (pkgReplTarget pkg) + && not (pkgBuildHaddocks pkg)) + then Just (installedUnitId pkg) + else Nothing + find_root (InstallPlan.Configured (PrunedComponent comp)) = + if not (null (elabComponentBuildTargets comp) + && isNothing (elabComponentReplTarget comp) + && not (elabComponentBuildHaddocks comp)) + then Just (installedUnitId comp) + else Nothing + find_root _ = Nothing + + setComponentBuildTargets comp = + comp { + elabComponentBuildTargets = buildTargets', + elabComponentReplTarget = replTarget', + elabComponentBuildHaddocks = buildHaddocks + } + where + -- I didn't feel like reimplementing elaboratePackageTargets, + -- so I just called it directly. + (buildTargets, replTarget, buildHaddocks) + = elaboratePackageTargets (elabComponentPackage comp) targets + -- Pare down the results for only things that are relevant + -- to us. This is because were sloppy when assigning targets + -- to IPIDs. + buildTargets' = mapMaybe f buildTargets + where f (ComponentTarget cname sub) + | Just cname == elabComponentName comp = Just sub + | otherwise = Nothing + replTarget' = replTarget >>= \(ComponentTarget cname sub) -> + if Just cname == elabComponentName comp + then Just sub + else Nothing + targets = fromMaybe [] + $ Map.lookup (installedPackageId comp) perPkgTargetsMap + -- Elaborate and set the targets we'll build for this package. This is just -- based on the targets from the user, not targets implied by reverse -- dependencies. Those comes in the second pass once we know the rev deps. -- - setBuildTargets pkg = + setPkgBuildTargets pkg = pkg { pkgBuildTargets = buildTargets, pkgReplTarget = replTarget, @@ -1496,18 +1663,17 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = -- the optional stanzas and we'll make further tweaks to the optional -- stanzas in the next pass. -- - pruneOptionalDependencies :: ElaboratedPlanPackage -> [InstalledPackageId] - pruneOptionalDependencies (InstallPlan.Configured pkg) = - (CD.flatDeps . CD.filterDeps keepNeeded) (depends pkg) + pruneOptionalDependencies :: ElaboratedPackage -> [InstalledPackageId] + pruneOptionalDependencies pkg = + -- TODO: do the right thing when this is a test-suite component itself + (CD.flatDeps . CD.filterDeps keepNeeded . fmap (map confInstId)) (pkgDependencies pkg) where keepNeeded (CD.ComponentTest _) _ = TestStanzas `Set.member` stanzas keepNeeded (CD.ComponentBench _) _ = BenchStanzas `Set.member` stanzas keepNeeded _ _ = True stanzas = pkgStanzasEnabled pkg - pruneOptionalDependencies pkg = - CD.flatDeps (depends pkg) - optionalStanzasRequiredByTargets :: ElaboratedConfiguredPackage + optionalStanzasRequiredByTargets :: ElaboratedPackage -> Set OptionalStanza optionalStanzasRequiredByTargets pkg = Set.fromList @@ -1517,7 +1683,7 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = , stanza <- maybeToList (componentOptionalStanza cname) ] - optionalStanzasRequestedByDefault :: ElaboratedConfiguredPackage + optionalStanzasRequestedByDefault :: ElaboratedPackage -> Set OptionalStanza optionalStanzasRequestedByDefault = Map.keysSet @@ -1536,7 +1702,7 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = -- all of the deps needed for the test suite, we go ahead and -- enable it always. optionalStanzasWithDepsAvailable :: Set InstalledPackageId - -> ElaboratedConfiguredPackage + -> ElaboratedPackage -> Set OptionalStanza optionalStanzasWithDepsAvailable availablePkgs pkg = Set.fromList @@ -1586,8 +1752,18 @@ pruneInstallPlanPass2 :: [ElaboratedPlanPackage] pruneInstallPlanPass2 pkgs = map (mapConfiguredPackage setStanzasDepsAndTargets) pkgs where - setStanzasDepsAndTargets pkg = - pkg { + setStanzasDepsAndTargets (ElabComponent comp) = + ElabComponent $ comp { + elabComponentBuildTargets = elabComponentBuildTargets comp + ++ targetsRequiredForRevDeps + } + where + targetsRequiredForRevDeps = + [ WholeComponent + | installedPackageId comp `Set.member` hasReverseLibDeps + ] + setStanzasDepsAndTargets (ElabPackage pkg) = + ElabPackage $ pkg { pkgStanzasEnabled = stanzas, pkgDependencies = CD.filterDeps keepNeeded (pkgDependencies pkg), pkgBuildTargets = pkgBuildTargets pkg ++ targetsRequiredForRevDeps @@ -1614,15 +1790,15 @@ pruneInstallPlanPass2 pkgs = hasReverseLibDeps :: Set InstalledPackageId hasReverseLibDeps = Set.fromList [ depid | pkg <- pkgs - , depid <- CD.flatDeps (depends pkg) ] - + , depid <- nodeNeighbors pkg ] -mapConfiguredPackage :: (ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage) - -> ElaboratedPlanPackage - -> ElaboratedPlanPackage +mapConfiguredPackage :: (srcpkg -> srcpkg') + -> InstallPlan.GenericPlanPackage ipkg srcpkg + -> InstallPlan.GenericPlanPackage ipkg srcpkg' mapConfiguredPackage f (InstallPlan.Configured pkg) = InstallPlan.Configured (f pkg) -mapConfiguredPackage _ pkg = pkg +mapConfiguredPackage _ (InstallPlan.PreExisting pkg) = + InstallPlan.PreExisting pkg componentOptionalStanza :: Cabal.ComponentName -> Maybe OptionalStanza componentOptionalStanza (Cabal.CTestName _) = Just TestStanzas @@ -1630,39 +1806,6 @@ componentOptionalStanza (Cabal.CBenchName _) = Just BenchStanzas componentOptionalStanza _ = Nothing -dependencyClosure :: (pkg -> InstalledPackageId) - -> (pkg -> [InstalledPackageId]) - -> [pkg] - -> [InstalledPackageId] - -> [pkg] -dependencyClosure pkgid deps allpkgs = - map vertexToPkg - . concatMap Tree.flatten - . OldGraph.dfs graph - . map pkgidToVertex - where - (graph, vertexToPkg, pkgidToVertex) = dependencyGraph pkgid deps allpkgs - --- TODO: Convert this to use Distribution.Compat.Graph, via a newtype --- which explicitly carries the accessors. -dependencyGraph :: (pkg -> InstalledPackageId) - -> (pkg -> [InstalledPackageId]) - -> [pkg] - -> (OldGraph.Graph, - OldGraph.Vertex -> pkg, - InstalledPackageId -> OldGraph.Vertex) -dependencyGraph pkgid deps pkgs = - (graph, vertexToPkg', pkgidToVertex') - where - (graph, vertexToPkg, pkgidToVertex) = - OldGraph.graphFromEdges [ ( pkg, pkgid pkg, deps pkg ) - | pkg <- pkgs ] - vertexToPkg' = (\(pkg,_,_) -> pkg) - . vertexToPkg - pkgidToVertex' = fromMaybe (error "dependencyGraph: lookup failure") - . pkgidToVertex - - --------------------------- -- Setup.hs script policy -- @@ -1858,7 +2001,9 @@ setupHsScriptOptions :: ElaboratedReadyPackage -> Bool -> Lock -> SetupScriptOptions -setupHsScriptOptions (ReadyPackage ElaboratedConfiguredPackage{..}) +-- TODO: Fix this so custom is a separate component. Custom can ALWAYS +-- be a separate component!!! +setupHsScriptOptions (ReadyPackage (getElaboratedPackage -> ElaboratedPackage{..})) ElaboratedSharedConfig{..} srcdir builddir isParallelBuild cacheLock = SetupScriptOptions { @@ -1928,20 +2073,25 @@ setupHsConfigureFlags :: ElaboratedReadyPackage -> Verbosity -> FilePath -> Cabal.ConfigFlags -setupHsConfigureFlags (ReadyPackage - pkg@ElaboratedConfiguredPackage{..}) +setupHsConfigureFlags (ReadyPackage pkg_or_comp) sharedConfig@ElaboratedSharedConfig{..} verbosity builddir = - sanityCheckElaboratedConfiguredPackage sharedConfig pkg + sanityCheckElaboratedPackage sharedConfig pkg (Cabal.ConfigFlags {..}) where - configArgs = [] + pkg@ElaboratedPackage{..} = getElaboratedPackage pkg_or_comp + + configArgs = mempty -- unused, passed via args configDistPref = toFlag builddir configCabalFilePath = mempty configVerbosity = toFlag verbosity - configIPID = toFlag (display (installedUnitId pkg)) - configCID = mempty + configIPID = case pkg_or_comp of + ElabPackage _ -> toFlag (display (installedUnitId pkg)) + ElabComponent _ -> mempty + configCID = case pkg_or_comp of + ElabPackage _ -> mempty + ElabComponent comp -> toFlag (unitIdComponentId (elabComponentId comp)) configProgramPaths = Map.toList pkgProgramPaths configProgramArgs = Map.toList pkgProgramArgs @@ -1982,13 +2132,20 @@ setupHsConfigureFlags (ReadyPackage configProgPrefix = maybe mempty toFlag pkgProgPrefix configProgSuffix = maybe mempty toFlag pkgProgSuffix + -- TODO: do this per-component configInstallDirs = fmap (toFlag . InstallDirs.toPathTemplate) pkgInstallDirs -- we only use configDependencies, unless we're talking to an old Cabal -- in which case we use configConstraints + -- NB: This does NOT use nodeNeighbors, which includes executable + -- dependencies which should NOT be fed in here configDependencies = [ (packageName srcid, uid) - | ConfiguredId srcid uid <- CD.nonSetupDeps pkgDependencies ] + | ConfiguredId srcid uid <- + case pkg_or_comp of + ElabPackage _ -> CD.nonSetupDeps pkgDependencies + ElabComponent comp -> elabComponentDependencies comp ] + -- TODO: don't need to provide these when pkgComponent is Just configConstraints = [ thisPackageVersion srcid | ConfiguredId srcid _uid <- CD.nonSetupDeps pkgDependencies ] @@ -1996,8 +2153,12 @@ setupHsConfigureFlags (ReadyPackage -- TODO: [required eventually] have to do this differently for older Cabal versions configPackageDBs = Nothing : map Just pkgBuildPackageDBStack - configTests = toFlag (TestStanzas `Set.member` pkgStanzasEnabled) - configBenchmarks = toFlag (BenchStanzas `Set.member` pkgStanzasEnabled) + configTests = case pkg_or_comp of + ElabPackage _ -> toFlag (TestStanzas `Set.member` pkgStanzasEnabled) + ElabComponent _ -> mempty + configBenchmarks = case pkg_or_comp of + ElabPackage _ -> toFlag (BenchStanzas `Set.member` pkgStanzasEnabled) + ElabComponent _ -> mempty configExactConfiguration = toFlag True configFlagError = mempty --TODO: [research required] appears not to be implemented @@ -2007,12 +2168,22 @@ setupHsConfigureFlags (ReadyPackage configPrograms_ = mempty -- never use, shouldn't exist +setupHsConfigureArgs :: ElaboratedConfiguredPackage + -> [String] +setupHsConfigureArgs (ElabPackage _pkg) = [] +setupHsConfigureArgs (ElabComponent comp) = + [showComponentTarget pkg (ComponentTarget cname WholeComponent)] + where + pkg = elabComponentPackage comp + cname = fromMaybe (error "setupHsConfigureArgs: trying to configure setup") + (elabComponentName comp) + setupHsBuildFlags :: ElaboratedConfiguredPackage -> ElaboratedSharedConfig -> Verbosity -> FilePath -> Cabal.BuildFlags -setupHsBuildFlags ElaboratedConfiguredPackage{..} _ verbosity builddir = +setupHsBuildFlags _ _ verbosity builddir = Cabal.BuildFlags { buildProgramPaths = mempty, --unused, set at configure time buildProgramArgs = mempty, --unused, set at configure time @@ -2025,11 +2196,11 @@ setupHsBuildFlags ElaboratedConfiguredPackage{..} _ verbosity builddir = setupHsBuildArgs :: ElaboratedConfiguredPackage -> [String] -setupHsBuildArgs pkg = - map (showComponentTarget pkg) (pkgBuildTargets pkg) +setupHsBuildArgs (ElabPackage pkg) = map (showComponentTarget pkg) (pkgBuildTargets pkg) +setupHsBuildArgs (ElabComponent _comp) = [] -showComponentTarget :: ElaboratedConfiguredPackage -> ComponentTarget -> String +showComponentTarget :: ElaboratedPackage -> ComponentTarget -> String showComponentTarget pkg = showBuildTarget . toBuildTarget where @@ -2052,7 +2223,7 @@ setupHsReplFlags :: ElaboratedConfiguredPackage -> Verbosity -> FilePath -> Cabal.ReplFlags -setupHsReplFlags ElaboratedConfiguredPackage{..} _ verbosity builddir = +setupHsReplFlags _ _ verbosity builddir = Cabal.ReplFlags { replProgramPaths = mempty, --unused, set at configure time replProgramArgs = mempty, --unused, set at configure time @@ -2063,9 +2234,11 @@ setupHsReplFlags ElaboratedConfiguredPackage{..} _ verbosity builddir = setupHsReplArgs :: ElaboratedConfiguredPackage -> [String] -setupHsReplArgs pkg = +setupHsReplArgs (ElabPackage pkg) = maybe [] (\t -> [showComponentTarget pkg t]) (pkgReplTarget pkg) --TODO: should be able to give multiple modules in one component +setupHsReplArgs (ElabComponent _comp) = + error "setupHsReplArgs: didn't implement me yet" setupHsCopyFlags :: ElaboratedConfiguredPackage @@ -2091,13 +2264,13 @@ setupHsRegisterFlags :: ElaboratedConfiguredPackage -> FilePath -> FilePath -> Cabal.RegisterFlags -setupHsRegisterFlags ElaboratedConfiguredPackage {pkgBuildStyle} _ +setupHsRegisterFlags pkg_or_comp _ verbosity builddir pkgConfFile = Cabal.RegisterFlags { regPackageDB = mempty, -- misfeature regGenScript = mempty, -- never use regGenPkgConf = toFlag (Just pkgConfFile), - regInPlace = case pkgBuildStyle of + regInPlace = case pkgBuildStyle (getElaboratedPackage pkg_or_comp) of BuildInplaceOnly -> toFlag True _ -> toFlag False, regPrintId = mempty, -- never use @@ -2113,7 +2286,9 @@ setupHsHaddockFlags :: ElaboratedConfiguredPackage -> Verbosity -> FilePath -> Cabal.HaddockFlags -setupHsHaddockFlags ElaboratedConfiguredPackage{..} _ verbosity builddir = +-- TODO: reconsider whether or not Executables/TestSuites/... +-- needed for component +setupHsHaddockFlags (getElaboratedPackage -> ElaboratedPackage{..}) _ verbosity builddir = Cabal.HaddockFlags { haddockProgramPaths = mempty, --unused, set at configure time haddockProgramArgs = mempty, --unused, set at configure time @@ -2192,17 +2367,20 @@ packageHashInputs :: ElaboratedSharedConfig -> PackageHashInputs packageHashInputs pkgshared - pkg@ElaboratedConfiguredPackage{ + (ElabPackage pkg@ElaboratedPackage{ pkgSourceId, pkgSourceHash = Just srchash, - pkgDependencies - } = + pkgDependencies, + pkgExeDependencies + }) = PackageHashInputs { pkgHashPkgId = pkgSourceId, + pkgHashComponent = Nothing, pkgHashSourceHash = srchash, - pkgHashDirectDeps = Set.fromList - [ installedPackageId dep - | dep <- CD.select relevantDeps pkgDependencies ], + pkgHashDirectDeps = Set.fromList $ + [ installedPackageId dep + | dep <- CD.select relevantDeps pkgDependencies ] ++ + CD.select relevantDeps pkgExeDependencies, pkgHashOtherConfig = packageHashConfigInputs pkgshared pkg } where @@ -2217,16 +2395,29 @@ packageHashInputs relevantDeps (CD.ComponentTest _) = False relevantDeps (CD.ComponentBench _) = False +packageHashInputs + pkgshared + (ElabComponent comp@ElaboratedComponent { + elabComponentPackage = pkg@ElaboratedPackage{ pkgSourceHash = Just srchash } + }) = + PackageHashInputs { + pkgHashPkgId = packageId comp, + pkgHashComponent = Just (elabComponent comp), + pkgHashSourceHash = srchash, + pkgHashDirectDeps = Set.fromList (nodeNeighbors comp), + pkgHashOtherConfig = packageHashConfigInputs pkgshared pkg + } + packageHashInputs _ pkg = error $ "packageHashInputs: only for packages with source hashes. " ++ display (packageId pkg) packageHashConfigInputs :: ElaboratedSharedConfig - -> ElaboratedConfiguredPackage + -> ElaboratedPackage -> PackageHashConfigInputs packageHashConfigInputs ElaboratedSharedConfig{..} - ElaboratedConfiguredPackage{..} = + ElaboratedPackage{..} = PackageHashConfigInputs { pkgHashCompilerId = compilerId pkgConfigCompiler, diff --git a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs index afcefde7323..76b60ffe75c 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -1,4 +1,6 @@ -{-# LANGUAGE DeriveGeneric, DeriveDataTypeable #-} +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE TypeFamilies #-} -- | Types used while planning how to build everything in a project. -- @@ -10,6 +12,17 @@ module Distribution.Client.ProjectPlanning.Types ( -- * Elaborated install plan types ElaboratedInstallPlan, ElaboratedConfiguredPackage(..), + + getElaboratedPackage, + elabInstallDirs, + elabDistDirParams, + elabRequiresRegistration, + elabBuildTargets, + elabReplTarget, + elabBuildHaddocks, + + ElaboratedComponent(..), + ElaboratedPackage(..), ElaboratedPlanPackage, ElaboratedSharedConfig(..), ElaboratedReadyPackage, @@ -32,7 +45,9 @@ import Distribution.Client.InstallPlan ( GenericInstallPlan, GenericPlanPackage ) import Distribution.Client.SolverInstallPlan ( SolverInstallPlan ) +import Distribution.Client.DistDirLayout +import Distribution.Types.ComponentEnabledSpec import Distribution.Package hiding (InstalledPackageId, installedPackageId) import Distribution.System @@ -46,9 +61,10 @@ import qualified Distribution.Simple.InstallDirs as InstallDirs import Distribution.Simple.InstallDirs (PathTemplate) import Distribution.Version +import qualified Distribution.Solver.Types.ComponentDeps as CD import Distribution.Solver.Types.ComponentDeps (ComponentDeps) import Distribution.Solver.Types.OptionalStanza -import Distribution.Solver.Types.PackageFixedDeps +import Distribution.Compat.Graph (IsNode(..)) import Data.Map (Map) import Data.Set (Set) @@ -91,16 +107,151 @@ data ElaboratedSharedConfig instance Binary ElaboratedSharedConfig +-- TODO: This is a misnomer, but I didn't want to rename things +-- willy-nilly yet data ElaboratedConfiguredPackage - = ElaboratedConfiguredPackage { + = ElabPackage ElaboratedPackage + | ElabComponent ElaboratedComponent + deriving (Eq, Show, Generic) + +instance IsNode ElaboratedConfiguredPackage where + type Key ElaboratedConfiguredPackage = UnitId + nodeKey (ElabPackage pkg) = nodeKey pkg + nodeKey (ElabComponent comp) = nodeKey comp + nodeNeighbors (ElabPackage pkg) = nodeNeighbors pkg + nodeNeighbors (ElabComponent comp) = nodeNeighbors comp + +elabDistDirParams :: ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> DistDirParams +elabDistDirParams shared (ElabPackage pkg) = DistDirParams { + distParamUnitId = pkgInstalledId pkg, + distParamPackageId = pkgSourceId pkg, + distParamComponentName = Nothing, + distParamCompilerId = compilerId (pkgConfigCompiler shared), + distParamPlatform = pkgConfigPlatform shared + } +elabDistDirParams shared (ElabComponent comp) = DistDirParams { + distParamUnitId = elabComponentId comp, + distParamPackageId = packageId comp, -- NB: NOT the munged ID + distParamComponentName = elabComponentName comp, -- TODO: Ick. Change type. + distParamCompilerId = compilerId (pkgConfigCompiler shared), + distParamPlatform = pkgConfigPlatform shared + } + +-- TODO: give each component a separate install dir prefix +elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs.InstallDirs FilePath +elabInstallDirs = pkgInstallDirs . getElaboratedPackage + +elabRequiresRegistration :: ElaboratedConfiguredPackage -> Bool +elabRequiresRegistration (ElabPackage pkg) = pkgRequiresRegistration pkg +elabRequiresRegistration (ElabComponent comp) + = case elabComponent comp of + CD.ComponentLib -> True + CD.ComponentSubLib _ -> True + _ -> False + +elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget] +elabBuildTargets (ElabPackage pkg) = pkgBuildTargets pkg +elabBuildTargets (ElabComponent comp) + | Just cname <- elabComponentName comp + = map (ComponentTarget cname) $ elabComponentBuildTargets comp + | otherwise = [] + +elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget +elabReplTarget (ElabPackage pkg) = pkgReplTarget pkg +elabReplTarget (ElabComponent comp) + | Just cname <- elabComponentName comp + = fmap (ComponentTarget cname) $ elabComponentReplTarget comp + | otherwise = Nothing + +elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool +elabBuildHaddocks (ElabPackage pkg) = pkgBuildHaddocks pkg +elabBuildHaddocks (ElabComponent comp) = elabComponentBuildHaddocks comp + +getElaboratedPackage :: ElaboratedConfiguredPackage -> ElaboratedPackage +getElaboratedPackage (ElabPackage pkg) = pkg +getElaboratedPackage (ElabComponent comp) = elabComponentPackage comp + +instance Binary ElaboratedConfiguredPackage + +instance Package ElaboratedConfiguredPackage where + packageId (ElabPackage pkg) = packageId pkg + packageId (ElabComponent comp) = packageId comp + +instance HasUnitId ElaboratedConfiguredPackage where + installedUnitId (ElabPackage pkg) = installedUnitId pkg + installedUnitId (ElabComponent comp) = installedUnitId comp + +instance HasConfiguredId ElaboratedConfiguredPackage where + configuredId (ElabPackage pkg) = configuredId pkg + configuredId (ElabComponent comp) = configuredId comp + +-- | Some extra metadata associated with an +-- 'ElaboratedConfiguredPackage' which indicates that the "package" +-- in question is actually a single component to be built. Arguably +-- it would be clearer if there were an ADT which branched into +-- package work items and component work items, but I've structured +-- it this way to minimize change to the existing code (which I +-- don't feel qualified to rewrite.) +data ElaboratedComponent + = ElaboratedComponent { + -- | The name of the component to be built + elabComponent :: CD.Component, + -- | The name of the component to be built. Nothing if + -- it's a setup dep. + elabComponentName :: Maybe ComponentName, + -- | The ID of the component to be built + elabComponentId :: UnitId, + -- | Dependencies of this component + elabComponentDependencies :: [ConfiguredId], + -- | The order-only dependencies of this component; e.g., + -- if you depend on an executable it goes here. + elabComponentExeDependencies :: [UnitId], + -- | The 'ElaboratedPackage' this component came from + elabComponentPackage :: ElaboratedPackage, + -- | What in this component should we build (TRANSIENT, see 'pkgBuildTargets') + elabComponentBuildTargets :: [SubComponentTarget], + -- | Should we REPL this component (TRANSIENT, see 'pkgReplTarget') + elabComponentReplTarget :: Maybe SubComponentTarget, + -- | Should we Haddock this component (TRANSIENT, see 'pkgBuildHaddocks') + elabComponentBuildHaddocks :: Bool + -- NB: Careful, if you add elabComponentInstallDirs, need + -- to adjust 'packageHashInputs'!!! + } + deriving (Eq, Show, Generic) + +instance Binary ElaboratedComponent + +instance Package ElaboratedComponent where + -- NB: DON'T return the munged ID by default. + -- The 'Package' type class is about the source package + -- name that the component belongs to; 'projAllPkgs' + -- in "Distribution.Client.ProjectOrchestration" depends + -- on this. + packageId = packageId . elabComponentPackage + +instance HasConfiguredId ElaboratedComponent where + configuredId comp = ConfiguredId (packageId comp) (installedUnitId comp) + +instance HasUnitId ElaboratedComponent where + installedUnitId = elabComponentId + +instance IsNode ElaboratedComponent where + type Key ElaboratedComponent = UnitId + nodeKey = elabComponentId + nodeNeighbors comp = + map installedUnitId (elabComponentDependencies comp) + ++ elabComponentExeDependencies comp + +data ElaboratedPackage + = ElaboratedPackage { pkgInstalledId :: InstalledPackageId, pkgSourceId :: PackageId, - -- | TODO: [code cleanup] we don't need this, just a few bits from it: - -- build type, spec version pkgDescription :: Cabal.PackageDescription, + pkgInternalPackages :: Map PackageName ComponentName, + -- | A total flag assignment for the package pkgFlagAssignment :: Cabal.FlagAssignment, @@ -111,6 +262,13 @@ data ElaboratedConfiguredPackage -- pkgDependencies :: ComponentDeps [ConfiguredId], + -- | The executable dependencies, which we don't pass as @--dependency@ flags; + -- these just need to be added to the path. + pkgExeDependencies :: ComponentDeps [UnitId], + + -- | Another way of phrasing 'pkgStanzasAvailable'. + pkgEnabled :: ComponentEnabledSpec, + -- | Which optional stanzas (ie testsuites, benchmarks) can be built. -- This means the solver produced a plan that has them available. -- This doesn't necessary mean we build them by default. @@ -226,16 +384,22 @@ data ElaboratedConfiguredPackage } deriving (Eq, Show, Generic) -instance Binary ElaboratedConfiguredPackage +instance Binary ElaboratedPackage -instance Package ElaboratedConfiguredPackage where +instance Package ElaboratedPackage where packageId = pkgSourceId -instance HasUnitId ElaboratedConfiguredPackage where +instance HasUnitId ElaboratedPackage where installedUnitId = pkgInstalledId -instance PackageFixedDeps ElaboratedConfiguredPackage where - depends = fmap (map installedPackageId) . pkgDependencies +instance HasConfiguredId ElaboratedPackage where + configuredId pkg = ConfiguredId (pkgSourceId pkg) (pkgInstalledId pkg) + +instance IsNode ElaboratedPackage where + type Key ElaboratedPackage = UnitId + nodeKey = pkgInstalledId + nodeNeighbors pkg = map installedUnitId (CD.flatDeps (pkgDependencies pkg)) + ++ CD.flatDeps (pkgExeDependencies pkg) -- | This is used in the install plan to indicate how the package will be -- built. diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs index 1b3a08890a6..990e6f53f28 100644 --- a/cabal-install/Distribution/Client/Types.hs +++ b/cabal-install/Distribution/Client/Types.hs @@ -3,6 +3,7 @@ {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} +{-# LANGUAGE TypeFamilies #-} {-# OPTIONS_GHC -fno-warn-orphans #-} ----------------------------------------------------------------------------- -- | @@ -21,7 +22,7 @@ module Distribution.Client.Types where import Distribution.Package ( PackageName, PackageId, Package(..) - , UnitId(..), HasUnitId(..) ) + , UnitId(..), HasUnitId(..), PackageInstalled(..) ) import Distribution.InstalledPackageInfo ( InstalledPackageInfo ) import Distribution.PackageDescription @@ -31,11 +32,13 @@ import Distribution.Version import Distribution.Solver.Types.PackageIndex ( PackageIndex ) +import qualified Distribution.Solver.Types.ComponentDeps as CD import Distribution.Solver.Types.ComponentDeps ( ComponentDeps ) import Distribution.Solver.Types.OptionalStanza import Distribution.Solver.Types.PackageFixedDeps import Distribution.Solver.Types.SourcePackage +import Distribution.Compat.Graph (IsNode(..)) import Data.Map (Map) import Network.URI (URI(..), URIAuth(..), nullURI) @@ -98,8 +101,23 @@ data ConfiguredPackage loc = ConfiguredPackage { } deriving (Eq, Show, Generic) +-- | 'HasConfiguredId' indicates data types which have a 'ConfiguredId'. +-- This type class is mostly used to conveniently finesse between +-- 'ElaboratedPackage' and 'ElaboratedComponent'. +-- +instance HasConfiguredId (ConfiguredPackage loc) where + configuredId pkg = ConfiguredId (packageId pkg) (confPkgId pkg) + +instance IsNode (ConfiguredPackage loc) where + type Key (ConfiguredPackage loc) = UnitId + nodeKey = confPkgId + -- TODO: if we update ConfiguredPackage to support order-only + -- dependencies, need to include those here + nodeNeighbors = map confInstId . CD.flatDeps . confPkgDeps + instance (Binary loc) => Binary (ConfiguredPackage loc) + -- | A ConfiguredId is a package ID for a configured package. -- -- Once we configure a source package we know it's UnitId. It is still @@ -115,7 +133,7 @@ data ConfiguredId = ConfiguredId { confSrcId :: PackageId , confInstId :: UnitId } - deriving (Eq, Generic) + deriving (Eq, Ord, Generic) instance Binary ConfiguredId @@ -131,16 +149,28 @@ instance HasUnitId ConfiguredId where instance Package (ConfiguredPackage loc) where packageId cpkg = packageId (confPkgSource cpkg) -instance PackageFixedDeps (ConfiguredPackage loc) where - depends cpkg = fmap (map installedUnitId) (confPkgDeps cpkg) +instance PackageInstalled (ConfiguredPackage loc) where + installedDepends = CD.flatDeps . fmap (map installedUnitId) . confPkgDeps instance HasUnitId (ConfiguredPackage loc) where installedUnitId = confPkgId +class HasConfiguredId a where + configuredId :: a -> ConfiguredId + +instance HasConfiguredId InstalledPackageInfo where + configuredId ipkg = ConfiguredId (packageId ipkg) (installedUnitId ipkg) + -- | Like 'ConfiguredPackage', but with all dependencies guaranteed to be -- installed already, hence itself ready to be installed. newtype GenericReadyPackage srcpkg = ReadyPackage srcpkg -- see 'ConfiguredPackage'. - deriving (Eq, Show, Generic, Package, PackageFixedDeps, HasUnitId, Binary) + deriving (Eq, Show, Generic, Package, PackageFixedDeps, HasUnitId, PackageInstalled, Binary) + +-- Can't newtype derive this +instance IsNode srcpkg => IsNode (GenericReadyPackage srcpkg) where + type Key (GenericReadyPackage srcpkg) = Key srcpkg + nodeKey (ReadyPackage spkg) = nodeKey spkg + nodeNeighbors (ReadyPackage spkg) = nodeNeighbors spkg type ReadyPackage = GenericReadyPackage (ConfiguredPackage UnresolvedPkgLoc) @@ -287,6 +317,10 @@ data BuildFailure = PlanningFailed instance Exception BuildFailure +-- Note that the @Maybe InstalledPackageInfo@ is a slight hack: we only +-- the public library's 'InstalledPackageInfo' is stored here, even if +-- there were 'InstalledPackageInfo' from internal libraries. This +-- 'InstalledPackageInfo' is not used anyway, so it makes no difference. data BuildResult = BuildResult DocsResult TestsResult (Maybe InstalledPackageInfo) deriving (Show, Generic) diff --git a/cabal-install/Distribution/Solver/Types/ComponentDeps.hs b/cabal-install/Distribution/Solver/Types/ComponentDeps.hs index 94781b8d0e1..6c36cc6083e 100644 --- a/cabal-install/Distribution/Solver/Types/ComponentDeps.hs +++ b/cabal-install/Distribution/Solver/Types/ComponentDeps.hs @@ -14,6 +14,7 @@ module Distribution.Solver.Types.ComponentDeps ( -- * Fine-grained package dependencies Component(..) + , componentNameToComponent , ComponentDep , ComponentDeps -- opaque -- ** Constructing ComponentDeps @@ -41,6 +42,8 @@ import Distribution.Compat.Semigroup (Semigroup((<>))) import GHC.Generics import Data.Foldable (fold) +import qualified Distribution.Types.ComponentName as CN + #if !MIN_VERSION_base(4,8,0) import Data.Foldable (Foldable(foldMap)) import Data.Monoid (Monoid(..)) @@ -90,6 +93,13 @@ instance Traversable ComponentDeps where instance Binary a => Binary (ComponentDeps a) +componentNameToComponent :: CN.ComponentName -> Component +componentNameToComponent (CN.CLibName) = ComponentLib +componentNameToComponent (CN.CSubLibName s) = ComponentSubLib s +componentNameToComponent (CN.CExeName s) = ComponentExe s +componentNameToComponent (CN.CTestName s) = ComponentTest s +componentNameToComponent (CN.CBenchName s) = ComponentBench s + {------------------------------------------------------------------------------- Construction -------------------------------------------------------------------------------} diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 626d6c3f79a..a1573083863 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -88,6 +88,11 @@ Extra-Source-Files: tests/IntegrationTests/new-build/T3460/sub-package-B/B.hs tests/IntegrationTests/new-build/T3460/sub-package-B/Setup.hs tests/IntegrationTests/new-build/T3460/sub-package-B/sub-package-B.cabal + tests/IntegrationTests/new-build/executable/Main.hs + tests/IntegrationTests/new-build/executable/Setup.hs + tests/IntegrationTests/new-build/executable/Test.hs + tests/IntegrationTests/new-build/executable/a.cabal + tests/IntegrationTests/new-build/executable/cabal.project tests/IntegrationTests/new-build/monitor_cabal_files.sh tests/IntegrationTests/new-build/monitor_cabal_files/cabal.project tests/IntegrationTests/new-build/monitor_cabal_files/p/P.hs diff --git a/cabal-install/tests/IntegrationTests/internal-libs/new_build.sh b/cabal-install/tests/IntegrationTests/internal-libs/new_build.sh index 959c79d079b..18f708913a5 100644 --- a/cabal-install/tests/IntegrationTests/internal-libs/new_build.sh +++ b/cabal-install/tests/IntegrationTests/internal-libs/new_build.sh @@ -1,4 +1,3 @@ . ./common.sh -cabal new-build p || exit 0 -exit 1 # expect broken +cabal new-build p diff --git a/cabal-install/tests/IntegrationTests/new-build/executable/Main.hs b/cabal-install/tests/IntegrationTests/new-build/executable/Main.hs new file mode 100644 index 00000000000..b3549c2fe3d --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/executable/Main.hs @@ -0,0 +1 @@ +main = return () diff --git a/cabal-install/tests/IntegrationTests/new-build/executable/Setup.hs b/cabal-install/tests/IntegrationTests/new-build/executable/Setup.hs new file mode 100644 index 00000000000..9a994af677b --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/executable/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/cabal-install/tests/IntegrationTests/new-build/executable/Test.hs b/cabal-install/tests/IntegrationTests/new-build/executable/Test.hs new file mode 100644 index 00000000000..b3549c2fe3d --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/executable/Test.hs @@ -0,0 +1 @@ +main = return () diff --git a/cabal-install/tests/IntegrationTests/new-build/executable/a.cabal b/cabal-install/tests/IntegrationTests/new-build/executable/a.cabal new file mode 100644 index 00000000000..ed9fc2919a6 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/executable/a.cabal @@ -0,0 +1,15 @@ +name: a +version: 0.1 +cabal-version: >= 1.10 +build-type: Simple + +executable aexe + main-is: Main.hs + build-depends: base + default-language: Haskell2010 + +test-suite atest + type: exitcode-stdio-1.0 + main-is: Test.hs + build-depends: base + default-language: Haskell2010 diff --git a/cabal-install/tests/IntegrationTests/new-build/executable/cabal.project b/cabal-install/tests/IntegrationTests/new-build/executable/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/executable/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index 3c7d2ae11e5..6e2c3355af1 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -237,12 +237,13 @@ planProject testdir cliConfig = do let targets = Map.fromList [ (installedUnitId pkg, [BuildDefaultComponents]) - | InstallPlan.Configured pkg <- InstallPlan.toList elaboratedPlan + | InstallPlan.Configured pkg_or_comp <- InstallPlan.toList elaboratedPlan + , let pkg = getElaboratedPackage pkg_or_comp , pkgBuildStyle pkg == BuildInplaceOnly ] elaboratedPlan' = pruneInstallPlanToTargets targets elaboratedPlan (elaboratedPlan'', pkgsBuildStatus) <- - rebuildTargetsDryRun distDirLayout + rebuildTargetsDryRun verbosity distDirLayout elaboratedShared elaboratedPlan' let buildSettings = resolveBuildTimeSettings @@ -350,30 +351,30 @@ expectPackagePreExisting plan buildOutcomes pkgid = do (_, buildResult) -> unexpectedBuildResult "PreExisting" planpkg buildResult expectPackageConfigured :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId - -> IO ElaboratedConfiguredPackage + -> IO ElaboratedPackage expectPackageConfigured plan buildOutcomes pkgid = do planpkg <- expectPlanPackage plan pkgid case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of (InstallPlan.Configured pkg, Nothing) - -> return pkg + -> return (getElaboratedPackage pkg) (_, buildResult) -> unexpectedBuildResult "Configured" planpkg buildResult expectPackageInstalled :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId - -> IO (ElaboratedConfiguredPackage, BuildResult) + -> IO (ElaboratedPackage, BuildResult) expectPackageInstalled plan buildOutcomes pkgid = do planpkg <- expectPlanPackage plan pkgid case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of (InstallPlan.Configured pkg, Just (Right result)) - -> return (pkg, result) + -> return (getElaboratedPackage pkg, result) (_, buildResult) -> unexpectedBuildResult "Installed" planpkg buildResult expectPackageFailed :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId - -> IO (ElaboratedConfiguredPackage, BuildFailure) + -> IO (ElaboratedPackage, BuildFailure) expectPackageFailed plan buildOutcomes pkgid = do planpkg <- expectPlanPackage plan pkgid case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of (InstallPlan.Configured pkg, Just (Left failure)) - -> return (pkg, failure) + -> return (getElaboratedPackage pkg, failure) (_, buildResult) -> unexpectedBuildResult "Failed" planpkg buildResult unexpectedBuildResult :: String -> ElaboratedPlanPackage diff --git a/cabal-install/tests/IntegrationTests2/exception/configure/a.cabal b/cabal-install/tests/IntegrationTests2/exception/configure/a.cabal index a9dced8d3a0..f0bf220bef0 100644 --- a/cabal-install/tests/IntegrationTests2/exception/configure/a.cabal +++ b/cabal-install/tests/IntegrationTests2/exception/configure/a.cabal @@ -1,3 +1,9 @@ name: a version: 1 build-type: Simple +-- This used to be a blank package with no components, +-- but I refactored new-build so that if a package has +-- no buildable components, we skip configuring it. +-- So put in a (failing) component so that we try to +-- configure. +executable a diff --git a/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs b/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs index f4fbf0fbebc..2d06a8cdb2b 100644 --- a/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs +++ b/cabal-install/tests/UnitTests/Distribution/Client/InstallPlan.hs @@ -1,10 +1,14 @@ +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE NoMonoLocalBinds #-} +{-# LANGUAGE ConstraintKinds #-} module UnitTests.Distribution.Client.InstallPlan (tests) where import Distribution.Package import Distribution.Version import qualified Distribution.Client.InstallPlan as InstallPlan -import Distribution.Client.InstallPlan (GenericInstallPlan) +import Distribution.Client.InstallPlan (GenericInstallPlan, IsUnit) import qualified Distribution.Compat.Graph as Graph +import Distribution.Compat.Graph (IsNode(..)) import Distribution.Solver.Types.Settings import Distribution.Solver.Types.PackageFixedDeps import Distribution.Solver.Types.ComponentDeps as CD @@ -146,6 +150,12 @@ instance Show TestInstallPlan where data TestPkg = TestPkg PackageId UnitId [UnitId] deriving (Eq, Show) +instance IsNode TestPkg where + type Key TestPkg = UnitId + nodeKey (TestPkg _ ipkgid _) = ipkgid + nodeNeighbors (TestPkg _ _ deps) = deps + + instance Package TestPkg where packageId (TestPkg pkgid _ _) = pkgid @@ -155,6 +165,9 @@ instance HasUnitId TestPkg where instance PackageFixedDeps TestPkg where depends (TestPkg _ _ deps) = CD.singleton CD.ComponentLib deps +instance PackageInstalled TestPkg where + installedDepends (TestPkg _ _ deps) = deps + instance Arbitrary TestInstallPlan where arbitrary = arbitraryTestInstallPlan @@ -191,8 +204,8 @@ arbitraryTestInstallPlan = do -- It takes generators for installed and source packages and the chance that -- each package is installed (for those packages with no prerequisites). -- -arbitraryInstallPlan :: (HasUnitId ipkg, PackageFixedDeps ipkg, - HasUnitId srcpkg, PackageFixedDeps srcpkg) +arbitraryInstallPlan :: (IsUnit ipkg, + IsUnit srcpkg) => (Vertex -> [Vertex] -> Gen ipkg) -> (Vertex -> [Vertex] -> Gen srcpkg) -> Float @@ -222,9 +235,7 @@ arbitraryInstallPlan mkIPkg mkSrcPkg ipkgProportion graph = do ] let index = Graph.fromList (map InstallPlan.PreExisting ipkgs ++ map InstallPlan.Configured srcpkgs) - case InstallPlan.new (IndependentGoals False) index of - Right plan -> return plan - Left _ -> error "arbitraryInstallPlan: generated invalid plan" + return $ InstallPlan.new (IndependentGoals False) index -- | Generate a random directed acyclic graph, based on the algorithm presented From 5c410b30f05ea6103691f23083e87904d1acc850 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Wed, 3 Aug 2016 02:39:38 -0700 Subject: [PATCH 06/23] showComponentTarget remove dependence on ElaboratedPackage. Signed-off-by: Edward Z. Yang --- .../Distribution/Client/ProjectOrchestration.hs | 2 +- cabal-install/Distribution/Client/ProjectPlanning.hs | 12 ++++++------ 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/cabal-install/Distribution/Client/ProjectOrchestration.hs b/cabal-install/Distribution/Client/ProjectOrchestration.hs index 857c93636a6..c873f7491ba 100644 --- a/cabal-install/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/Distribution/Client/ProjectOrchestration.hs @@ -476,7 +476,7 @@ printPlan verbosity showTargets pkg | null (pkgBuildTargets pkg) = "" | otherwise - = " (" ++ unwords [ showComponentTarget pkg t | t <- pkgBuildTargets pkg ] + = " (" ++ unwords [ showComponentTarget (packageId pkg) t | t <- pkgBuildTargets pkg ] ++ ")" -- TODO: [code cleanup] this should be a proper function in a proper place diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 87db0e9ba65..6a3c8632cda 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -2172,7 +2172,7 @@ setupHsConfigureArgs :: ElaboratedConfiguredPackage -> [String] setupHsConfigureArgs (ElabPackage _pkg) = [] setupHsConfigureArgs (ElabComponent comp) = - [showComponentTarget pkg (ComponentTarget cname WholeComponent)] + [showComponentTarget (packageId pkg) (ComponentTarget cname WholeComponent)] where pkg = elabComponentPackage comp cname = fromMaybe (error "setupHsConfigureArgs: trying to configure setup") @@ -2196,16 +2196,16 @@ setupHsBuildFlags _ _ verbosity builddir = setupHsBuildArgs :: ElaboratedConfiguredPackage -> [String] -setupHsBuildArgs (ElabPackage pkg) = map (showComponentTarget pkg) (pkgBuildTargets pkg) +setupHsBuildArgs (ElabPackage pkg) = map (showComponentTarget (packageId pkg)) (pkgBuildTargets pkg) setupHsBuildArgs (ElabComponent _comp) = [] -showComponentTarget :: ElaboratedPackage -> ComponentTarget -> String -showComponentTarget pkg = +showComponentTarget :: PackageId -> ComponentTarget -> String +showComponentTarget pkgid = showBuildTarget . toBuildTarget where showBuildTarget t = - Cabal.showBuildTarget (qlBuildTarget t) (packageId pkg) t + Cabal.showBuildTarget (qlBuildTarget t) pkgid t qlBuildTarget Cabal.BuildTargetComponent{} = Cabal.QL2 qlBuildTarget _ = Cabal.QL3 @@ -2235,7 +2235,7 @@ setupHsReplFlags _ _ verbosity builddir = setupHsReplArgs :: ElaboratedConfiguredPackage -> [String] setupHsReplArgs (ElabPackage pkg) = - maybe [] (\t -> [showComponentTarget pkg t]) (pkgReplTarget pkg) + maybe [] (\t -> [showComponentTarget (packageId pkg) t]) (pkgReplTarget pkg) --TODO: should be able to give multiple modules in one component setupHsReplArgs (ElabComponent _comp) = error "setupHsReplArgs: didn't implement me yet" From 36a186aebb5a430365048a002e278be87f75757f Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Wed, 3 Aug 2016 02:51:37 -0700 Subject: [PATCH 07/23] Refactor showBuildTarget to not require QualLevel, making it total. Signed-off-by: Edward Z. Yang --- Cabal/Distribution/Simple/BuildTarget.hs | 15 +++++++++++++-- .../Distribution/Client/BuildTarget.hs | 2 ++ .../Distribution/Client/ProjectPlanning.hs | 19 ------------------- .../Client/ProjectPlanning/Types.hs | 16 ++++++++++++++++ 4 files changed, 31 insertions(+), 21 deletions(-) diff --git a/Cabal/Distribution/Simple/BuildTarget.hs b/Cabal/Distribution/Simple/BuildTarget.hs index 4b89bbfb3c3..0a8ffa2b6bc 100644 --- a/Cabal/Distribution/Simple/BuildTarget.hs +++ b/Cabal/Distribution/Simple/BuildTarget.hs @@ -233,10 +233,21 @@ showUserBuildTarget = intercalate ":" . getComponents getComponents (UserBuildTargetDouble s1 s2) = [s1,s2] getComponents (UserBuildTargetTriple s1 s2 s3) = [s1,s2,s3] -showBuildTarget :: QualLevel -> PackageId -> BuildTarget -> String -showBuildTarget ql pkgid bt = +-- | Unless you use 'QL1', this function is PARTIAL; +-- use 'showBuildTarget' instead. +showBuildTarget' :: QualLevel -> PackageId -> BuildTarget -> String +showBuildTarget' ql pkgid bt = showUserBuildTarget (renderBuildTarget ql bt pkgid) +-- | Unambiguously render a 'BuildTarget', so that it can +-- be parsed in all situations. +showBuildTarget :: PackageId -> BuildTarget -> String +showBuildTarget pkgid t = + showBuildTarget' (qlBuildTarget t) pkgid t + where + qlBuildTarget BuildTargetComponent{} = QL2 + qlBuildTarget _ = QL3 + -- ------------------------------------------------------------ -- * Resolving user targets to build targets diff --git a/cabal-install/Distribution/Client/BuildTarget.hs b/cabal-install/Distribution/Client/BuildTarget.hs index 537b743f9ff..e21d4b58b01 100644 --- a/cabal-install/Distribution/Client/BuildTarget.hs +++ b/cabal-install/Distribution/Client/BuildTarget.hs @@ -13,6 +13,8 @@ module Distribution.Client.BuildTarget ( -- * Build targets BuildTarget(..), + -- Don't export me: it's partial (if you try to qualify too + -- much you will error.) --showBuildTarget, QualLevel(..), buildTargetPackage, diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 6a3c8632cda..4b863bdfb30 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -103,7 +103,6 @@ import qualified Distribution.Simple.LocalBuildInfo as Cabal import Distribution.Simple.LocalBuildInfo (ComponentName(..)) import qualified Distribution.Simple.Register as Cabal import qualified Distribution.Simple.InstallDirs as InstallDirs -import qualified Distribution.Simple.BuildTarget as Cabal import Distribution.Simple.Utils hiding (matchFileGlob) import Distribution.Version @@ -2200,24 +2199,6 @@ setupHsBuildArgs (ElabPackage pkg) = map (showComponentTarget (packageId pkg)) ( setupHsBuildArgs (ElabComponent _comp) = [] -showComponentTarget :: PackageId -> ComponentTarget -> String -showComponentTarget pkgid = - showBuildTarget . toBuildTarget - where - showBuildTarget t = - Cabal.showBuildTarget (qlBuildTarget t) pkgid t - - qlBuildTarget Cabal.BuildTargetComponent{} = Cabal.QL2 - qlBuildTarget _ = Cabal.QL3 - - toBuildTarget :: ComponentTarget -> Cabal.BuildTarget - toBuildTarget (ComponentTarget cname subtarget) = - case subtarget of - WholeComponent -> Cabal.BuildTargetComponent cname - ModuleTarget mname -> Cabal.BuildTargetModule cname mname - FileTarget fname -> Cabal.BuildTargetFile cname fname - - setupHsReplFlags :: ElaboratedConfiguredPackage -> ElaboratedSharedConfig -> Verbosity diff --git a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs index 76b60ffe75c..9b2d6f93eab 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -32,6 +32,7 @@ module Distribution.Client.ProjectPlanning.Types ( -- * Build targets PackageTarget(..), ComponentTarget(..), + showComponentTarget, SubComponentTarget(..), -- * Setup script @@ -54,6 +55,7 @@ import Distribution.System import qualified Distribution.PackageDescription as Cabal import Distribution.InstalledPackageInfo (InstalledPackageInfo) import Distribution.Simple.Compiler +import qualified Distribution.Simple.BuildTarget as Cabal import Distribution.Simple.Program.Db import Distribution.ModuleName (ModuleName) import Distribution.Simple.LocalBuildInfo (ComponentName(..)) @@ -461,6 +463,20 @@ instance Binary PackageTarget instance Binary ComponentTarget instance Binary SubComponentTarget +-- | Unambiguously render a 'ComponentTarget', e.g., to pass +-- to a Cabal Setup script. +showComponentTarget :: PackageId -> ComponentTarget -> String +showComponentTarget pkgid = + Cabal.showBuildTarget pkgid . toBuildTarget + where + toBuildTarget :: ComponentTarget -> Cabal.BuildTarget + toBuildTarget (ComponentTarget cname subtarget) = + case subtarget of + WholeComponent -> Cabal.BuildTargetComponent cname + ModuleTarget mname -> Cabal.BuildTargetModule cname mname + FileTarget fname -> Cabal.BuildTargetFile cname fname + + --------------------------- -- Setup.hs script policy From 929679c48399e37a6d6c39c4bcf3998c16a47e65 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Wed, 3 Aug 2016 02:53:14 -0700 Subject: [PATCH 08/23] Docs and modest safety improvements. Signed-off-by: Edward Z. Yang --- cabal-install/Distribution/Client/BuildTarget.hs | 8 +++++++- 1 file changed, 7 insertions(+), 1 deletion(-) diff --git a/cabal-install/Distribution/Client/BuildTarget.hs b/cabal-install/Distribution/Client/BuildTarget.hs index e21d4b58b01..eeeb15a4220 100644 --- a/cabal-install/Distribution/Client/BuildTarget.hs +++ b/cabal-install/Distribution/Client/BuildTarget.hs @@ -8,6 +8,10 @@ -- Maintainer : duncan@community.haskell.org -- -- Handling for user-specified build targets +-- Unlike "Distribution.Simple.BuildTarget" these build +-- targets also handle package qualification (so, up to +-- four levels of qualification, as opposed to the former's +-- three.) ----------------------------------------------------------------------------- module Distribution.Client.BuildTarget ( @@ -433,7 +437,9 @@ showUserBuildTarget = intercalate ":" . components showBuildTarget :: QualLevel -> BuildTarget PackageInfo -> String showBuildTarget ql = showUserBuildTarget . forgetFileStatus - . head . renderBuildTarget ql + . hd . renderBuildTarget ql + where hd [] = error "showBuildTarget: head" + hd (x:_) = x -- ------------------------------------------------------------ From 6764810df3f79a8ae1109e90c536385e2720f2d9 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Thu, 4 Aug 2016 03:28:34 -0700 Subject: [PATCH 09/23] Fix #1541, by adding internal build-tools to PATH. Signed-off-by: Edward Z. Yang --- Cabal/Cabal.cabal | 4 +++ Cabal/Distribution/Simple/Build.hs | 3 ++ Cabal/Distribution/Simple/Configure.hs | 28 +++++++++++------- Cabal/Distribution/Simple/GHC/Internal.hs | 8 +++++ Cabal/Distribution/Simple/Program/GHC.hs | 8 ++++- Cabal/Distribution/Simple/Program/Run.hs | 29 +++++++++++++++++-- .../Types/ComponentLocalBuildInfo.hs | 4 +++ Cabal/Distribution/Types/LocalBuildInfo.hs | 13 ++++++++- Cabal/changelog | 3 ++ Cabal/doc/developing-packages.markdown | 3 +- Cabal/tests/PackageTests/BuildToolsPath/A.hs | 5 ++++ .../BuildToolsPath/MyCustomPreprocessor.hs | 11 +++++++ .../BuildToolsPath/build-tools-path.cabal | 25 ++++++++++++++++ .../BuildToolsPath/hello/Hello.hs | 6 ++++ Cabal/tests/PackageTests/Tests.hs | 6 ++++ 15 files changed, 140 insertions(+), 16 deletions(-) create mode 100644 Cabal/tests/PackageTests/BuildToolsPath/A.hs create mode 100644 Cabal/tests/PackageTests/BuildToolsPath/MyCustomPreprocessor.hs create mode 100644 Cabal/tests/PackageTests/BuildToolsPath/build-tools-path.cabal create mode 100644 Cabal/tests/PackageTests/BuildToolsPath/hello/Hello.hs diff --git a/Cabal/Cabal.cabal b/Cabal/Cabal.cabal index 98f10df1d7f..03fd00b9290 100644 --- a/Cabal/Cabal.cabal +++ b/Cabal/Cabal.cabal @@ -98,6 +98,10 @@ extra-source-files: tests/PackageTests/BuildDeps/TargetSpecificDeps3/lemon.hs tests/PackageTests/BuildDeps/TargetSpecificDeps3/my.cabal tests/PackageTests/BuildTestSuiteDetailedV09/Dummy2.hs + tests/PackageTests/BuildToolsPath/A.hs + tests/PackageTests/BuildToolsPath/MyCustomPreprocessor.hs + tests/PackageTests/BuildToolsPath/build-tools-path.cabal + tests/PackageTests/BuildToolsPath/hello/Hello.hs tests/PackageTests/BuildableField/BuildableField.cabal tests/PackageTests/BuildableField/Main.hs tests/PackageTests/CMain/Bar.hs diff --git a/Cabal/Distribution/Simple/Build.hs b/Cabal/Distribution/Simple/Build.hs index 598c00932f7..ab08940fea0 100644 --- a/Cabal/Distribution/Simple/Build.hs +++ b/Cabal/Distribution/Simple/Build.hs @@ -425,6 +425,7 @@ testSuiteLibV09AsLibAndExe pkg_descr libClbi = LibComponentLocalBuildInfo { componentPackageDeps = componentPackageDeps clbi , componentInternalDeps = componentInternalDeps clbi + , componentExeDeps = componentExeDeps clbi , componentLocalName = CSubLibName (testName test) , componentIsPublic = False , componentIncludes = componentIncludes clbi @@ -465,6 +466,7 @@ testSuiteLibV09AsLibAndExe pkg_descr -- (doesn't clobber something) we won't run into trouble componentUnitId = mkUnitId (stubName test), componentInternalDeps = [componentUnitId clbi], + componentExeDeps = [], componentLocalName = CExeName (stubName test), componentPackageDeps = deps, componentIncludes = zip (map fst deps) (repeat defaultRenaming) @@ -488,6 +490,7 @@ benchmarkExeV10asExe bm@Benchmark { benchmarkInterface = BenchmarkExeV10 _ f } componentUnitId = componentUnitId clbi, componentLocalName = CExeName (benchmarkName bm), componentInternalDeps = componentInternalDeps clbi, + componentExeDeps = componentExeDeps clbi, componentPackageDeps = componentPackageDeps clbi, componentIncludes = componentIncludes clbi } diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index b9ce2f366bc..ba75d42f8f0 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -1777,14 +1777,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_ foldM go [] graph where go z (component, dep_cnames) = do - -- NB: We want to preserve cdeps because it contains extra - -- information like build-tools ordering - let dep_uids = [ componentUnitId dep_clbi - | cname <- dep_cnames - -- Being in z relies on topsort! - , dep_clbi <- z - , componentLocalName dep_clbi == cname ] - clbi <- componentLocalBuildInfo z component dep_uids + clbi <- componentLocalBuildInfo z component dep_cnames return (clbi:z) -- The allPkgDeps contains all the package deps for the whole package @@ -1793,8 +1786,19 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_ -- needs. Note, this only works because we cannot yet depend on two -- versions of the same package. componentLocalBuildInfo :: [ComponentLocalBuildInfo] - -> Component -> [UnitId] -> IO ComponentLocalBuildInfo - componentLocalBuildInfo internalComps component dep_uids = + -> Component -> [ComponentName] -> IO ComponentLocalBuildInfo + componentLocalBuildInfo internalComps component dep_cnames = + -- NB: We want to preserve cdeps because it contains extra + -- information like build-tools ordering + let dep_uids = [ componentUnitId dep_clbi + | cname <- dep_cnames + , dep_clbi <- internalComps + , componentLocalName dep_clbi == cname ] + dep_exes = [ componentUnitId dep_clbi + | cname@(CExeName _) <- dep_cnames + , dep_clbi <- internalComps + , componentLocalName dep_clbi == cname ] + in -- (putStrLn $ "configuring " ++ display (componentName component)) >> case component of CLib lib -> do @@ -1811,6 +1815,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_ return LibComponentLocalBuildInfo { componentPackageDeps = cpds, componentInternalDeps = dep_uids, + componentExeDeps = dep_exes, componentUnitId = uid, componentLocalName = componentName component, componentIsPublic = libName lib == Nothing, @@ -1823,6 +1828,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_ return ExeComponentLocalBuildInfo { componentUnitId = uid, componentInternalDeps = dep_uids, + componentExeDeps = dep_exes, componentLocalName = componentName component, componentPackageDeps = cpds, componentIncludes = includes @@ -1831,6 +1837,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_ return TestComponentLocalBuildInfo { componentUnitId = uid, componentInternalDeps = dep_uids, + componentExeDeps = dep_exes, componentLocalName = componentName component, componentPackageDeps = cpds, componentIncludes = includes @@ -1839,6 +1846,7 @@ mkComponentsLocalBuildInfo cfg use_external_internal comp installedPackages pkg_ return BenchComponentLocalBuildInfo { componentUnitId = uid, componentInternalDeps = dep_uids, + componentExeDeps = dep_exes, componentLocalName = componentName component, componentPackageDeps = cpds, componentIncludes = includes diff --git a/Cabal/Distribution/Simple/GHC/Internal.hs b/Cabal/Distribution/Simple/GHC/Internal.hs index 669f62ccca5..2bed4040e36 100644 --- a/Cabal/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/Distribution/Simple/GHC/Internal.hs @@ -46,6 +46,8 @@ import Distribution.Simple.Setup import qualified Distribution.ModuleName as ModuleName import Distribution.Simple.Program import Distribution.Simple.LocalBuildInfo +import Distribution.Types.LocalBuildInfo +import Distribution.Types.TargetInfo import Distribution.Simple.Utils import Distribution.Simple.BuildPaths import Distribution.System @@ -304,6 +306,7 @@ componentGhcOptions verbosity lbi bi clbi odir = ghcOptOptimisation = toGhcOptimisation (withOptimization lbi), ghcOptDebugInfo = toGhcDebugInfo (withDebugInfo lbi), ghcOptExtra = toNubListR $ hcOptions GHC bi, + ghcOptExtraPath = toNubListR $ exe_paths, ghcOptLanguage = toFlag (fromMaybe Haskell98 (defaultLanguage bi)), -- Unsupported extensions have already been checked by configure ghcOptExtensions = toNubListR $ usedExtensions bi, @@ -320,6 +323,11 @@ componentGhcOptions verbosity lbi bi clbi odir = toGhcDebugInfo NormalDebugInfo = toFlag True toGhcDebugInfo MaximalDebugInfo = toFlag True + exe_paths = [ componentBuildDir lbi (targetCLBI exe_tgt) + | uid <- componentExeDeps clbi + -- TODO: Ugh, localPkgDescr + , Just exe_tgt <- [unitIdTarget' (localPkgDescr lbi) lbi uid] ] + -- | Strip out flags that are not supported in ghci filterGhciFlags :: [String] -> [String] filterGhciFlags = filter supported diff --git a/Cabal/Distribution/Simple/Program/GHC.hs b/Cabal/Distribution/Simple/Program/GHC.hs index ac6ba0b6538..b4d58dc7fd7 100644 --- a/Cabal/Distribution/Simple/Program/GHC.hs +++ b/Cabal/Distribution/Simple/Program/GHC.hs @@ -210,6 +210,10 @@ data GhcOptions = GhcOptions { -- | Get GHC to be quiet or verbose with what it's doing; the @ghc -v@ flag. ghcOptVerbosity :: Flag Verbosity, + -- | Put the extra folders in the PATH environment variable we invoke + -- GHC with + ghcOptExtraPath :: NubListR FilePath, + -- | Let GHC know that it is Cabal that's calling it. -- Modifies some of the GHC error messages. ghcOptCabal :: Flag Bool @@ -251,7 +255,9 @@ runGHC verbosity ghcProg comp platform opts = do ghcInvocation :: ConfiguredProgram -> Compiler -> Platform -> GhcOptions -> ProgramInvocation ghcInvocation prog comp platform opts = - programInvocation prog (renderGhcOptions comp platform opts) + (programInvocation prog (renderGhcOptions comp platform opts)) { + progInvokePathEnv = fromNubListR (ghcOptExtraPath opts) + } renderGhcOptions :: Compiler -> Platform -> GhcOptions -> [String] renderGhcOptions comp _platform@(Platform _arch os) opts diff --git a/Cabal/Distribution/Simple/Program/Run.hs b/Cabal/Distribution/Simple/Program/Run.hs index 5da7ec05612..3e54b585a9a 100644 --- a/Cabal/Distribution/Simple/Program/Run.hs +++ b/Cabal/Distribution/Simple/Program/Run.hs @@ -32,6 +32,7 @@ import Distribution.Verbosity import Distribution.Compat.Environment import qualified Data.Map as Map +import System.FilePath import System.Exit ( ExitCode(..), exitWith ) @@ -46,6 +47,8 @@ data ProgramInvocation = ProgramInvocation { progInvokePath :: FilePath, progInvokeArgs :: [String], progInvokeEnv :: [(String, Maybe String)], + -- Extra paths to add to PATH + progInvokePathEnv :: [FilePath], progInvokeCwd :: Maybe FilePath, progInvokeInput :: Maybe String, progInvokeInputEncoding :: IOEncoding, @@ -61,6 +64,7 @@ emptyProgramInvocation = progInvokePath = "", progInvokeArgs = [], progInvokeEnv = [], + progInvokePathEnv = [], progInvokeCwd = Nothing, progInvokeInput = Nothing, progInvokeInputEncoding = IOEncodingText, @@ -91,6 +95,7 @@ runProgramInvocation verbosity progInvokePath = path, progInvokeArgs = args, progInvokeEnv = [], + progInvokePathEnv = [], progInvokeCwd = Nothing, progInvokeInput = Nothing } = @@ -101,10 +106,12 @@ runProgramInvocation verbosity progInvokePath = path, progInvokeArgs = args, progInvokeEnv = envOverrides, + progInvokePathEnv = extraPath, progInvokeCwd = mcwd, progInvokeInput = Nothing } = do - menv <- getEffectiveEnvironment envOverrides + pathOverride <- getExtraPathEnv envOverrides extraPath + menv <- getEffectiveEnvironment (envOverrides ++ pathOverride) exitCode <- rawSystemIOWithEnv verbosity path args mcwd menv @@ -117,11 +124,13 @@ runProgramInvocation verbosity progInvokePath = path, progInvokeArgs = args, progInvokeEnv = envOverrides, + progInvokePathEnv = extraPath, progInvokeCwd = mcwd, progInvokeInput = Just inputStr, progInvokeInputEncoding = encoding } = do - menv <- getEffectiveEnvironment envOverrides + pathOverride <- getExtraPathEnv envOverrides extraPath + menv <- getEffectiveEnvironment (envOverrides ++ pathOverride) (_, errors, exitCode) <- rawSystemStdInOut verbosity path args mcwd menv @@ -141,6 +150,7 @@ getProgramInvocationOutput verbosity progInvokePath = path, progInvokeArgs = args, progInvokeEnv = envOverrides, + progInvokePathEnv = extraPath, progInvokeCwd = mcwd, progInvokeInput = minputStr, progInvokeOutputEncoding = encoding @@ -148,7 +158,8 @@ getProgramInvocationOutput verbosity let utf8 = case encoding of IOEncodingUTF8 -> True; _ -> False decode | utf8 = fromUTF8 . normaliseLineEndings | otherwise = id - menv <- getEffectiveEnvironment envOverrides + pathOverride <- getExtraPathEnv envOverrides extraPath + menv <- getEffectiveEnvironment (envOverrides ++ pathOverride) (output, errors, exitCode) <- rawSystemStdInOut verbosity path args mcwd menv @@ -166,6 +177,18 @@ getProgramInvocationOutput verbosity IOEncodingUTF8 -> (toUTF8 inputStr, True) -- use binary mode for utf8 +getExtraPathEnv :: [(String, Maybe String)] -> [FilePath] -> IO [(String, Maybe String)] +getExtraPathEnv _ [] = return [] +getExtraPathEnv env extras = do + mb_path <- case lookup "PATH" env of + Just x -> return x + Nothing -> lookupEnv "PATH" + let extra = intercalate [searchPathSeparator] extras + path' = case mb_path of + Nothing -> extra + Just path -> extra ++ searchPathSeparator : path + return [("PATH", Just path')] + -- | Return the current environment extended with the given overrides. -- getEffectiveEnvironment :: [(String, Maybe String)] diff --git a/Cabal/Distribution/Types/ComponentLocalBuildInfo.hs b/Cabal/Distribution/Types/ComponentLocalBuildInfo.hs index b6611724cf7..79eb824623f 100644 --- a/Cabal/Distribution/Types/ComponentLocalBuildInfo.hs +++ b/Cabal/Distribution/Types/ComponentLocalBuildInfo.hs @@ -40,6 +40,7 @@ data ComponentLocalBuildInfo -- @-package-id@ arguments. This is a modernized version of -- 'componentPackageDeps', which is kept around for BC purposes. componentIncludes :: [(UnitId, ModuleRenaming)], + componentExeDeps :: [UnitId], -- | The internal dependencies which induce a graph on the -- 'ComponentLocalBuildInfo' of this package. This does NOT -- coincide with 'componentPackageDeps' because it ALSO records @@ -62,6 +63,7 @@ data ComponentLocalBuildInfo componentUnitId :: UnitId, componentPackageDeps :: [(UnitId, PackageId)], componentIncludes :: [(UnitId, ModuleRenaming)], + componentExeDeps :: [UnitId], componentInternalDeps :: [UnitId] } | TestComponentLocalBuildInfo { @@ -69,6 +71,7 @@ data ComponentLocalBuildInfo componentUnitId :: UnitId, componentPackageDeps :: [(UnitId, PackageId)], componentIncludes :: [(UnitId, ModuleRenaming)], + componentExeDeps :: [UnitId], componentInternalDeps :: [UnitId] } @@ -77,6 +80,7 @@ data ComponentLocalBuildInfo componentUnitId :: UnitId, componentPackageDeps :: [(UnitId, PackageId)], componentIncludes :: [(UnitId, ModuleRenaming)], + componentExeDeps :: [UnitId], componentInternalDeps :: [UnitId] } deriving (Generic, Read, Show) diff --git a/Cabal/Distribution/Types/LocalBuildInfo.hs b/Cabal/Distribution/Types/LocalBuildInfo.hs index 15ae66a7f83..dfbaf10e720 100644 --- a/Cabal/Distribution/Types/LocalBuildInfo.hs +++ b/Cabal/Distribution/Types/LocalBuildInfo.hs @@ -29,6 +29,7 @@ module Distribution.Types.LocalBuildInfo ( -- details. componentNameTargets', + unitIdTarget', allTargetsInBuildOrder', withAllTargetsInBuildOrder', neededTargetsInBuildOrder', @@ -39,6 +40,7 @@ module Distribution.Types.LocalBuildInfo ( -- prevent someone from accidentally defining them componentNameTargets, + unitIdTarget, allTargetsInBuildOrder, withAllTargetsInBuildOrder, neededTargetsInBuildOrder, @@ -210,6 +212,12 @@ componentNameTargets' pkg_descr lbi cname = Just clbis -> map (mkTargetInfo pkg_descr lbi) clbis Nothing -> [] +unitIdTarget' :: PackageDescription -> LocalBuildInfo -> UnitId -> Maybe TargetInfo +unitIdTarget' pkg_descr lbi uid = + case Graph.lookup uid (componentGraph lbi) 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] @@ -262,11 +270,14 @@ testCoverage lbi = exeCoverage lbi && libCoverage lbi ------------------------------------------------------------------------------- -- 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." #-} +{-# 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 '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 +unitIdTarget :: LocalBuildInfo -> UnitId -> Maybe TargetInfo +unitIdTarget lbi = unitIdTarget' (localPkgDescr lbi) lbi + allTargetsInBuildOrder :: LocalBuildInfo -> [TargetInfo] allTargetsInBuildOrder lbi = allTargetsInBuildOrder' (localPkgDescr lbi) lbi diff --git a/Cabal/changelog b/Cabal/changelog index c4a01c2dc72..aef6aac05ac 100644 --- a/Cabal/changelog +++ b/Cabal/changelog @@ -70,6 +70,9 @@ the component to be configured. The semantics of this mode of operation are described in + * Internal 'build-tools' dependencies are now added to PATH + upon invocation of GHC, so that they can be conveniently + used via `-pgmF`. (#1541) 1.24.0.0 Ryan Thomas March 2016 * Support GHC 8. diff --git a/Cabal/doc/developing-packages.markdown b/Cabal/doc/developing-packages.markdown index f20d1c83f22..64cc60dadfb 100644 --- a/Cabal/doc/developing-packages.markdown +++ b/Cabal/doc/developing-packages.markdown @@ -1416,7 +1416,8 @@ for these fields. build this package, e.g. `c2hs >= 0.15, cpphs`. If no version constraint is specified, any version is assumed to be acceptable. `build-tools` can refer to locally defined executables, in which - case Cabal will make sure that executable is built first. + case Cabal will make sure that executable is built first and + add it to the PATH upon invocations to the compiler. `buildable:` _boolean_ (default: `True`) : Is the component buildable? Like some of the other fields below, diff --git a/Cabal/tests/PackageTests/BuildToolsPath/A.hs b/Cabal/tests/PackageTests/BuildToolsPath/A.hs new file mode 100644 index 00000000000..e5e075ad70c --- /dev/null +++ b/Cabal/tests/PackageTests/BuildToolsPath/A.hs @@ -0,0 +1,5 @@ +{-# OPTIONS_GHC -F -pgmF my-custom-preprocessor #-} +module A where + +a :: String +a = "0000" diff --git a/Cabal/tests/PackageTests/BuildToolsPath/MyCustomPreprocessor.hs b/Cabal/tests/PackageTests/BuildToolsPath/MyCustomPreprocessor.hs new file mode 100644 index 00000000000..09c949ab176 --- /dev/null +++ b/Cabal/tests/PackageTests/BuildToolsPath/MyCustomPreprocessor.hs @@ -0,0 +1,11 @@ +module Main where + +import System.Environment +import System.IO + +main :: IO () +main = do + (_:source:target:_) <- getArgs + let f '0' = '1' + f c = c + writeFile target . map f =<< readFile source diff --git a/Cabal/tests/PackageTests/BuildToolsPath/build-tools-path.cabal b/Cabal/tests/PackageTests/BuildToolsPath/build-tools-path.cabal new file mode 100644 index 00000000000..12214a34357 --- /dev/null +++ b/Cabal/tests/PackageTests/BuildToolsPath/build-tools-path.cabal @@ -0,0 +1,25 @@ +name: build-tools-path +version: 0.1.0.0 +synopsis: Checks build-tools are put in PATH +license: BSD3 +category: Testing +build-type: Simple +cabal-version: >=1.10 + +executable my-custom-preprocessor + main-is: MyCustomPreprocessor.hs + build-depends: base, directory + default-language: Haskell2010 + +library + exposed-modules: A + build-depends: base + build-tools: my-custom-preprocessor + -- ^ Note the internal dependency. + default-language: Haskell2010 + +executable hello-world + main-is: Hello.hs + build-depends: base, build-tools-path + default-language: Haskell2010 + hs-source-dirs: hello diff --git a/Cabal/tests/PackageTests/BuildToolsPath/hello/Hello.hs b/Cabal/tests/PackageTests/BuildToolsPath/hello/Hello.hs new file mode 100644 index 00000000000..89a5e5a026d --- /dev/null +++ b/Cabal/tests/PackageTests/BuildToolsPath/hello/Hello.hs @@ -0,0 +1,6 @@ +module Main where + +import A + +main :: IO () +main = putStrLn a diff --git a/Cabal/tests/PackageTests/Tests.hs b/Cabal/tests/PackageTests/Tests.hs index 8cee8ce5dc6..20ea7061c22 100644 --- a/Cabal/tests/PackageTests/Tests.hs +++ b/Cabal/tests/PackageTests/Tests.hs @@ -484,6 +484,12 @@ tests config = do runExe' "hello-world" [] >>= assertOutputContains "hello from A" + -- Test PATH-munging + tc "BuildToolsPath" $ do + cabal_build [] + runExe' "hello-world" [] + >>= assertOutputContains "1111" + -- Test that executable recompilation works -- https://github.com/haskell/cabal/issues/3294 tc "Regression/T3294" $ do From bd7e23108082e669569653804153874ce8c23287 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Fri, 5 Aug 2016 15:04:46 -0700 Subject: [PATCH 10/23] Be more careful about ComponentId versus UnitId. Two big ideas: * @--dependency@ takes a ComponentId, not UnitId. I used to think it should be a UnitId but it is now clear that you want to finger the indefinite unit id, which can be uniquely identified with a ComponentId * When hashing for an InstalledPackageId in new-build, we should produce a ComponentId, not a UnitId. While cleaning up the results, for any codepaths which we don't plan on implementing Backpack (Distribution.Client.Install, I'm looking at you), just coerce ComponentId into UnitIds as necessary. Signed-off-by: Edward Z. Yang --- Cabal/Distribution/InstalledPackageInfo.hs | 3 + Cabal/Distribution/Package.hs | 2 +- Cabal/Distribution/Simple/Configure.hs | 26 ++++----- Cabal/Distribution/Simple/PackageIndex.hs | 12 +++- Cabal/Distribution/Simple/Setup.hs | 6 +- .../Distribution/Client/Configure.hs | 8 +-- cabal-install/Distribution/Client/Install.hs | 45 +++++++------- .../Distribution/Client/InstallPlan.hs | 7 +-- .../Distribution/Client/PackageHash.hs | 6 +- .../Distribution/Client/ProjectBuilding.hs | 34 +++++------ .../Client/ProjectOrchestration.hs | 17 +++--- .../Distribution/Client/ProjectPlanOutput.hs | 5 +- .../Distribution/Client/ProjectPlanning.hs | 58 ++++++++++--------- .../Client/ProjectPlanning/Types.hs | 23 ++++---- .../Distribution/Client/SetupWrapper.hs | 21 +++---- cabal-install/Distribution/Client/Types.hs | 46 ++++++++------- 16 files changed, 167 insertions(+), 152 deletions(-) diff --git a/Cabal/Distribution/InstalledPackageInfo.hs b/Cabal/Distribution/InstalledPackageInfo.hs index 2d3cee9b60d..4cbf5d112ae 100644 --- a/Cabal/Distribution/InstalledPackageInfo.hs +++ b/Cabal/Distribution/InstalledPackageInfo.hs @@ -108,6 +108,9 @@ installedComponentId ipi = case installedUnitId ipi of {-# DEPRECATED installedPackageId "Use installedUnitId instead" #-} -- | Backwards compatibility with Cabal pre-1.24. +-- This type synonym is slightly awful because in cabal-install +-- we define an 'InstalledPackageId' but it's a ComponentId, +-- not a UnitId! installedPackageId :: InstalledPackageInfo -> UnitId installedPackageId = installedUnitId diff --git a/Cabal/Distribution/Package.hs b/Cabal/Distribution/Package.hs index 5e7ff259ae2..8278ba98d25 100644 --- a/Cabal/Distribution/Package.hs +++ b/Cabal/Distribution/Package.hs @@ -239,7 +239,7 @@ packageVersion = pkgVersion . packageId instance Package PackageIdentifier where packageId = id --- | Packages that have an installed package ID +-- | Packages that have an installed unit ID class Package pkg => HasUnitId pkg where installedUnitId :: pkg -> UnitId diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index ba75d42f8f0..7946ca556a4 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -1332,15 +1332,15 @@ newPackageDepsBehaviour pkg = -- deps in the end. So we still need to remember which installed packages to -- pick. combinedConstraints :: [Dependency] -> - [(PackageName, UnitId)] -> + [(PackageName, ComponentId)] -> InstalledPackageIndex -> Either String ([Dependency], Map PackageName InstalledPackageInfo) combinedConstraints constraints dependencies installedPackages = do - when (not (null badUnitIds)) $ + when (not (null badComponentIds)) $ Left $ render $ text "The following package dependencies were requested" - $+$ nest 4 (dispDependencies badUnitIds) + $+$ nest 4 (dispDependencies badComponentIds) $+$ text "however the given installed package instance does not exist." --TODO: we don't check that all dependencies are used! @@ -1359,26 +1359,26 @@ combinedConstraints constraints dependencies installedPackages = do | (_, _, Just pkg) <- dependenciesPkgInfo ] -- The dependencies along with the installed package info, if it exists - dependenciesPkgInfo :: [(PackageName, UnitId, + dependenciesPkgInfo :: [(PackageName, ComponentId, Maybe InstalledPackageInfo)] dependenciesPkgInfo = - [ (pkgname, ipkgid, mpkg) - | (pkgname, ipkgid) <- dependencies - , let mpkg = PackageIndex.lookupUnitId - installedPackages ipkgid + [ (pkgname, cid, mpkg) + | (pkgname, cid) <- dependencies + , let mpkg = PackageIndex.lookupComponentId + installedPackages cid ] -- If we looked up a package specified by an installed package id -- (i.e. someone has written a hash) and didn't find it then it's -- an error. - badUnitIds = - [ (pkgname, ipkgid) - | (pkgname, ipkgid, Nothing) <- dependenciesPkgInfo ] + badComponentIds = + [ (pkgname, cid) + | (pkgname, cid, Nothing) <- dependenciesPkgInfo ] dispDependencies deps = hsep [ text "--dependency=" - <<>> quotes (disp pkgname <<>> char '=' <<>> disp ipkgid) - | (pkgname, ipkgid) <- deps ] + <<>> quotes (disp pkgname <<>> char '=' <<>> disp cid) + | (pkgname, cid) <- deps ] -- ----------------------------------------------------------------------------- -- Configuring program dependencies diff --git a/Cabal/Distribution/Simple/PackageIndex.hs b/Cabal/Distribution/Simple/PackageIndex.hs index 47e194d0839..e9be24bdd28 100644 --- a/Cabal/Distribution/Simple/PackageIndex.hs +++ b/Cabal/Distribution/Simple/PackageIndex.hs @@ -77,6 +77,7 @@ module Distribution.Simple.PackageIndex ( -- ** Precise lookups lookupUnitId, + lookupComponentId, lookupSourcePackageId, lookupPackageId, lookupPackageName, @@ -379,14 +380,21 @@ allPackagesBySourcePackageId (PackageIndex _ pnames) = -- * Lookups -- --- | Does a lookup by source package id (name & version). +-- | Does a lookup by unit identifier. -- -- Since multiple package DBs mask each other by 'UnitId', -- then we get back at most one package. -- lookupUnitId :: PackageIndex a -> UnitId -> Maybe a -lookupUnitId (PackageIndex pids _) pid = Map.lookup pid pids +lookupUnitId (PackageIndex m _) uid = Map.lookup uid m + +-- | Does a lookup by component identifier. In the absence +-- of Backpack, this is just a 'lookupUnitId'. +-- +lookupComponentId :: PackageIndex a -> ComponentId + -> Maybe a +lookupComponentId (PackageIndex m _) uid = Map.lookup (SimpleUnitId uid) m -- | Backwards compatibility for Cabal pre-1.24. {-# DEPRECATED lookupInstalledPackageId "Use lookupUnitId instead" #-} diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs index 39667819be4..fa2eaab1016 100644 --- a/Cabal/Distribution/Simple/Setup.hs +++ b/Cabal/Distribution/Simple/Setup.hs @@ -404,7 +404,7 @@ data ConfigFlags = ConfigFlags { configStripLibs :: Flag Bool, -- ^Enable library stripping configConstraints :: [Dependency], -- ^Additional constraints for -- dependencies. - configDependencies :: [(PackageName, UnitId)], + configDependencies :: [(PackageName, ComponentId)], -- ^The packages depended on. configConfigurationsFlags :: FlagAssignment, configTests :: Flag Bool, -- ^Enable test suite compilation @@ -709,7 +709,7 @@ configureOptions showOrParseArgs = ,option "" ["dependency"] "A list of exact dependencies. E.g., --dependency=\"void=void-0.5.8-177d5cdf20962d0581fe2e4932a6c309\"" configDependencies (\v flags -> flags { configDependencies = v}) - (reqArg "NAME=ID" + (reqArg "NAME=CID" (readP_to_E (const "dependency expected") ((\x -> [x]) `fmap` parseDependency)) (map (\x -> display (fst x) ++ "=" ++ display (snd x)))) @@ -795,7 +795,7 @@ showProfDetailLevelFlag :: Flag ProfDetailLevel -> [String] showProfDetailLevelFlag NoFlag = [] showProfDetailLevelFlag (Flag dl) = [showProfDetailLevel dl] -parseDependency :: Parse.ReadP r (PackageName, UnitId) +parseDependency :: Parse.ReadP r (PackageName, ComponentId) parseDependency = do x <- parse _ <- Parse.char '=' diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs index 412f3dbff96..4737b51ab2e 100644 --- a/cabal-install/Distribution/Client/Configure.hs +++ b/cabal-install/Distribution/Client/Configure.hs @@ -55,7 +55,7 @@ import Distribution.Simple.PackageIndex import Distribution.Simple.Utils ( defaultPackageDesc ) import Distribution.Package - ( Package(..), UnitId, packageName + ( Package(..), packageName , Dependency(..), thisPackageVersion ) import qualified Distribution.PackageDescription as PkgDesc @@ -244,14 +244,14 @@ configureSetupScript packageDBs defaultSetupDeps = maybe False PkgDesc.defaultSetupDepends maybeSetupBuildInfo - explicitSetupDeps :: Maybe [(UnitId, PackageId)] + explicitSetupDeps :: Maybe [(InstalledPackageId, PackageId)] explicitSetupDeps = do -- Check if there is an explicit setup stanza. _buildInfo <- maybeSetupBuildInfo -- Return the setup dependencies computed by the solver ReadyPackage cpkg <- mpkg - return [ ( uid, srcid ) - | ConfiguredId srcid uid <- CD.setupDeps (confPkgDeps cpkg) + return [ ( cid, srcid ) + | ConfiguredId srcid cid <- CD.setupDeps (confPkgDeps cpkg) ] -- | Warn if any constraints or preferences name packages that are not in the diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs index 44e717a4a31..ca04073b4af 100644 --- a/cabal-install/Distribution/Client/Install.hs +++ b/cabal-install/Distribution/Client/Install.hs @@ -77,6 +77,7 @@ import Distribution.Client.Dependency.Types import Distribution.Client.FetchUtils import Distribution.Client.HttpUtils ( HttpTransport (..) ) +import Distribution.Solver.Types.PackageFixedDeps import qualified Distribution.Client.Haddock as Haddock (regenerateHaddockIndex) import Distribution.Client.IndexUtils as IndexUtils ( getSourcePackages, getInstalledPackages ) @@ -149,10 +150,9 @@ import Distribution.Simple.Register (registerPackage) import Distribution.Simple.Program.HcPkg (MultiInstance(..)) import Distribution.Package ( PackageIdentifier(..), PackageId, packageName, packageVersion - , Package(..) + , Package(..), HasUnitId(..) , Dependency(..), thisPackageVersion - , UnitId(..) - , HasUnitId(..) ) + , UnitId(..) ) import qualified Distribution.PackageDescription as PackageDescription import Distribution.PackageDescription ( PackageDescription, GenericPackageDescription(..), Flag(..) @@ -618,7 +618,7 @@ packageStatus installedPkgIndex cpkg = -- deps of installed pkg (resolveInstalledIds $ Installed.depends pkg) -- deps of configured pkg - (resolveInstalledIds $ map confInstId (CD.nonSetupDeps (confPkgDeps pkg'))) + (resolveInstalledIds $ CD.nonSetupDeps (depends pkg')) -- convert to source pkg ids via index resolveInstalledIds :: [UnitId] -> [PackageIdentifier] @@ -1156,12 +1156,11 @@ performInstallations verbosity | otherwise = False substLogFileName :: PathTemplate -> PackageIdentifier -> UnitId -> FilePath - substLogFileName template pkg ipid = fromPathTemplate + substLogFileName template pkg uid = fromPathTemplate . substPathTemplate env $ template - where env = initialPathTemplateEnv (packageId pkg) - ipid - (compilerInfo comp) platform + where env = initialPathTemplateEnv (packageId pkg) uid + (compilerInfo comp) platform miscOptions = InstallMisc { libVersion = flagToMaybe (configCabalVersion configExFlags) @@ -1179,7 +1178,7 @@ executeInstallPlan verbosity jobCtl keepGoing useLogFile plan0 installPkg = InstallPlan.execute jobCtl keepGoing depsFailure plan0 $ \pkg -> do buildOutcome <- installPkg pkg - printBuildResult (packageId pkg) (installedPackageId pkg) buildOutcome + printBuildResult (packageId pkg) (installedUnitId pkg) buildOutcome return buildOutcome where @@ -1188,7 +1187,7 @@ executeInstallPlan verbosity jobCtl keepGoing useLogFile plan0 installPkg = -- Print build log if something went wrong, and 'Installed $PKGID' -- otherwise. printBuildResult :: PackageId -> UnitId -> BuildOutcome -> IO () - printBuildResult pkgid ipid buildOutcome = case buildOutcome of + printBuildResult pkgid uid buildOutcome = case buildOutcome of (Right _) -> notice verbosity $ "Installed " ++ display pkgid (Left _) -> do notice verbosity $ "Failed to install " ++ display pkgid @@ -1196,7 +1195,7 @@ executeInstallPlan verbosity jobCtl keepGoing useLogFile plan0 installPkg = case useLogFile of Nothing -> return () Just (mkLogFileName, _) -> do - let logName = mkLogFileName pkgid ipid + let logName = mkLogFileName pkgid uid putStr $ "Build log ( " ++ logName ++ " ):\n" printFile logName @@ -1231,9 +1230,9 @@ installReadyPackage platform cinfo configFlags -- In the end only one set gets passed to Setup.hs configure, depending on -- the Cabal version we are talking to. configConstraints = [ thisPackageVersion srcid - | ConfiguredId srcid _uid <- CD.nonSetupDeps deps ], - configDependencies = [ (packageName srcid, uid) - | ConfiguredId srcid uid <- CD.nonSetupDeps deps ], + | ConfiguredId srcid _ipid <- CD.nonSetupDeps deps ], + configDependencies = [ (packageName srcid, dep_ipid) + | ConfiguredId srcid dep_ipid <- CD.nonSetupDeps deps ], -- Use '--exact-configuration' if supported. configExactConfiguration = toFlag True, configBenchmarks = toFlag False, @@ -1415,7 +1414,7 @@ installUnpackedPackage verbosity installLock numJobs -- Install phase onFailure InstallFailed $ criticalSection installLock $ do -- Actual installation - withWin32SelfUpgrade verbosity ipid configFlags + withWin32SelfUpgrade verbosity uid configFlags cinfo platform pkg $ do setup Cabal.copyCommand copyFlags mLogPath @@ -1423,8 +1422,8 @@ installUnpackedPackage verbosity installLock numJobs -- it can be incorporated into the final InstallPlan ipkgs <- genPkgConfs mLogPath let ipkgs' = case ipkgs of - [ipkg] -> [ipkg { Installed.installedUnitId = ipid }] - _ -> assert (any ((== ipid) + [ipkg] -> [ipkg { Installed.installedUnitId = uid }] + _ -> assert (any ((== uid) . Installed.installedUnitId) ipkgs) ipkgs let packageDBs = interpretPackageDbFlags @@ -1439,7 +1438,7 @@ installUnpackedPackage verbosity installLock numJobs where pkgid = packageId pkg - ipid = installedUnitId rpkg + uid = installedUnitId rpkg cinfo = compilerInfo comp buildCommand' = buildCommand conf buildFlags _ = emptyBuildFlags { @@ -1480,7 +1479,7 @@ installUnpackedPackage verbosity installLock numJobs } where CompilerId flavor _ = compilerInfoId cinfo - env = initialPathTemplateEnv pkgid ipid cinfo platform + env = initialPathTemplateEnv pkgid uid cinfo platform userInstall = fromFlagOrDefault defaultUserInstall (configUserInstall configFlags') @@ -1527,7 +1526,7 @@ installUnpackedPackage verbosity installLock numJobs case useLogFile of Nothing -> return Nothing Just (mkLogFileName, _) -> do - let logFileName = mkLogFileName (packageId pkg) ipid + let logFileName = mkLogFileName (packageId pkg) uid logDir = takeDirectory logFileName unless (null logDir) $ createDirectoryIfMissing True logDir logFileExists <- doesFileExist logFileName @@ -1570,7 +1569,7 @@ withWin32SelfUpgrade :: Verbosity -> PackageDescription -> IO a -> IO a withWin32SelfUpgrade _ _ _ _ _ _ action | buildOS /= Windows = action -withWin32SelfUpgrade verbosity ipid configFlags cinfo platform pkg action = do +withWin32SelfUpgrade verbosity uid configFlags cinfo platform pkg action = do defaultDirs <- InstallDirs.defaultInstallDirs compFlavor @@ -1598,10 +1597,10 @@ withWin32SelfUpgrade verbosity ipid configFlags cinfo platform pkg action = do templateDirs = InstallDirs.combineInstallDirs fromFlagOrDefault defaultDirs (configInstallDirs configFlags) absoluteDirs = InstallDirs.absoluteInstallDirs - pkgid ipid + pkgid uid cinfo InstallDirs.NoCopyDest platform templateDirs substTemplate = InstallDirs.fromPathTemplate . InstallDirs.substPathTemplate env - where env = InstallDirs.initialPathTemplateEnv pkgid ipid + where env = InstallDirs.initialPathTemplateEnv pkgid uid cinfo platform diff --git a/cabal-install/Distribution/Client/InstallPlan.hs b/cabal-install/Distribution/Client/InstallPlan.hs index 25eed68a6e3..1c99d177996 100644 --- a/cabal-install/Distribution/Client/InstallPlan.hs +++ b/cabal-install/Distribution/Client/InstallPlan.hs @@ -423,15 +423,12 @@ configureInstallPlan solverPlan = -> ConfiguredPackage UnresolvedPkgLoc configureSolverPackage mapDep spkg = ConfiguredPackage { - confPkgId = SimpleUnitId - $ Configure.computeComponentId + confPkgId = Configure.computeComponentId Cabal.NoFlag Cabal.NoFlag (packageId spkg) PD.CLibName - -- TODO: this is a hack that won't work for Backpack. - (map ((\(SimpleUnitId cid0) -> cid0) . confInstId) - (CD.libraryDeps deps)) + (map confInstId (CD.libraryDeps deps)) (solverPkgFlags spkg), confPkgSource = solverPkgSource spkg, confPkgFlags = solverPkgFlags spkg, diff --git a/cabal-install/Distribution/Client/PackageHash.hs b/cabal-install/Distribution/Client/PackageHash.hs index 8468cbcbff4..63e61ee01e8 100644 --- a/cabal-install/Distribution/Client/PackageHash.hs +++ b/cabal-install/Distribution/Client/PackageHash.hs @@ -29,7 +29,7 @@ module Distribution.Client.PackageHash ( ) where import Distribution.Package - ( PackageId, PackageIdentifier(..), mkUnitId ) + ( PackageId, PackageIdentifier(..), ComponentId(..) ) import Distribution.System ( Platform, OS(Windows), buildOS ) import Distribution.PackageDescription @@ -86,7 +86,7 @@ hashedInstalledPackageId -- hashedInstalledPackageIdLong :: PackageHashInputs -> InstalledPackageId hashedInstalledPackageIdLong pkghashinputs@PackageHashInputs{pkgHashPkgId} = - mkUnitId $ + ComponentId $ display pkgHashPkgId -- to be a bit user friendly ++ "-" ++ showHashValue (hashPackageHashInputs pkghashinputs) @@ -111,7 +111,7 @@ hashedInstalledPackageIdLong pkghashinputs@PackageHashInputs{pkgHashPkgId} = -- hashedInstalledPackageIdShort :: PackageHashInputs -> InstalledPackageId hashedInstalledPackageIdShort pkghashinputs@PackageHashInputs{pkgHashPkgId} = - mkUnitId $ + ComponentId $ intercalate "-" -- max length now 64 [ truncateStr 14 (display name) diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs index e1749044b80..737e250e81d 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/Distribution/Client/ProjectBuilding.hs @@ -124,7 +124,7 @@ import System.Directory -- -- This is used as the result of the dry-run of building an install plan. -- -type BuildStatusMap = Map InstalledPackageId BuildStatus +type BuildStatusMap = Map UnitId BuildStatus -- | The build status for an individual package is the state that the -- package is in /prior/ to initiating a (re)build. @@ -336,13 +336,13 @@ foldMInstallPlanDepOrder => GenericInstallPlan ipkg srcpkg -> (GenericPlanPackage ipkg srcpkg -> [b] -> m b) - -> m (Map InstalledPackageId b) + -> m (Map UnitId b) foldMInstallPlanDepOrder plan0 visit = go Map.empty (InstallPlan.reverseTopologicalOrder plan0) where - go :: Map InstalledPackageId b + go :: Map UnitId b -> [GenericPlanPackage ipkg srcpkg] - -> m (Map InstalledPackageId b) + -> m (Map UnitId b) go !results [] = return results go !results (pkg : pkgs) = do @@ -361,24 +361,24 @@ improveInstallPlanWithUpToDatePackages :: ElaboratedInstallPlan -> ElaboratedInstallPlan improveInstallPlanWithUpToDatePackages installPlan pkgsBuildStatus = replaceWithPrePreExisting installPlan - [ (installedPackageId pkg, mipkg) + [ (installedUnitId pkg, mipkg) | InstallPlan.Configured pkg <- InstallPlan.reverseTopologicalOrder installPlan - , let ipkgid = installedPackageId pkg - Just pkgBuildStatus = Map.lookup ipkgid pkgsBuildStatus + , let uid = installedUnitId pkg + Just pkgBuildStatus = Map.lookup uid pkgsBuildStatus , BuildStatusUpToDate (BuildResult { buildResultLibInfo = mipkg }) <- [pkgBuildStatus] ] where replaceWithPrePreExisting = - foldl' (\plan (ipkgid, mipkg) -> + foldl' (\plan (uid, mipkg) -> -- TODO: A grievous hack. Better to have a special type -- of entry representing pre-existing executables. let stub_ipkg = Installed.emptyInstalledPackageInfo { - Installed.installedUnitId = ipkgid + Installed.installedUnitId = uid } ipkg = fromMaybe stub_ipkg mipkg - in InstallPlan.preexisting ipkgid ipkg plan) + in InstallPlan.preexisting uid ipkg plan) ----------------------------- @@ -699,8 +699,8 @@ rebuildTargets verbosity installPlan $ \pkg -> handle (return . Left) $ fmap Right $ --TODO: review exception handling - let ipkgid = installedPackageId pkg - Just pkgBuildStatus = Map.lookup ipkgid pkgsBuildStatus in + let uid = installedUnitId pkg + Just pkgBuildStatus = Map.lookup uid pkgsBuildStatus in rebuildTarget verbosity @@ -838,8 +838,8 @@ asyncDownloadPackages verbosity withRepoCtx installPlan pkgsBuildStatus body [ pkgSourceLocation (getElaboratedPackage pkg_or_comp) | InstallPlan.Configured pkg_or_comp <- InstallPlan.reverseTopologicalOrder installPlan - , let ipkgid = installedPackageId pkg_or_comp - Just pkgBuildStatus = Map.lookup ipkgid pkgsBuildStatus + , let uid = installedUnitId pkg_or_comp + Just pkgBuildStatus = Map.lookup uid pkgsBuildStatus , BuildStatusDownload <- [pkgBuildStatus] ] @@ -1059,7 +1059,7 @@ buildAndInstallUnpackedPackage verbosity -- grab and modify the InstalledPackageInfo. We decide what -- the installed package id is, not the build system. ipkg0 <- generateInstalledPackageInfo - let ipkg = ipkg0 { Installed.installedUnitId = ipkgid } + let ipkg = ipkg0 { Installed.installedUnitId = uid } criticalSection registerLock $ Cabal.registerPackage verbosity compiler progdb @@ -1081,7 +1081,7 @@ buildAndInstallUnpackedPackage verbosity where pkgid = packageId rpkg - ipkgid = installedPackageId rpkg + uid = installedUnitId rpkg isParallelBuild = buildSettingNumJobs >= 2 @@ -1125,7 +1125,7 @@ buildAndInstallUnpackedPackage verbosity mlogFile = case buildSettingLogFile of Nothing -> Nothing - Just mkLogFile -> Just (mkLogFile compiler platform pkgid ipkgid) + Just mkLogFile -> Just (mkLogFile compiler platform pkgid uid) initLogFile = case mlogFile of diff --git a/cabal-install/Distribution/Client/ProjectOrchestration.hs b/cabal-install/Distribution/Client/ProjectOrchestration.hs index c873f7491ba..af0491a08c5 100644 --- a/cabal-install/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/Distribution/Client/ProjectOrchestration.hs @@ -62,8 +62,7 @@ import Distribution.Client.ProjectPlanning.Types import Distribution.Client.ProjectBuilding import Distribution.Client.Types - ( InstalledPackageId, installedPackageId - , GenericReadyPackage(..), PackageLocation(..) ) + ( GenericReadyPackage(..), PackageLocation(..) ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.BuildTarget ( UserBuildTarget, resolveUserBuildTargets @@ -318,14 +317,14 @@ resolveAndCheckTargets :: PackageTarget -> ElaboratedInstallPlan -> [BuildTarget PackageName] -> Either [BuildTargetProblem] - (Map InstalledPackageId [PackageTarget]) + (Map UnitId [PackageTarget]) resolveAndCheckTargets targetDefaultComponents targetSpecificComponent installPlan targets = case partitionEithers (map checkTarget targets) of ([], targets') -> Right $ Map.fromListWith (++) - [ (ipkgid, [t]) | (ipkgids, t) <- targets' - , ipkgid <- ipkgids ] + [ (uid, [t]) | (uids, t) <- targets' + , uid <- uids ] (problems, _) -> Left problems where -- TODO [required eventually] currently all build targets refer to packages @@ -369,15 +368,15 @@ resolveAndCheckTargets targetDefaultComponents -- NB: It's a list of 'InstalledPackageId', because each component -- in the install plan from a single package needs to be associated with -- the same 'PackageName'. - projAllPkgs, projLocalPkgs :: Map PackageName [InstalledPackageId] + projAllPkgs, projLocalPkgs :: Map PackageName [UnitId] projAllPkgs = Map.fromListWith (++) - [ (packageName pkg, [installedPackageId pkg]) + [ (packageName pkg, [installedUnitId pkg]) | pkg <- InstallPlan.toList installPlan ] projLocalPkgs = Map.fromListWith (++) - [ (packageName pkg, [installedPackageId pkg_or_comp]) + [ (packageName pkg, [installedUnitId pkg_or_comp]) | InstallPlan.Configured pkg_or_comp <- InstallPlan.toList installPlan , let pkg = getElaboratedPackage pkg_or_comp , case pkgSourceLocation pkg of @@ -459,7 +458,7 @@ printPlan verbosity ElabComponent comp -> " (" ++ maybe "custom" display (elabComponentName comp) ++ ")") ++ showFlagAssignment (nonDefaultFlags pkg) ++ - let buildStatus = pkgsBuildStatus Map.! installedPackageId pkg_or_comp in + let buildStatus = pkgsBuildStatus Map.! installedUnitId pkg_or_comp in " (" ++ showBuildStatus buildStatus ++ ")" where pkg = getElaboratedPackage pkg_or_comp diff --git a/cabal-install/Distribution/Client/ProjectPlanOutput.hs b/cabal-install/Distribution/Client/ProjectPlanOutput.hs index 0d5e6a141c7..44ce17c364d 100644 --- a/cabal-install/Distribution/Client/ProjectPlanOutput.hs +++ b/cabal-install/Distribution/Client/ProjectPlanOutput.hs @@ -10,6 +10,7 @@ module Distribution.Client.ProjectPlanOutput ( import Distribution.Client.ProjectPlanning.Types import Distribution.Client.DistDirLayout +import Distribution.Client.Types import qualified Distribution.Client.InstallPlan as InstallPlan import qualified Distribution.Client.Utils.Json as J @@ -82,7 +83,7 @@ encodePlanAsJson elaboratedInstallPlan _elaboratedSharedConfig = flat_deps = ordNub (ComponentDeps.flatDeps (pkgDependencies pkg)) components = J.object [ comp2str c J..= J.object - [ "depends" J..= map (jdisplay . installedUnitId) v ] + [ "depends" J..= map (jdisplay . confInstId) v ] -- NB: does NOT contain order-only dependencies | (c,v) <- ComponentDeps.toList (pkgDependencies pkg) ] @@ -96,7 +97,7 @@ encodePlanAsJson elaboratedInstallPlan _elaboratedSharedConfig = | (PD.FlagName fn,v) <- pkgFlagAssignment pkg ] -- NB: does NOT contain order-only dependencies - , "depends" J..= map (jdisplay . installedUnitId) (elabComponentDependencies comp) + , "depends" J..= map (jdisplay . confInstId) (elabComponentDependencies comp) ] where pkg = elabComponentPackage comp diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 4b863bdfb30..84ef49735d9 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -211,7 +211,7 @@ sanityCheckElaboratedPackage sharedConfig -- the 'hashedInstalledPackageId' we would compute from -- the elaborated configured package . assert (pkgBuildStyle == BuildInplaceOnly || - installedPackageId pkg == hashedInstalledPackageId + pkgInstalledId == hashedInstalledPackageId (packageHashInputs sharedConfig (ElabPackage pkg))) -- either a package is built inplace, or we are not attempting to @@ -1071,7 +1071,7 @@ elaborateInstallPlan platform compiler compilerprogdb ecomp = ElaboratedComponent { elabComponent = cname', elabComponentName = Just cname, - elabComponentId = cid, + elabComponentId = SimpleUnitId cid, -- Backpack later! elabComponentPackage = pkg, elabComponentDependencies = deps, -- TODO: track dependencies on executables @@ -1081,9 +1081,10 @@ elaborateInstallPlan platform compiler compilerprogdb elabComponentReplTarget = Nothing, elabComponentBuildHaddocks = False } + cid :: ComponentId cid = case pkgBuildStyle pkg of BuildInplaceOnly -> - mkUnitId $ + ComponentId $ display pkgid ++ "-inplace" ++ (case Cabal.componentNameString cname of Nothing -> "" @@ -1129,7 +1130,7 @@ elaborateInstallPlan platform compiler compilerprogdb pkgInstalledId | shouldBuildInplaceOnly pkg - = mkUnitId (display pkgid ++ "-inplace") + = ComponentId (display pkgid ++ "-inplace") | otherwise = assert (isJust pkgSourceHash) $ @@ -1253,12 +1254,13 @@ elaborateInstallPlan platform compiler compilerprogdb pkgProgPrefix = perPkgOptionMaybe pkgid packageConfigProgPrefix pkgProgSuffix = perPkgOptionMaybe pkgid packageConfigProgSuffix + -- TODO: This needs to be overridden in per-component mode pkgInstallDirs | shouldBuildInplaceOnly pkg -- use the ordinary default install dirs = (InstallDirs.absoluteInstallDirs pkgid - pkgInstalledId + (SimpleUnitId pkgInstalledId) (compilerInfo compiler) InstallDirs.NoCopyDest platform @@ -1513,7 +1515,7 @@ pkgBuildTargetWholeComponents (ElabComponent comp) = -- targets. Also, update the package config to specify which optional stanzas -- to enable, and which targets within each package to build. -- -pruneInstallPlanToTargets :: Map InstalledPackageId [PackageTarget] +pruneInstallPlanToTargets :: Map UnitId [PackageTarget] -> ElaboratedInstallPlan -> ElaboratedInstallPlan pruneInstallPlanToTargets perPkgTargetsMap = InstallPlan.new (IndependentGoals False) @@ -1532,7 +1534,7 @@ pruneInstallPlanToTargets perPkgTargetsMap = -- where we don't need to avoid configuring a test suite; it always -- is configured separately. data PrunedPackage - = PrunedPackage ElaboratedPackage [InstalledPackageId] + = PrunedPackage ElaboratedPackage [UnitId] | PrunedComponent ElaboratedComponent instance Package PrunedPackage where @@ -1543,7 +1545,7 @@ instance HasUnitId PrunedPackage where installedUnitId = nodeKey instance IsNode PrunedPackage where - type Key PrunedPackage = InstalledPackageId + type Key PrunedPackage = UnitId nodeKey (PrunedPackage pkg _) = nodeKey pkg nodeKey (PrunedComponent comp) = nodeKey comp nodeNeighbors (PrunedPackage _ deps) = deps @@ -1562,7 +1564,7 @@ fromPrunedPackage (PrunedComponent comp) = ElabComponent comp -- are used only by unneeded optional stanzas. These pruned deps are only -- used for the dependency closure and are not persisted in this pass. -- -pruneInstallPlanPass1 :: Map InstalledPackageId [PackageTarget] +pruneInstallPlanPass1 :: Map UnitId [PackageTarget] -> [ElaboratedPlanPackage] -> [ElaboratedPlanPackage] pruneInstallPlanPass1 perPkgTargetsMap pkgs = @@ -1615,7 +1617,7 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = then Just sub else Nothing targets = fromMaybe [] - $ Map.lookup (installedPackageId comp) perPkgTargetsMap + $ Map.lookup (installedUnitId comp) perPkgTargetsMap -- Elaborate and set the targets we'll build for this package. This is just -- based on the targets from the user, not targets implied by reverse @@ -1631,7 +1633,7 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = (buildTargets, replTarget, buildHaddocks) = elaboratePackageTargets pkg targets targets = fromMaybe [] - $ Map.lookup (installedPackageId pkg) perPkgTargetsMap + $ Map.lookup (installedUnitId pkg) perPkgTargetsMap -- Decide whether or not to enable testsuites and benchmarks -- @@ -1662,10 +1664,10 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = -- the optional stanzas and we'll make further tweaks to the optional -- stanzas in the next pass. -- - pruneOptionalDependencies :: ElaboratedPackage -> [InstalledPackageId] + pruneOptionalDependencies :: ElaboratedPackage -> [UnitId] pruneOptionalDependencies pkg = -- TODO: do the right thing when this is a test-suite component itself - (CD.flatDeps . CD.filterDeps keepNeeded . fmap (map confInstId)) (pkgDependencies pkg) + (CD.flatDeps . CD.filterDeps keepNeeded . fmap (map (SimpleUnitId . confInstId))) (pkgDependencies pkg) where keepNeeded (CD.ComponentTest _) _ = TestStanzas `Set.member` stanzas keepNeeded (CD.ComponentBench _) _ = BenchStanzas `Set.member` stanzas @@ -1691,7 +1693,7 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = availablePkgs = Set.fromList - [ installedPackageId pkg + [ installedUnitId pkg | InstallPlan.PreExisting pkg <- pkgs ] -- | Given a set of already installed packages @availablePkgs@, @@ -1700,15 +1702,15 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = -- to implement "sticky" testsuites, where once we have installed -- all of the deps needed for the test suite, we go ahead and -- enable it always. -optionalStanzasWithDepsAvailable :: Set InstalledPackageId +optionalStanzasWithDepsAvailable :: Set UnitId -> ElaboratedPackage -> Set OptionalStanza optionalStanzasWithDepsAvailable availablePkgs pkg = Set.fromList [ stanza | stanza <- Set.toList (pkgStanzasAvailable pkg) - , let deps :: [InstalledPackageId] - deps = map installedPackageId + , let deps :: [UnitId] + deps = map (SimpleUnitId . confInstId) $ CD.select (optionalStanzaDeps stanza) (pkgDependencies pkg) , all (`Set.member` availablePkgs) deps @@ -1759,7 +1761,7 @@ pruneInstallPlanPass2 pkgs = where targetsRequiredForRevDeps = [ WholeComponent - | installedPackageId comp `Set.member` hasReverseLibDeps + | installedUnitId comp `Set.member` hasReverseLibDeps ] setStanzasDepsAndTargets (ElabPackage pkg) = ElabPackage $ pkg { @@ -1779,14 +1781,14 @@ pruneInstallPlanPass2 pkgs = targetsRequiredForRevDeps = [ ComponentTarget Cabal.defaultLibName WholeComponent -- if anything needs this pkg, build the library component - | installedPackageId pkg `Set.member` hasReverseLibDeps + | installedUnitId pkg `Set.member` hasReverseLibDeps ] --TODO: also need to track build-tool rev-deps for exes - availablePkgs :: Set InstalledPackageId - availablePkgs = Set.fromList (map installedPackageId pkgs) + availablePkgs :: Set UnitId + availablePkgs = Set.fromList (map installedUnitId pkgs) - hasReverseLibDeps :: Set InstalledPackageId + hasReverseLibDeps :: Set UnitId hasReverseLibDeps = Set.fromList [ depid | pkg <- pkgs , depid <- nodeNeighbors pkg ] @@ -2139,8 +2141,8 @@ setupHsConfigureFlags (ReadyPackage pkg_or_comp) -- in which case we use configConstraints -- NB: This does NOT use nodeNeighbors, which includes executable -- dependencies which should NOT be fed in here - configDependencies = [ (packageName srcid, uid) - | ConfiguredId srcid uid <- + configDependencies = [ (packageName srcid, cid) + | ConfiguredId srcid cid <- case pkg_or_comp of ElabPackage _ -> CD.nonSetupDeps pkgDependencies ElabComponent comp -> elabComponentDependencies comp ] @@ -2359,7 +2361,7 @@ packageHashInputs pkgHashComponent = Nothing, pkgHashSourceHash = srchash, pkgHashDirectDeps = Set.fromList $ - [ installedPackageId dep + [ confInstId dep | dep <- CD.select relevantDeps pkgDependencies ] ++ CD.select relevantDeps pkgExeDependencies, pkgHashOtherConfig = packageHashConfigInputs pkgshared pkg @@ -2385,7 +2387,7 @@ packageHashInputs pkgHashPkgId = packageId comp, pkgHashComponent = Just (elabComponent comp), pkgHashSourceHash = srchash, - pkgHashDirectDeps = Set.fromList (nodeNeighbors comp), + pkgHashDirectDeps = Set.fromList (map confInstId (elabComponentDependencies comp)), pkgHashOtherConfig = packageHashConfigInputs pkgshared pkg } @@ -2450,8 +2452,8 @@ improveInstallPlanWithPreExistingPackages installedPkgIndex installPlan = canPackageBeImproved pkg = PackageIndex.lookupUnitId - installedPkgIndex (installedPackageId pkg) + installedPkgIndex (installedUnitId pkg) replaceWithPreExisting = foldl' (\plan ipkg -> InstallPlan.preexisting - (installedPackageId ipkg) ipkg plan) + (installedUnitId ipkg) ipkg plan) diff --git a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs index 9b2d6f93eab..464fd26fb2a 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -125,14 +125,14 @@ instance IsNode ElaboratedConfiguredPackage where elabDistDirParams :: ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> DistDirParams elabDistDirParams shared (ElabPackage pkg) = DistDirParams { - distParamUnitId = pkgInstalledId pkg, + distParamUnitId = installedUnitId pkg, distParamPackageId = pkgSourceId pkg, distParamComponentName = Nothing, distParamCompilerId = compilerId (pkgConfigCompiler shared), distParamPlatform = pkgConfigPlatform shared } elabDistDirParams shared (ElabComponent comp) = DistDirParams { - distParamUnitId = elabComponentId comp, + distParamUnitId = installedUnitId comp, distParamPackageId = packageId comp, -- NB: NOT the munged ID distParamComponentName = elabComponentName comp, -- TODO: Ick. Change type. distParamCompilerId = compilerId (pkgConfigCompiler shared), @@ -207,7 +207,7 @@ data ElaboratedComponent elabComponentDependencies :: [ConfiguredId], -- | The order-only dependencies of this component; e.g., -- if you depend on an executable it goes here. - elabComponentExeDependencies :: [UnitId], + elabComponentExeDependencies :: [ComponentId], -- | The 'ElaboratedPackage' this component came from elabComponentPackage :: ElaboratedPackage, -- | What in this component should we build (TRANSIENT, see 'pkgBuildTargets') @@ -232,7 +232,7 @@ instance Package ElaboratedComponent where packageId = packageId . elabComponentPackage instance HasConfiguredId ElaboratedComponent where - configuredId comp = ConfiguredId (packageId comp) (installedUnitId comp) + configuredId comp = ConfiguredId (packageId comp) (unitIdComponentId (elabComponentId comp)) instance HasUnitId ElaboratedComponent where installedUnitId = elabComponentId @@ -241,8 +241,9 @@ instance IsNode ElaboratedComponent where type Key ElaboratedComponent = UnitId nodeKey = elabComponentId nodeNeighbors comp = - map installedUnitId (elabComponentDependencies comp) - ++ elabComponentExeDependencies comp + -- TODO: Change this with Backpack! + map (SimpleUnitId . confInstId) (elabComponentDependencies comp) + ++ map SimpleUnitId (elabComponentExeDependencies comp) data ElaboratedPackage = ElaboratedPackage { @@ -266,7 +267,7 @@ data ElaboratedPackage -- | The executable dependencies, which we don't pass as @--dependency@ flags; -- these just need to be added to the path. - pkgExeDependencies :: ComponentDeps [UnitId], + pkgExeDependencies :: ComponentDeps [ComponentId], -- | Another way of phrasing 'pkgStanzasAvailable'. pkgEnabled :: ComponentEnabledSpec, @@ -392,16 +393,16 @@ instance Package ElaboratedPackage where packageId = pkgSourceId instance HasUnitId ElaboratedPackage where - installedUnitId = pkgInstalledId + installedUnitId = SimpleUnitId . pkgInstalledId instance HasConfiguredId ElaboratedPackage where configuredId pkg = ConfiguredId (pkgSourceId pkg) (pkgInstalledId pkg) instance IsNode ElaboratedPackage where type Key ElaboratedPackage = UnitId - nodeKey = pkgInstalledId - nodeNeighbors pkg = map installedUnitId (CD.flatDeps (pkgDependencies pkg)) - ++ CD.flatDeps (pkgExeDependencies pkg) + nodeKey = installedUnitId + nodeNeighbors pkg = map (SimpleUnitId . confInstId) (CD.flatDeps (pkgDependencies pkg)) + ++ map SimpleUnitId (CD.flatDeps (pkgExeDependencies pkg)) -- | This is used in the install plan to indicate how the package will be -- built. diff --git a/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs index 22ae2dd67cf..106e514f775 100644 --- a/cabal-install/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/Distribution/Client/SetupWrapper.hs @@ -27,9 +27,8 @@ import Distribution.Version ( Version(..), VersionRange, anyVersion , intersectVersionRanges, orLaterVersion , withinRange ) -import Distribution.InstalledPackageInfo (installedUnitId) import Distribution.Package - ( UnitId(..), PackageIdentifier(..), PackageId, + ( UnitId(..), ComponentId, PackageIdentifier(..), PackageId, PackageName(..), Package(..), packageName , packageVersion, Dependency(..) ) import Distribution.PackageDescription @@ -66,6 +65,8 @@ import Distribution.Simple.Program.GHC ( GhcMode(..), GhcOptions(..), renderGhcOptions ) import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.PackageIndex (InstalledPackageIndex) +import qualified Distribution.InstalledPackageInfo as IPI +import Distribution.Client.Types import Distribution.Client.Config ( defaultCabalDir ) import Distribution.Client.IndexUtils @@ -162,7 +163,7 @@ data SetupScriptOptions = SetupScriptOptions { forceExternalSetupMethod :: Bool, -- | List of dependencies to use when building Setup.hs. - useDependencies :: [(UnitId, PackageId)], + useDependencies :: [(ComponentId, PackageId)], -- | Is the list of setup dependencies exclusive? -- @@ -383,7 +384,7 @@ externalSetupMethod verbosity options pkg bt mkargs = do Nothing -> getInstalledPackages verbosity comp (usePackageDB options') conf - cabalLibVersionToUse :: IO (Version, (Maybe UnitId) + cabalLibVersionToUse :: IO (Version, (Maybe ComponentId) ,SetupScriptOptions) cabalLibVersionToUse = case useCabalSpecVersion options of @@ -418,7 +419,7 @@ externalSetupMethod verbosity options pkg bt mkargs = do (&&) <$> setupProgFile `existsAndIsMoreRecentThan` setupHs <*> setupProgFile `existsAndIsMoreRecentThan` setupVersionFile - installedVersion :: IO (Version, Maybe UnitId + installedVersion :: IO (Version, Maybe InstalledPackageId ,SetupScriptOptions) installedVersion = do (comp, conf, options') <- configureCompiler options @@ -465,7 +466,7 @@ externalSetupMethod verbosity options pkg bt mkargs = do UnknownBuildType _ -> error "buildTypeScript UnknownBuildType" installedCabalVersion :: SetupScriptOptions -> Compiler -> ProgramConfiguration - -> IO (Version, Maybe UnitId + -> IO (Version, Maybe InstalledPackageId ,SetupScriptOptions) installedCabalVersion options' compiler conf = do index <- maybeGetInstalledPackages options' compiler conf @@ -478,7 +479,7 @@ externalSetupMethod verbosity options pkg bt mkargs = do ++ " but no suitable version is installed." pkgs -> let ipkginfo = head . snd . bestVersion fst $ pkgs in return (packageVersion ipkginfo - ,Just . installedUnitId $ ipkginfo, options'') + ,Just . IPI.installedComponentId $ ipkginfo, options'') bestVersion :: (a -> Version) -> [a] -> a bestVersion f = firstMaximumBy (comparing (preference . f)) @@ -551,7 +552,7 @@ externalSetupMethod verbosity options pkg bt mkargs = do -- | Look up the setup executable in the cache; update the cache if the setup -- executable is not found. getCachedSetupExecutable :: SetupScriptOptions - -> Version -> Maybe UnitId + -> Version -> Maybe InstalledPackageId -> IO FilePath getCachedSetupExecutable options' cabalLibVersion maybeCabalLibInstalledPkgId = do @@ -586,7 +587,7 @@ externalSetupMethod verbosity options pkg bt mkargs = do -- Currently this is GHC/GHCJS only. It should really be generalised. -- compileSetupExecutable :: SetupScriptOptions - -> Version -> Maybe UnitId -> Bool + -> Version -> Maybe ComponentId -> Bool -> IO FilePath compileSetupExecutable options' cabalLibVersion maybeCabalLibInstalledPkgId forceCompile = do @@ -623,7 +624,7 @@ externalSetupMethod verbosity options pkg bt mkargs = do if any hasCabal (useDependencies options') then [] else cabalDep - addRenaming (ipid, _) = (ipid, defaultRenaming) + addRenaming (ipid, _) = (SimpleUnitId ipid, defaultRenaming) cppMacrosFile = setupDir "setup_macros.h" ghcOptions = mempty { -- Respect -v0, but don't crank up verbosity on GHC if diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs index 990e6f53f28..3db012e969e 100644 --- a/cabal-install/Distribution/Client/Types.hs +++ b/cabal-install/Distribution/Client/Types.hs @@ -22,7 +22,8 @@ module Distribution.Client.Types where import Distribution.Package ( PackageName, PackageId, Package(..) - , UnitId(..), HasUnitId(..), PackageInstalled(..) ) + , UnitId(..), ComponentId(..), HasUnitId(..) + , PackageInstalled(..), unitIdComponentId ) import Distribution.InstalledPackageInfo ( InstalledPackageInfo ) import Distribution.PackageDescription @@ -77,10 +78,7 @@ instance Binary SourcePackageDb -- slightly and we may distinguish these two types and have an explicit -- conversion when we register units with the compiler. -- -type InstalledPackageId = UnitId - -installedPackageId :: HasUnitId pkg => pkg -> InstalledPackageId -installedPackageId = installedUnitId +type InstalledPackageId = ComponentId -- | A 'ConfiguredPackage' is a not-yet-installed package along with the @@ -88,8 +86,11 @@ installedPackageId = installedUnitId -- the sense that it provides all the configuration information and so the -- final configure process will be independent of the environment. -- +-- 'ConfiguredPackage' is assumed to not support Backpack. Only the +-- @new-build@ codepath supports Backpack. +-- data ConfiguredPackage loc = ConfiguredPackage { - confPkgId :: UnitId, -- the generated 'UnitId' for this package + confPkgId :: InstalledPackageId, confPkgSource :: SourcePackage loc, -- package info, including repo confPkgFlags :: FlagAssignment, -- complete flag assignment for the package confPkgStanzas :: [OptionalStanza], -- list of enabled optional stanzas for the package @@ -108,12 +109,17 @@ data ConfiguredPackage loc = ConfiguredPackage { instance HasConfiguredId (ConfiguredPackage loc) where configuredId pkg = ConfiguredId (packageId pkg) (confPkgId pkg) +-- 'ConfiguredPackage' is the legacy codepath, we are guaranteed +-- to never have a nontrivial 'UnitId' +instance PackageFixedDeps (ConfiguredPackage loc) where + depends = fmap (map (SimpleUnitId . confInstId)) . confPkgDeps + instance IsNode (ConfiguredPackage loc) where type Key (ConfiguredPackage loc) = UnitId - nodeKey = confPkgId + nodeKey = SimpleUnitId . confPkgId -- TODO: if we update ConfiguredPackage to support order-only -- dependencies, need to include those here - nodeNeighbors = map confInstId . CD.flatDeps . confPkgDeps + nodeNeighbors = CD.flatDeps . depends instance (Binary loc) => Binary (ConfiguredPackage loc) @@ -126,12 +132,9 @@ instance (Binary loc) => Binary (ConfiguredPackage loc) -- -- An already installed package of course is also "configured" (all it's -- configuration parameters and dependencies have been specified). --- --- TODO: I wonder if it would make sense to promote this datatype to Cabal --- and use it consistently instead of UnitIds? data ConfiguredId = ConfiguredId { confSrcId :: PackageId - , confInstId :: UnitId + , confInstId :: ComponentId } deriving (Eq, Ord, Generic) @@ -143,28 +146,29 @@ instance Show ConfiguredId where instance Package ConfiguredId where packageId = confSrcId -instance HasUnitId ConfiguredId where - installedUnitId = confInstId - instance Package (ConfiguredPackage loc) where packageId cpkg = packageId (confPkgSource cpkg) -instance PackageInstalled (ConfiguredPackage loc) where - installedDepends = CD.flatDeps . fmap (map installedUnitId) . confPkgDeps - +-- Never has nontrivial UnitId instance HasUnitId (ConfiguredPackage loc) where - installedUnitId = confPkgId + installedUnitId = SimpleUnitId . confPkgId + +instance PackageInstalled (ConfiguredPackage loc) where + installedDepends = CD.flatDeps . depends class HasConfiguredId a where configuredId :: a -> ConfiguredId +-- NB: This instance is slightly dangerous, in that you'll lose +-- information about the specific UnitId you depended on. instance HasConfiguredId InstalledPackageInfo where - configuredId ipkg = ConfiguredId (packageId ipkg) (installedUnitId ipkg) + configuredId ipkg = ConfiguredId (packageId ipkg) (unitIdComponentId (installedUnitId ipkg)) -- | Like 'ConfiguredPackage', but with all dependencies guaranteed to be -- installed already, hence itself ready to be installed. newtype GenericReadyPackage srcpkg = ReadyPackage srcpkg -- see 'ConfiguredPackage'. - deriving (Eq, Show, Generic, Package, PackageFixedDeps, HasUnitId, PackageInstalled, Binary) + deriving (Eq, Show, Generic, Package, PackageFixedDeps, + HasUnitId, PackageInstalled, Binary) -- Can't newtype derive this instance IsNode srcpkg => IsNode (GenericReadyPackage srcpkg) where From 56bb80b30d5d35ebd2b107ec3d548bda3ad59867 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Sat, 6 Aug 2016 02:15:49 -0700 Subject: [PATCH 11/23] Add record selectors for PackageIndex, and use them when not all fields are destructed. Signed-off-by: Edward Z. Yang --- Cabal/Distribution/Simple/PackageIndex.hs | 42 +++++++++++------------ 1 file changed, 21 insertions(+), 21 deletions(-) diff --git a/Cabal/Distribution/Simple/PackageIndex.hs b/Cabal/Distribution/Simple/PackageIndex.hs index e9be24bdd28..5dfe353e98d 100644 --- a/Cabal/Distribution/Simple/PackageIndex.hs +++ b/Cabal/Distribution/Simple/PackageIndex.hs @@ -132,11 +132,11 @@ import qualified Data.Tree as Tree -- Packages are uniquely identified in by their 'UnitId', they can -- also be efficiently looked up by package name or by name and version. -- -data PackageIndex a = PackageIndex +data PackageIndex a = PackageIndex { -- The primary index. Each InstalledPackageInfo record is uniquely identified -- by its UnitId. -- - !(Map UnitId a) + unitIdIndex :: !(Map UnitId a), -- This auxiliary index maps package names (case-sensitively) to all the -- versions and instances of that package. This allows us to find all @@ -149,9 +149,9 @@ data PackageIndex a = PackageIndex -- -- FIXME: Clarify what "preference order" means. Check that this invariant is -- preserved. See #1463 for discussion. - !(Map PackageName (Map Version [a])) + packageIdIndex :: !(Map PackageName (Map Version [a])) - deriving (Eq, Generic, Show, Read) + } deriving (Eq, Generic, Show, Read) instance Binary a => Binary (PackageIndex a) @@ -354,16 +354,16 @@ deleteDependency (Dependency name verstionRange) = -- | Get all the packages from the index. -- allPackages :: PackageIndex a -> [a] -allPackages (PackageIndex pids _) = Map.elems pids +allPackages = Map.elems . unitIdIndex -- | Get all the packages from the index. -- -- They are grouped by package name (case-sensitively). -- allPackagesByName :: PackageIndex a -> [(PackageName, [a])] -allPackagesByName (PackageIndex _ pnames) = +allPackagesByName index = [ (pkgname, concat (Map.elems pvers)) - | (pkgname, pvers) <- Map.toList pnames ] + | (pkgname, pvers) <- Map.toList (packageIdIndex index) ] -- | Get all the packages from the index. -- @@ -371,9 +371,9 @@ allPackagesByName (PackageIndex _ pnames) = -- allPackagesBySourcePackageId :: HasUnitId a => PackageIndex a -> [(PackageId, [a])] -allPackagesBySourcePackageId (PackageIndex _ pnames) = +allPackagesBySourcePackageId index = [ (packageId ipkg, ipkgs) - | pvers <- Map.elems pnames + | pvers <- Map.elems (packageIdIndex index) , ipkgs@(ipkg:_) <- Map.elems pvers ] -- @@ -387,14 +387,14 @@ allPackagesBySourcePackageId (PackageIndex _ pnames) = -- lookupUnitId :: PackageIndex a -> UnitId -> Maybe a -lookupUnitId (PackageIndex m _) uid = Map.lookup uid m +lookupUnitId index uid = Map.lookup uid (unitIdIndex index) -- | Does a lookup by component identifier. In the absence -- of Backpack, this is just a 'lookupUnitId'. -- lookupComponentId :: PackageIndex a -> ComponentId -> Maybe a -lookupComponentId (PackageIndex m _) uid = Map.lookup (SimpleUnitId uid) m +lookupComponentId index uid = Map.lookup (SimpleUnitId uid) (unitIdIndex index) -- | Backwards compatibility for Cabal pre-1.24. {-# DEPRECATED lookupInstalledPackageId "Use lookupUnitId instead" #-} @@ -410,8 +410,8 @@ lookupInstalledPackageId = lookupUnitId -- preference, with the most preferred first. -- lookupSourcePackageId :: PackageIndex a -> PackageId -> [a] -lookupSourcePackageId (PackageIndex _ pnames) pkgid = - case Map.lookup (packageName pkgid) pnames of +lookupSourcePackageId index pkgid = + case Map.lookup (packageName pkgid) (packageIdIndex index) of Nothing -> [] Just pvers -> case Map.lookup (packageVersion pkgid) pvers of Nothing -> [] @@ -429,8 +429,8 @@ lookupPackageId index pkgid = case lookupSourcePackageId index pkgid of -- lookupPackageName :: PackageIndex a -> PackageName -> [(Version, [a])] -lookupPackageName (PackageIndex _ pnames) name = - case Map.lookup name pnames of +lookupPackageName index name = + case Map.lookup name (packageIdIndex index) of Nothing -> [] Just pvers -> Map.toList pvers @@ -442,8 +442,8 @@ lookupPackageName (PackageIndex _ pnames) name = -- lookupDependency :: PackageIndex a -> Dependency -> [(Version, [a])] -lookupDependency (PackageIndex _ pnames) (Dependency name versionRange) = - case Map.lookup name pnames of +lookupDependency index (Dependency name versionRange) = + case Map.lookup name (packageIdIndex index) of Nothing -> [] Just pvers -> [ entry | entry@(ver, _) <- Map.toList pvers @@ -466,8 +466,8 @@ lookupDependency (PackageIndex _ pnames) (Dependency name versionRange) = -- it is a non-empty list of non-empty lists. -- searchByName :: PackageIndex a -> String -> SearchResult [a] -searchByName (PackageIndex _ pnames) name = - case [ pkgs | pkgs@(PackageName name',_) <- Map.toList pnames +searchByName index name = + case [ pkgs | pkgs@(PackageName name',_) <- Map.toList (packageIdIndex index) , lowercase name' == lname ] of [] -> None [(_,pvers)] -> Unambiguous (concat (Map.elems pvers)) @@ -483,9 +483,9 @@ data SearchResult a = None | Unambiguous a | Ambiguous [a] -- That is, all packages that contain the given string in their name. -- searchByNameSubstring :: PackageIndex a -> String -> [a] -searchByNameSubstring (PackageIndex _ pnames) searchterm = +searchByNameSubstring index searchterm = [ pkg - | (PackageName name, pvers) <- Map.toList pnames + | (PackageName name, pvers) <- Map.toList (packageIdIndex index) , lsearchterm `isInfixOf` lowercase name , pkgs <- Map.elems pvers , pkg <- pkgs ] From 15dd84559f3b957752e97dd7014758b7c17d5657 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Sun, 7 Aug 2016 13:36:56 -0700 Subject: [PATCH 12/23] Prevent nodeNeighbors from returning a node multiple times This causes strange output when we output the install plan. Thanks @hvr for reporting. Signed-off-by: Edward Z. Yang --- .../Distribution/Client/ProjectPlanning/Types.hs | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs index 464fd26fb2a..2c4c8e223a3 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -67,6 +67,7 @@ import qualified Distribution.Solver.Types.ComponentDeps as CD import Distribution.Solver.Types.ComponentDeps (ComponentDeps) import Distribution.Solver.Types.OptionalStanza import Distribution.Compat.Graph (IsNode(..)) +import Distribution.Simple.Utils (ordNub) import Data.Map (Map) import Data.Set (Set) @@ -401,8 +402,12 @@ instance HasConfiguredId ElaboratedPackage where instance IsNode ElaboratedPackage where type Key ElaboratedPackage = UnitId nodeKey = installedUnitId - nodeNeighbors pkg = map (SimpleUnitId . confInstId) (CD.flatDeps (pkgDependencies pkg)) - ++ map SimpleUnitId (CD.flatDeps (pkgExeDependencies pkg)) + nodeNeighbors pkg = + -- Important not to have duplicates: otherwise InstallPlan gets + -- confused + ordNub $ + map (SimpleUnitId . confInstId) (CD.flatDeps (pkgDependencies pkg)) + ++ map SimpleUnitId (CD.flatDeps (pkgExeDependencies pkg)) -- | This is used in the install plan to indicate how the package will be -- built. From 4e782d653935f3e6e27f264914e49b1997161a18 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Mon, 15 Aug 2016 21:17:54 -0700 Subject: [PATCH 13/23] Use per-component install directories. Signed-off-by: Edward Z. Yang --- .../Distribution/Client/ProjectPlanning.hs | 26 +++++++++++++++++-- .../Client/ProjectPlanning/Types.hs | 10 +++---- 2 files changed, 29 insertions(+), 7 deletions(-) diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 84ef49735d9..147737f3e29 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -1076,6 +1076,7 @@ elaborateInstallPlan platform compiler compilerprogdb elabComponentDependencies = deps, -- TODO: track dependencies on executables elabComponentExeDependencies = [], + elabComponentInstallDirs = installDirs, -- These are filled in later elabComponentBuildTargets = [], elabComponentReplTarget = Nothing, @@ -1104,6 +1105,28 @@ elaborateInstallPlan platform compiler compilerprogdb , Just confid' <- [Map.lookup cdep internal_map] ] deps = external_deps ++ internal_deps + installDirs + | shouldBuildInplaceOnly spkg + -- use the ordinary default install dirs + = (InstallDirs.absoluteInstallDirs + pkgid + (SimpleUnitId cid) -- differs! + (compilerInfo compiler) + InstallDirs.NoCopyDest + platform + defaultInstallDirs) { + + InstallDirs.libsubdir = "", -- absoluteInstallDirs sets these as + InstallDirs.datasubdir = "" -- 'undefined' but we have to use + } -- them as "Setup.hs configure" args + + | otherwise + -- use special simplified install dirs + = storePackageInstallDirs + cabalDirLayout + (compilerId compiler) + cid + elaborateSolverPackage :: (SolverId -> [ElaboratedPlanPackage]) -> SolverPackage UnresolvedPkgLoc @@ -2133,9 +2156,8 @@ setupHsConfigureFlags (ReadyPackage pkg_or_comp) configProgPrefix = maybe mempty toFlag pkgProgPrefix configProgSuffix = maybe mempty toFlag pkgProgSuffix - -- TODO: do this per-component configInstallDirs = fmap (toFlag . InstallDirs.toPathTemplate) - pkgInstallDirs + (elabInstallDirs pkg_or_comp) -- we only use configDependencies, unless we're talking to an old Cabal -- in which case we use configConstraints diff --git a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs index 2c4c8e223a3..2a415b70839 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -140,9 +140,9 @@ elabDistDirParams shared (ElabComponent comp) = DistDirParams { distParamPlatform = pkgConfigPlatform shared } --- TODO: give each component a separate install dir prefix elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs.InstallDirs FilePath -elabInstallDirs = pkgInstallDirs . getElaboratedPackage +elabInstallDirs (ElabPackage pkg) = pkgInstallDirs pkg +elabInstallDirs (ElabComponent comp) = elabComponentInstallDirs comp elabRequiresRegistration :: ElaboratedConfiguredPackage -> Bool elabRequiresRegistration (ElabPackage pkg) = pkgRequiresRegistration pkg @@ -216,9 +216,9 @@ data ElaboratedComponent -- | Should we REPL this component (TRANSIENT, see 'pkgReplTarget') elabComponentReplTarget :: Maybe SubComponentTarget, -- | Should we Haddock this component (TRANSIENT, see 'pkgBuildHaddocks') - elabComponentBuildHaddocks :: Bool - -- NB: Careful, if you add elabComponentInstallDirs, need - -- to adjust 'packageHashInputs'!!! + elabComponentBuildHaddocks :: Bool, + -- | Where things should get installed to + elabComponentInstallDirs :: InstallDirs.InstallDirs FilePath } deriving (Eq, Show, Generic) From bb08006dfbfc2ab6e89f7db378a43c2029d56887 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Mon, 15 Aug 2016 21:39:22 -0700 Subject: [PATCH 14/23] Don't provide --constraints when pkgComponent is Just. Signed-off-by: Edward Z. Yang --- cabal-install/Distribution/Client/ProjectPlanning.hs | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 147737f3e29..c24ac65ffc2 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -2168,9 +2168,13 @@ setupHsConfigureFlags (ReadyPackage pkg_or_comp) case pkg_or_comp of ElabPackage _ -> CD.nonSetupDeps pkgDependencies ElabComponent comp -> elabComponentDependencies comp ] - -- TODO: don't need to provide these when pkgComponent is Just - configConstraints = [ thisPackageVersion srcid - | ConfiguredId srcid _uid <- CD.nonSetupDeps pkgDependencies ] + configConstraints = + case pkg_or_comp of + ElabPackage _ -> + [ thisPackageVersion srcid + | ConfiguredId srcid _uid <- CD.nonSetupDeps pkgDependencies ] + ElabComponent _ -> [] + -- explicitly clear, then our package db stack -- TODO: [required eventually] have to do this differently for older Cabal versions From 18cb2462194cc53e4e3e64618e0ee032e377039a Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Mon, 15 Aug 2016 22:06:41 -0700 Subject: [PATCH 15/23] Only put library dependencies in elabComponentDependencies. Signed-off-by: Edward Z. Yang --- .../Distribution/Client/ProjectPlanning.hs | 29 ++++++++++++------- 1 file changed, 18 insertions(+), 11 deletions(-) diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index c24ac65ffc2..c15f2f656d5 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -1060,10 +1060,10 @@ elaborateInstallPlan platform compiler compilerprogdb internalPkgSet = pkgInternalPackages pkg comps_graph = Cabal.mkComponentsGraph (pkgEnabled pkg) pd internalPkgSet - buildComponent :: Map ComponentName ConfiguredId + buildComponent :: Map PackageName ConfiguredId -> (Cabal.Component, [Cabal.ComponentName]) - -> (Map ComponentName ConfiguredId, ElaboratedComponent) - buildComponent internal_map (comp, cdeps) = + -> (Map PackageName ConfiguredId, ElaboratedComponent) + buildComponent internal_map (comp, _cdeps) = (internal_map', ecomp) where cname = Cabal.componentName comp @@ -1073,7 +1073,9 @@ elaborateInstallPlan platform compiler compilerprogdb elabComponentName = Just cname, elabComponentId = SimpleUnitId cid, -- Backpack later! elabComponentPackage = pkg, - elabComponentDependencies = deps, + elabComponentDependencies = + CD.select (== cname') (pkgDependencies pkg) ++ + internal_lib_deps, -- TODO: track dependencies on executables elabComponentExeDependencies = [], elabComponentInstallDirs = installDirs, @@ -1097,13 +1099,18 @@ elaborateInstallPlan platform compiler compilerprogdb elaboratedSharedConfig (ElabComponent ecomp)) -- knot tied confid = ConfiguredId pkgid cid - external_deps = CD.select (== cname') (pkgDependencies pkg) - internal_map' = Map.insert cname confid internal_map - -- TODO: Custom setup dep. - internal_deps = [ confid' - | cdep <- cdeps - , Just confid' <- [Map.lookup cdep internal_map] ] - deps = external_deps ++ internal_deps + + bi = Cabal.componentBuildInfo comp + internal_lib_deps + = [ confid' + | Dependency pkgname _ <- PD.targetBuildDepends bi + , Just confid' <- [Map.lookup pkgname internal_map] ] + internal_map' = case cname of + CLibName + -> Map.insert (packageName pkg) confid internal_map + CSubLibName libname + -> Map.insert (PackageName libname) confid internal_map + _ -> internal_map installDirs | shouldBuildInplaceOnly spkg From 4b4690b8df8f14a8851c01b01849db69b4897e59 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Mon, 15 Aug 2016 22:20:01 -0700 Subject: [PATCH 16/23] Correctly track internal executable dependencies as exe deps. Signed-off-by: Edward Z. Yang --- .../Distribution/Client/ProjectPlanning.hs | 24 +++++++++++++------ 1 file changed, 17 insertions(+), 7 deletions(-) diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index c15f2f656d5..3b90cfbb882 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -1030,7 +1030,7 @@ elaborateInstallPlan platform compiler compilerprogdb elaborateAndExpandSolverPackage mapDep spkg | eligible , Right g <- comps_graph - = map ElabComponent (snd (mapAccumL buildComponent Map.empty g)) + = map ElabComponent (snd (mapAccumL buildComponent (Map.empty, Map.empty) g)) | otherwise = [ElabPackage pkg] where @@ -1060,11 +1060,12 @@ elaborateInstallPlan platform compiler compilerprogdb internalPkgSet = pkgInternalPackages pkg comps_graph = Cabal.mkComponentsGraph (pkgEnabled pkg) pd internalPkgSet - buildComponent :: Map PackageName ConfiguredId + buildComponent :: (Map PackageName ConfiguredId, Map String ConfiguredId) -> (Cabal.Component, [Cabal.ComponentName]) - -> (Map PackageName ConfiguredId, ElaboratedComponent) - buildComponent internal_map (comp, _cdeps) = - (internal_map', ecomp) + -> ((Map PackageName ConfiguredId, Map String ConfiguredId), + ElaboratedComponent) + buildComponent (internal_map, exe_map) (comp, _cdeps) = + ((internal_map', exe_map'), ecomp) where cname = Cabal.componentName comp cname' = CD.componentNameToComponent cname @@ -1076,8 +1077,8 @@ elaborateInstallPlan platform compiler compilerprogdb elabComponentDependencies = CD.select (== cname') (pkgDependencies pkg) ++ internal_lib_deps, - -- TODO: track dependencies on executables - elabComponentExeDependencies = [], + elabComponentExeDependencies = + internal_exe_deps, elabComponentInstallDirs = installDirs, -- These are filled in later elabComponentBuildTargets = [], @@ -1105,12 +1106,21 @@ elaborateInstallPlan platform compiler compilerprogdb = [ confid' | Dependency pkgname _ <- PD.targetBuildDepends bi , Just confid' <- [Map.lookup pkgname internal_map] ] + internal_exe_deps + = [ confInstId confid' + | Dependency (PackageName toolname) _ <- PD.buildTools bi + , toolname `elem` map PD.exeName (PD.executables pd) + , Just confid' <- [Map.lookup toolname exe_map] + ] internal_map' = case cname of CLibName -> Map.insert (packageName pkg) confid internal_map CSubLibName libname -> Map.insert (PackageName libname) confid internal_map _ -> internal_map + exe_map' = case cname of + CExeName exename -> Map.insert exename confid exe_map + _ -> exe_map installDirs | shouldBuildInplaceOnly spkg From da15a6f4134adccbb868b08b32565ecb6614c61a Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Tue, 16 Aug 2016 00:09:34 -0700 Subject: [PATCH 17/23] Fix build-tools PATH usage with per-component new-build Signed-off-by: Edward Z. Yang --- .../Distribution/Client/Configure.hs | 1 + .../Distribution/Client/ProjectBuilding.hs | 2 + .../Distribution/Client/ProjectPlanning.hs | 39 +++++++++++++++---- .../Client/ProjectPlanning/Types.hs | 7 ++++ .../Distribution/Client/SetupWrapper.hs | 18 ++++++--- cabal-install/Distribution/Client/Utils.hs | 25 ++++++++++-- cabal-install/cabal-install.cabal | 6 +++ .../new-build/BuildToolsPath.sh | 3 ++ .../new-build/BuildToolsPath/A.hs | 5 +++ .../BuildToolsPath/MyCustomPreprocessor.hs | 11 ++++++ .../BuildToolsPath/build-tools-path.cabal | 25 ++++++++++++ .../new-build/BuildToolsPath/cabal.project | 1 + .../new-build/BuildToolsPath/hello/Hello.hs | 6 +++ 13 files changed, 131 insertions(+), 18 deletions(-) create mode 100644 cabal-install/tests/IntegrationTests/new-build/BuildToolsPath.sh create mode 100644 cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/A.hs create mode 100644 cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/MyCustomPreprocessor.hs create mode 100644 cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/build-tools-path.cabal create mode 100644 cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/cabal.project create mode 100644 cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/hello/Hello.hs diff --git a/cabal-install/Distribution/Client/Configure.hs b/cabal-install/Distribution/Client/Configure.hs index 4737b51ab2e..81f6faaa560 100644 --- a/cabal-install/Distribution/Client/Configure.hs +++ b/cabal-install/Distribution/Client/Configure.hs @@ -203,6 +203,7 @@ configureSetupScript packageDBs , useDistPref = distPref , useLoggingHandle = Nothing , useWorkingDir = Nothing + , useExtraPathEnv = [] , setupCacheLock = lock , useWin32CleanHack = False , forceExternalSetupMethod = forceExternal diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs index 737e250e81d..df60ac99c25 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/Distribution/Client/ProjectBuilding.hs @@ -1199,6 +1199,8 @@ buildInplaceUnpackedPackage verbosity pkg buildStatus allSrcFiles buildResult + -- PURPOSELY omitted: no copy! + mipkg <- whenReRegister $ annotateFailureNoLog InstallFailed $ do -- Register locally diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 3b90cfbb882..d75256632cd 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -1060,9 +1060,9 @@ elaborateInstallPlan platform compiler compilerprogdb internalPkgSet = pkgInternalPackages pkg comps_graph = Cabal.mkComponentsGraph (pkgEnabled pkg) pd internalPkgSet - buildComponent :: (Map PackageName ConfiguredId, Map String ConfiguredId) + buildComponent :: (Map PackageName ConfiguredId, Map String (ConfiguredId, FilePath)) -> (Cabal.Component, [Cabal.ComponentName]) - -> ((Map PackageName ConfiguredId, Map String ConfiguredId), + -> ((Map PackageName ConfiguredId, Map String (ConfiguredId, FilePath)), ElaboratedComponent) buildComponent (internal_map, exe_map) (comp, _cdeps) = ((internal_map', exe_map'), ecomp) @@ -1079,6 +1079,8 @@ elaborateInstallPlan platform compiler compilerprogdb internal_lib_deps, elabComponentExeDependencies = internal_exe_deps, + elabComponentExeDependencyPaths = + internal_exe_dep_paths, elabComponentInstallDirs = installDirs, -- These are filled in later elabComponentBuildTargets = [], @@ -1106,11 +1108,12 @@ elaborateInstallPlan platform compiler compilerprogdb = [ confid' | Dependency pkgname _ <- PD.targetBuildDepends bi , Just confid' <- [Map.lookup pkgname internal_map] ] - internal_exe_deps - = [ confInstId confid' + (internal_exe_deps, internal_exe_dep_paths) + = unzip $ + [ (confInstId confid', path) | Dependency (PackageName toolname) _ <- PD.buildTools bi , toolname `elem` map PD.exeName (PD.executables pd) - , Just confid' <- [Map.lookup toolname exe_map] + , Just (confid', path) <- [Map.lookup toolname exe_map] ] internal_map' = case cname of CLibName @@ -1119,8 +1122,25 @@ elaborateInstallPlan platform compiler compilerprogdb -> Map.insert (PackageName libname) confid internal_map _ -> internal_map exe_map' = case cname of - CExeName exename -> Map.insert exename confid exe_map - _ -> exe_map + CExeName exename + -> Map.insert exename (confid, inplace_bin_dir) exe_map + _ -> exe_map + -- NB: For inplace NOT InstallPaths.bindir installDirs; for an + -- inplace build those values are utter nonsense. So we + -- have to guess where the directory is going to be. + -- Fortunately this is "stable" part of Cabal API. + -- But the way we get the build directory is A HORRIBLE + -- HACK. + inplace_bin_dir + | shouldBuildInplaceOnly spkg + = distBuildDirectory + (elabDistDirParams elaboratedSharedConfig (ElabComponent ecomp)) + "build" case Cabal.componentNameString cname of + Just n -> n + Nothing -> "" + | otherwise + = InstallDirs.bindir installDirs + installDirs | shouldBuildInplaceOnly spkg @@ -2044,7 +2064,7 @@ setupHsScriptOptions :: ElaboratedReadyPackage -> SetupScriptOptions -- TODO: Fix this so custom is a separate component. Custom can ALWAYS -- be a separate component!!! -setupHsScriptOptions (ReadyPackage (getElaboratedPackage -> ElaboratedPackage{..})) +setupHsScriptOptions (ReadyPackage pkg_or_comp) ElaboratedSharedConfig{..} srcdir builddir isParallelBuild cacheLock = SetupScriptOptions { @@ -2062,10 +2082,13 @@ setupHsScriptOptions (ReadyPackage (getElaboratedPackage -> ElaboratedPackage{.. useDistPref = builddir, useLoggingHandle = Nothing, -- this gets set later useWorkingDir = Just srcdir, + useExtraPathEnv = elabExeDependencyPaths pkg_or_comp, useWin32CleanHack = False, --TODO: [required eventually] forceExternalSetupMethod = isParallelBuild, setupCacheLock = Just cacheLock } + where + ElaboratedPackage{..} = getElaboratedPackage pkg_or_comp -- | To be used for the input for elaborateInstallPlan. diff --git a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs index 2a415b70839..3629590bc73 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -17,6 +17,7 @@ module Distribution.Client.ProjectPlanning.Types ( elabInstallDirs, elabDistDirParams, elabRequiresRegistration, + elabExeDependencyPaths, elabBuildTargets, elabReplTarget, elabBuildHaddocks, @@ -170,6 +171,10 @@ elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool elabBuildHaddocks (ElabPackage pkg) = pkgBuildHaddocks pkg elabBuildHaddocks (ElabComponent comp) = elabComponentBuildHaddocks comp +elabExeDependencyPaths :: ElaboratedConfiguredPackage -> [FilePath] +elabExeDependencyPaths (ElabPackage _) = [] -- TODO: not implemented +elabExeDependencyPaths (ElabComponent comp) = elabComponentExeDependencyPaths comp + getElaboratedPackage :: ElaboratedConfiguredPackage -> ElaboratedPackage getElaboratedPackage (ElabPackage pkg) = pkg getElaboratedPackage (ElabComponent comp) = elabComponentPackage comp @@ -209,6 +214,8 @@ data ElaboratedComponent -- | The order-only dependencies of this component; e.g., -- if you depend on an executable it goes here. elabComponentExeDependencies :: [ComponentId], + -- | The file paths of all our executable dependencies. + elabComponentExeDependencyPaths :: [FilePath], -- | The 'ElaboratedPackage' this component came from elabComponentPackage :: ElaboratedPackage, -- | What in this component should we build (TRANSIENT, see 'pkgBuildTargets') diff --git a/cabal-install/Distribution/Client/SetupWrapper.hs b/cabal-install/Distribution/Client/SetupWrapper.hs index 106e514f775..985c21034ee 100644 --- a/cabal-install/Distribution/Client/SetupWrapper.hs +++ b/cabal-install/Distribution/Client/SetupWrapper.hs @@ -52,7 +52,7 @@ import Distribution.Simple.Program , getProgramSearchPath, getDbProgramOutput, runDbProgram, ghcProgram , ghcjsProgram ) import Distribution.Simple.Program.Find - ( programSearchPathAsPATHVar ) + ( programSearchPathAsPATHVar, ProgramSearchPathEntry(ProgramSearchPathDir) ) import Distribution.Simple.Program.Run ( getEffectiveEnvironment ) import qualified Distribution.Simple.Program.Strip as Strip @@ -80,7 +80,7 @@ import Distribution.Simple.Utils , createDirectoryIfMissingVerbose, installExecutableFile , copyFileVerbose, rewriteFile, intercalate ) import Distribution.Client.Utils - ( inDir, tryCanonicalizePath + ( inDir, tryCanonicalizePath, withExtraPathEnv , existsAndIsMoreRecentThan, moreRecentFile, withEnv #if mingw32_HOST_OS , canonicalizePathNoThrow @@ -160,6 +160,8 @@ data SetupScriptOptions = SetupScriptOptions { useDistPref :: FilePath, useLoggingHandle :: Maybe Handle, useWorkingDir :: Maybe FilePath, + -- | Extra things to add to PATH when invoking the setup script. + useExtraPathEnv :: [FilePath], forceExternalSetupMethod :: Bool, -- | List of dependencies to use when building Setup.hs. @@ -228,6 +230,7 @@ defaultSetupScriptOptions = SetupScriptOptions { useDistPref = defaultDistPref, useLoggingHandle = Nothing, useWorkingDir = Nothing, + useExtraPathEnv = [], useWin32CleanHack = False, forceExternalSetupMethod = False, setupCacheLock = Nothing @@ -304,9 +307,10 @@ internalSetupMethod verbosity options _ bt mkargs = do let args = mkargs cabalVersion info verbosity $ "Using internal setup method with build-type " ++ show bt ++ " and args:\n " ++ show args - inDir (useWorkingDir options) $ + inDir (useWorkingDir options) $ do withEnv "HASKELL_DIST_DIR" (useDistPref options) $ - buildTypeAction bt args + withExtraPathEnv (useExtraPathEnv options) $ + buildTypeAction bt args buildTypeAction :: BuildType -> ([String] -> IO ()) buildTypeAction Simple = Simple.defaultMainArgs @@ -335,7 +339,8 @@ selfExecSetupMethod verbosity options _pkg bt mkargs = do ++ show logHandle searchpath <- programSearchPathAsPATHVar - (getProgramSearchPath (useProgramConfig options)) + (map ProgramSearchPathDir (useExtraPathEnv options) ++ + getProgramSearchPath (useProgramConfig options)) env <- getEffectiveEnvironment [("PATH", Just searchpath) ,("HASKELL_DIST_DIR", Just (useDistPref options))] @@ -689,7 +694,8 @@ externalSetupMethod verbosity options pkg bt mkargs = do where doInvoke path' = do searchpath <- programSearchPathAsPATHVar - (getProgramSearchPath (useProgramConfig options')) + (map ProgramSearchPathDir (useExtraPathEnv options') ++ + getProgramSearchPath (useProgramConfig options')) env <- getEffectiveEnvironment [("PATH", Just searchpath) ,("HASKELL_DIST_DIR", Just (useDistPref options))] diff --git a/cabal-install/Distribution/Client/Utils.hs b/cabal-install/Distribution/Client/Utils.hs index 4fa8719556d..80b37b8d831 100644 --- a/cabal-install/Distribution/Client/Utils.hs +++ b/cabal-install/Distribution/Client/Utils.hs @@ -4,6 +4,7 @@ module Distribution.Client.Utils ( MergeResult(..) , mergeBy, duplicates, duplicatesBy , readMaybe , inDir, withEnv, logDirChange + , withExtraPathEnv , determineNumJobs, numberOfProcessors , removeExistingFile , withTempFileName @@ -18,7 +19,7 @@ module Distribution.Client.Utils ( MergeResult(..) , relaxEncodingErrors) where -import Distribution.Compat.Environment ( lookupEnv, setEnv, unsetEnv ) +import Distribution.Compat.Environment import Distribution.Compat.Exception ( catchIO ) import Distribution.Compat.Time ( getModTime ) import Distribution.Simple.Setup ( Flag(..) ) @@ -31,6 +32,7 @@ import Control.Monad ( when ) import Data.Bits ( (.|.), shiftL, shiftR ) +import System.FilePath import Data.Char ( ord, chr ) #if MIN_VERSION_base(4,6,0) @@ -38,7 +40,7 @@ import Text.Read ( readMaybe ) #endif import Data.List - ( isPrefixOf, sortBy, groupBy ) + ( isPrefixOf, sortBy, groupBy, intercalate ) import Data.Word ( Word8, Word32) import Foreign.C.Types ( CInt(..) ) @@ -47,8 +49,6 @@ import qualified Control.Exception as Exception import System.Directory ( canonicalizePath, doesFileExist, getCurrentDirectory , removeFile, setCurrentDirectory ) -import System.FilePath - ( (), isAbsolute, takeDrive, splitPath, joinPath ) import System.IO ( Handle, hClose, openTempFile #if MIN_VERSION_base(4,4,0) @@ -153,6 +153,23 @@ withEnv k v m = do Nothing -> unsetEnv k Just old -> setEnv k old) +-- | Executes the action, increasing the PATH environment +-- in some way +-- +-- Warning: This operation is NOT thread-safe, because the +-- environment variables are a process-global concept. +withExtraPathEnv :: [FilePath] -> IO a -> IO a +withExtraPathEnv paths m = do + oldPathSplit <- getSearchPath + let newPath = mungePath $ intercalate [searchPathSeparator] (paths ++ oldPathSplit) + oldPath = mungePath $ intercalate [searchPathSeparator] oldPathSplit + -- TODO: This is a horrible hack to work around the fact that + -- setEnv can't take empty values as an argument + mungePath p | p == "" = "/dev/null" + | otherwise = p + setEnv "PATH" newPath + m `Exception.finally` setEnv "PATH" oldPath + -- | Log directory change in 'make' compatible syntax logDirChange :: (String -> IO ()) -> Maybe FilePath -> IO a -> IO a logDirChange _ Nothing m = m diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index a1573083863..a7e0612e53c 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -77,6 +77,12 @@ Extra-Source-Files: tests/IntegrationTests/multiple-source/p/p.cabal tests/IntegrationTests/multiple-source/q/Setup.hs tests/IntegrationTests/multiple-source/q/q.cabal + tests/IntegrationTests/new-build/BuildToolsPath.sh + tests/IntegrationTests/new-build/BuildToolsPath/A.hs + tests/IntegrationTests/new-build/BuildToolsPath/MyCustomPreprocessor.hs + tests/IntegrationTests/new-build/BuildToolsPath/build-tools-path.cabal + tests/IntegrationTests/new-build/BuildToolsPath/cabal.project + tests/IntegrationTests/new-build/BuildToolsPath/hello/Hello.hs tests/IntegrationTests/new-build/T3460.sh tests/IntegrationTests/new-build/T3460/C.hs tests/IntegrationTests/new-build/T3460/Setup.hs diff --git a/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath.sh b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath.sh new file mode 100644 index 00000000000..90f3107853e --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath.sh @@ -0,0 +1,3 @@ +. ./common.sh +cd BuildToolsPath +cabal new-build build-tools-path hello-world diff --git a/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/A.hs b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/A.hs new file mode 100644 index 00000000000..e5e075ad70c --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/A.hs @@ -0,0 +1,5 @@ +{-# OPTIONS_GHC -F -pgmF my-custom-preprocessor #-} +module A where + +a :: String +a = "0000" diff --git a/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/MyCustomPreprocessor.hs b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/MyCustomPreprocessor.hs new file mode 100644 index 00000000000..09c949ab176 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/MyCustomPreprocessor.hs @@ -0,0 +1,11 @@ +module Main where + +import System.Environment +import System.IO + +main :: IO () +main = do + (_:source:target:_) <- getArgs + let f '0' = '1' + f c = c + writeFile target . map f =<< readFile source diff --git a/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/build-tools-path.cabal b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/build-tools-path.cabal new file mode 100644 index 00000000000..12214a34357 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/build-tools-path.cabal @@ -0,0 +1,25 @@ +name: build-tools-path +version: 0.1.0.0 +synopsis: Checks build-tools are put in PATH +license: BSD3 +category: Testing +build-type: Simple +cabal-version: >=1.10 + +executable my-custom-preprocessor + main-is: MyCustomPreprocessor.hs + build-depends: base, directory + default-language: Haskell2010 + +library + exposed-modules: A + build-depends: base + build-tools: my-custom-preprocessor + -- ^ Note the internal dependency. + default-language: Haskell2010 + +executable hello-world + main-is: Hello.hs + build-depends: base, build-tools-path + default-language: Haskell2010 + hs-source-dirs: hello diff --git a/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/cabal.project b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/cabal.project new file mode 100644 index 00000000000..e6fdbadb439 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/cabal.project @@ -0,0 +1 @@ +packages: . diff --git a/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/hello/Hello.hs b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/hello/Hello.hs new file mode 100644 index 00000000000..89a5e5a026d --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/BuildToolsPath/hello/Hello.hs @@ -0,0 +1,6 @@ +module Main where + +import A + +main :: IO () +main = putStrLn a From c41ead762140be4c0a80e39b9980386edaaf17c3 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Wed, 17 Aug 2016 23:27:29 -0700 Subject: [PATCH 18/23] Rewrite ElaboratedConfiguredPackage. As requested by Duncan, the majority of fields that originally lived in ElaboratedPackage now are moved to ElaboratedConfiguredPackage under the prefix 'elab'. Some code has gotten simpler as a result. Signed-off-by: Edward Z. Yang --- .../Distribution/Client/CmdFreeze.hs | 15 +- .../Distribution/Client/ProjectBuilding.hs | 69 +- .../Client/ProjectOrchestration.hs | 48 +- .../Distribution/Client/ProjectPlanOutput.hs | 44 +- .../Distribution/Client/ProjectPlanning.hs | 918 +++++++++--------- .../Client/ProjectPlanning/Types.hs | 463 ++++----- cabal-install/tests/IntegrationTests2.hs | 27 +- 7 files changed, 749 insertions(+), 835 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdFreeze.hs b/cabal-install/Distribution/Client/CmdFreeze.hs index 95b41c5a981..8b6115e3e91 100644 --- a/cabal-install/Distribution/Client/CmdFreeze.hs +++ b/cabal-install/Distribution/Client/CmdFreeze.hs @@ -11,7 +11,6 @@ import Distribution.Client.ProjectConfig ( ProjectConfig(..), ProjectConfigShared(..) , commandLineFlagsToProjectConfig, writeProjectLocalFreezeConfig , findProjectRoot ) -import Distribution.Client.ProjectPlanning.Types import Distribution.Client.Targets ( UserConstraint(..) ) import Distribution.Solver.Types.ConstraintSource @@ -147,18 +146,16 @@ projectFreezeConstraints plan = flagAssignments = Map.fromList [ (pkgname, flags) - | InstallPlan.Configured pkg_or_comp <- InstallPlan.toList plan - , let pkg = getElaboratedPackage pkg_or_comp - flags = pkgFlagAssignment pkg - pkgname = packageName pkg + | InstallPlan.Configured elab <- InstallPlan.toList plan + , let flags = elabFlagAssignment elab + pkgname = packageName elab , not (null flags) ] localPackages :: Map PackageName () localPackages = Map.fromList - [ (packageName pkg, ()) - | InstallPlan.Configured pkg_or_comp <- InstallPlan.toList plan - , let pkg = getElaboratedPackage pkg_or_comp - , pkgLocalToProject pkg + [ (packageName elab, ()) + | InstallPlan.Configured elab <- InstallPlan.toList plan + , elabLocalToProject elab ] diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs index df60ac99c25..4d56fa93b72 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/Distribution/Client/ProjectBuilding.hs @@ -263,7 +263,7 @@ rebuildTargetsDryRun verbosity distDirLayout@DistDirLayout{..} shared = \install return BuildStatusPreExisting dryRunPkg (InstallPlan.Configured pkg) depsBuildStatus = do - mloc <- checkFetched (pkgSourceLocation (getElaboratedPackage pkg)) + mloc <- checkFetched (elabPkgSourceLocation pkg) case mloc of Nothing -> return BuildStatusDownload @@ -289,7 +289,7 @@ rebuildTargetsDryRun verbosity distDirLayout@DistDirLayout{..} shared = \install -> FilePath -> IO BuildStatus dryRunTarballPkg pkg depsBuildStatus tarball = - case pkgBuildStyle (getElaboratedPackage pkg) of + case elabBuildStyle pkg of BuildAndInstall -> return (BuildStatusUnpack tarball) BuildInplaceOnly -> do -- TODO: [nice to have] use a proper file monitor rather than this dir exists test @@ -435,8 +435,8 @@ newPackageFileMonitor DistDirLayout{distPackageCacheFile} dparams = -- packageFileMonitorKeyValues :: ElaboratedConfiguredPackage -> (ElaboratedConfiguredPackage, Set ComponentName) -packageFileMonitorKeyValues pkg_or_comp = - (pkg_or_comp_config, buildComponents) +packageFileMonitorKeyValues elab = + (elab_config, buildComponents) where -- The first part is the value used to guard (re)configuring the package. -- That is, if this value changes then we will reconfigure. @@ -445,25 +445,18 @@ packageFileMonitorKeyValues pkg_or_comp = -- do not affect the configure step need to be nulled out. Those parts are -- the specific targets that we're going to build. -- - pkg_or_comp_config = - case pkg_or_comp of - ElabPackage pkg -> ElabPackage $ pkg { - pkgBuildTargets = [], - pkgReplTarget = Nothing, - pkgBuildHaddocks = False - } - ElabComponent comp -> - ElabComponent $ comp { - elabComponentBuildTargets = [], - elabComponentReplTarget = Nothing, - elabComponentBuildHaddocks = False - } + elab_config = + elab { + elabBuildTargets = [], + elabReplTarget = Nothing, + elabBuildHaddocks = False + } -- The second part is the value used to guard the build step. So this is -- more or less the opposite of the first part, as it's just the info about -- what targets we're going to build. -- - buildComponents = pkgBuildTargetWholeComponents pkg_or_comp + buildComponents = elabBuildTargetWholeComponents elab -- | Do all the checks on whether a package has changed and thus needs either -- rebuilding or reconfiguring and rebuilding. @@ -718,11 +711,10 @@ rebuildTargets verbosity packageDBsToUse = -- all the package dbs we may need to create (Set.toList . Set.fromList) [ pkgdb - | InstallPlan.Configured pkg_or_comp <- InstallPlan.toList installPlan - , let pkg = getElaboratedPackage pkg_or_comp - , (pkgdb:_) <- map reverse [ pkgBuildPackageDBStack pkg, - pkgRegisterPackageDBStack pkg, - pkgSetupPackageDBStack pkg ] + | InstallPlan.Configured elab <- InstallPlan.toList installPlan + , (pkgdb:_) <- map reverse [ elabBuildPackageDBStack elab, + elabRegisterPackageDBStack elab, + elabSetupPackageDBStack elab ] ] -- | Given all the context and resources, (re)build an individual package. @@ -755,7 +747,6 @@ rebuildTarget verbosity BuildStatusUpToDate {} -> unexpectedState where unexpectedState = error "rebuildTarget: unexpected package status" - backing_pkg = getElaboratedPackage pkg downloadPhase = do downsrcloc <- annotateFailureNoLog DownloadFailed $ @@ -768,10 +759,10 @@ rebuildTarget verbosity unpackTarballPhase tarball = withTarballLocalDirectory verbosity distDirLayout tarball - (packageId pkg) (elabDistDirParams sharedPackageConfig pkg) (pkgBuildStyle backing_pkg) - (pkgDescriptionOverride backing_pkg) $ + (packageId pkg) (elabDistDirParams sharedPackageConfig pkg) (elabBuildStyle pkg) + (elabPkgDescriptionOverride pkg) $ - case pkgBuildStyle backing_pkg of + case elabBuildStyle pkg of BuildAndInstall -> buildAndInstall BuildInplaceOnly -> buildInplace buildStatus where @@ -782,7 +773,7 @@ rebuildTarget verbosity -- would only start from download or unpack phases. -- rebuildPhase buildStatus srcdir = - assert (pkgBuildStyle backing_pkg == BuildInplaceOnly) $ + assert (elabBuildStyle pkg == BuildInplaceOnly) $ buildInplace buildStatus srcdir builddir where @@ -835,10 +826,10 @@ asyncDownloadPackages verbosity withRepoCtx installPlan pkgsBuildStatus body where pkgsToDownload = ordNub $ - [ pkgSourceLocation (getElaboratedPackage pkg_or_comp) - | InstallPlan.Configured pkg_or_comp + [ elabPkgSourceLocation elab + | InstallPlan.Configured elab <- InstallPlan.reverseTopologicalOrder installPlan - , let uid = installedUnitId pkg_or_comp + , let uid = installedUnitId elab Just pkgBuildStatus = Map.lookup uid pkgsBuildStatus , BuildStatusDownload <- [pkgBuildStatus] ] @@ -851,9 +842,9 @@ waitAsyncPackageDownload :: Verbosity -> AsyncFetchMap -> ElaboratedConfiguredPackage -> IO DownloadedSourceLocation -waitAsyncPackageDownload verbosity downloadMap pkg_or_comp = do +waitAsyncPackageDownload verbosity downloadMap elab = do pkgloc <- waitAsyncFetchPackage verbosity downloadMap - (pkgSourceLocation (getElaboratedPackage pkg_or_comp)) + (elabPkgSourceLocation elab) case downloadedSourceLocation pkgloc of Just loc -> return loc Nothing -> fail "waitAsyncPackageDownload: unexpected source location" @@ -1011,10 +1002,10 @@ buildAndInstallUnpackedPackage verbosity --TODO: [required feature] docs and tests --TODO: [required feature] sudo re-exec - let dispname = case pkg of + let dispname = case elabPkgOrComp pkg of ElabPackage _ -> display pkgid ElabComponent comp -> display pkgid ++ " " - ++ maybe "custom" display (elabComponentName comp) + ++ maybe "custom" display (compComponentName comp) -- Configure phase when isParallelBuild $ @@ -1064,7 +1055,7 @@ buildAndInstallUnpackedPackage verbosity criticalSection registerLock $ Cabal.registerPackage verbosity compiler progdb HcPkg.MultiInstance - (pkgRegisterPackageDBStack (getElaboratedPackage pkg)) ipkg + (elabRegisterPackageDBStack pkg) ipkg return (Just ipkg) else return Nothing @@ -1118,7 +1109,7 @@ buildAndInstallUnpackedPackage verbosity setupWrapper verbosity scriptOptions { useLoggingHandle = mLogFileHandle } - (Just (pkgDescription (getElaboratedPackage pkg))) + (Just (elabPkgDescription pkg)) cmd flags args mlogFile :: Maybe FilePath @@ -1213,7 +1204,7 @@ buildInplaceUnpackedPackage verbosity let ipkg = ipkg0 { Installed.installedUnitId = ipkgid } criticalSection registerLock $ Cabal.registerPackage verbosity compiler progdb HcPkg.NoMultiInstance - (pkgRegisterPackageDBStack (getElaboratedPackage pkg)) + (elabRegisterPackageDBStack pkg) ipkg return (Just ipkg) @@ -1297,7 +1288,7 @@ buildInplaceUnpackedPackage verbosity setup cmd flags args = setupWrapper verbosity scriptOptions - (Just (pkgDescription (getElaboratedPackage pkg))) + (Just (elabPkgDescription pkg)) cmd flags args generateInstalledPackageInfo :: IO InstalledPackageInfo diff --git a/cabal-install/Distribution/Client/ProjectOrchestration.hs b/cabal-install/Distribution/Client/ProjectOrchestration.hs index af0491a08c5..bede782e857 100644 --- a/cabal-install/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/Distribution/Client/ProjectOrchestration.hs @@ -305,9 +305,8 @@ selectTargets verbosity targetDefaultComponents targetSpecificComponent return (pruneInstallPlanToTargets buildTargets' installPlan) where localPackages = - [ (pkgDescription pkg, pkgSourceLocation pkg) - | InstallPlan.Configured pkg_or_comp <- InstallPlan.toList installPlan - , let pkg = getElaboratedPackage pkg_or_comp ] + [ (elabPkgDescription elab, elabPkgSourceLocation elab) + | InstallPlan.Configured elab <- InstallPlan.toList installPlan ] --TODO: [code cleanup] is there a better way to identify local packages? @@ -376,10 +375,9 @@ resolveAndCheckTargets targetDefaultComponents projLocalPkgs = Map.fromListWith (++) - [ (packageName pkg, [installedUnitId pkg_or_comp]) - | InstallPlan.Configured pkg_or_comp <- InstallPlan.toList installPlan - , let pkg = getElaboratedPackage pkg_or_comp - , case pkgSourceLocation pkg of + [ (packageName elab, [installedUnitId elab]) + | InstallPlan.Configured elab <- InstallPlan.toList installPlan + , case elabPkgSourceLocation elab of LocalUnpackedPackage _ -> True; _ -> False --TODO: [code cleanup] is there a better way to identify local packages? ] @@ -438,33 +436,31 @@ printPlan verbosity = notice verbosity $ unlines $ ("In order, the following " ++ wouldWill ++ " be built (use -v for more details):") - : map showPkg pkgs + : map (\(ReadyPackage pkg) -> showPkg pkg (elabPkgOrComp pkg)) pkgs where pkgs = InstallPlan.executionOrder elaboratedPlan wouldWill | buildSettingDryRun = "would" | otherwise = "will" - showPkg (ReadyPackage (ElabPackage pkg)) = display (packageId pkg) - showPkg (ReadyPackage (ElabComponent comp)) = - display (packageId (elabComponentPackage comp)) ++ - " (" ++ maybe "custom" display (elabComponentName comp) ++ ")" + showPkg elab (ElabPackage _) = display (packageId elab) + showPkg elab (ElabComponent comp) = + display (packageId elab) ++ + " (" ++ maybe "custom" display (compComponentName comp) ++ ")" showPkgAndReason :: ElaboratedReadyPackage -> String - showPkgAndReason (ReadyPackage pkg_or_comp) = - display (installedUnitId pkg_or_comp) ++ - (case pkg_or_comp of - ElabPackage _ -> showTargets pkg ++ showStanzas pkg + showPkgAndReason (ReadyPackage elab) = + display (installedUnitId elab) ++ + (case elabPkgOrComp elab of + ElabPackage pkg -> showTargets elab ++ showStanzas pkg ElabComponent comp -> - " (" ++ maybe "custom" display (elabComponentName comp) ++ ")") ++ - showFlagAssignment (nonDefaultFlags pkg) ++ - let buildStatus = pkgsBuildStatus Map.! installedUnitId pkg_or_comp in + " (" ++ maybe "custom" display (compComponentName comp) ++ ")") ++ + showFlagAssignment (nonDefaultFlags elab) ++ + let buildStatus = pkgsBuildStatus Map.! installedUnitId elab in " (" ++ showBuildStatus buildStatus ++ ")" - where - pkg = getElaboratedPackage pkg_or_comp - nonDefaultFlags :: ElaboratedPackage -> FlagAssignment - nonDefaultFlags pkg = pkgFlagAssignment pkg \\ pkgFlagDefaults pkg + nonDefaultFlags :: ElaboratedConfiguredPackage -> FlagAssignment + nonDefaultFlags elab = elabFlagAssignment elab \\ elabFlagDefaults elab showStanzas pkg = concat $ [ " *test" @@ -472,10 +468,10 @@ printPlan verbosity ++ [ " *bench" | BenchStanzas `Set.member` pkgStanzasEnabled pkg ] - showTargets pkg - | null (pkgBuildTargets pkg) = "" + showTargets elab + | null (elabBuildTargets elab) = "" | otherwise - = " (" ++ unwords [ showComponentTarget (packageId pkg) t | t <- pkgBuildTargets pkg ] + = " (" ++ unwords [ showComponentTarget (packageId elab) t | t <- elabBuildTargets elab ] ++ ")" -- TODO: [code cleanup] this should be a proper function in a proper place diff --git a/cabal-install/Distribution/Client/ProjectPlanOutput.hs b/cabal-install/Distribution/Client/ProjectPlanOutput.hs index 44ce17c364d..d51f158b713 100644 --- a/cabal-install/Distribution/Client/ProjectPlanOutput.hs +++ b/cabal-install/Distribution/Client/ProjectPlanOutput.hs @@ -69,38 +69,24 @@ encodePlanAsJson elaboratedInstallPlan _elaboratedSharedConfig = ] -- pkg :: ElaboratedPackage - toJ (InstallPlan.Configured (ElabPackage pkg)) = - J.object + toJ (InstallPlan.Configured elab) = + J.object $ [ "type" J..= J.String "configured" - , "id" J..= (jdisplay . installedUnitId) pkg - , "components" J..= components - , "depends" J..= map (jdisplay . confInstId) flat_deps + , "id" J..= (jdisplay . installedUnitId) elab + , "depends" J..= map (jdisplay . confInstId) (elabLibDependencies elab) , "flags" J..= J.object [ fn J..= v | (PD.FlagName fn,v) <- - pkgFlagAssignment pkg ] - ] - where - flat_deps = ordNub (ComponentDeps.flatDeps (pkgDependencies pkg)) - components = J.object - [ comp2str c J..= J.object - [ "depends" J..= map (jdisplay . confInstId) v ] - -- NB: does NOT contain order-only dependencies - | (c,v) <- ComponentDeps.toList (pkgDependencies pkg) ] - - -- ecp :: ElaboratedConfiguredPackage - toJ (InstallPlan.Configured (ElabComponent comp)) = - J.object - [ "type" J..= J.String "configured-component" - , "id" J..= (jdisplay . installedUnitId) comp - , "name" J..= J.String (comp2str (elabComponent comp)) - , "flags" J..= J.object [ fn J..= v - | (PD.FlagName fn,v) <- - pkgFlagAssignment pkg ] - -- NB: does NOT contain order-only dependencies - , "depends" J..= map (jdisplay . confInstId) (elabComponentDependencies comp) - ] - where - pkg = elabComponentPackage comp + elabFlagAssignment elab ] + ] ++ + case elabPkgOrComp elab of + ElabPackage pkg -> + let components = J.object + [ comp2str c J..= J.object + [ "depends" J..= map (jdisplay . confInstId) v ] + -- NB: does NOT contain non-lib dependencies + | (c,v) <- ComponentDeps.toList (pkgLibDependencies pkg) ] + in ["components" J..= components ] + ElabComponent _ -> [] -- TODO: maybe move this helper to "ComponentDeps" module? -- Or maybe define a 'Text' instance? diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index d75256632cd..c2f01ad2bcd 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -29,7 +29,7 @@ module Distribution.Client.ProjectPlanning ( -- * Utils required for building pkgHasEphemeralBuildTargets, - pkgBuildTargetWholeComponents, + elabBuildTargetWholeComponents, -- * Setup.hs CLI flags for building setupHsScriptOptions, @@ -180,48 +180,71 @@ import System.Directory (doesDirectoryExist) -- data BuildStyle = --- | Check that an 'ElaboratedPackage' actually makes +-- | Check that an 'ElaboratedConfiguredPackage' actually makes -- sense under some 'ElaboratedSharedConfig'. --- --- TODO: I guess maybe there's some 'ElaboratedComponent' sanity --- check one could also do -sanityCheckElaboratedPackage :: ElaboratedSharedConfig - -> ElaboratedPackage - -> a - -> a -sanityCheckElaboratedPackage sharedConfig - pkg@ElaboratedPackage{..} - ret = - - -- we should only have enabled stanzas that actually can be built - -- (according to the solver) - assert (pkgStanzasEnabled `Set.isSubsetOf` pkgStanzasAvailable) - - -- the stanzas that the user explicitly requested should be - -- enabled (by the previous test, they are also available) - . assert (Map.keysSet (Map.filter id pkgStanzasRequested) - `Set.isSubsetOf` pkgStanzasEnabled) - - -- the stanzas explicitly disabled should not be available - . assert (Set.null (Map.keysSet (Map.filter not pkgStanzasRequested) - `Set.intersection` pkgStanzasAvailable)) +sanityCheckElaboratedConfiguredPackage + :: ElaboratedSharedConfig + -> ElaboratedConfiguredPackage + -> a + -> a +sanityCheckElaboratedConfiguredPackage sharedConfig + elab@ElaboratedConfiguredPackage{..} = + (case elabPkgOrComp of + ElabPackage pkg -> sanityCheckElaboratedPackage elab pkg + ElabComponent comp -> sanityCheckElaboratedComponent elab comp) -- either a package is being built inplace, or the -- 'installedPackageId' we assigned is consistent with -- the 'hashedInstalledPackageId' we would compute from -- the elaborated configured package - . assert (pkgBuildStyle == BuildInplaceOnly || - pkgInstalledId == hashedInstalledPackageId - (packageHashInputs sharedConfig (ElabPackage pkg))) + . assert (elabBuildStyle == BuildInplaceOnly || + unitIdComponentId elabUnitId == hashedInstalledPackageId + (packageHashInputs sharedConfig elab)) + + -- the stanzas explicitly disabled should not be available + . assert (Set.null (Map.keysSet (Map.filter not elabStanzasRequested) + `Set.intersection` elabStanzasAvailable)) -- either a package is built inplace, or we are not attempting to -- build any test suites or benchmarks (we never build these -- for remote packages!) - . assert (pkgBuildStyle == BuildInplaceOnly || - Set.null pkgStanzasAvailable) - - $ ret + . assert (elabBuildStyle == BuildInplaceOnly || + Set.null elabStanzasAvailable) + +sanityCheckElaboratedComponent + :: ElaboratedConfiguredPackage + -> ElaboratedComponent + -> a + -> a +sanityCheckElaboratedComponent ElaboratedConfiguredPackage{..} + ElaboratedComponent{..} = + + -- Should not be building bench or test if not inplace. + assert (elabBuildStyle == BuildInplaceOnly || + case compComponentName of + Nothing -> True + Just CLibName -> True + Just (CSubLibName _) -> True + Just (CExeName _) -> True + Just (CBenchName _) -> False + Just (CTestName _) -> False) + + +sanityCheckElaboratedPackage + :: ElaboratedConfiguredPackage + -> ElaboratedPackage + -> a + -> a +sanityCheckElaboratedPackage ElaboratedConfiguredPackage{..} + ElaboratedPackage{..} = + -- we should only have enabled stanzas that actually can be built + -- (according to the solver) + assert (pkgStanzasEnabled `Set.isSubsetOf` elabStanzasAvailable) + -- the stanzas that the user explicitly requested should be + -- enabled (by the previous test, they are also available) + . assert (Map.keysSet (Map.filter id elabStanzasRequested) + `Set.isSubsetOf` pkgStanzasEnabled) ------------------------------------------------------------------------------ -- * Deciding what to do: making an 'ElaboratedInstallPlan' @@ -1021,103 +1044,106 @@ elaborateInstallPlan platform compiler compilerprogdb [InstallPlan.PreExisting pkg] SolverInstallPlan.Configured pkg -> - map InstallPlan.Configured (elaborateAndExpandSolverPackage mapDep pkg) - - elaborateAndExpandSolverPackage + -- SolverPackage + let pd = PD.packageDescription (packageDescription (solverPkgSource pkg)) + eligible + -- At this point in time, only non-Custom setup scripts + -- are supported. Implementing per-component builds with + -- Custom would require us to create a new 'ElabSetup' + -- type, and teach all of the code paths how to handle it. + -- Once you've implemented that, delete this guard. + | fromMaybe PD.Custom (PD.buildType pd) == PD.Custom + = False + -- Only non-Custom or sufficiently recent Custom + -- scripts can be expanded. + | otherwise + = (fromMaybe PD.Custom (PD.buildType pd) /= PD.Custom + -- This is when we started distributing dependencies + -- per component (instead of glomming them altogether + -- and distributing to everything.) I didn't feel + -- like implementing the legacy behavior. + && PD.specVersion pd >= Version [1,7,1] [] + ) + || PD.specVersion pd >= Version [2,0,0] [] + in map InstallPlan.Configured $ if eligible + then elaborateSolverToComponents mapDep pkg + else [elaborateSolverToPackage mapDep pkg] + + elaborateSolverToComponents :: (SolverId -> [ElaboratedPlanPackage]) -> SolverPackage UnresolvedPkgLoc -> [ElaboratedConfiguredPackage] - elaborateAndExpandSolverPackage mapDep spkg - | eligible - , Right g <- comps_graph - = map ElabComponent (snd (mapAccumL buildComponent (Map.empty, Map.empty) g)) - | otherwise - = [ElabPackage pkg] + elaborateSolverToComponents mapDep spkg@(SolverPackage _ _ _ deps0) + = snd (mapAccumL buildComponent (Map.empty, Map.empty) comps_graph) where - pkg = elaborateSolverPackage mapDep spkg - pkgid = pkgSourceId pkg - pd = pkgDescription pkg - eligible - -- TODO - -- At this point in time, only non-Custom setup scripts - -- are supported. Implementing per-component builds with - -- Custom would require us to create a new 'ElabSetup' - -- type, and teach all of the code paths how to handle it. - -- Once you've implemented that, delete this guard. - | fromMaybe PD.Custom (PD.buildType pd) == PD.Custom - = False - -- Only non-Custom or sufficiently recent Custom - -- scripts can be expanded. - | otherwise - = (fromMaybe PD.Custom (PD.buildType pd) /= PD.Custom - -- This is when we started distributing dependencies - -- per component (instead of glomming them altogether - -- and distributing to everything.) I didn't feel - -- like implementing the legacy behavior. - && PD.specVersion pd >= Version [1,7,1] [] - ) - || PD.specVersion pd >= Version [2,0,0] [] - internalPkgSet = pkgInternalPackages pkg - comps_graph = Cabal.mkComponentsGraph (pkgEnabled pkg) pd internalPkgSet + elab0@ElaboratedConfiguredPackage{..} = elaborateSolverToCommon mapDep spkg + comps_graph = + case Cabal.mkComponentsGraph + elabEnabledSpec + elabPkgDescription + elabInternalPackages of + Left _ -> error ("component cycle in " ++ display elabPkgSourceId) + Right g -> g buildComponent :: (Map PackageName ConfiguredId, Map String (ConfiguredId, FilePath)) -> (Cabal.Component, [Cabal.ComponentName]) -> ((Map PackageName ConfiguredId, Map String (ConfiguredId, FilePath)), - ElaboratedComponent) + ElaboratedConfiguredPackage) buildComponent (internal_map, exe_map) (comp, _cdeps) = - ((internal_map', exe_map'), ecomp) + ((internal_map', exe_map'), elab) where - cname = Cabal.componentName comp - cname' = CD.componentNameToComponent cname - ecomp = ElaboratedComponent { - elabComponent = cname', - elabComponentName = Just cname, - elabComponentId = SimpleUnitId cid, -- Backpack later! - elabComponentPackage = pkg, - elabComponentDependencies = - CD.select (== cname') (pkgDependencies pkg) ++ - internal_lib_deps, - elabComponentExeDependencies = - internal_exe_deps, - elabComponentExeDependencyPaths = - internal_exe_dep_paths, - elabComponentInstallDirs = installDirs, - -- These are filled in later - elabComponentBuildTargets = [], - elabComponentReplTarget = Nothing, - elabComponentBuildHaddocks = False - } + elab = elab0 { + elabUnitId = SimpleUnitId cid, -- Backpack later! + elabInstallDirs = install_dirs, + elabRequiresRegistration = requires_reg, + elabPkgOrComp = ElabComponent $ ElaboratedComponent {..} + } + cid :: ComponentId - cid = case pkgBuildStyle pkg of + cid = case elabBuildStyle of BuildInplaceOnly -> ComponentId $ - display pkgid ++ "-inplace" ++ + display elabPkgSourceId ++ "-inplace" ++ (case Cabal.componentNameString cname of Nothing -> "" Just s -> "-" ++ s) BuildAndInstall -> - -- TODO: change these types hashedInstalledPackageId (packageHashInputs elaboratedSharedConfig - (ElabComponent ecomp)) -- knot tied - confid = ConfiguredId pkgid cid + elab) -- knot tied + + cname = Cabal.componentName comp + requires_reg = case cname of + CLibName -> True + CSubLibName _ -> True + _ -> False + compComponentName = Just cname + compSolverName = CD.componentNameToComponent cname + compLibDependencies = + concatMap (elaborateSolverId mapDep) + (CD.select (== compSolverName) deps0) ++ + internal_lib_deps bi = Cabal.componentBuildInfo comp + confid = ConfiguredId elabPkgSourceId cid + + compSetupDependencies = concatMap (elaborateSolverId mapDep) (CD.setupDeps deps0) internal_lib_deps = [ confid' - | Dependency pkgname _ <- PD.targetBuildDepends bi - , Just confid' <- [Map.lookup pkgname internal_map] ] - (internal_exe_deps, internal_exe_dep_paths) + | Dependency pkgname _ <- PD.targetBuildDepends bi + , Just confid' <- [Map.lookup pkgname internal_map] ] + (compExeDependencies, compExeDependencyPaths) = unzip $ [ (confInstId confid', path) | Dependency (PackageName toolname) _ <- PD.buildTools bi - , toolname `elem` map PD.exeName (PD.executables pd) + , toolname `elem` map PD.exeName (PD.executables elabPkgDescription) , Just (confid', path) <- [Map.lookup toolname exe_map] ] + internal_map' = case cname of CLibName - -> Map.insert (packageName pkg) confid internal_map + -> Map.insert (packageName elabPkgSourceId) confid internal_map CSubLibName libname -> Map.insert (PackageName libname) confid internal_map _ -> internal_map @@ -1125,6 +1151,7 @@ elaborateInstallPlan platform compiler compilerprogdb CExeName exename -> Map.insert exename (confid, inplace_bin_dir) exe_map _ -> exe_map + -- NB: For inplace NOT InstallPaths.bindir installDirs; for an -- inplace build those values are utter nonsense. So we -- have to guess where the directory is going to be. @@ -1134,20 +1161,19 @@ elaborateInstallPlan platform compiler compilerprogdb inplace_bin_dir | shouldBuildInplaceOnly spkg = distBuildDirectory - (elabDistDirParams elaboratedSharedConfig (ElabComponent ecomp)) + (elabDistDirParams elaboratedSharedConfig elab) "build" case Cabal.componentNameString cname of Just n -> n Nothing -> "" | otherwise - = InstallDirs.bindir installDirs + = InstallDirs.bindir install_dirs - - installDirs + install_dirs | shouldBuildInplaceOnly spkg -- use the ordinary default install dirs = (InstallDirs.absoluteInstallDirs - pkgid - (SimpleUnitId cid) -- differs! + elabPkgSourceId + (SimpleUnitId cid) (compilerInfo compiler) InstallDirs.NoCopyDest platform @@ -1164,64 +1190,111 @@ elaborateInstallPlan platform compiler compilerprogdb (compilerId compiler) cid - - elaborateSolverPackage :: (SolverId -> [ElaboratedPlanPackage]) - -> SolverPackage UnresolvedPkgLoc - -> ElaboratedPackage - elaborateSolverPackage + elaborateSolverId :: (SolverId -> [ElaboratedPlanPackage]) + -> SolverId -> [ConfiguredId] + elaborateSolverId mapDep = map configuredId . filter is_lib . mapDep + where is_lib (InstallPlan.PreExisting _) = True + is_lib (InstallPlan.Configured elab) = + case elabPkgOrComp elab of + ElabPackage _ -> True + ElabComponent comp -> compSolverName comp == CD.ComponentLib + + elaborateSolverToPackage :: (SolverId -> [ElaboratedPlanPackage]) + -> SolverPackage UnresolvedPkgLoc + -> ElaboratedConfiguredPackage + elaborateSolverToPackage mapDep - pkg@(SolverPackage (SourcePackage pkgid gdesc srcloc descOverride) - flags stanzas deps0) = - elaboratedPackage - where - -- Knot tying: the final elaboratedPackage includes the + pkg@(SolverPackage (SourcePackage pkgid _gdesc _srcloc _descOverride) + _flags _stanzas deps0) = + -- Knot tying: the final elab includes the -- pkgInstalledId, which is calculated by hashing many -- of the other fields of the elaboratedPackage. - -- - elaboratedPackage = ElaboratedPackage {..} - - deps = fmap (concatMap elaborateSolverId) deps0 + elab + where + elab0@ElaboratedConfiguredPackage{..} = elaborateSolverToCommon mapDep pkg + elab = elab0 { + elabUnitId = SimpleUnitId pkgInstalledId, + elabInstallDirs = install_dirs, + elabRequiresRegistration = requires_reg, + elabPkgOrComp = ElabPackage $ ElaboratedPackage {..} + } - elaborateSolverId = map configuredId . filter is_lib . mapDep - where is_lib (InstallPlan.PreExisting _) = True - is_lib (InstallPlan.Configured (ElabPackage _)) = True - is_lib (InstallPlan.Configured (ElabComponent comp)) - = elabComponent comp == CD.ComponentLib + deps = fmap (concatMap (elaborateSolverId mapDep)) deps0 + requires_reg = PD.hasPublicLib elabPkgDescription pkgInstalledId | shouldBuildInplaceOnly pkg = ComponentId (display pkgid ++ "-inplace") | otherwise - = assert (isJust pkgSourceHash) $ + = assert (isJust elabPkgSourceHash) $ hashedInstalledPackageId (packageHashInputs elaboratedSharedConfig - (ElabPackage elaboratedPackage)) -- recursive use of elaboratedPackage + elab) -- recursive use of elab | otherwise = error $ "elaborateInstallPlan: non-inplace package " ++ " is missing a source hash: " ++ display pkgid - -- All the other fields of the ElaboratedConfiguredPackage - -- - pkgSourceId = pkgid - pkgDescription = let Right (desc, _) = + pkgLibDependencies = deps + + -- Filled in later + pkgStanzasEnabled = Set.empty + + install_dirs + | shouldBuildInplaceOnly pkg + -- use the ordinary default install dirs + = (InstallDirs.absoluteInstallDirs + pkgid + (SimpleUnitId pkgInstalledId) + (compilerInfo compiler) + InstallDirs.NoCopyDest + platform + defaultInstallDirs) { + + InstallDirs.libsubdir = "", -- absoluteInstallDirs sets these as + InstallDirs.datasubdir = "" -- 'undefined' but we have to use + } -- them as "Setup.hs configure" args + + | otherwise + -- use special simplified install dirs + = storePackageInstallDirs + cabalDirLayout + (compilerId compiler) + pkgInstalledId + + elaborateSolverToCommon :: (SolverId -> [ElaboratedPlanPackage]) + -> SolverPackage UnresolvedPkgLoc + -> ElaboratedConfiguredPackage + elaborateSolverToCommon mapDep + pkg@(SolverPackage (SourcePackage pkgid gdesc srcloc descOverride) + flags stanzas deps0) = + elaboratedPackage + where + elaboratedPackage = ElaboratedConfiguredPackage {..} + + -- These get filled in later + elabUnitId = error "elaborateSolverToCommon: elabUnitId" + elabPkgOrComp = error "elaborateSolverToCommon: elabPkgOrComp" + elabInstallDirs = error "elaborateSolverToCommon: elabInstallDirs" + elabRequiresRegistration = error "elaborateSolverToCommon: elabRequiresRegistration" + + elabPkgSourceId = pkgid + elabPkgDescription = let Right (desc, _) = PD.finalizePD - flags pkgEnabled (const True) + flags elabEnabledSpec (const True) platform (compilerInfo compiler) [] gdesc in desc - pkgInternalPackages = Cabal.getInternalPackages gdesc - pkgFlagAssignment = flags - pkgFlagDefaults = [ (Cabal.flagName flag, Cabal.flagDefault flag) + elabInternalPackages = Cabal.getInternalPackages gdesc + elabFlagAssignment = flags + elabFlagDefaults = [ (Cabal.flagName flag, Cabal.flagDefault flag) | flag <- PD.genPackageFlags gdesc ] - pkgDependencies = deps - -- TODO: add support for dependencies on executables - pkgExeDependencies = CD.empty - pkgEnabled = enableStanzas stanzas - pkgStanzasAvailable = Set.fromList stanzas - pkgStanzasRequested = + + elabEnabledSpec = enableStanzas stanzas + elabStanzasAvailable = Set.fromList stanzas + elabStanzasRequested = -- NB: even if a package stanza is requested, if the package -- doesn't actually have any of that stanza we omit it from -- the request, to ensure that we don't decide that this @@ -1229,9 +1302,9 @@ elaborateInstallPlan platform compiler compilerprogdb -- because the ElaboratedConfiguredPackage is where we test -- whether or not there have been changes.) Map.fromList $ [ (TestStanzas, v) | v <- maybeToList tests - , _ <- PD.testSuites pkgDescription ] + , _ <- PD.testSuites elabPkgDescription ] ++ [ (BenchStanzas, v) | v <- maybeToList benchmarks - , _ <- PD.benchmarks pkgDescription ] + , _ <- PD.benchmarks elabPkgDescription ] where tests, benchmarks :: Maybe Bool tests = perPkgOptionMaybe pkgid packageConfigTests @@ -1245,109 +1318,87 @@ elaborateInstallPlan platform compiler compilerprogdb -- but this function doesn't know what is installed (since -- we haven't improved the plan yet), so we do it in another pass. -- Check the comments of those functions for more details. - pkgStanzasEnabled = Set.empty - pkgBuildTargets = [] - pkgReplTarget = Nothing - pkgBuildHaddocks = False - - pkgSourceLocation = srcloc - pkgSourceHash = Map.lookup pkgid sourcePackageHashes - pkgLocalToProject = isLocalToProject pkg - pkgBuildStyle = if shouldBuildInplaceOnly pkg + elabBuildTargets = [] + elabReplTarget = Nothing + elabBuildHaddocks = False + + elabPkgSourceLocation = srcloc + elabPkgSourceHash = Map.lookup pkgid sourcePackageHashes + elabLocalToProject = isLocalToProject pkg + elabBuildStyle = if shouldBuildInplaceOnly pkg then BuildInplaceOnly else BuildAndInstall - pkgBuildPackageDBStack = buildAndRegisterDbs - pkgRegisterPackageDBStack = buildAndRegisterDbs - pkgRequiresRegistration = PD.hasPublicLib pkgDescription + elabBuildPackageDBStack = buildAndRegisterDbs + elabRegisterPackageDBStack = buildAndRegisterDbs - pkgSetupScriptStyle = packageSetupScriptStyle pkgDescription - pkgSetupScriptCliVersion = packageSetupScriptSpecVersion - pkgSetupScriptStyle pkgDescription deps - pkgSetupPackageDBStack = buildAndRegisterDbs + elabSetupScriptStyle = packageSetupScriptStyle elabPkgDescription + -- Computing the deps here is a little awful + deps = fmap (concatMap (elaborateSolverId mapDep)) deps0 + elabSetupScriptCliVersion = packageSetupScriptSpecVersion + elabSetupScriptStyle elabPkgDescription deps + elabSetupPackageDBStack = buildAndRegisterDbs buildAndRegisterDbs | shouldBuildInplaceOnly pkg = inplacePackageDbs | otherwise = storePackageDbs - pkgDescriptionOverride = descOverride + elabPkgDescriptionOverride = descOverride - pkgVanillaLib = perPkgOptionFlag pkgid True packageConfigVanillaLib --TODO: [required feature]: also needs to be handled recursively - pkgSharedLib = pkgid `Set.member` pkgsUseSharedLibrary - pkgDynExe = perPkgOptionFlag pkgid False packageConfigDynExe - pkgGHCiLib = perPkgOptionFlag pkgid False packageConfigGHCiLib --TODO: [required feature] needs to default to enabled on windows still + elabVanillaLib = perPkgOptionFlag pkgid True packageConfigVanillaLib --TODO: [required feature]: also needs to be handled recursively + elabSharedLib = pkgid `Set.member` pkgsUseSharedLibrary + elabDynExe = perPkgOptionFlag pkgid False packageConfigDynExe + elabGHCiLib = perPkgOptionFlag pkgid False packageConfigGHCiLib --TODO: [required feature] needs to default to enabled on windows still - pkgProfExe = perPkgOptionFlag pkgid False packageConfigProf - pkgProfLib = pkgid `Set.member` pkgsUseProfilingLibrary + elabProfExe = perPkgOptionFlag pkgid False packageConfigProf + elabProfLib = pkgid `Set.member` pkgsUseProfilingLibrary - (pkgProfExeDetail, - pkgProfLibDetail) = perPkgOptionLibExeFlag pkgid ProfDetailDefault + (elabProfExeDetail, + elabProfLibDetail) = perPkgOptionLibExeFlag pkgid ProfDetailDefault packageConfigProfDetail packageConfigProfLibDetail - pkgCoverage = perPkgOptionFlag pkgid False packageConfigCoverage + elabCoverage = perPkgOptionFlag pkgid False packageConfigCoverage - pkgOptimization = perPkgOptionFlag pkgid NormalOptimisation packageConfigOptimization - pkgSplitObjs = perPkgOptionFlag pkgid False packageConfigSplitObjs - pkgStripLibs = perPkgOptionFlag pkgid False packageConfigStripLibs - pkgStripExes = perPkgOptionFlag pkgid False packageConfigStripExes - pkgDebugInfo = perPkgOptionFlag pkgid NoDebugInfo packageConfigDebugInfo + elabOptimization = perPkgOptionFlag pkgid NormalOptimisation packageConfigOptimization + elabSplitObjs = perPkgOptionFlag pkgid False packageConfigSplitObjs + elabStripLibs = perPkgOptionFlag pkgid False packageConfigStripLibs + elabStripExes = perPkgOptionFlag pkgid False packageConfigStripExes + elabDebugInfo = perPkgOptionFlag pkgid NoDebugInfo packageConfigDebugInfo -- Combine the configured compiler prog settings with the user-supplied -- config. For the compiler progs any user-supplied config was taken -- into account earlier when configuring the compiler so its ok that -- our configured settings for the compiler override the user-supplied -- config here. - pkgProgramPaths = Map.fromList + elabProgramPaths = Map.fromList [ (programId prog, programPath prog) | prog <- configuredPrograms compilerprogdb ] <> perPkgOptionMapLast pkgid packageConfigProgramPaths - pkgProgramArgs = Map.fromList + elabProgramArgs = Map.fromList [ (programId prog, args) | prog <- configuredPrograms compilerprogdb , let args = programOverrideArgs prog , not (null args) ] <> perPkgOptionMapMappend pkgid packageConfigProgramArgs - pkgProgramPathExtra = perPkgOptionNubList pkgid packageConfigProgramPathExtra - pkgConfigureScriptArgs = perPkgOptionList pkgid packageConfigConfigureArgs - pkgExtraLibDirs = perPkgOptionList pkgid packageConfigExtraLibDirs - pkgExtraFrameworkDirs = perPkgOptionList pkgid packageConfigExtraFrameworkDirs - pkgExtraIncludeDirs = perPkgOptionList pkgid packageConfigExtraIncludeDirs - pkgProgPrefix = perPkgOptionMaybe pkgid packageConfigProgPrefix - pkgProgSuffix = perPkgOptionMaybe pkgid packageConfigProgSuffix - - -- TODO: This needs to be overridden in per-component mode - pkgInstallDirs - | shouldBuildInplaceOnly pkg - -- use the ordinary default install dirs - = (InstallDirs.absoluteInstallDirs - pkgid - (SimpleUnitId pkgInstalledId) - (compilerInfo compiler) - InstallDirs.NoCopyDest - platform - defaultInstallDirs) { - - InstallDirs.libsubdir = "", -- absoluteInstallDirs sets these as - InstallDirs.datasubdir = "" -- 'undefined' but we have to use - } -- them as "Setup.hs configure" args - - | otherwise - -- use special simplified install dirs - = storePackageInstallDirs - cabalDirLayout - (compilerId compiler) - pkgInstalledId - - pkgHaddockHoogle = perPkgOptionFlag pkgid False packageConfigHaddockHoogle - pkgHaddockHtml = perPkgOptionFlag pkgid False packageConfigHaddockHtml - pkgHaddockHtmlLocation = perPkgOptionMaybe pkgid packageConfigHaddockHtmlLocation - pkgHaddockExecutables = perPkgOptionFlag pkgid False packageConfigHaddockExecutables - pkgHaddockTestSuites = perPkgOptionFlag pkgid False packageConfigHaddockTestSuites - pkgHaddockBenchmarks = perPkgOptionFlag pkgid False packageConfigHaddockBenchmarks - pkgHaddockInternal = perPkgOptionFlag pkgid False packageConfigHaddockInternal - pkgHaddockCss = perPkgOptionMaybe pkgid packageConfigHaddockCss - pkgHaddockHscolour = perPkgOptionFlag pkgid False packageConfigHaddockHscolour - pkgHaddockHscolourCss = perPkgOptionMaybe pkgid packageConfigHaddockHscolourCss - pkgHaddockContents = perPkgOptionMaybe pkgid packageConfigHaddockContents + elabProgramPathExtra = perPkgOptionNubList pkgid packageConfigProgramPathExtra + elabConfigureScriptArgs = perPkgOptionList pkgid packageConfigConfigureArgs + elabExtraLibDirs = perPkgOptionList pkgid packageConfigExtraLibDirs + elabExtraFrameworkDirs = perPkgOptionList pkgid packageConfigExtraFrameworkDirs + elabExtraIncludeDirs = perPkgOptionList pkgid packageConfigExtraIncludeDirs + elabProgPrefix = perPkgOptionMaybe pkgid packageConfigProgPrefix + elabProgSuffix = perPkgOptionMaybe pkgid packageConfigProgSuffix + + + elabHaddockHoogle = perPkgOptionFlag pkgid False packageConfigHaddockHoogle + elabHaddockHtml = perPkgOptionFlag pkgid False packageConfigHaddockHtml + elabHaddockHtmlLocation = perPkgOptionMaybe pkgid packageConfigHaddockHtmlLocation + elabHaddockExecutables = perPkgOptionFlag pkgid False packageConfigHaddockExecutables + elabHaddockTestSuites = perPkgOptionFlag pkgid False packageConfigHaddockTestSuites + elabHaddockBenchmarks = perPkgOptionFlag pkgid False packageConfigHaddockBenchmarks + elabHaddockInternal = perPkgOptionFlag pkgid False packageConfigHaddockInternal + elabHaddockCss = perPkgOptionMaybe pkgid packageConfigHaddockCss + elabHaddockHscolour = perPkgOptionFlag pkgid False packageConfigHaddockHscolour + elabHaddockHscolourCss = perPkgOptionMaybe pkgid packageConfigHaddockHscolourCss + elabHaddockContents = perPkgOptionMaybe pkgid packageConfigHaddockContents perPkgOptionFlag :: PackageId -> a -> (PackageConfig -> Flag a) -> a perPkgOptionMaybe :: PackageId -> (PackageConfig -> Flag a) -> Maybe a @@ -1474,9 +1525,9 @@ elaborateInstallPlan platform compiler compilerprogdb --TODO: this needs to report some user target/config errors -elaboratePackageTargets :: ElaboratedPackage -> [PackageTarget] +elaboratePackageTargets :: ElaboratedConfiguredPackage -> [PackageTarget] -> ([ComponentTarget], Maybe ComponentTarget, Bool) -elaboratePackageTargets ElaboratedPackage{..} targets = +elaboratePackageTargets ElaboratedConfiguredPackage{..} targets = let buildTargets = nubComponentTargets . map compatSubComponentTargets . concatMap elaborateBuildTarget @@ -1503,7 +1554,7 @@ elaboratePackageTargets ElaboratedPackage{..} targets = pkgDefaultComponents = [ ComponentTarget cname WholeComponent - | c <- Cabal.pkgComponents pkgDescription + | c <- Cabal.pkgComponents elabPkgDescription , PD.buildable (Cabal.componentBuildInfo c) , let cname = Cabal.componentName c , enabledOptionalStanza cname @@ -1512,7 +1563,7 @@ elaboratePackageTargets ElaboratedPackage{..} targets = enabledOptionalStanza cname = case componentOptionalStanza cname of Nothing -> True - Just stanza -> Map.lookup stanza pkgStanzasRequested + Just stanza -> Map.lookup stanza elabStanzasRequested == Just True -- Not all Cabal Setup.hs versions support sub-component targets, so switch @@ -1545,25 +1596,20 @@ elaboratePackageTargets ElaboratedPackage{..} targets = [] -> ts pkgHasEphemeralBuildTargets :: ElaboratedConfiguredPackage -> Bool --- TODO: Arguably ElabComponent should have its own notes about --- subtargets / repl targets rather than cribbing it off --- ElaboratedPackage. -pkgHasEphemeralBuildTargets (getElaboratedPackage -> pkg) = - isJust (pkgReplTarget pkg) - || (not . null) [ () | ComponentTarget _ subtarget <- pkgBuildTargets pkg +pkgHasEphemeralBuildTargets elab = + isJust (elabReplTarget elab) + || (not . null) [ () | ComponentTarget _ subtarget <- elabBuildTargets elab , subtarget /= WholeComponent ] -- | The components that we'll build all of, meaning that after they're built -- we can skip building them again (unlike with building just some modules or -- other files within a component). -- -pkgBuildTargetWholeComponents :: ElaboratedConfiguredPackage +elabBuildTargetWholeComponents :: ElaboratedConfiguredPackage -> Set ComponentName -pkgBuildTargetWholeComponents (ElabPackage pkg) = +elabBuildTargetWholeComponents elab = Set.fromList - [ cname | ComponentTarget cname WholeComponent <- pkgBuildTargets pkg ] -pkgBuildTargetWholeComponents (ElabComponent comp) = - Set.fromList $ maybe [] (:[]) (elabComponentName comp) + [ cname | ComponentTarget cname WholeComponent <- elabBuildTargets elab ] ------------------------------------------------------------------------------ @@ -1590,30 +1636,23 @@ pruneInstallPlanToTargets perPkgTargetsMap = -- so we can take a closure over them. We'll throw out the -- overriden dependencies when we're done so it's strictly temporary. -- --- This rigamarole is totally unnecessary for 'ElaboratedComponent', --- where we don't need to avoid configuring a test suite; it always --- is configured separately. -data PrunedPackage - = PrunedPackage ElaboratedPackage [UnitId] - | PrunedComponent ElaboratedComponent +-- For 'ElaboratedComponent', this the cached unit IDs always +-- coincide with the real thing. +data PrunedPackage = PrunedPackage ElaboratedConfiguredPackage [UnitId] instance Package PrunedPackage where - packageId (PrunedPackage pkg _) = packageId pkg - packageId (PrunedComponent comp) = packageId comp + packageId (PrunedPackage elab _) = packageId elab instance HasUnitId PrunedPackage where installedUnitId = nodeKey instance IsNode PrunedPackage where type Key PrunedPackage = UnitId - nodeKey (PrunedPackage pkg _) = nodeKey pkg - nodeKey (PrunedComponent comp) = nodeKey comp + nodeKey (PrunedPackage elab _) = nodeKey elab nodeNeighbors (PrunedPackage _ deps) = deps - nodeNeighbors (PrunedComponent comp) = nodeNeighbors comp fromPrunedPackage :: PrunedPackage -> ElaboratedConfiguredPackage -fromPrunedPackage (PrunedPackage pkg _) = ElabPackage pkg -fromPrunedPackage (PrunedComponent comp) = ElabComponent comp +fromPrunedPackage (PrunedPackage elab _) = elab -- | The first pass does three things: -- @@ -1634,66 +1673,41 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = pkgs' = map (mapConfiguredPackage prune) pkgs g = Graph.fromList pkgs' - prune (ElabPackage pkg) = - let pkg' = (pruneOptionalStanzas . setPkgBuildTargets) pkg - in PrunedPackage pkg' (pruneOptionalDependencies pkg') - prune (ElabComponent comp) = PrunedComponent (setComponentBuildTargets comp) + prune elab = + let elab' = (pruneOptionalStanzas . setElabBuildTargets) elab + in PrunedPackage elab' (pruneOptionalDependencies elab') roots = mapMaybe find_root pkgs' - find_root (InstallPlan.Configured (PrunedPackage pkg _)) = - if not (null (pkgBuildTargets pkg) - && isNothing (pkgReplTarget pkg) - && not (pkgBuildHaddocks pkg)) - then Just (installedUnitId pkg) - else Nothing - find_root (InstallPlan.Configured (PrunedComponent comp)) = - if not (null (elabComponentBuildTargets comp) - && isNothing (elabComponentReplTarget comp) - && not (elabComponentBuildHaddocks comp)) - then Just (installedUnitId comp) + find_root (InstallPlan.Configured (PrunedPackage elab _)) = + if not (null (elabBuildTargets elab) + && isNothing (elabReplTarget elab) + && not (elabBuildHaddocks elab)) + then Just (installedUnitId elab) else Nothing find_root _ = Nothing - setComponentBuildTargets comp = - comp { - elabComponentBuildTargets = buildTargets', - elabComponentReplTarget = replTarget', - elabComponentBuildHaddocks = buildHaddocks - } - where - -- I didn't feel like reimplementing elaboratePackageTargets, - -- so I just called it directly. - (buildTargets, replTarget, buildHaddocks) - = elaboratePackageTargets (elabComponentPackage comp) targets - -- Pare down the results for only things that are relevant - -- to us. This is because were sloppy when assigning targets - -- to IPIDs. - buildTargets' = mapMaybe f buildTargets - where f (ComponentTarget cname sub) - | Just cname == elabComponentName comp = Just sub - | otherwise = Nothing - replTarget' = replTarget >>= \(ComponentTarget cname sub) -> - if Just cname == elabComponentName comp - then Just sub - else Nothing - targets = fromMaybe [] - $ Map.lookup (installedUnitId comp) perPkgTargetsMap - -- Elaborate and set the targets we'll build for this package. This is just -- based on the targets from the user, not targets implied by reverse -- dependencies. Those comes in the second pass once we know the rev deps. -- - setPkgBuildTargets pkg = - pkg { - pkgBuildTargets = buildTargets, - pkgReplTarget = replTarget, - pkgBuildHaddocks = buildHaddocks + setElabBuildTargets elab = + elab { + elabBuildTargets = mapMaybe targetForElab buildTargets, + elabReplTarget = replTarget >>= targetForElab, + elabBuildHaddocks = buildHaddocks } where (buildTargets, replTarget, buildHaddocks) - = elaboratePackageTargets pkg targets + = elaboratePackageTargets elab targets targets = fromMaybe [] - $ Map.lookup (installedUnitId pkg) perPkgTargetsMap + $ Map.lookup (installedUnitId elab) perPkgTargetsMap + targetForElab tgt@(ComponentTarget cname _) = + case elabPkgOrComp elab of + ElabPackage _ -> Just tgt -- always valid + ElabComponent comp + -- Only if the component name matches + | compComponentName comp == Just cname -> Just tgt + | otherwise -> Nothing -- Decide whether or not to enable testsuites and benchmarks -- @@ -1711,12 +1725,17 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = -- disabled. Technically this introduces a little bit of stateful -- behaviour to make this "sticky", but it should be benign. -- - pruneOptionalStanzas pkg = pkg { pkgStanzasEnabled = stanzas } + pruneOptionalStanzas :: ElaboratedConfiguredPackage -> ElaboratedConfiguredPackage + pruneOptionalStanzas elab@ElaboratedConfiguredPackage{ elabPkgOrComp = ElabPackage pkg } = + elab { + elabPkgOrComp = ElabPackage (pkg { pkgStanzasEnabled = stanzas }) + } where stanzas :: Set OptionalStanza - stanzas = optionalStanzasRequiredByTargets pkg - <> optionalStanzasRequestedByDefault pkg - <> optionalStanzasWithDepsAvailable availablePkgs pkg + stanzas = optionalStanzasRequiredByTargets elab + <> optionalStanzasRequestedByDefault elab + <> optionalStanzasWithDepsAvailable availablePkgs elab pkg + pruneOptionalStanzas elab = elab -- Calculate package dependencies but cut out those needed only by -- optional stanzas that we've determined we will not enable. @@ -1724,32 +1743,32 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = -- the optional stanzas and we'll make further tweaks to the optional -- stanzas in the next pass. -- - pruneOptionalDependencies :: ElaboratedPackage -> [UnitId] - pruneOptionalDependencies pkg = - -- TODO: do the right thing when this is a test-suite component itself - (CD.flatDeps . CD.filterDeps keepNeeded . fmap (map (SimpleUnitId . confInstId))) (pkgDependencies pkg) + pruneOptionalDependencies :: ElaboratedConfiguredPackage -> [UnitId] + pruneOptionalDependencies elab@ElaboratedConfiguredPackage{ elabPkgOrComp = ElabComponent _ } = nodeNeighbors elab -- no pruning + pruneOptionalDependencies ElaboratedConfiguredPackage{ elabPkgOrComp = ElabPackage pkg } = + (CD.flatDeps . CD.filterDeps keepNeeded) (pkgOrderDependencies pkg) where keepNeeded (CD.ComponentTest _) _ = TestStanzas `Set.member` stanzas keepNeeded (CD.ComponentBench _) _ = BenchStanzas `Set.member` stanzas keepNeeded _ _ = True stanzas = pkgStanzasEnabled pkg - optionalStanzasRequiredByTargets :: ElaboratedPackage + optionalStanzasRequiredByTargets :: ElaboratedConfiguredPackage -> Set OptionalStanza optionalStanzasRequiredByTargets pkg = Set.fromList [ stanza - | ComponentTarget cname _ <- pkgBuildTargets pkg - ++ maybeToList (pkgReplTarget pkg) + | ComponentTarget cname _ <- elabBuildTargets pkg + ++ maybeToList (elabReplTarget pkg) , stanza <- maybeToList (componentOptionalStanza cname) ] - optionalStanzasRequestedByDefault :: ElaboratedPackage + optionalStanzasRequestedByDefault :: ElaboratedConfiguredPackage -> Set OptionalStanza optionalStanzasRequestedByDefault = Map.keysSet . Map.filter (id :: Bool -> Bool) - . pkgStanzasRequested + . elabStanzasRequested availablePkgs = Set.fromList @@ -1763,16 +1782,18 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = -- all of the deps needed for the test suite, we go ahead and -- enable it always. optionalStanzasWithDepsAvailable :: Set UnitId + -> ElaboratedConfiguredPackage -> ElaboratedPackage -> Set OptionalStanza -optionalStanzasWithDepsAvailable availablePkgs pkg = +optionalStanzasWithDepsAvailable availablePkgs elab pkg = Set.fromList [ stanza - | stanza <- Set.toList (pkgStanzasAvailable pkg) + | stanza <- Set.toList (elabStanzasAvailable elab) , let deps :: [UnitId] - deps = map (SimpleUnitId . confInstId) - $ CD.select (optionalStanzaDeps stanza) - (pkgDependencies pkg) + deps = CD.select (optionalStanzaDeps stanza) + -- TODO: probably need to select other + -- dep types too eventually + (pkgOrderDependencies pkg) , all (`Set.member` availablePkgs) deps ] where @@ -1813,37 +1834,30 @@ pruneInstallPlanPass2 :: [ElaboratedPlanPackage] pruneInstallPlanPass2 pkgs = map (mapConfiguredPackage setStanzasDepsAndTargets) pkgs where - setStanzasDepsAndTargets (ElabComponent comp) = - ElabComponent $ comp { - elabComponentBuildTargets = elabComponentBuildTargets comp - ++ targetsRequiredForRevDeps + setStanzasDepsAndTargets elab = + elab { + elabBuildTargets = elabBuildTargets elab + ++ targetsRequiredForRevDeps, + elabPkgOrComp = + case elabPkgOrComp elab of + ElabPackage pkg -> + let stanzas = pkgStanzasEnabled pkg + <> optionalStanzasWithDepsAvailable availablePkgs elab pkg + keepNeeded (CD.ComponentTest _) _ = TestStanzas `Set.member` stanzas + keepNeeded (CD.ComponentBench _) _ = BenchStanzas `Set.member` stanzas + keepNeeded _ _ = True + in ElabPackage $ pkg { + pkgStanzasEnabled = stanzas, + pkgLibDependencies = CD.filterDeps keepNeeded (pkgLibDependencies pkg) + } + r@(ElabComponent _) -> r } where - targetsRequiredForRevDeps = - [ WholeComponent - | installedUnitId comp `Set.member` hasReverseLibDeps - ] - setStanzasDepsAndTargets (ElabPackage pkg) = - ElabPackage $ pkg { - pkgStanzasEnabled = stanzas, - pkgDependencies = CD.filterDeps keepNeeded (pkgDependencies pkg), - pkgBuildTargets = pkgBuildTargets pkg ++ targetsRequiredForRevDeps - } - where - stanzas :: Set OptionalStanza - stanzas = pkgStanzasEnabled pkg - <> optionalStanzasWithDepsAvailable availablePkgs pkg - - keepNeeded (CD.ComponentTest _) _ = TestStanzas `Set.member` stanzas - keepNeeded (CD.ComponentBench _) _ = BenchStanzas `Set.member` stanzas - keepNeeded _ _ = True - targetsRequiredForRevDeps = [ ComponentTarget Cabal.defaultLibName WholeComponent - -- if anything needs this pkg, build the library component - | installedUnitId pkg `Set.member` hasReverseLibDeps + | installedUnitId elab `Set.member` hasReverseLibDeps ] - --TODO: also need to track build-tool rev-deps for exes + availablePkgs :: Set UnitId availablePkgs = Set.fromList (map installedUnitId pkgs) @@ -2064,31 +2078,29 @@ setupHsScriptOptions :: ElaboratedReadyPackage -> SetupScriptOptions -- TODO: Fix this so custom is a separate component. Custom can ALWAYS -- be a separate component!!! -setupHsScriptOptions (ReadyPackage pkg_or_comp) +setupHsScriptOptions (ReadyPackage elab@ElaboratedConfiguredPackage{..}) ElaboratedSharedConfig{..} srcdir builddir isParallelBuild cacheLock = SetupScriptOptions { - useCabalVersion = thisVersion pkgSetupScriptCliVersion, - useCabalSpecVersion = Just pkgSetupScriptCliVersion, + useCabalVersion = thisVersion elabSetupScriptCliVersion, + useCabalSpecVersion = Just elabSetupScriptCliVersion, useCompiler = Just pkgConfigCompiler, usePlatform = Just pkgConfigPlatform, - usePackageDB = pkgSetupPackageDBStack, + usePackageDB = elabSetupPackageDBStack, usePackageIndex = Nothing, useDependencies = [ (uid, srcid) - | ConfiguredId srcid uid <- CD.setupDeps pkgDependencies ], + | ConfiguredId srcid uid <- elabSetupDependencies elab ], useDependenciesExclusive = True, - useVersionMacros = pkgSetupScriptStyle == SetupCustomExplicitDeps, + useVersionMacros = elabSetupScriptStyle == SetupCustomExplicitDeps, useProgramConfig = pkgConfigCompilerProgs, useDistPref = builddir, useLoggingHandle = Nothing, -- this gets set later useWorkingDir = Just srcdir, - useExtraPathEnv = elabExeDependencyPaths pkg_or_comp, + useExtraPathEnv = elabExeDependencyPaths elab, useWin32CleanHack = False, --TODO: [required eventually] forceExternalSetupMethod = isParallelBuild, setupCacheLock = Just cacheLock } - where - ElaboratedPackage{..} = getElaboratedPackage pkg_or_comp -- | To be used for the input for elaborateInstallPlan. @@ -2137,94 +2149,90 @@ setupHsConfigureFlags :: ElaboratedReadyPackage -> Verbosity -> FilePath -> Cabal.ConfigFlags -setupHsConfigureFlags (ReadyPackage pkg_or_comp) +setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..}) sharedConfig@ElaboratedSharedConfig{..} verbosity builddir = - sanityCheckElaboratedPackage sharedConfig pkg + sanityCheckElaboratedConfiguredPackage sharedConfig elab (Cabal.ConfigFlags {..}) where - pkg@ElaboratedPackage{..} = getElaboratedPackage pkg_or_comp - configArgs = mempty -- unused, passed via args configDistPref = toFlag builddir configCabalFilePath = mempty configVerbosity = toFlag verbosity - configIPID = case pkg_or_comp of - ElabPackage _ -> toFlag (display (installedUnitId pkg)) + configIPID = case elabPkgOrComp of + ElabPackage pkg -> toFlag (display (pkgInstalledId pkg)) ElabComponent _ -> mempty - configCID = case pkg_or_comp of + configCID = case elabPkgOrComp of ElabPackage _ -> mempty - ElabComponent comp -> toFlag (unitIdComponentId (elabComponentId comp)) + ElabComponent _ -> toFlag (unitIdComponentId elabUnitId) - configProgramPaths = Map.toList pkgProgramPaths - configProgramArgs = Map.toList pkgProgramArgs - configProgramPathExtra = toNubList pkgProgramPathExtra + configProgramPaths = Map.toList elabProgramPaths + configProgramArgs = Map.toList elabProgramArgs + configProgramPathExtra = toNubList elabProgramPathExtra configHcFlavor = toFlag (compilerFlavor pkgConfigCompiler) configHcPath = mempty -- we use configProgramPaths instead configHcPkg = mempty -- we use configProgramPaths instead - configVanillaLib = toFlag pkgVanillaLib - configSharedLib = toFlag pkgSharedLib - configDynExe = toFlag pkgDynExe - configGHCiLib = toFlag pkgGHCiLib + configVanillaLib = toFlag elabVanillaLib + configSharedLib = toFlag elabSharedLib + configDynExe = toFlag elabDynExe + configGHCiLib = toFlag elabGHCiLib configProfExe = mempty - configProfLib = toFlag pkgProfLib - configProf = toFlag pkgProfExe + configProfLib = toFlag elabProfLib + configProf = toFlag elabProfExe -- configProfDetail is for exe+lib, but overridden by configProfLibDetail -- so we specify both so we can specify independently - configProfDetail = toFlag pkgProfExeDetail - configProfLibDetail = toFlag pkgProfLibDetail + configProfDetail = toFlag elabProfExeDetail + configProfLibDetail = toFlag elabProfLibDetail - configCoverage = toFlag pkgCoverage + configCoverage = toFlag elabCoverage configLibCoverage = mempty - configOptimization = toFlag pkgOptimization - configSplitObjs = toFlag pkgSplitObjs - configStripExes = toFlag pkgStripExes - configStripLibs = toFlag pkgStripLibs - configDebugInfo = toFlag pkgDebugInfo + configOptimization = toFlag elabOptimization + configSplitObjs = toFlag elabSplitObjs + configStripExes = toFlag elabStripExes + configStripLibs = toFlag elabStripLibs + configDebugInfo = toFlag elabDebugInfo configAllowOlder = mempty -- we use configExactConfiguration True configAllowNewer = mempty -- we use configExactConfiguration True - configConfigurationsFlags = pkgFlagAssignment - configConfigureArgs = pkgConfigureScriptArgs - configExtraLibDirs = pkgExtraLibDirs - configExtraFrameworkDirs = pkgExtraFrameworkDirs - configExtraIncludeDirs = pkgExtraIncludeDirs - configProgPrefix = maybe mempty toFlag pkgProgPrefix - configProgSuffix = maybe mempty toFlag pkgProgSuffix + configConfigurationsFlags = elabFlagAssignment + configConfigureArgs = elabConfigureScriptArgs + configExtraLibDirs = elabExtraLibDirs + configExtraFrameworkDirs = elabExtraFrameworkDirs + configExtraIncludeDirs = elabExtraIncludeDirs + configProgPrefix = maybe mempty toFlag elabProgPrefix + configProgSuffix = maybe mempty toFlag elabProgSuffix configInstallDirs = fmap (toFlag . InstallDirs.toPathTemplate) - (elabInstallDirs pkg_or_comp) + elabInstallDirs -- we only use configDependencies, unless we're talking to an old Cabal -- in which case we use configConstraints -- NB: This does NOT use nodeNeighbors, which includes executable - -- dependencies which should NOT be fed in here + -- dependencies which should NOT be fed in here (also you don't have + -- enough info anyway) configDependencies = [ (packageName srcid, cid) - | ConfiguredId srcid cid <- - case pkg_or_comp of - ElabPackage _ -> CD.nonSetupDeps pkgDependencies - ElabComponent comp -> elabComponentDependencies comp ] + | ConfiguredId srcid cid <- elabLibDependencies elab ] configConstraints = - case pkg_or_comp of + case elabPkgOrComp of ElabPackage _ -> [ thisPackageVersion srcid - | ConfiguredId srcid _uid <- CD.nonSetupDeps pkgDependencies ] + | ConfiguredId srcid _uid <- elabLibDependencies elab ] ElabComponent _ -> [] -- explicitly clear, then our package db stack -- TODO: [required eventually] have to do this differently for older Cabal versions - configPackageDBs = Nothing : map Just pkgBuildPackageDBStack + configPackageDBs = Nothing : map Just elabBuildPackageDBStack - configTests = case pkg_or_comp of - ElabPackage _ -> toFlag (TestStanzas `Set.member` pkgStanzasEnabled) + configTests = case elabPkgOrComp of + ElabPackage pkg -> toFlag (TestStanzas `Set.member` pkgStanzasEnabled pkg) ElabComponent _ -> mempty - configBenchmarks = case pkg_or_comp of - ElabPackage _ -> toFlag (BenchStanzas `Set.member` pkgStanzasEnabled) + configBenchmarks = case elabPkgOrComp of + ElabPackage pkg -> toFlag (BenchStanzas `Set.member` pkgStanzasEnabled pkg) ElabComponent _ -> mempty configExactConfiguration = toFlag True @@ -2237,13 +2245,12 @@ setupHsConfigureFlags (ReadyPackage pkg_or_comp) setupHsConfigureArgs :: ElaboratedConfiguredPackage -> [String] -setupHsConfigureArgs (ElabPackage _pkg) = [] -setupHsConfigureArgs (ElabComponent comp) = - [showComponentTarget (packageId pkg) (ComponentTarget cname WholeComponent)] +setupHsConfigureArgs (ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage _ }) = [] +setupHsConfigureArgs elab@(ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp }) = + [showComponentTarget (packageId elab) (ComponentTarget cname WholeComponent)] where - pkg = elabComponentPackage comp cname = fromMaybe (error "setupHsConfigureArgs: trying to configure setup") - (elabComponentName comp) + (compComponentName comp) setupHsBuildFlags :: ElaboratedConfiguredPackage -> ElaboratedSharedConfig @@ -2263,8 +2270,10 @@ setupHsBuildFlags _ _ verbosity builddir = setupHsBuildArgs :: ElaboratedConfiguredPackage -> [String] -setupHsBuildArgs (ElabPackage pkg) = map (showComponentTarget (packageId pkg)) (pkgBuildTargets pkg) -setupHsBuildArgs (ElabComponent _comp) = [] +setupHsBuildArgs elab@(ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage _ }) + = map (showComponentTarget (packageId elab)) (elabBuildTargets elab) +setupHsBuildArgs (ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent _ }) + = [] setupHsReplFlags :: ElaboratedConfiguredPackage @@ -2283,11 +2292,9 @@ setupHsReplFlags _ _ verbosity builddir = setupHsReplArgs :: ElaboratedConfiguredPackage -> [String] -setupHsReplArgs (ElabPackage pkg) = - maybe [] (\t -> [showComponentTarget (packageId pkg) t]) (pkgReplTarget pkg) +setupHsReplArgs elab = + maybe [] (\t -> [showComponentTarget (packageId elab) t]) (elabReplTarget elab) --TODO: should be able to give multiple modules in one component -setupHsReplArgs (ElabComponent _comp) = - error "setupHsReplArgs: didn't implement me yet" setupHsCopyFlags :: ElaboratedConfiguredPackage @@ -2313,13 +2320,13 @@ setupHsRegisterFlags :: ElaboratedConfiguredPackage -> FilePath -> FilePath -> Cabal.RegisterFlags -setupHsRegisterFlags pkg_or_comp _ +setupHsRegisterFlags ElaboratedConfiguredPackage{..} _ verbosity builddir pkgConfFile = Cabal.RegisterFlags { regPackageDB = mempty, -- misfeature regGenScript = mempty, -- never use regGenPkgConf = toFlag (Just pkgConfFile), - regInPlace = case pkgBuildStyle (getElaboratedPackage pkg_or_comp) of + regInPlace = case elabBuildStyle of BuildInplaceOnly -> toFlag True _ -> toFlag False, regPrintId = mempty, -- never use @@ -2337,22 +2344,22 @@ setupHsHaddockFlags :: ElaboratedConfiguredPackage -> Cabal.HaddockFlags -- TODO: reconsider whether or not Executables/TestSuites/... -- needed for component -setupHsHaddockFlags (getElaboratedPackage -> ElaboratedPackage{..}) _ verbosity builddir = +setupHsHaddockFlags (ElaboratedConfiguredPackage{..}) _ verbosity builddir = Cabal.HaddockFlags { haddockProgramPaths = mempty, --unused, set at configure time haddockProgramArgs = mempty, --unused, set at configure time - haddockHoogle = toFlag pkgHaddockHoogle, - haddockHtml = toFlag pkgHaddockHtml, - haddockHtmlLocation = maybe mempty toFlag pkgHaddockHtmlLocation, + haddockHoogle = toFlag elabHaddockHoogle, + haddockHtml = toFlag elabHaddockHtml, + haddockHtmlLocation = maybe mempty toFlag elabHaddockHtmlLocation, haddockForHackage = mempty, --TODO: new flag - haddockExecutables = toFlag pkgHaddockExecutables, - haddockTestSuites = toFlag pkgHaddockTestSuites, - haddockBenchmarks = toFlag pkgHaddockBenchmarks, - haddockInternal = toFlag pkgHaddockInternal, - haddockCss = maybe mempty toFlag pkgHaddockCss, - haddockHscolour = toFlag pkgHaddockHscolour, - haddockHscolourCss = maybe mempty toFlag pkgHaddockHscolourCss, - haddockContents = maybe mempty toFlag pkgHaddockContents, + haddockExecutables = toFlag elabHaddockExecutables, + haddockTestSuites = toFlag elabHaddockTestSuites, + haddockBenchmarks = toFlag elabHaddockBenchmarks, + haddockInternal = toFlag elabHaddockInternal, + haddockCss = maybe mempty toFlag elabHaddockCss, + haddockHscolour = toFlag elabHaddockHscolour, + haddockHscolourCss = maybe mempty toFlag elabHaddockHscolourCss, + haddockContents = maybe mempty toFlag elabHaddockContents, haddockDistPref = toFlag builddir, haddockKeepTempFiles = mempty, --TODO: from build settings haddockVerbosity = toFlag verbosity @@ -2416,21 +2423,23 @@ packageHashInputs :: ElaboratedSharedConfig -> PackageHashInputs packageHashInputs pkgshared - (ElabPackage pkg@ElaboratedPackage{ - pkgSourceId, - pkgSourceHash = Just srchash, - pkgDependencies, - pkgExeDependencies + elab@(ElaboratedConfiguredPackage { + elabPkgSourceHash = Just srchash }) = PackageHashInputs { - pkgHashPkgId = pkgSourceId, + pkgHashPkgId = packageId elab, pkgHashComponent = Nothing, pkgHashSourceHash = srchash, - pkgHashDirectDeps = Set.fromList $ - [ confInstId dep - | dep <- CD.select relevantDeps pkgDependencies ] ++ - CD.select relevantDeps pkgExeDependencies, - pkgHashOtherConfig = packageHashConfigInputs pkgshared pkg + pkgHashDirectDeps = + case elabPkgOrComp elab of + ElabPackage (ElaboratedPackage{..}) -> + Set.fromList $ + [ confInstId dep + | dep <- CD.select relevantDeps pkgLibDependencies ] + ElabComponent comp -> + Set.fromList (map confInstId (compLibDependencies comp) + ++ compExeDependencies comp), + pkgHashOtherConfig = packageHashConfigInputs pkgshared elab } where -- Obviously the main deps are relevant @@ -2444,54 +2453,41 @@ packageHashInputs relevantDeps (CD.ComponentTest _) = False relevantDeps (CD.ComponentBench _) = False -packageHashInputs - pkgshared - (ElabComponent comp@ElaboratedComponent { - elabComponentPackage = pkg@ElaboratedPackage{ pkgSourceHash = Just srchash } - }) = - PackageHashInputs { - pkgHashPkgId = packageId comp, - pkgHashComponent = Just (elabComponent comp), - pkgHashSourceHash = srchash, - pkgHashDirectDeps = Set.fromList (map confInstId (elabComponentDependencies comp)), - pkgHashOtherConfig = packageHashConfigInputs pkgshared pkg - } - packageHashInputs _ pkg = error $ "packageHashInputs: only for packages with source hashes. " ++ display (packageId pkg) packageHashConfigInputs :: ElaboratedSharedConfig - -> ElaboratedPackage + -> ElaboratedConfiguredPackage -> PackageHashConfigInputs packageHashConfigInputs ElaboratedSharedConfig{..} - ElaboratedPackage{..} = + ElaboratedConfiguredPackage{..} = PackageHashConfigInputs { pkgHashCompilerId = compilerId pkgConfigCompiler, pkgHashPlatform = pkgConfigPlatform, - pkgHashFlagAssignment = pkgFlagAssignment, - pkgHashConfigureScriptArgs = pkgConfigureScriptArgs, - pkgHashVanillaLib = pkgVanillaLib, - pkgHashSharedLib = pkgSharedLib, - pkgHashDynExe = pkgDynExe, - pkgHashGHCiLib = pkgGHCiLib, - pkgHashProfLib = pkgProfLib, - pkgHashProfExe = pkgProfExe, - pkgHashProfLibDetail = pkgProfLibDetail, - pkgHashProfExeDetail = pkgProfExeDetail, - pkgHashCoverage = pkgCoverage, - pkgHashOptimization = pkgOptimization, - pkgHashSplitObjs = pkgSplitObjs, - pkgHashStripLibs = pkgStripLibs, - pkgHashStripExes = pkgStripExes, - pkgHashDebugInfo = pkgDebugInfo, - pkgHashExtraLibDirs = pkgExtraLibDirs, - pkgHashExtraFrameworkDirs = pkgExtraFrameworkDirs, - pkgHashExtraIncludeDirs = pkgExtraIncludeDirs, - pkgHashProgPrefix = pkgProgPrefix, - pkgHashProgSuffix = pkgProgSuffix + pkgHashFlagAssignment = elabFlagAssignment, + pkgHashConfigureScriptArgs = elabConfigureScriptArgs, + pkgHashVanillaLib = elabVanillaLib, + pkgHashSharedLib = elabSharedLib, + pkgHashDynExe = elabDynExe, + pkgHashGHCiLib = elabGHCiLib, + pkgHashProfLib = elabProfLib, + pkgHashProfExe = elabProfExe, + pkgHashProfLibDetail = elabProfLibDetail, + pkgHashProfExeDetail = elabProfExeDetail, + pkgHashCoverage = elabCoverage, + pkgHashOptimization = elabOptimization, + pkgHashSplitObjs = elabSplitObjs, + pkgHashStripLibs = elabStripLibs, + pkgHashStripExes = elabStripExes, + pkgHashDebugInfo = elabDebugInfo, + pkgHashExtraLibDirs = elabExtraLibDirs, + pkgHashExtraFrameworkDirs = elabExtraFrameworkDirs, + pkgHashExtraIncludeDirs = elabExtraIncludeDirs, + pkgHashProgPrefix = elabProgPrefix, + pkgHashProgSuffix = elabProgSuffix } diff --git a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs index 3629590bc73..f0d7b947276 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -13,17 +13,15 @@ module Distribution.Client.ProjectPlanning.Types ( ElaboratedInstallPlan, ElaboratedConfiguredPackage(..), - getElaboratedPackage, - elabInstallDirs, elabDistDirParams, - elabRequiresRegistration, elabExeDependencyPaths, - elabBuildTargets, - elabReplTarget, - elabBuildHaddocks, + elabLibDependencies, + elabSetupDependencies, + ElaboratedPackageOrComponent(..), ElaboratedComponent(..), ElaboratedPackage(..), + pkgOrderDependencies, ElaboratedPlanPackage, ElaboratedSharedConfig(..), ElaboratedReadyPackage, @@ -111,179 +109,52 @@ data ElaboratedSharedConfig instance Binary ElaboratedSharedConfig --- TODO: This is a misnomer, but I didn't want to rename things --- willy-nilly yet data ElaboratedConfiguredPackage - = ElabPackage ElaboratedPackage - | ElabComponent ElaboratedComponent - deriving (Eq, Show, Generic) - -instance IsNode ElaboratedConfiguredPackage where - type Key ElaboratedConfiguredPackage = UnitId - nodeKey (ElabPackage pkg) = nodeKey pkg - nodeKey (ElabComponent comp) = nodeKey comp - nodeNeighbors (ElabPackage pkg) = nodeNeighbors pkg - nodeNeighbors (ElabComponent comp) = nodeNeighbors comp - -elabDistDirParams :: ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> DistDirParams -elabDistDirParams shared (ElabPackage pkg) = DistDirParams { - distParamUnitId = installedUnitId pkg, - distParamPackageId = pkgSourceId pkg, - distParamComponentName = Nothing, - distParamCompilerId = compilerId (pkgConfigCompiler shared), - distParamPlatform = pkgConfigPlatform shared - } -elabDistDirParams shared (ElabComponent comp) = DistDirParams { - distParamUnitId = installedUnitId comp, - distParamPackageId = packageId comp, -- NB: NOT the munged ID - distParamComponentName = elabComponentName comp, -- TODO: Ick. Change type. - distParamCompilerId = compilerId (pkgConfigCompiler shared), - distParamPlatform = pkgConfigPlatform shared - } - -elabInstallDirs :: ElaboratedConfiguredPackage -> InstallDirs.InstallDirs FilePath -elabInstallDirs (ElabPackage pkg) = pkgInstallDirs pkg -elabInstallDirs (ElabComponent comp) = elabComponentInstallDirs comp - -elabRequiresRegistration :: ElaboratedConfiguredPackage -> Bool -elabRequiresRegistration (ElabPackage pkg) = pkgRequiresRegistration pkg -elabRequiresRegistration (ElabComponent comp) - = case elabComponent comp of - CD.ComponentLib -> True - CD.ComponentSubLib _ -> True - _ -> False - -elabBuildTargets :: ElaboratedConfiguredPackage -> [ComponentTarget] -elabBuildTargets (ElabPackage pkg) = pkgBuildTargets pkg -elabBuildTargets (ElabComponent comp) - | Just cname <- elabComponentName comp - = map (ComponentTarget cname) $ elabComponentBuildTargets comp - | otherwise = [] - -elabReplTarget :: ElaboratedConfiguredPackage -> Maybe ComponentTarget -elabReplTarget (ElabPackage pkg) = pkgReplTarget pkg -elabReplTarget (ElabComponent comp) - | Just cname <- elabComponentName comp - = fmap (ComponentTarget cname) $ elabComponentReplTarget comp - | otherwise = Nothing - -elabBuildHaddocks :: ElaboratedConfiguredPackage -> Bool -elabBuildHaddocks (ElabPackage pkg) = pkgBuildHaddocks pkg -elabBuildHaddocks (ElabComponent comp) = elabComponentBuildHaddocks comp - -elabExeDependencyPaths :: ElaboratedConfiguredPackage -> [FilePath] -elabExeDependencyPaths (ElabPackage _) = [] -- TODO: not implemented -elabExeDependencyPaths (ElabComponent comp) = elabComponentExeDependencyPaths comp - -getElaboratedPackage :: ElaboratedConfiguredPackage -> ElaboratedPackage -getElaboratedPackage (ElabPackage pkg) = pkg -getElaboratedPackage (ElabComponent comp) = elabComponentPackage comp - -instance Binary ElaboratedConfiguredPackage - -instance Package ElaboratedConfiguredPackage where - packageId (ElabPackage pkg) = packageId pkg - packageId (ElabComponent comp) = packageId comp - -instance HasUnitId ElaboratedConfiguredPackage where - installedUnitId (ElabPackage pkg) = installedUnitId pkg - installedUnitId (ElabComponent comp) = installedUnitId comp - -instance HasConfiguredId ElaboratedConfiguredPackage where - configuredId (ElabPackage pkg) = configuredId pkg - configuredId (ElabComponent comp) = configuredId comp - --- | Some extra metadata associated with an --- 'ElaboratedConfiguredPackage' which indicates that the "package" --- in question is actually a single component to be built. Arguably --- it would be clearer if there were an ADT which branched into --- package work items and component work items, but I've structured --- it this way to minimize change to the existing code (which I --- don't feel qualified to rewrite.) -data ElaboratedComponent - = ElaboratedComponent { - -- | The name of the component to be built - elabComponent :: CD.Component, - -- | The name of the component to be built. Nothing if - -- it's a setup dep. - elabComponentName :: Maybe ComponentName, - -- | The ID of the component to be built - elabComponentId :: UnitId, - -- | Dependencies of this component - elabComponentDependencies :: [ConfiguredId], - -- | The order-only dependencies of this component; e.g., - -- if you depend on an executable it goes here. - elabComponentExeDependencies :: [ComponentId], - -- | The file paths of all our executable dependencies. - elabComponentExeDependencyPaths :: [FilePath], - -- | The 'ElaboratedPackage' this component came from - elabComponentPackage :: ElaboratedPackage, - -- | What in this component should we build (TRANSIENT, see 'pkgBuildTargets') - elabComponentBuildTargets :: [SubComponentTarget], - -- | Should we REPL this component (TRANSIENT, see 'pkgReplTarget') - elabComponentReplTarget :: Maybe SubComponentTarget, - -- | Should we Haddock this component (TRANSIENT, see 'pkgBuildHaddocks') - elabComponentBuildHaddocks :: Bool, - -- | Where things should get installed to - elabComponentInstallDirs :: InstallDirs.InstallDirs FilePath - } - deriving (Eq, Show, Generic) - -instance Binary ElaboratedComponent - -instance Package ElaboratedComponent where - -- NB: DON'T return the munged ID by default. - -- The 'Package' type class is about the source package - -- name that the component belongs to; 'projAllPkgs' - -- in "Distribution.Client.ProjectOrchestration" depends - -- on this. - packageId = packageId . elabComponentPackage - -instance HasConfiguredId ElaboratedComponent where - configuredId comp = ConfiguredId (packageId comp) (unitIdComponentId (elabComponentId comp)) + = ElaboratedConfiguredPackage { + -- | The 'UnitId' which uniquely identifies this item in a build plan + elabUnitId :: UnitId, -instance HasUnitId ElaboratedComponent where - installedUnitId = elabComponentId + -- | The 'PackageId' of the originating package + elabPkgSourceId :: PackageId, -instance IsNode ElaboratedComponent where - type Key ElaboratedComponent = UnitId - nodeKey = elabComponentId - nodeNeighbors comp = - -- TODO: Change this with Backpack! - map (SimpleUnitId . confInstId) (elabComponentDependencies comp) - ++ map SimpleUnitId (elabComponentExeDependencies comp) + -- | Mapping from 'PackageName's to 'ComponentName', for every + -- package that is overloaded with an internal component name + elabInternalPackages :: Map PackageName ComponentName, -data ElaboratedPackage - = ElaboratedPackage { + -- | A total flag assignment for the package. + -- TODO: Actually this can be per-component if we drop + -- all flags that don't affect a component. + elabFlagAssignment :: Cabal.FlagAssignment, - pkgInstalledId :: InstalledPackageId, - pkgSourceId :: PackageId, - - pkgDescription :: Cabal.PackageDescription, + -- | The original default flag assignment, used only for reporting. + elabFlagDefaults :: Cabal.FlagAssignment, - pkgInternalPackages :: Map PackageName ComponentName, + elabPkgDescription :: Cabal.PackageDescription, - -- | A total flag assignment for the package - pkgFlagAssignment :: Cabal.FlagAssignment, + -- | Where the package comes from, e.g. tarball, local dir etc. This + -- is not the same as where it may be unpacked to for the build. + elabPkgSourceLocation :: PackageLocation (Maybe FilePath), - -- | The original default flag assignment, used only for reporting. - pkgFlagDefaults :: Cabal.FlagAssignment, + -- | The hash of the source, e.g. the tarball. We don't have this for + -- local source dir packages. + elabPkgSourceHash :: Maybe PackageSourceHash, - -- | The exact dependencies (on other plan packages) - -- - pkgDependencies :: ComponentDeps [ConfiguredId], + -- | Is this package one of the ones specified by location in the + -- project file? (As opposed to a dependency, or a named package pulled + -- in) + elabLocalToProject :: Bool, - -- | The executable dependencies, which we don't pass as @--dependency@ flags; - -- these just need to be added to the path. - pkgExeDependencies :: ComponentDeps [ComponentId], + -- | Are we going to build and install this package to the store, or are + -- we going to build it and register it locally. + elabBuildStyle :: BuildStyle, -- | Another way of phrasing 'pkgStanzasAvailable'. - pkgEnabled :: ComponentEnabledSpec, + elabEnabledSpec :: ComponentEnabledSpec, -- | Which optional stanzas (ie testsuites, benchmarks) can be built. -- This means the solver produced a plan that has them available. -- This doesn't necessary mean we build them by default. - pkgStanzasAvailable :: Set OptionalStanza, + elabStanzasAvailable :: Set OptionalStanza, -- | Which optional stanzas the user explicitly asked to enable or -- to disable. This tells us which ones we build by default, and @@ -303,118 +174,196 @@ data ElaboratedPackage -- that a user enabled tests globally, and some local packages -- just happen not to have any tests. (But perhaps we should -- warn if ALL local packages don't have any tests.) - pkgStanzasRequested :: Map OptionalStanza Bool, - - -- | Which optional stanzas (ie testsuites, benchmarks) will actually - -- be enabled during the package configure step. - pkgStanzasEnabled :: Set OptionalStanza, - - -- | Where the package comes from, e.g. tarball, local dir etc. This - -- is not the same as where it may be unpacked to for the build. - pkgSourceLocation :: PackageLocation (Maybe FilePath), - - -- | The hash of the source, e.g. the tarball. We don't have this for - -- local source dir packages. - pkgSourceHash :: Maybe PackageSourceHash, - - --pkgSourceDir ? -- currently passed in later because they can use temp locations - --pkgBuildDir ? -- but could in principle still have it here, with optional instr to use temp loc - - -- | Is this package one of the ones specified by location in the - -- project file? (As opposed to a dependency, or a named package pulled - -- in) - pkgLocalToProject :: Bool, - - -- | Are we going to build and install this package to the store, or are - -- we going to build it and register it locally. - pkgBuildStyle :: BuildStyle, - - pkgSetupPackageDBStack :: PackageDBStack, - pkgBuildPackageDBStack :: PackageDBStack, - pkgRegisterPackageDBStack :: PackageDBStack, - - -- | The package contains a library and so must be registered - pkgRequiresRegistration :: Bool, - pkgDescriptionOverride :: Maybe CabalFileText, - - pkgVanillaLib :: Bool, - pkgSharedLib :: Bool, - pkgDynExe :: Bool, - pkgGHCiLib :: Bool, - pkgProfLib :: Bool, - pkgProfExe :: Bool, - pkgProfLibDetail :: ProfDetailLevel, - pkgProfExeDetail :: ProfDetailLevel, - pkgCoverage :: Bool, - pkgOptimization :: OptimisationLevel, - pkgSplitObjs :: Bool, - pkgStripLibs :: Bool, - pkgStripExes :: Bool, - pkgDebugInfo :: DebugInfoLevel, - - pkgProgramPaths :: Map String FilePath, - pkgProgramArgs :: Map String [String], - pkgProgramPathExtra :: [FilePath], - pkgConfigureScriptArgs :: [String], - pkgExtraLibDirs :: [FilePath], - pkgExtraFrameworkDirs :: [FilePath], - pkgExtraIncludeDirs :: [FilePath], - pkgProgPrefix :: Maybe PathTemplate, - pkgProgSuffix :: Maybe PathTemplate, - - pkgInstallDirs :: InstallDirs.InstallDirs FilePath, - - pkgHaddockHoogle :: Bool, - pkgHaddockHtml :: Bool, - pkgHaddockHtmlLocation :: Maybe String, - pkgHaddockExecutables :: Bool, - pkgHaddockTestSuites :: Bool, - pkgHaddockBenchmarks :: Bool, - pkgHaddockInternal :: Bool, - pkgHaddockCss :: Maybe FilePath, - pkgHaddockHscolour :: Bool, - pkgHaddockHscolourCss :: Maybe FilePath, - pkgHaddockContents :: Maybe PathTemplate, + elabStanzasRequested :: Map OptionalStanza Bool, + + elabSetupPackageDBStack :: PackageDBStack, + elabBuildPackageDBStack :: PackageDBStack, + elabRegisterPackageDBStack :: PackageDBStack, + + -- | The package/component contains/is a library and so must be registered + elabRequiresRegistration :: Bool, + + elabPkgDescriptionOverride :: Maybe CabalFileText, + + -- TODO: make per-component variants of these flags + elabVanillaLib :: Bool, + elabSharedLib :: Bool, + elabDynExe :: Bool, + elabGHCiLib :: Bool, + elabProfLib :: Bool, + elabProfExe :: Bool, + elabProfLibDetail :: ProfDetailLevel, + elabProfExeDetail :: ProfDetailLevel, + elabCoverage :: Bool, + elabOptimization :: OptimisationLevel, + elabSplitObjs :: Bool, + elabStripLibs :: Bool, + elabStripExes :: Bool, + elabDebugInfo :: DebugInfoLevel, + + elabProgramPaths :: Map String FilePath, + elabProgramArgs :: Map String [String], + elabProgramPathExtra :: [FilePath], + elabConfigureScriptArgs :: [String], + elabExtraLibDirs :: [FilePath], + elabExtraFrameworkDirs :: [FilePath], + elabExtraIncludeDirs :: [FilePath], + elabProgPrefix :: Maybe PathTemplate, + elabProgSuffix :: Maybe PathTemplate, + + elabInstallDirs :: InstallDirs.InstallDirs FilePath, + + elabHaddockHoogle :: Bool, + elabHaddockHtml :: Bool, + elabHaddockHtmlLocation :: Maybe String, + elabHaddockExecutables :: Bool, + elabHaddockTestSuites :: Bool, + elabHaddockBenchmarks :: Bool, + elabHaddockInternal :: Bool, + elabHaddockCss :: Maybe FilePath, + elabHaddockHscolour :: Bool, + elabHaddockHscolourCss :: Maybe FilePath, + elabHaddockContents :: Maybe PathTemplate, -- Setup.hs related things: -- | One of four modes for how we build and interact with the Setup.hs -- script, based on whether it's a build-type Custom, with or without -- explicit deps and the cabal spec version the .cabal file needs. - pkgSetupScriptStyle :: SetupScriptStyle, + elabSetupScriptStyle :: SetupScriptStyle, -- | The version of the Cabal command line interface that we are using -- for this package. This is typically the version of the Cabal lib -- that the Setup.hs is built against. - pkgSetupScriptCliVersion :: Version, + elabSetupScriptCliVersion :: Version, -- Build time related: - pkgBuildTargets :: [ComponentTarget], - pkgReplTarget :: Maybe ComponentTarget, - pkgBuildHaddocks :: Bool - } + elabBuildTargets :: [ComponentTarget], + elabReplTarget :: Maybe ComponentTarget, + elabBuildHaddocks :: Bool, + + --pkgSourceDir ? -- currently passed in later because they can use temp locations + --pkgBuildDir ? -- but could in principle still have it here, with optional instr to use temp loc + + -- | Component/package specific information + elabPkgOrComp :: ElaboratedPackageOrComponent + } deriving (Eq, Show, Generic) -instance Binary ElaboratedPackage +instance Package ElaboratedConfiguredPackage where + packageId = elabPkgSourceId + +instance HasConfiguredId ElaboratedConfiguredPackage where + configuredId elab = ConfiguredId (packageId elab) (unitIdComponentId (elabUnitId elab)) + +instance HasUnitId ElaboratedConfiguredPackage where + installedUnitId = elabUnitId + +instance IsNode ElaboratedConfiguredPackage where + type Key ElaboratedConfiguredPackage = UnitId + nodeKey = elabUnitId + nodeNeighbors elab = case elabPkgOrComp elab of + -- Important not to have duplicates: otherwise InstallPlan gets + -- confused. NB: this DOES include setup deps. + ElabPackage pkg -> ordNub (CD.flatDeps (pkgOrderDependencies pkg)) + ElabComponent comp -> compOrderDependencies comp + +instance Binary ElaboratedConfiguredPackage + +data ElaboratedPackageOrComponent + = ElabPackage ElaboratedPackage + | ElabComponent ElaboratedComponent + deriving (Eq, Show, Generic) + +instance Binary ElaboratedPackageOrComponent + +elabDistDirParams :: ElaboratedSharedConfig -> ElaboratedConfiguredPackage -> DistDirParams +elabDistDirParams shared elab = DistDirParams { + distParamUnitId = installedUnitId elab, + distParamPackageId = elabPkgSourceId elab, + distParamComponentName = case elabPkgOrComp elab of + ElabComponent comp -> compComponentName comp + ElabPackage _ -> Nothing, + distParamCompilerId = compilerId (pkgConfigCompiler shared), + distParamPlatform = pkgConfigPlatform shared + } + +-- | The library dependencies (i.e., the libraries we depend on, NOT +-- the dependencies of the library), NOT including setup dependencies. +elabLibDependencies :: ElaboratedConfiguredPackage -> [ConfiguredId] +elabLibDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage pkg } + = ordNub (CD.nonSetupDeps (pkgLibDependencies pkg)) +elabLibDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp } + = compLibDependencies comp + +elabExeDependencyPaths :: ElaboratedConfiguredPackage -> [FilePath] +elabExeDependencyPaths ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage _ } + = [] -- TODO: not implemented +elabExeDependencyPaths ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp } + = compExeDependencyPaths comp -instance Package ElaboratedPackage where - packageId = pkgSourceId +elabSetupDependencies :: ElaboratedConfiguredPackage -> [ConfiguredId] +elabSetupDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage pkg } + = CD.setupDeps (pkgLibDependencies pkg) +elabSetupDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp } + = compSetupDependencies comp -instance HasUnitId ElaboratedPackage where - installedUnitId = SimpleUnitId . pkgInstalledId -instance HasConfiguredId ElaboratedPackage where - configuredId pkg = ConfiguredId (pkgSourceId pkg) (pkgInstalledId pkg) +-- | Some extra metadata associated with an +-- 'ElaboratedConfiguredPackage' which indicates that the "package" +-- in question is actually a single component to be built. Arguably +-- it would be clearer if there were an ADT which branched into +-- package work items and component work items, but I've structured +-- it this way to minimize change to the existing code (which I +-- don't feel qualified to rewrite.) +data ElaboratedComponent + = ElaboratedComponent { + -- | The name of the component to be built according to the solver + compSolverName :: CD.Component, + -- | The name of the component to be built. Nothing if + -- it's a setup dep. + compComponentName :: Maybe ComponentName, + -- | The library dependencies of this component. + compLibDependencies :: [ConfiguredId], + -- | The executable dependencies of this component. + compExeDependencies :: [ComponentId], + -- | The paths all our executable dependencies will be installed + -- to once they are installed. + compExeDependencyPaths :: [FilePath], + -- | The setup dependencies. TODO: Remove this when setups + -- are components of their own. + compSetupDependencies :: [ConfiguredId] + } + deriving (Eq, Show, Generic) + +instance Binary ElaboratedComponent + +compOrderDependencies :: ElaboratedComponent -> [UnitId] +compOrderDependencies comp = + -- TODO: Change this with Backpack! + map (SimpleUnitId . confInstId) (compLibDependencies comp) + ++ map SimpleUnitId (compExeDependencies comp) + ++ map (SimpleUnitId . confInstId) (compSetupDependencies comp) + +data ElaboratedPackage + = ElaboratedPackage { + pkgInstalledId :: InstalledPackageId, + + -- | The exact dependencies (on other plan packages) + -- + pkgLibDependencies :: ComponentDeps [ConfiguredId], + + -- | Which optional stanzas (ie testsuites, benchmarks) will actually + -- be enabled during the package configure step. + pkgStanzasEnabled :: Set OptionalStanza + } + deriving (Eq, Show, Generic) + +instance Binary ElaboratedPackage -instance IsNode ElaboratedPackage where - type Key ElaboratedPackage = UnitId - nodeKey = installedUnitId - nodeNeighbors pkg = - -- Important not to have duplicates: otherwise InstallPlan gets - -- confused - ordNub $ - map (SimpleUnitId . confInstId) (CD.flatDeps (pkgDependencies pkg)) - ++ map SimpleUnitId (CD.flatDeps (pkgExeDependencies pkg)) +pkgOrderDependencies :: ElaboratedPackage -> ComponentDeps [UnitId] +pkgOrderDependencies pkg = + fmap (map (SimpleUnitId . confInstId)) (pkgLibDependencies pkg) -- | This is used in the install plan to indicate how the package will be -- built. diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index 6e2c3355af1..edccd676969 100644 --- a/cabal-install/tests/IntegrationTests2.hs +++ b/cabal-install/tests/IntegrationTests2.hs @@ -118,7 +118,7 @@ testSetupScriptStyles config reportSubCase = do reportSubCase (show SetupCustomExplicitDeps) (plan1, res1) <- executePlan =<< planProject testdir1 config (pkg1, _) <- expectPackageInstalled plan1 res1 pkgidA - pkgSetupScriptStyle pkg1 @?= SetupCustomExplicitDeps + elabSetupScriptStyle pkg1 @?= SetupCustomExplicitDeps hasDefaultSetupDeps pkg1 @?= Just False marker1 <- readFile (basedir testdir1 "marker") marker1 @?= "ok" @@ -127,7 +127,7 @@ testSetupScriptStyles config reportSubCase = do reportSubCase (show SetupCustomImplicitDeps) (plan2, res2) <- executePlan =<< planProject testdir2 config (pkg2, _) <- expectPackageInstalled plan2 res2 pkgidA - pkgSetupScriptStyle pkg2 @?= SetupCustomImplicitDeps + elabSetupScriptStyle pkg2 @?= SetupCustomImplicitDeps hasDefaultSetupDeps pkg2 @?= Just True marker2 <- readFile (basedir testdir2 "marker") marker2 @?= "ok" @@ -136,7 +136,7 @@ testSetupScriptStyles config reportSubCase = do reportSubCase (show SetupNonCustomInternalLib) (plan3, res3) <- executePlan =<< planProject testdir3 config (pkg3, _) <- expectPackageInstalled plan3 res3 pkgidA - pkgSetupScriptStyle pkg3 @?= SetupNonCustomInternalLib + elabSetupScriptStyle pkg3 @?= SetupNonCustomInternalLib {- --TODO: the SetupNonCustomExternalLib case is hard to test since it -- requires a version of Cabal that's later than the one we're testing @@ -155,7 +155,7 @@ testSetupScriptStyles config reportSubCase = do pkgidA = PackageIdentifier (PackageName "a") (Version [0,1] []) -- The solver fills in default setup deps explicitly, but marks them as such hasDefaultSetupDeps = fmap defaultSetupDepends - . setupBuildInfo . pkgDescription + . setupBuildInfo . elabPkgDescription -- | Test the behaviour with and without @--keep-going@ -- @@ -236,10 +236,9 @@ planProject testdir cliConfig = do let targets = Map.fromList - [ (installedUnitId pkg, [BuildDefaultComponents]) - | InstallPlan.Configured pkg_or_comp <- InstallPlan.toList elaboratedPlan - , let pkg = getElaboratedPackage pkg_or_comp - , pkgBuildStyle pkg == BuildInplaceOnly ] + [ (installedUnitId elab, [BuildDefaultComponents]) + | InstallPlan.Configured elab <- InstallPlan.toList elaboratedPlan + , elabBuildStyle elab == BuildInplaceOnly ] elaboratedPlan' = pruneInstallPlanToTargets targets elaboratedPlan (elaboratedPlan'', pkgsBuildStatus) <- @@ -351,30 +350,30 @@ expectPackagePreExisting plan buildOutcomes pkgid = do (_, buildResult) -> unexpectedBuildResult "PreExisting" planpkg buildResult expectPackageConfigured :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId - -> IO ElaboratedPackage + -> IO ElaboratedConfiguredPackage expectPackageConfigured plan buildOutcomes pkgid = do planpkg <- expectPlanPackage plan pkgid case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of (InstallPlan.Configured pkg, Nothing) - -> return (getElaboratedPackage pkg) + -> return pkg (_, buildResult) -> unexpectedBuildResult "Configured" planpkg buildResult expectPackageInstalled :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId - -> IO (ElaboratedPackage, BuildResult) + -> IO (ElaboratedConfiguredPackage, BuildResult) expectPackageInstalled plan buildOutcomes pkgid = do planpkg <- expectPlanPackage plan pkgid case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of (InstallPlan.Configured pkg, Just (Right result)) - -> return (getElaboratedPackage pkg, result) + -> return (pkg, result) (_, buildResult) -> unexpectedBuildResult "Installed" planpkg buildResult expectPackageFailed :: ElaboratedInstallPlan -> BuildOutcomes -> PackageId - -> IO (ElaboratedPackage, BuildFailure) + -> IO (ElaboratedConfiguredPackage, BuildFailure) expectPackageFailed plan buildOutcomes pkgid = do planpkg <- expectPlanPackage plan pkgid case (planpkg, InstallPlan.lookupBuildOutcome planpkg buildOutcomes) of (InstallPlan.Configured pkg, Just (Left failure)) - -> return (getElaboratedPackage pkg, failure) + -> return (pkg, failure) (_, buildResult) -> unexpectedBuildResult "Failed" planpkg buildResult unexpectedBuildResult :: String -> ElaboratedPlanPackage From f63273da5982616398743e4eec952e6bddc48f04 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Thu, 18 Aug 2016 00:06:02 -0700 Subject: [PATCH 19/23] Introduce InstallPlan.depends = nodeNeighbors and use it. Signed-off-by: Edward Z. Yang --- cabal-install/Distribution/Client/InstallPlan.hs | 4 ++++ cabal-install/Distribution/Client/ProjectBuilding.hs | 2 +- cabal-install/Distribution/Client/ProjectPlanning.hs | 11 ++++++----- 3 files changed, 11 insertions(+), 6 deletions(-) diff --git a/cabal-install/Distribution/Client/InstallPlan.hs b/cabal-install/Distribution/Client/InstallPlan.hs index 1c99d177996..fbc923265d5 100644 --- a/cabal-install/Distribution/Client/InstallPlan.hs +++ b/cabal-install/Distribution/Client/InstallPlan.hs @@ -28,6 +28,7 @@ module Distribution.Client.InstallPlan ( new, toList, planIndepGoals, + depends, fromSolverInstallPlan, configureInstallPlan, @@ -161,6 +162,9 @@ data GenericPlanPackage ipkg srcpkg type IsUnit a = (IsNode a, Key a ~ UnitId) +depends :: IsUnit a => a -> [UnitId] +depends = nodeNeighbors + -- NB: Expanded constraint synonym here to avoid undecidable -- instance errors in GHC 7.8 and earlier. instance (IsNode ipkg, IsNode srcpkg, Key ipkg ~ UnitId, Key srcpkg ~ UnitId) diff --git a/cabal-install/Distribution/Client/ProjectBuilding.hs b/cabal-install/Distribution/Client/ProjectBuilding.hs index 4d56fa93b72..1dc4e2e0278 100644 --- a/cabal-install/Distribution/Client/ProjectBuilding.hs +++ b/cabal-install/Distribution/Client/ProjectBuilding.hs @@ -351,7 +351,7 @@ foldMInstallPlanDepOrder plan0 visit = depresults = map (\ipkgid -> let Just result = Map.lookup ipkgid results in result) - (nodeNeighbors pkg) + (InstallPlan.depends pkg) result <- visit pkg depresults let results' = Map.insert (nodeKey pkg) result results go results' pkgs diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index c2f01ad2bcd..35383209033 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -1744,9 +1744,10 @@ pruneInstallPlanPass1 perPkgTargetsMap pkgs = -- stanzas in the next pass. -- pruneOptionalDependencies :: ElaboratedConfiguredPackage -> [UnitId] - pruneOptionalDependencies elab@ElaboratedConfiguredPackage{ elabPkgOrComp = ElabComponent _ } = nodeNeighbors elab -- no pruning - pruneOptionalDependencies ElaboratedConfiguredPackage{ elabPkgOrComp = ElabPackage pkg } = - (CD.flatDeps . CD.filterDeps keepNeeded) (pkgOrderDependencies pkg) + pruneOptionalDependencies elab@ElaboratedConfiguredPackage{ elabPkgOrComp = ElabComponent _ } + = InstallPlan.depends elab -- no pruning + pruneOptionalDependencies ElaboratedConfiguredPackage{ elabPkgOrComp = ElabPackage pkg } + = (CD.flatDeps . CD.filterDeps keepNeeded) (pkgOrderDependencies pkg) where keepNeeded (CD.ComponentTest _) _ = TestStanzas `Set.member` stanzas keepNeeded (CD.ComponentBench _) _ = BenchStanzas `Set.member` stanzas @@ -1865,7 +1866,7 @@ pruneInstallPlanPass2 pkgs = hasReverseLibDeps :: Set UnitId hasReverseLibDeps = Set.fromList [ depid | pkg <- pkgs - , depid <- nodeNeighbors pkg ] + , depid <- InstallPlan.depends pkg ] mapConfiguredPackage :: (srcpkg -> srcpkg') -> InstallPlan.GenericPlanPackage ipkg srcpkg @@ -2211,7 +2212,7 @@ setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..}) -- we only use configDependencies, unless we're talking to an old Cabal -- in which case we use configConstraints - -- NB: This does NOT use nodeNeighbors, which includes executable + -- NB: This does NOT use InstallPlan.depends, which includes executable -- dependencies which should NOT be fed in here (also you don't have -- enough info anyway) configDependencies = [ (packageName srcid, cid) From c0a4860202393882d2fd0f4de253c3af3a092fe2 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Fri, 19 Aug 2016 23:08:18 -0700 Subject: [PATCH 20/23] Solve for, build, and add to path build-tools dependencies. This fixes #220: new-build now builds, installs and adds executables to PATH automatically if they show up in 'build-tools'. However, there is still more that could be done: the new behavior only applies to a specific list of 'build-tools' (alex, happy, etc) which Cabal recognizes out of the box. The plan is to introduce a new 'tool-depends' field to allow dependencies on other executables as well. Signed-off-by: Edward Z. Yang --- Cabal/Distribution/Simple/Configure.hs | 4 +- .../Distribution/Client/Dependency.hs | 3 +- .../Distribution/Client/InstallPlan.hs | 8 +- .../Distribution/Client/ProjectPlanning.hs | 101 ++++++++++++++---- .../Client/ProjectPlanning/Types.hs | 23 +++- .../Distribution/Client/SolverInstallPlan.hs | 14 +-- .../Distribution/Solver/Modular/Assignment.hs | 4 +- .../Distribution/Solver/Modular/Builder.hs | 8 +- .../Solver/Modular/ConfiguredConversion.hs | 46 +++++--- .../Distribution/Solver/Modular/Dependency.hs | 35 +++--- .../Distribution/Solver/Modular/Index.hs | 2 +- .../Solver/Modular/IndexConversion.hs | 94 ++++++++-------- .../Distribution/Solver/Modular/Linking.hs | 2 +- .../Distribution/Solver/Modular/Package.hs | 9 +- .../Distribution/Solver/Modular/Validate.hs | 3 +- .../Solver/Types/InstSolverPackage.hs | 28 +++++ .../Distribution/Solver/Types/PackagePath.hs | 13 +++ .../Solver/Types/ResolverPackage.hs | 26 +++-- .../Solver/Types/SolverPackage.hs | 3 +- cabal-install/cabal-install.cabal | 7 ++ .../new-build/external_build_tools.sh | 3 + .../external_build_tools/cabal.project | 1 + .../external_build_tools/client/Hello.hs | 8 ++ .../external_build_tools/client/client.cabal | 13 +++ .../happy/MyCustomPreprocessor.hs | 11 ++ .../external_build_tools/happy/happy.cabal | 12 +++ .../Distribution/Solver/Modular/DSL.hs | 45 ++++++-- .../Distribution/Solver/Modular/Solver.hs | 51 +++++++++ 28 files changed, 436 insertions(+), 141 deletions(-) create mode 100644 cabal-install/Distribution/Solver/Types/InstSolverPackage.hs create mode 100644 cabal-install/tests/IntegrationTests/new-build/external_build_tools.sh create mode 100644 cabal-install/tests/IntegrationTests/new-build/external_build_tools/cabal.project create mode 100644 cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/Hello.hs create mode 100644 cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/client.cabal create mode 100644 cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/MyCustomPreprocessor.hs create mode 100644 cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/happy.cabal diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs index 7946ca556a4..d65fd778196 100644 --- a/Cabal/Distribution/Simple/Configure.hs +++ b/Cabal/Distribution/Simple/Configure.hs @@ -1393,7 +1393,9 @@ configureRequiredProgram :: Verbosity -> ProgramConfiguration -> Dependency configureRequiredProgram verbosity conf (Dependency (PackageName progName) verRange) = case lookupKnownProgram progName conf of - Nothing -> die ("Unknown build tool " ++ progName) + Nothing -> + -- Try to configure it as a 'simpleProgram' automatically + configureProgram verbosity (simpleProgram progName) conf Just prog -- requireProgramVersion always requires the program have a version -- but if the user says "build-depends: foo" ie no version constraint diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs index c577991d564..92e322905fb 100644 --- a/cabal-install/Distribution/Client/Dependency.hs +++ b/cabal-install/Distribution/Client/Dependency.hs @@ -768,7 +768,7 @@ showPackageProblem (InvalidDep dep pkgid) = configuredPackageProblems :: Platform -> CompilerInfo -> SolverPackage UnresolvedPkgLoc -> [PackageProblem] configuredPackageProblems platform cinfo - (SolverPackage pkg specifiedFlags stanzas specifiedDeps') = + (SolverPackage pkg specifiedFlags stanzas specifiedDeps' _specifiedExeDeps') = [ DuplicateFlag flag | ((flag,_):_) <- duplicates specifiedFlags ] ++ [ MissingFlag flag | OnlyInLeft flag <- mergedFlags ] ++ [ ExtraFlag flag | OnlyInRight flag <- mergedFlags ] @@ -779,6 +779,7 @@ configuredPackageProblems platform cinfo ++ [ ExtraDep pkgid | OnlyInRight pkgid <- mergedDeps ] ++ [ InvalidDep dep pkgid | InBoth dep pkgid <- mergedDeps , not (packageSatisfiesDependency pkgid dep) ] + -- TODO: sanity tests on executable deps where specifiedDeps :: ComponentDeps [PackageId] specifiedDeps = fmap (map solverSrcId) specifiedDeps' diff --git a/cabal-install/Distribution/Client/InstallPlan.hs b/cabal-install/Distribution/Client/InstallPlan.hs index fbc923265d5..66167b1c641 100644 --- a/cabal-install/Distribution/Client/InstallPlan.hs +++ b/cabal-install/Distribution/Client/InstallPlan.hs @@ -79,6 +79,7 @@ import Distribution.Client.SolverInstallPlan (SolverInstallPlan) import qualified Distribution.Solver.Types.ComponentDeps as CD import Distribution.Solver.Types.Settings import Distribution.Solver.Types.SolverId +import Distribution.Solver.Types.InstSolverPackage -- TODO: Need this when we compute final UnitIds -- import qualified Distribution.Simple.Configure as Configure @@ -415,8 +416,8 @@ configureInstallPlan :: SolverInstallPlan -> InstallPlan configureInstallPlan solverPlan = flip fromSolverInstallPlan solverPlan $ \mapDep planpkg -> [case planpkg of - SolverInstallPlan.PreExisting pkg _ -> - PreExisting pkg + SolverInstallPlan.PreExisting pkg -> + PreExisting (instSolverPkgIPI pkg) SolverInstallPlan.Configured pkg -> Configured (configureSolverPackage mapDep pkg) @@ -438,9 +439,10 @@ configureInstallPlan solverPlan = confPkgFlags = solverPkgFlags spkg, confPkgStanzas = solverPkgStanzas spkg, confPkgDeps = deps + -- NB: no support for executable dependencies } where - deps = fmap (concatMap (map configuredId . mapDep)) (solverPkgDeps spkg) + deps = fmap (concatMap (map configuredId . mapDep)) (solverPkgLibDeps spkg) -- ------------------------------------------------------------ diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index 35383209033..c3faba0bb71 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -79,6 +79,7 @@ import Distribution.Solver.Types.PkgConfigDb import Distribution.Solver.Types.Settings import Distribution.Solver.Types.SolverId import Distribution.Solver.Types.SolverPackage +import Distribution.Solver.Types.InstSolverPackage import Distribution.Solver.Types.SourcePackage import Distribution.Package hiding @@ -1040,8 +1041,8 @@ elaborateInstallPlan platform compiler compilerprogdb elaboratedInstallPlan = flip InstallPlan.fromSolverInstallPlan solverPlan $ \mapDep planpkg -> case planpkg of - SolverInstallPlan.PreExisting pkg _ -> - [InstallPlan.PreExisting pkg] + SolverInstallPlan.PreExisting pkg -> + [InstallPlan.PreExisting (instSolverPkgIPI pkg)] SolverInstallPlan.Configured pkg -> -- SolverPackage @@ -1073,7 +1074,7 @@ elaborateInstallPlan platform compiler compilerprogdb :: (SolverId -> [ElaboratedPlanPackage]) -> SolverPackage UnresolvedPkgLoc -> [ElaboratedConfiguredPackage] - elaborateSolverToComponents mapDep spkg@(SolverPackage _ _ _ deps0) + elaborateSolverToComponents mapDep spkg@(SolverPackage _ _ _ deps0 exe_deps0) = snd (mapAccumL buildComponent (Map.empty, Map.empty) comps_graph) where elab0@ElaboratedConfiguredPackage{..} = elaborateSolverToCommon mapDep spkg @@ -1121,19 +1122,28 @@ elaborateInstallPlan platform compiler compilerprogdb compComponentName = Just cname compSolverName = CD.componentNameToComponent cname compLibDependencies = - concatMap (elaborateSolverId mapDep) + concatMap (elaborateLibSolverId mapDep) (CD.select (== compSolverName) deps0) ++ internal_lib_deps + compExeDependencies = + (map confInstId $ + concatMap (elaborateExeSolverId mapDep) + (CD.select (== compSolverName) exe_deps0)) ++ + internal_exe_deps + compExeDependencyPaths = + concatMap (elaborateExePath mapDep) + (CD.select (== compSolverName) exe_deps0) ++ + internal_exe_paths bi = Cabal.componentBuildInfo comp confid = ConfiguredId elabPkgSourceId cid - compSetupDependencies = concatMap (elaborateSolverId mapDep) (CD.setupDeps deps0) + compSetupDependencies = concatMap (elaborateLibSolverId mapDep) (CD.setupDeps deps0) internal_lib_deps = [ confid' | Dependency pkgname _ <- PD.targetBuildDepends bi , Just confid' <- [Map.lookup pkgname internal_map] ] - (compExeDependencies, compExeDependencyPaths) + (internal_exe_deps, internal_exe_paths) = unzip $ [ (confInstId confid', path) | Dependency (PackageName toolname) _ <- PD.buildTools bi @@ -1190,22 +1200,56 @@ elaborateInstallPlan platform compiler compilerprogdb (compilerId compiler) cid - elaborateSolverId :: (SolverId -> [ElaboratedPlanPackage]) + elaborateLibSolverId :: (SolverId -> [ElaboratedPlanPackage]) -> SolverId -> [ConfiguredId] - elaborateSolverId mapDep = map configuredId . filter is_lib . mapDep + elaborateLibSolverId mapDep = map configuredId . filter is_lib . mapDep where is_lib (InstallPlan.PreExisting _) = True is_lib (InstallPlan.Configured elab) = case elabPkgOrComp elab of ElabPackage _ -> True ElabComponent comp -> compSolverName comp == CD.ComponentLib + elaborateExeSolverId :: (SolverId -> [ElaboratedPlanPackage]) + -> SolverId -> [ConfiguredId] + elaborateExeSolverId mapDep = map configuredId . filter is_exe . mapDep + where is_exe (InstallPlan.PreExisting _) = False + is_exe (InstallPlan.Configured elab) = + case elabPkgOrComp elab of + ElabPackage _ -> True + ElabComponent comp -> + case compSolverName comp of + CD.ComponentExe _ -> True + _ -> False + + elaborateExePath :: (SolverId -> [ElaboratedPlanPackage]) + -> SolverId -> [FilePath] + elaborateExePath mapDep = concatMap get_exe_path . mapDep + where + -- Pre-existing executables are assumed to be in PATH + -- already. In fact, this should be impossible. + -- Modest duplication with 'inplace_bin_dir' + get_exe_path (InstallPlan.PreExisting _) = [] + get_exe_path (InstallPlan.Configured elab) = + [if elabBuildStyle elab == BuildInplaceOnly + then distBuildDirectory + (elabDistDirParams elaboratedSharedConfig elab) + "build" + case elabPkgOrComp elab of + ElabPackage _ -> "" + ElabComponent comp -> + case fmap Cabal.componentNameString + (compComponentName comp) of + Just (Just n) -> n + _ -> "" + else InstallDirs.bindir (elabInstallDirs elab)] + elaborateSolverToPackage :: (SolverId -> [ElaboratedPlanPackage]) -> SolverPackage UnresolvedPkgLoc -> ElaboratedConfiguredPackage elaborateSolverToPackage mapDep pkg@(SolverPackage (SourcePackage pkgid _gdesc _srcloc _descOverride) - _flags _stanzas deps0) = + _flags _stanzas deps0 exe_deps0) = -- Knot tying: the final elab includes the -- pkgInstalledId, which is calculated by hashing many -- of the other fields of the elaboratedPackage. @@ -1219,7 +1263,7 @@ elaborateInstallPlan platform compiler compilerprogdb elabPkgOrComp = ElabPackage $ ElaboratedPackage {..} } - deps = fmap (concatMap (elaborateSolverId mapDep)) deps0 + deps = fmap (concatMap (elaborateLibSolverId mapDep)) deps0 requires_reg = PD.hasPublicLib elabPkgDescription pkgInstalledId @@ -1238,6 +1282,8 @@ elaborateInstallPlan platform compiler compilerprogdb ++ " is missing a source hash: " ++ display pkgid pkgLibDependencies = deps + pkgExeDependencies = fmap (concatMap (elaborateExeSolverId mapDep)) exe_deps0 + pkgExeDependencyPaths = fmap (concatMap (elaborateExePath mapDep)) exe_deps0 -- Filled in later pkgStanzasEnabled = Set.empty @@ -1269,7 +1315,7 @@ elaborateInstallPlan platform compiler compilerprogdb -> ElaboratedConfiguredPackage elaborateSolverToCommon mapDep pkg@(SolverPackage (SourcePackage pkgid gdesc srcloc descOverride) - flags stanzas deps0) = + flags stanzas deps0 _exe_deps0) = elaboratedPackage where elaboratedPackage = ElaboratedConfiguredPackage {..} @@ -1332,7 +1378,7 @@ elaborateInstallPlan platform compiler compilerprogdb elabSetupScriptStyle = packageSetupScriptStyle elabPkgDescription -- Computing the deps here is a little awful - deps = fmap (concatMap (elaborateSolverId mapDep)) deps0 + deps = fmap (concatMap (elaborateLibSolverId mapDep)) deps0 elabSetupScriptCliVersion = packageSetupScriptSpecVersion elabSetupScriptStyle elabPkgDescription deps elabSetupPackageDBStack = buildAndRegisterDbs @@ -1838,7 +1884,8 @@ pruneInstallPlanPass2 pkgs = setStanzasDepsAndTargets elab = elab { elabBuildTargets = elabBuildTargets elab - ++ targetsRequiredForRevDeps, + ++ libTargetsRequiredForRevDeps + ++ exeTargetsRequiredForRevDeps, elabPkgOrComp = case elabPkgOrComp elab of ElabPackage pkg -> @@ -1849,15 +1896,24 @@ pruneInstallPlanPass2 pkgs = keepNeeded _ _ = True in ElabPackage $ pkg { pkgStanzasEnabled = stanzas, - pkgLibDependencies = CD.filterDeps keepNeeded (pkgLibDependencies pkg) + pkgLibDependencies = CD.filterDeps keepNeeded (pkgLibDependencies pkg), + pkgExeDependencies = CD.filterDeps keepNeeded (pkgExeDependencies pkg), + pkgExeDependencyPaths = CD.filterDeps keepNeeded (pkgExeDependencyPaths pkg) } r@(ElabComponent _) -> r } where - targetsRequiredForRevDeps = + libTargetsRequiredForRevDeps = [ ComponentTarget Cabal.defaultLibName WholeComponent | installedUnitId elab `Set.member` hasReverseLibDeps ] + exeTargetsRequiredForRevDeps = + -- TODO: allow requesting executable with different name + -- than package name + [ ComponentTarget (Cabal.CExeName (unPackageName (packageName (elabPkgSourceId elab)))) + WholeComponent + | installedUnitId elab `Set.member` hasReverseExeDeps + ] availablePkgs :: Set UnitId @@ -1865,8 +1921,15 @@ pruneInstallPlanPass2 pkgs = hasReverseLibDeps :: Set UnitId hasReverseLibDeps = - Set.fromList [ depid | pkg <- pkgs - , depid <- InstallPlan.depends pkg ] + Set.fromList [ SimpleUnitId (confInstId depid) + | InstallPlan.Configured pkg <- pkgs + , depid <- elabLibDependencies pkg ] + + hasReverseExeDeps :: Set UnitId + hasReverseExeDeps = + Set.fromList [ SimpleUnitId depid + | InstallPlan.Configured pkg <- pkgs + , depid <- elabExeDependencies pkg ] mapConfiguredPackage :: (srcpkg -> srcpkg') -> InstallPlan.GenericPlanPackage ipkg srcpkg @@ -2436,7 +2499,9 @@ packageHashInputs ElabPackage (ElaboratedPackage{..}) -> Set.fromList $ [ confInstId dep - | dep <- CD.select relevantDeps pkgLibDependencies ] + | dep <- CD.select relevantDeps pkgLibDependencies ] ++ + [ confInstId dep + | dep <- CD.select relevantDeps pkgExeDependencies ] ElabComponent comp -> Set.fromList (map confInstId (compLibDependencies comp) ++ compExeDependencies comp), diff --git a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs index f0d7b947276..6ba3f3a9e77 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning/Types.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning/Types.hs @@ -16,6 +16,7 @@ module Distribution.Client.ProjectPlanning.Types ( elabDistDirParams, elabExeDependencyPaths, elabLibDependencies, + elabExeDependencies, elabSetupDependencies, ElaboratedPackageOrComponent(..), @@ -73,6 +74,7 @@ import Data.Set (Set) import qualified Data.ByteString.Lazy as LBS import Distribution.Compat.Binary import GHC.Generics (Generic) +import qualified Data.Monoid as Mon @@ -296,9 +298,15 @@ elabLibDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage pk elabLibDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp } = compLibDependencies comp +elabExeDependencies :: ElaboratedConfiguredPackage -> [ComponentId] +elabExeDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage pkg } + = map confInstId (CD.nonSetupDeps (pkgExeDependencies pkg)) +elabExeDependencies ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp } + = compExeDependencies comp + elabExeDependencyPaths :: ElaboratedConfiguredPackage -> [FilePath] -elabExeDependencyPaths ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage _ } - = [] -- TODO: not implemented +elabExeDependencyPaths ElaboratedConfiguredPackage { elabPkgOrComp = ElabPackage pkg } + = CD.nonSetupDeps (pkgExeDependencyPaths pkg) elabExeDependencyPaths ElaboratedConfiguredPackage { elabPkgOrComp = ElabComponent comp } = compExeDependencyPaths comp @@ -353,6 +361,14 @@ data ElaboratedPackage -- pkgLibDependencies :: ComponentDeps [ConfiguredId], + -- | Dependencies on executable packages. + -- + pkgExeDependencies :: ComponentDeps [ConfiguredId], + + -- | Paths where executable dependencies live. + -- + pkgExeDependencyPaths :: ComponentDeps [FilePath], + -- | Which optional stanzas (ie testsuites, benchmarks) will actually -- be enabled during the package configure step. pkgStanzasEnabled :: Set OptionalStanza @@ -363,7 +379,8 @@ instance Binary ElaboratedPackage pkgOrderDependencies :: ElaboratedPackage -> ComponentDeps [UnitId] pkgOrderDependencies pkg = - fmap (map (SimpleUnitId . confInstId)) (pkgLibDependencies pkg) + fmap (map (SimpleUnitId . confInstId)) (pkgLibDependencies pkg) `Mon.mappend` + fmap (map (SimpleUnitId . confInstId)) (pkgExeDependencies pkg) -- | This is used in the install plan to indicate how the package will be -- built. diff --git a/cabal-install/Distribution/Client/SolverInstallPlan.hs b/cabal-install/Distribution/Client/SolverInstallPlan.hs index bfa064095b1..0a6cd44a6a2 100644 --- a/cabal-install/Distribution/Client/SolverInstallPlan.hs +++ b/cabal-install/Distribution/Client/SolverInstallPlan.hs @@ -125,7 +125,7 @@ showInstallPlan :: SolverInstallPlan -> String showInstallPlan = showPlanIndex . planIndex showPlanPackage :: SolverPlanPackage -> String -showPlanPackage (PreExisting ipkg _) = "PreExisting " ++ display (packageId ipkg) +showPlanPackage (PreExisting ipkg) = "PreExisting " ++ display (packageId ipkg) ++ " (" ++ display (installedUnitId ipkg) ++ ")" showPlanPackage (Configured spkg) = "Configured " ++ display (packageId spkg) @@ -207,7 +207,7 @@ showPlanProblem (PackageStateInvalid pkg pkg') = ++ " which is in the " ++ showPlanState pkg' ++ " state" where - showPlanState (PreExisting _ _) = "pre-existing" + showPlanState (PreExisting _) = "pre-existing" showPlanState (Configured _) = "configured" -- | For an invalid plan, produce a detailed list of problems as human readable @@ -279,7 +279,7 @@ nonSetupClosure index pkgids0 = closure Graph.empty pkgids0 Just _ -> closure completed pkgids Nothing -> closure completed' pkgids' where completed' = Graph.insert pkg completed - pkgids' = CD.nonSetupDeps (resolverPackageDeps pkg) ++ pkgids + pkgids' = CD.nonSetupDeps (resolverPackageLibDeps pkg) ++ pkgids -- | Compute the root sets of a plan -- @@ -310,7 +310,7 @@ libraryRoots index = -- | The setup dependencies of each package in the plan setupRoots :: SolverPlanIndex -> [[SolverId]] setupRoots = filter (not . null) - . map (CD.setupDeps . resolverPackageDeps) + . map (CD.setupDeps . resolverPackageLibDeps) . Graph.toList -- | Given a package index where we assume we want to use all the packages @@ -342,7 +342,7 @@ dependencyInconsistencies' index = | -- For each package @pkg@ pkg <- Graph.toList index -- Find out which @sid@ @pkg@ depends on - , sid <- CD.nonSetupDeps (resolverPackageDeps pkg) + , sid <- CD.nonSetupDeps (resolverPackageLibDeps pkg) -- And look up those @sid@ (i.e., @sid@ is the ID of @dep@) , Just dep <- [Graph.lookup sid index] ] @@ -358,8 +358,8 @@ dependencyInconsistencies' index = reallyIsInconsistent [p1, p2] = let pid1 = nodeKey p1 pid2 = nodeKey p2 - in pid1 `notElem` CD.nonSetupDeps (resolverPackageDeps p2) - && pid2 `notElem` CD.nonSetupDeps (resolverPackageDeps p1) + in pid1 `notElem` CD.nonSetupDeps (resolverPackageLibDeps p2) + && pid2 `notElem` CD.nonSetupDeps (resolverPackageLibDeps p1) reallyIsInconsistent _ = True diff --git a/cabal-install/Distribution/Solver/Modular/Assignment.hs b/cabal-install/Distribution/Solver/Modular/Assignment.hs index 9de3c03838a..56303c412b3 100644 --- a/cabal-install/Distribution/Solver/Modular/Assignment.hs +++ b/cabal-install/Distribution/Solver/Modular/Assignment.hs @@ -82,10 +82,10 @@ extend extSupported langSupported pkgPresent var = foldM extendSingle extendSingle a (Pkg pn vr) = if pkgPresent pn vr then Right a else Left (varToConflictSet var, [Pkg pn vr]) - extendSingle a (Dep qpn ci) = + extendSingle a (Dep is_exe qpn ci) = let ci' = M.findWithDefault (Constrained []) qpn a in case (\ x -> M.insert qpn x a) <$> merge ci' ci of - Left (c, (d, d')) -> Left (c, L.map (Dep qpn) (simplify (P qpn) d d')) + Left (c, (d, d')) -> Left (c, L.map (Dep is_exe qpn) (simplify (P qpn) d d')) Right x -> Right x -- We're trying to remove trivial elements of the conflict. If we're just diff --git a/cabal-install/Distribution/Solver/Modular/Builder.hs b/cabal-install/Distribution/Solver/Modular/Builder.hs index 591679ac34d..722194f145f 100644 --- a/cabal-install/Distribution/Solver/Modular/Builder.hs +++ b/cabal-install/Distribution/Solver/Modular/Builder.hs @@ -55,7 +55,7 @@ extendOpen qpn' gs s@(BS { rdeps = gs', open = o' }) = go gs' o' gs -- This is important, because in general, if a goal is inserted twice, -- the later addition will have better dependency information. go g o (ng@(OpenGoal (Stanza _ _ ) _gr) : ngs) = go g (cons' ng () o) ngs - go g o (ng@(OpenGoal (Simple (Dep qpn _) c) _gr) : ngs) + go g o (ng@(OpenGoal (Simple (Dep _ qpn _) c) _gr) : ngs) | qpn == qpn' = go g o ngs -- we ignore self-dependencies at this point; TODO: more care may be needed | qpn `M.member` g = go (M.adjust ((c, qpn'):) qpn g) o ngs @@ -127,7 +127,7 @@ build = ana go error "Distribution.Solver.Modular.Builder: build.go called with Lang goal" go (BS { index = _ , next = OneGoal (OpenGoal (Simple (Pkg _ _ ) _) _ ) }) = error "Distribution.Solver.Modular.Builder: build.go called with Pkg goal" - go bs@(BS { index = idx, next = OneGoal (OpenGoal (Simple (Dep qpn@(Q _ pn) _) _) gr) }) = + go bs@(BS { index = idx, next = OneGoal (OpenGoal (Simple (Dep _ qpn@(Q _ pn) _) _) gr) }) = -- If the package does not exist in the index, we construct an emty PChoiceF node for it -- After all, we have no choices here. Alternatively, we could immediately construct -- a Fail node here, but that would complicate the construction of conflict sets. @@ -186,7 +186,9 @@ buildTree idx (IndependentGoals ind) igs = , qualifyOptions = defaultQualifyOptions idx } where - topLevelGoal qpn = OpenGoal (Simple (Dep qpn (Constrained [])) ()) UserGoal + -- Should a top-level goal allowed to be an executable style + -- dependency? Well, I don't think it would make much difference + topLevelGoal qpn = OpenGoal (Simple (Dep False {- not exe -} qpn (Constrained [])) ()) UserGoal qpns | ind = makeIndependent igs | otherwise = L.map (Q (PackagePath DefaultNamespace Unqualified)) igs diff --git a/cabal-install/Distribution/Solver/Modular/ConfiguredConversion.hs b/cabal-install/Distribution/Solver/Modular/ConfiguredConversion.hs index bb2e1999c93..10cf411303e 100644 --- a/cabal-install/Distribution/Solver/Modular/ConfiguredConversion.hs +++ b/cabal-install/Distribution/Solver/Modular/ConfiguredConversion.hs @@ -4,6 +4,7 @@ module Distribution.Solver.Modular.ConfiguredConversion import Data.Maybe import Prelude hiding (pi) +import Data.Either (partitionEithers) import Distribution.Package (UnitId, packageId) @@ -18,6 +19,7 @@ import Distribution.Solver.Types.PackagePath import Distribution.Solver.Types.ResolverPackage import Distribution.Solver.Types.SolverId import Distribution.Solver.Types.SolverPackage +import Distribution.Solver.Types.InstSolverPackage import Distribution.Solver.Types.SourcePackage -- | Converts from the solver specific result @CP QPN@ into @@ -28,27 +30,43 @@ convCP :: SI.InstalledPackageIndex -> CP QPN -> ResolverPackage loc convCP iidx sidx (CP qpi fa es ds) = case convPI qpi of - Left pi -> PreExisting - (fromJust $ SI.lookupUnitId iidx pi) ds' - Right pi -> Configured $ SolverPackage - srcpkg - fa - es - ds' + Left pi -> PreExisting $ + InstSolverPackage { + instSolverPkgIPI = fromJust $ SI.lookupUnitId iidx pi, + instSolverPkgLibDeps = fmap fst ds', + instSolverPkgExeDeps = fmap snd ds' + } + Right pi -> Configured $ + SolverPackage { + solverPkgSource = srcpkg, + solverPkgFlags = fa, + solverPkgStanzas = es, + solverPkgLibDeps = fmap fst ds', + solverPkgExeDeps = fmap snd ds' + } where Just srcpkg = CI.lookupPackageId sidx pi where - ds' :: ComponentDeps [SolverId] - ds' = fmap (map convConfId) ds + ds' :: ComponentDeps ([SolverId] {- lib -}, [SolverId] {- exe -}) + ds' = fmap (partitionEithers . map convConfId) ds convPI :: PI QPN -> Either UnitId PackageId convPI (PI _ (I _ (Inst pi))) = Left pi -convPI pi = Right (packageId (convConfId pi)) +convPI pi = Right (packageId (either id id (convConfId pi))) -convConfId :: PI QPN -> SolverId -convConfId (PI (Q _ pn) (I v loc)) = +convConfId :: PI QPN -> Either SolverId {- is lib -} SolverId {- is exe -} +convConfId (PI (Q (PackagePath _ q) pn) (I v loc)) = case loc of - Inst pi -> PreExistingId sourceId pi - _otherwise -> PlannedId sourceId + Inst pi -> Left (PreExistingId sourceId pi) + _otherwise + | Exe _ pn' <- q + -- NB: the dependencies of the executable are also + -- qualified. So the way to tell if this is an executable + -- dependency is to make sure the qualifier is pointing + -- at the actual thing. Fortunately for us, I was + -- silly and didn't allow arbitrarily nested build-tools + -- dependencies, so a shallow check works. + , pn == pn' -> Right (PlannedId sourceId) + | otherwise -> Left (PlannedId sourceId) where sourceId = PackageIdentifier pn v diff --git a/cabal-install/Distribution/Solver/Modular/Dependency.hs b/cabal-install/Distribution/Solver/Modular/Dependency.hs index d4af4f35648..4c2242ec2d1 100644 --- a/cabal-install/Distribution/Solver/Modular/Dependency.hs +++ b/cabal-install/Distribution/Solver/Modular/Dependency.hs @@ -165,6 +165,9 @@ flattenFlaggedDeps = concatMap aux type TrueFlaggedDeps qpn = FlaggedDeps Component qpn type FalseFlaggedDeps qpn = FlaggedDeps Component qpn +-- | Is this dependency on an executable +type IsExe = Bool + -- | A dependency (constraint) associates a package name with a -- constrained instance. -- @@ -172,20 +175,22 @@ type FalseFlaggedDeps qpn = FlaggedDeps Component qpn -- is used both to record the dependencies as well as who's doing the -- depending; having a 'Functor' instance makes bugs where we don't distinguish -- these two far too likely. (By rights 'Dep' ought to have two type variables.) -data Dep qpn = Dep qpn (CI qpn) -- dependency on a package +data Dep qpn = Dep IsExe qpn (CI qpn) -- dependency on a package (possibly for executable | Ext Extension -- dependency on a language extension | Lang Language -- dependency on a language version | Pkg PN VR -- dependency on a pkg-config package deriving (Eq, Show) showDep :: Dep QPN -> String -showDep (Dep qpn (Fixed i v) ) = +showDep (Dep is_exe qpn (Fixed i v) ) = (if P qpn /= v then showVar v ++ " => " else "") ++ - showQPN qpn ++ "==" ++ showI i -showDep (Dep qpn (Constrained [(vr, v)])) = - showVar v ++ " => " ++ showQPN qpn ++ showVR vr -showDep (Dep qpn ci ) = - showQPN qpn ++ showCI ci + showQPN qpn ++ + (if is_exe then " (exe) " else "") ++ "==" ++ showI i +showDep (Dep is_exe qpn (Constrained [(vr, v)])) = + showVar v ++ " => " ++ showQPN qpn ++ + (if is_exe then " (exe) " else "") ++ showVR vr +showDep (Dep is_exe qpn ci ) = + showQPN qpn ++ (if is_exe then " (exe) " else "") ++ showCI ci showDep (Ext ext) = "requires " ++ display ext showDep (Lang lang) = "requires " ++ display lang showDep (Pkg pn vr) = "requires pkg-config package " @@ -237,10 +242,11 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go goD (Ext ext) _ = Ext ext goD (Lang lang) _ = Lang lang goD (Pkg pkn vr) _ = Pkg pkn vr - goD (Dep dep ci) comp - | qBase dep = Dep (Q (PackagePath ns (Base pn)) dep) (fmap (Q pp) ci) - | qSetup comp = Dep (Q (PackagePath ns (Setup pn)) dep) (fmap (Q pp) ci) - | otherwise = Dep (Q (PackagePath ns inheritedQ) dep) (fmap (Q pp) ci) + goD (Dep is_exe dep ci) comp + | is_exe = Dep is_exe (Q (PackagePath ns (Exe pn dep)) dep) (fmap (Q pp) ci) + | qBase dep = Dep is_exe (Q (PackagePath ns (Base pn)) dep) (fmap (Q pp) ci) + | qSetup comp = Dep is_exe (Q (PackagePath ns (Setup pn)) dep) (fmap (Q pp) ci) + | otherwise = Dep is_exe (Q (PackagePath ns inheritedQ) dep) (fmap (Q pp) ci) -- If P has a setup dependency on Q, and Q has a regular dependency on R, then -- we say that the 'Setup' qualifier is inherited: P has an (indirect) setup @@ -252,6 +258,7 @@ qualifyDeps QO{..} (Q pp@(PackagePath ns q) pn) = go inheritedQ :: Qualifier inheritedQ = case q of Setup _ -> q + Exe _ _ -> q Unqualified -> q Base _ -> Unqualified @@ -282,7 +289,7 @@ unqualifyDeps = go go1 (Simple dep comp) = Simple (goD dep) comp goD :: Dep QPN -> Dep PN - goD (Dep qpn ci) = Dep (unq qpn) (fmap unq ci) + goD (Dep is_exe qpn ci) = Dep is_exe (unq qpn) (fmap unq ci) goD (Ext ext) = Ext ext goD (Lang lang) = Lang lang goD (Pkg pn vr) = Pkg pn vr @@ -354,7 +361,7 @@ instance ResetVar CI where resetVar v (Constrained vrs) = Constrained (L.map (\ (x, y) -> (x, resetVar v y)) vrs) instance ResetVar Dep where - resetVar v (Dep qpn ci) = Dep qpn (resetVar v ci) + resetVar v (Dep is_exe qpn ci) = Dep is_exe qpn (resetVar v ci) resetVar _ (Ext ext) = Ext ext resetVar _ (Lang lang) = Lang lang resetVar _ (Pkg pn vr) = Pkg pn vr @@ -401,7 +408,7 @@ data OpenGoal comp = OpenGoal (FlaggedDep comp QPN) QGoalReason -- | Closes a goal, i.e., removes all the extraneous information that we -- need only during the build phase. close :: OpenGoal comp -> Goal QPN -close (OpenGoal (Simple (Dep qpn _) _) gr) = Goal (P qpn) gr +close (OpenGoal (Simple (Dep _ qpn _) _) gr) = Goal (P qpn) gr close (OpenGoal (Simple (Ext _) _) _ ) = error "Distribution.Solver.Modular.Dependency.close: called on Ext goal" close (OpenGoal (Simple (Lang _) _) _ ) = diff --git a/cabal-install/Distribution/Solver/Modular/Index.hs b/cabal-install/Distribution/Solver/Modular/Index.hs index 7fc55e42735..56a8f708763 100644 --- a/cabal-install/Distribution/Solver/Modular/Index.hs +++ b/cabal-install/Distribution/Solver/Modular/Index.hs @@ -44,7 +44,7 @@ defaultQualifyOptions idx = QO { -- .. which are installed .. , (I _ver (Inst _), PInfo deps _flagNfo _fr) <- M.toList is -- .. and flatten all their dependencies .. - , (Dep dep _ci, _comp) <- flattenFlaggedDeps deps + , (Dep _is_exe dep _ci, _comp) <- flattenFlaggedDeps deps ] , qoSetupIndependent = True } diff --git a/cabal-install/Distribution/Solver/Modular/IndexConversion.hs b/cabal-install/Distribution/Solver/Modular/IndexConversion.hs index 971c7796bfd..48942ffd541 100644 --- a/cabal-install/Distribution/Solver/Modular/IndexConversion.hs +++ b/cabal-install/Distribution/Solver/Modular/IndexConversion.hs @@ -87,7 +87,9 @@ convIPId pn' idx ipid = Nothing -> Nothing Just ipi -> let i = I (pkgVersion (sourcePackageId ipi)) (Inst ipid) pn = pkgName (sourcePackageId ipi) - in Just (D.Simple (Dep pn (Fixed i (P pn'))) ()) + in Just (D.Simple (Dep False pn (Fixed i (P pn'))) ()) + -- NB: something we pick up from the + -- InstalledPackageIndex is NEVER an executable -- | Convert a cabal-install source package index to the simpler, -- more uniform index format of the solver. @@ -118,8 +120,10 @@ convGPD os arch cinfo strfl pi -- and thus cannot actually be solved over. We'll do this -- by creating a set of package names which are "internal" -- and dropping them as we convert. - ipns = S.fromList [ PackageName nm - | (nm, _) <- sub_libs ] + ipns = S.fromList $ [ PackageName nm + | (nm, _) <- sub_libs ] ++ + [ PackageName nm + | (nm, _) <- exes ] conv :: Mon.Monoid a => Component -> (a -> BuildInfo) -> CondTree ConfVar [Dependency] a -> FlaggedDeps Component PN @@ -139,44 +143,6 @@ convGPD os arch cinfo strfl pi in PInfo flagged_deps fds Nothing --- With convenience libraries, we have to do some work. Imagine you --- have the following Cabal file: --- --- name: foo --- library foo-internal --- build-depends: external-a --- library --- build-depends: foo-internal, external-b --- library foo-helper --- build-depends: foo, external-c --- test-suite foo-tests --- build-depends: foo-helper, external-d --- --- What should the final flagged dependency tree be? Ideally, it --- should look like this: --- --- [ Simple (Dep external-a) (Library foo-internal) --- , Simple (Dep external-b) (Library foo) --- , Stanza (SN foo TestStanzas) $ --- [ Simple (Dep external-c) (Library foo-helper) --- , Simple (Dep external-d) (TestSuite foo-tests) ] --- ] --- --- There are two things to note: --- --- 1. First, we eliminated the "local" dependencies foo-internal --- and foo-helper. This are implicitly assumed to refer to "foo" --- so we don't need to have them around. If you forget this, --- Cabal will then try to pick a version for "foo-helper" but --- no such package exists (this is the cost of overloading --- build-depends to refer to both packages and components.) --- --- 2. Second, it is more precise to have external-c be qualified --- by a test stanza, since foo-helper only needs to be built if --- your are building the test suite (and not the main library). --- If you omit it, Cabal will always attempt to depsolve for --- foo-helper even if you aren't building the test suite. - -- | Create a flagged dependency tree from a list @fds@ of flagged -- dependencies, using @f@ to form the tree node (@f@ will be -- something like @Stanza sn@). @@ -214,15 +180,36 @@ convCondTree :: OS -> Arch -> CompilerInfo -> PI PN -> FlagInfo -> CondTree ConfVar [Dependency] a -> FlaggedDeps Component PN convCondTree os arch cinfo pi@(PI pn _) fds comp getInfo ipns (CondNode info ds branches) = concatMap - (\d -> filterIPNs ipns d (D.Simple (convDep pn d) comp)) + (\d -> filterIPNs ipns d (D.Simple (convLibDep pn d) comp)) ds -- unconditional package dependencies ++ L.map (\e -> D.Simple (Ext e) comp) (PD.allExtensions bi) -- unconditional extension dependencies ++ L.map (\l -> D.Simple (Lang l) comp) (PD.allLanguages bi) -- unconditional language dependencies ++ L.map (\(Dependency pkn vr) -> D.Simple (Pkg pkn vr) comp) (PD.pkgconfigDepends bi) -- unconditional pkg-config dependencies ++ concatMap (convBranch os arch cinfo pi fds comp getInfo ipns) branches + -- build-tools dependencies + ++ concatMap + (\(Dependency (PackageName exe) vr) -> + case packageProvidingBuildTool exe of + Nothing -> [] + Just pn' -> [D.Simple (convExeDep pn (Dependency pn' vr)) comp]) + (PD.buildTools bi) where bi = getInfo info +-- | This function maps known @build-tools@ entries to Haskell package +-- names which provide them. This mapping corresponds exactly to +-- those build-tools that Cabal understands by default +-- ('builtinPrograms'), and are cabal install'able. This mapping is +-- purely for legacy; for other executables, @tool-depends@ should be +-- used instead. +-- +packageProvidingBuildTool :: String -> Maybe PackageName +packageProvidingBuildTool s = + if s `elem` ["hscolour", "haddock", "happy", "alex", "hsc2hs", + "c2hs", "cpphs", "greencard"] + then Just (PackageName s) + else Nothing + -- | Branch interpreter. Mutually recursive with 'convCondTree'. -- -- Here, we try to simplify one of Cabal's condition tree branches into the @@ -300,19 +287,26 @@ convBranch os arch cinfo pi@(PI pn _) fds comp getInfo ipns (c', t', mf') = -- Note that we make assumptions here on the form of the dependencies that -- can occur at this point. In particular, no occurrences of Fixed, and no -- occurrences of multiple version ranges, as all dependencies below this - -- point have been generated using 'convDep'. + -- point have been generated using 'convLibDep'. + -- + -- WARNING: This is quadratic! extractCommon :: FlaggedDeps Component PN -> FlaggedDeps Component PN -> FlaggedDeps Component PN - extractCommon ps ps' = [ D.Simple (Dep pn1 (Constrained [(vr1 .||. vr2, P pn)])) comp - | D.Simple (Dep pn1 (Constrained [(vr1, _)])) _ <- ps - , D.Simple (Dep pn2 (Constrained [(vr2, _)])) _ <- ps' + extractCommon ps ps' = [ D.Simple (Dep is_exe1 pn1 (Constrained [(vr1 .||. vr2, P pn)])) comp + | D.Simple (Dep is_exe1 pn1 (Constrained [(vr1, _)])) _ <- ps + , D.Simple (Dep is_exe2 pn2 (Constrained [(vr2, _)])) _ <- ps' , pn1 == pn2 + , is_exe1 == is_exe2 ] --- | Convert a Cabal dependency to a solver-specific dependency. -convDep :: PN -> Dependency -> Dep PN -convDep pn' (Dependency pn vr) = Dep pn (Constrained [(vr, P pn')]) +-- | Convert a Cabal dependency on a library to a solver-specific dependency. +convLibDep :: PN -> Dependency -> Dep PN +convLibDep pn' (Dependency pn vr) = Dep False {- not exe -} pn (Constrained [(vr, P pn')]) + +-- | Convert a Cabal dependency on a executable (build-tools) to a solver-specific dependency. +convExeDep :: PN -> Dependency -> Dep PN +convExeDep pn' (Dependency pn vr) = Dep True pn (Constrained [(vr, P pn')]) -- | Convert setup dependencies convSetupBuildInfo :: PI PN -> SetupBuildInfo -> FlaggedDeps Component PN convSetupBuildInfo (PI pn _i) nfo = - L.map (\d -> D.Simple (convDep pn d) ComponentSetup) (PD.setupDepends nfo) + L.map (\d -> D.Simple (convLibDep pn d) ComponentSetup) (PD.setupDepends nfo) diff --git a/cabal-install/Distribution/Solver/Modular/Linking.hs b/cabal-install/Distribution/Solver/Modular/Linking.hs index d37a7a17fe4..da77d0c4eff 100644 --- a/cabal-install/Distribution/Solver/Modular/Linking.hs +++ b/cabal-install/Distribution/Solver/Modular/Linking.hs @@ -301,7 +301,7 @@ linkDeps target = \blame deps -> do go1 :: [Var QPN] -> FlaggedDep Component QPN -> FlaggedDep Component QPN -> UpdateState () go1 blame dep rdep = case (dep, rdep) of - (Simple (Dep qpn _) _, ~(Simple (Dep qpn' _) _)) -> do + (Simple (Dep _ qpn _) _, ~(Simple (Dep _ qpn' _) _)) -> do vs <- get let lg = M.findWithDefault (lgSingleton qpn Nothing) qpn $ vsLinks vs lg' = M.findWithDefault (lgSingleton qpn' Nothing) qpn' $ vsLinks vs diff --git a/cabal-install/Distribution/Solver/Modular/Package.hs b/cabal-install/Distribution/Solver/Modular/Package.hs index ee521072392..011a62e38dc 100644 --- a/cabal-install/Distribution/Solver/Modular/Package.hs +++ b/cabal-install/Distribution/Solver/Modular/Package.hs @@ -76,8 +76,12 @@ instI :: I -> Bool instI (I _ (Inst _)) = True instI _ = False --- | Is the package in the primary group of packages. In particular this --- does not include packages pulled in as setup deps. +-- | Is the package in the primary group of packages. This is used to +-- determine (1) if we should try to establish stanza preferences +-- for this goal, and (2) whether or not a user specified @--constraint@ +-- should apply to this dependency (grep 'primaryPP' to see the +-- use sites). In particular this does not include packages pulled in +-- as setup deps. -- primaryPP :: PackagePath -> Bool primaryPP (PackagePath _ns q) = go q @@ -85,6 +89,7 @@ primaryPP (PackagePath _ns q) = go q go Unqualified = True go (Base _) = True go (Setup _) = False + go (Exe _ _) = False -- | Create artificial parents for each of the package names, making -- them all independent. diff --git a/cabal-install/Distribution/Solver/Modular/Validate.hs b/cabal-install/Distribution/Solver/Modular/Validate.hs index abc021baaa4..38a78e60cbd 100644 --- a/cabal-install/Distribution/Solver/Modular/Validate.hs +++ b/cabal-install/Distribution/Solver/Modular/Validate.hs @@ -153,7 +153,8 @@ validate = cata go let qdeps = qualifyDeps qo qpn deps -- the new active constraints are given by the instance we have chosen, -- plus the dependency information we have for that instance - let newactives = Dep qpn (Fixed i (P qpn)) : L.map (resetVar (P qpn)) (extractDeps pfa psa qdeps) + -- TODO: is the False here right? + let newactives = Dep False {- not exe -} qpn (Fixed i (P qpn)) : L.map (resetVar (P qpn)) (extractDeps pfa psa qdeps) -- We now try to extend the partial assignment with the new active constraints. let mnppa = extend extSupported langSupported pkgPresent (P qpn) ppa newactives -- In case we continue, we save the scoped dependencies diff --git a/cabal-install/Distribution/Solver/Types/InstSolverPackage.hs b/cabal-install/Distribution/Solver/Types/InstSolverPackage.hs new file mode 100644 index 00000000000..5c3862a80b7 --- /dev/null +++ b/cabal-install/Distribution/Solver/Types/InstSolverPackage.hs @@ -0,0 +1,28 @@ +{-# LANGUAGE DeriveGeneric #-} +module Distribution.Solver.Types.InstSolverPackage + ( InstSolverPackage(..) + ) where + +import Distribution.Compat.Binary (Binary(..)) +import Distribution.Package ( Package(..), HasUnitId(..) ) +import Distribution.Solver.Types.ComponentDeps ( ComponentDeps ) +import Distribution.Solver.Types.SolverId +import Distribution.InstalledPackageInfo (InstalledPackageInfo) +import GHC.Generics (Generic) + +-- | An 'InstSolverPackage' is a pre-existing installed pacakge +-- specified by the dependency solver. +data InstSolverPackage = InstSolverPackage { + instSolverPkgIPI :: InstalledPackageInfo, + instSolverPkgLibDeps :: ComponentDeps [SolverId], + instSolverPkgExeDeps :: ComponentDeps [SolverId] + } + deriving (Eq, Show, Generic) + +instance Binary InstSolverPackage + +instance Package InstSolverPackage where + packageId = packageId . instSolverPkgIPI + +instance HasUnitId InstSolverPackage where + installedUnitId = installedUnitId . instSolverPkgIPI diff --git a/cabal-install/Distribution/Solver/Types/PackagePath.hs b/cabal-install/Distribution/Solver/Types/PackagePath.hs index f5693fbf4fb..5ba2ecac4e5 100644 --- a/cabal-install/Distribution/Solver/Types/PackagePath.hs +++ b/cabal-install/Distribution/Solver/Types/PackagePath.hs @@ -47,6 +47,18 @@ data Qualifier = -- infinite search trees in the solver. Therefore we limit ourselves to -- a single qualifier (within a given namespace). | Setup PackageName + + -- | If we depend on an executable from a package (via + -- @build-tools@), we should solve for the dependencies of that + -- package separately (since we're not going to actually try to + -- link it.) We qualify for EACH package separately; e.g., + -- @'Exe' pn1 pn2@ qualifies the @build-tools@ dependency on + -- @pn2@ from package @pn1@. (If we tracked only @pn1@, that + -- would require a consistent dependency resolution for all + -- of the depended upon executables from a package; if we + -- tracked only @pn2@, that would require us to pick only one + -- version of an executable over the entire install plan.) + | Exe PackageName PackageName deriving (Eq, Ord, Show) -- | String representation of a package path. @@ -68,6 +80,7 @@ showPP (PackagePath ns q) = -- 'Base' qualifier, will always be @base@). go Unqualified = "" go (Setup pn) = display pn ++ "-setup." + go (Exe pn pn2) = display pn ++ "-" ++ display pn2 ++ "-exe." go (Base pn) = display pn ++ "." -- | A qualified entity. Pairs a package path with the entity. diff --git a/cabal-install/Distribution/Solver/Types/ResolverPackage.hs b/cabal-install/Distribution/Solver/Types/ResolverPackage.hs index 34318eed7ce..277f96e1aa3 100644 --- a/cabal-install/Distribution/Solver/Types/ResolverPackage.hs +++ b/cabal-install/Distribution/Solver/Types/ResolverPackage.hs @@ -2,17 +2,19 @@ {-# LANGUAGE DeriveGeneric #-} module Distribution.Solver.Types.ResolverPackage ( ResolverPackage(..) - , resolverPackageDeps + , resolverPackageLibDeps + , resolverPackageExeDeps ) where +import Distribution.Solver.Types.InstSolverPackage import Distribution.Solver.Types.SolverId import Distribution.Solver.Types.SolverPackage import qualified Distribution.Solver.Types.ComponentDeps as CD import Distribution.Compat.Binary (Binary(..)) import Distribution.Compat.Graph (IsNode(..)) -import Distribution.InstalledPackageInfo (InstalledPackageInfo) import Distribution.Package (Package(..), HasUnitId(..)) +import Distribution.Simple.Utils (ordNub) import GHC.Generics (Generic) -- | The dependency resolver picks either pre-existing installed packages @@ -20,23 +22,29 @@ import GHC.Generics (Generic) -- -- This is like the 'InstallPlan.PlanPackage' but with fewer cases. -- -data ResolverPackage loc = PreExisting InstalledPackageInfo (CD.ComponentDeps [SolverId]) +data ResolverPackage loc = PreExisting InstSolverPackage | Configured (SolverPackage loc) deriving (Eq, Show, Generic) instance Binary loc => Binary (ResolverPackage loc) instance Package (ResolverPackage loc) where - packageId (PreExisting ipkg _) = packageId ipkg + packageId (PreExisting ipkg) = packageId ipkg packageId (Configured spkg) = packageId spkg -resolverPackageDeps :: ResolverPackage loc -> CD.ComponentDeps [SolverId] -resolverPackageDeps (PreExisting _ deps) = deps -resolverPackageDeps (Configured spkg) = solverPkgDeps spkg +resolverPackageLibDeps :: ResolverPackage loc -> CD.ComponentDeps [SolverId] +resolverPackageLibDeps (PreExisting ipkg) = instSolverPkgLibDeps ipkg +resolverPackageLibDeps (Configured spkg) = solverPkgLibDeps spkg + +resolverPackageExeDeps :: ResolverPackage loc -> CD.ComponentDeps [SolverId] +resolverPackageExeDeps (PreExisting ipkg) = instSolverPkgExeDeps ipkg +resolverPackageExeDeps (Configured spkg) = solverPkgExeDeps spkg instance IsNode (ResolverPackage loc) where type Key (ResolverPackage loc) = SolverId - nodeKey (PreExisting ipkg _) = PreExistingId (packageId ipkg) (installedUnitId ipkg) + nodeKey (PreExisting ipkg) = PreExistingId (packageId ipkg) (installedUnitId ipkg) nodeKey (Configured spkg) = PlannedId (packageId spkg) -- Use dependencies for ALL components - nodeNeighbors pkg = CD.flatDeps (resolverPackageDeps pkg) + nodeNeighbors pkg = + ordNub $ CD.flatDeps (resolverPackageLibDeps pkg) ++ + CD.flatDeps (resolverPackageExeDeps pkg) diff --git a/cabal-install/Distribution/Solver/Types/SolverPackage.hs b/cabal-install/Distribution/Solver/Types/SolverPackage.hs index 0bd5f8e8fd7..fc91f717862 100644 --- a/cabal-install/Distribution/Solver/Types/SolverPackage.hs +++ b/cabal-install/Distribution/Solver/Types/SolverPackage.hs @@ -23,7 +23,8 @@ data SolverPackage loc = SolverPackage { solverPkgSource :: SourcePackage loc, solverPkgFlags :: FlagAssignment, solverPkgStanzas :: [OptionalStanza], - solverPkgDeps :: ComponentDeps [SolverId] + solverPkgLibDeps :: ComponentDeps [SolverId], + solverPkgExeDeps :: ComponentDeps [SolverId] } deriving (Eq, Show, Generic) diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index a7e0612e53c..a755cf790c0 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -99,6 +99,12 @@ Extra-Source-Files: tests/IntegrationTests/new-build/executable/Test.hs tests/IntegrationTests/new-build/executable/a.cabal tests/IntegrationTests/new-build/executable/cabal.project + tests/IntegrationTests/new-build/external_build_tools.sh + tests/IntegrationTests/new-build/external_build_tools/cabal.project + tests/IntegrationTests/new-build/external_build_tools/client/Hello.hs + tests/IntegrationTests/new-build/external_build_tools/client/client.cabal + tests/IntegrationTests/new-build/external_build_tools/happy/MyCustomPreprocessor.hs + tests/IntegrationTests/new-build/external_build_tools/happy/happy.cabal tests/IntegrationTests/new-build/monitor_cabal_files.sh tests/IntegrationTests/new-build/monitor_cabal_files/cabal.project tests/IntegrationTests/new-build/monitor_cabal_files/p/P.hs @@ -279,6 +285,7 @@ executable cabal Distribution.Solver.Types.ConstraintSource Distribution.Solver.Types.DependencyResolver Distribution.Solver.Types.InstalledPreference + Distribution.Solver.Types.InstSolverPackage Distribution.Solver.Types.LabeledPackageConstraint Distribution.Solver.Types.OptionalStanza Distribution.Solver.Types.PackageConstraint diff --git a/cabal-install/tests/IntegrationTests/new-build/external_build_tools.sh b/cabal-install/tests/IntegrationTests/new-build/external_build_tools.sh new file mode 100644 index 00000000000..a12a5c83a12 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/external_build_tools.sh @@ -0,0 +1,3 @@ +. ./common.sh +cd external_build_tools +cabal new-build client diff --git a/cabal-install/tests/IntegrationTests/new-build/external_build_tools/cabal.project b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/cabal.project new file mode 100644 index 00000000000..b5377830e88 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/cabal.project @@ -0,0 +1 @@ +packages: client, happy diff --git a/cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/Hello.hs b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/Hello.hs new file mode 100644 index 00000000000..2573eba65c2 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/Hello.hs @@ -0,0 +1,8 @@ +{-# OPTIONS_GHC -F -pgmF happy #-} +module Main where + +a :: String +a = "0000" + +main :: IO () +main = putStrLn a diff --git a/cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/client.cabal b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/client.cabal new file mode 100644 index 00000000000..23070a812fa --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/client/client.cabal @@ -0,0 +1,13 @@ +name: client +version: 0.1.0.0 +synopsis: Checks build-tools are put in PATH +license: BSD3 +category: Testing +build-type: Simple +cabal-version: >=1.10 + +executable hello-world + main-is: Hello.hs + build-depends: base + build-tools: happy + default-language: Haskell2010 diff --git a/cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/MyCustomPreprocessor.hs b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/MyCustomPreprocessor.hs new file mode 100644 index 00000000000..09c949ab176 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/MyCustomPreprocessor.hs @@ -0,0 +1,11 @@ +module Main where + +import System.Environment +import System.IO + +main :: IO () +main = do + (_:source:target:_) <- getArgs + let f '0' = '1' + f c = c + writeFile target . map f =<< readFile source diff --git a/cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/happy.cabal b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/happy.cabal new file mode 100644 index 00000000000..0e95effb701 --- /dev/null +++ b/cabal-install/tests/IntegrationTests/new-build/external_build_tools/happy/happy.cabal @@ -0,0 +1,12 @@ +name: happy +version: 999.999.999 +synopsis: Checks build-tools on legacy package name are put in PATH +license: BSD3 +category: Testing +build-type: Simple +cabal-version: >=1.10 + +executable happy + main-is: MyCustomPreprocessor.hs + build-depends: base, directory + default-language: Haskell2010 diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs index 3ae64ccd098..cbe70725ad6 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/DSL.hs @@ -122,6 +122,12 @@ data ExampleDependency = -- | Simple dependency on a fixed version | ExFix ExamplePkgName ExamplePkgVersion + -- | Build-tools dependency + | ExBuildToolAny ExamplePkgName + + -- | Build-tools dependency on a fixed version + | ExBuildToolFix ExamplePkgName ExamplePkgVersion + -- | Dependencies indexed by a flag | ExFlag ExampleFlagName Dependencies Dependencies @@ -222,7 +228,7 @@ exDbPkgs = map (either exInstName exAvName) exAvSrcPkg :: ExampleAvailable -> UnresolvedSourcePackage exAvSrcPkg ex = - let (libraryDeps, exts, mlang, pcpkgs) = splitTopLevel (CD.libraryDeps (exAvDeps ex)) + let (libraryDeps, exts, mlang, pcpkgs, exes) = splitTopLevel (CD.libraryDeps (exAvDeps ex)) testSuites = [(name, deps) | (CD.ComponentTest name, deps) <- CD.toList (exAvDeps ex)] in SourcePackage { packageInfoId = exAvPkgId ex @@ -244,7 +250,8 @@ exAvSrcPkg ex = } , C.genPackageFlags = nub $ concatMap extractFlags $ CD.libraryDeps (exAvDeps ex) ++ concatMap snd testSuites - , C.condLibrary = Just (mkCondTree (extsLib exts <> langLib mlang <> pcpkgLib pcpkgs) + , C.condLibrary = Just (mkCondTree + (extsLib exts <> langLib mlang <> pcpkgLib pcpkgs <> buildtoolsLib exes) disableLib (Buildable libraryDeps)) , C.condSubLibraries = [] @@ -263,27 +270,36 @@ exAvSrcPkg ex = , [Extension] , Maybe Language , [(ExamplePkgName, ExamplePkgVersion)] -- pkg-config + , [(ExamplePkgName, Maybe Int)] ) splitTopLevel [] = - ([], [], Nothing, []) + ([], [], Nothing, [], []) + splitTopLevel (ExBuildToolAny p:deps) = + let (other, exts, lang, pcpkgs, exes) = splitTopLevel deps + in (other, exts, lang, pcpkgs, (p, Nothing):exes) + splitTopLevel (ExBuildToolFix p v:deps) = + let (other, exts, lang, pcpkgs, exes) = splitTopLevel deps + in (other, exts, lang, pcpkgs, (p, Just v):exes) splitTopLevel (ExExt ext:deps) = - let (other, exts, lang, pcpkgs) = splitTopLevel deps - in (other, ext:exts, lang, pcpkgs) + let (other, exts, lang, pcpkgs, exes) = splitTopLevel deps + in (other, ext:exts, lang, pcpkgs, exes) splitTopLevel (ExLang lang:deps) = case splitTopLevel deps of - (other, exts, Nothing, pcpkgs) -> (other, exts, Just lang, pcpkgs) + (other, exts, Nothing, pcpkgs, exes) -> (other, exts, Just lang, pcpkgs, exes) _ -> error "Only 1 Language dependency is supported" splitTopLevel (ExPkg pkg:deps) = - let (other, exts, lang, pcpkgs) = splitTopLevel deps - in (other, exts, lang, pkg:pcpkgs) + let (other, exts, lang, pcpkgs, exes) = splitTopLevel deps + in (other, exts, lang, pkg:pcpkgs, exes) splitTopLevel (dep:deps) = - let (other, exts, lang, pcpkgs) = splitTopLevel deps - in (dep:other, exts, lang, pcpkgs) + let (other, exts, lang, pcpkgs, exes) = splitTopLevel deps + in (dep:other, exts, lang, pcpkgs, exes) -- Extract the total set of flags used extractFlags :: ExampleDependency -> [C.Flag] extractFlags (ExAny _) = [] extractFlags (ExFix _ _) = [] + extractFlags (ExBuildToolAny _) = [] + extractFlags (ExBuildToolFix _ _) = [] extractFlags (ExFlag f a b) = C.MkFlag { C.flagName = C.FlagName f , C.flagDescription = "" @@ -310,6 +326,9 @@ exAvSrcPkg ex = let (directDeps, flaggedDeps) = splitDeps deps in C.CondNode { C.condTreeData = x -- Necessary for language extensions + -- TODO: Arguably, build-tools dependencies should also + -- effect constraints on conditional tree. But no way to + -- distinguish between them , C.condTreeConstraints = map mkDirect directDeps , C.condTreeComponents = map (mkFlagged dontBuild) flaggedDeps } @@ -380,6 +399,12 @@ exAvSrcPkg ex = pcpkgLib :: [(ExamplePkgName, ExamplePkgVersion)] -> C.Library pcpkgLib ds = mempty { C.libBuildInfo = mempty { C.pkgconfigDepends = [mkDirect (n, (Just v)) | (n,v) <- ds] } } + buildtoolsLib :: [(ExamplePkgName, Maybe Int)] -> C.Library + buildtoolsLib ds = mempty { C.libBuildInfo = mempty { + C.buildTools = map mkDirect ds + } } + + exAvPkgId :: ExampleAvailable -> C.PackageIdentifier exAvPkgId ex = C.PackageIdentifier { pkgName = C.PackageName (exAvName ex) diff --git a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs index 3b62327c148..25f0da0ba6d 100644 --- a/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs +++ b/cabal-install/tests/UnitTests/Distribution/Solver/Modular/Solver.hs @@ -156,6 +156,14 @@ tests = [ , runTest $ mkTest dbBJ7 "bj7" ["A"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1)]) , runTest $ indep $ mkTest dbBJ8 "bj8" ["A", "B"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1)]) ] + -- Build-tools dependencies + , testGroup "build-tools" [ + runTest $ mkTest dbBuildTools1 "bt1" ["A"] (SolverSuccess [("A", 1), ("alex", 1)]) + , runTest $ mkTest dbBuildTools2 "bt2" ["A"] (SolverSuccess [("A", 1)]) + , runTest $ mkTest dbBuildTools3 "bt3" ["C"] (SolverSuccess [("A", 1), ("B", 1), ("C", 1), ("alex", 1), ("alex", 2)]) + , runTest $ mkTest dbBuildTools4 "bt4" ["B"] (SolverSuccess [("A", 1), ("A", 2), ("B", 1), ("alex", 1)]) + , runTest $ mkTest dbBuildTools5 "bt5" ["A"] (SolverSuccess [("A", 1), ("alex", 1), ("happy", 1)]) + ] ] where soft prefs test = test { testSoftConstraints = prefs } @@ -1064,3 +1072,46 @@ dbBJ8 = [ , Right $ exAv "B" 1 [ExAny "C"] , Right $ exAv "C" 1 [] ] + +{------------------------------------------------------------------------------- + Databases for build-tools +-------------------------------------------------------------------------------} +dbBuildTools1 :: ExampleDb +dbBuildTools1 = [ + Right $ exAv "alex" 1 [], + Right $ exAv "A" 1 [ExBuildToolAny "alex"] + ] + +-- Test that build-tools on a random thing doesn't matter (only +-- the ones we recognize need to be in db) +dbBuildTools2 :: ExampleDb +dbBuildTools2 = [ + Right $ exAv "A" 1 [ExBuildToolAny "otherdude"] + ] + +-- Test that we can solve for different versions of executables +dbBuildTools3 :: ExampleDb +dbBuildTools3 = [ + Right $ exAv "alex" 1 [], + Right $ exAv "alex" 2 [], + Right $ exAv "A" 1 [ExBuildToolFix "alex" 1], + Right $ exAv "B" 1 [ExBuildToolFix "alex" 2], + Right $ exAv "C" 1 [ExAny "A", ExAny "B"] + ] + +-- Test that exe is not related to library choices +dbBuildTools4 :: ExampleDb +dbBuildTools4 = [ + Right $ exAv "alex" 1 [ExFix "A" 1], + Right $ exAv "A" 1 [], + Right $ exAv "A" 2 [], + Right $ exAv "B" 1 [ExBuildToolFix "alex" 1, ExFix "A" 2] + ] + +-- Test that build-tools on build-tools works +dbBuildTools5 :: ExampleDb +dbBuildTools5 = [ + Right $ exAv "alex" 1 [], + Right $ exAv "happy" 1 [ExBuildToolAny "alex"], + Right $ exAv "A" 1 [ExBuildToolAny "happy"] + ] From 0e4085980fabb141f1530bfcbf7ebe1bdcbbddf8 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Sat, 20 Aug 2016 01:55:35 -0700 Subject: [PATCH 21/23] Remove stale comment. Signed-off-by: Edward Z. Yang --- cabal-install/Distribution/Client/Utils.hs | 2 -- 1 file changed, 2 deletions(-) diff --git a/cabal-install/Distribution/Client/Utils.hs b/cabal-install/Distribution/Client/Utils.hs index 80b37b8d831..d4cbd92f146 100644 --- a/cabal-install/Distribution/Client/Utils.hs +++ b/cabal-install/Distribution/Client/Utils.hs @@ -73,8 +73,6 @@ import System.IO.Error (ioError, mkIOError, doesNotExistErrorType) -- | Generic merging utility. For sorted input lists this is a full outer join. -- --- * The result list never contains @(Nothing, Nothing)@. --- mergeBy :: (a -> b -> Ordering) -> [a] -> [b] -> [MergeResult a b] mergeBy cmp = merge where From 10a9c4a4b9010b7313a65a0999db71795d2c6967 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Sat, 20 Aug 2016 17:14:51 -0700 Subject: [PATCH 22/23] Try to not redo building executables if we see the cid in the store. Actually we could probably do this a bit more properly with UnitId in the Backpack patchset. Signed-off-by: Edward Z. Yang --- .../Distribution/Client/ProjectPlanning.hs | 34 ++++++++++++++++--- 1 file changed, 30 insertions(+), 4 deletions(-) diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs index c3faba0bb71..8584e3af1f1 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -85,6 +85,7 @@ import Distribution.Solver.Types.SourcePackage import Distribution.Package hiding (InstalledPackageId, installedPackageId) import Distribution.System +import qualified Distribution.InstalledPackageInfo as Installed import qualified Distribution.PackageDescription as Cabal import qualified Distribution.PackageDescription as PD import qualified Distribution.PackageDescription.Configuration as PD @@ -129,7 +130,7 @@ import Data.Either import Data.Monoid import Data.Function import System.FilePath -import System.Directory (doesDirectoryExist) +import System.Directory (doesDirectoryExist, getDirectoryContents) ------------------------------------------------------------------------------ -- * Elaborated install plan @@ -604,8 +605,10 @@ rebuildInstallPlan verbosity storePkgIndex <- getPackageDBContents verbosity compiler progdb platform storePackageDb + storeExeIndex <- getExecutableDBContents storeDirectory let improvedPlan = improveInstallPlanWithPreExistingPackages storePkgIndex + storeExeIndex elaboratedPlan liftIO $ debugNoWrap verbosity (InstallPlan.showInstallPlan improvedPlan) return improvedPlan @@ -665,6 +668,20 @@ getPackageDBContents verbosity compiler progdb platform packagedb = do Cabal.getPackageDBContents verbosity compiler packagedb progdb +-- | Return the list of all already installed executables +getExecutableDBContents + :: FilePath -- store directory + -> Rebuild (Set ComponentId) +getExecutableDBContents storeDirectory = do + monitorFiles [monitorFileGlob (FilePathGlob (FilePathRoot storeDirectory) (GlobFile [WildCard]))] + paths <- liftIO $ getDirectoryContents storeDirectory + return (Set.fromList (map ComponentId (filter valid paths))) + where + valid "." = False + valid ".." = False + valid "package.db" = False + valid _ = True + getSourcePackages :: Verbosity -> (forall a. (RepoContext -> IO a) -> IO a) -> Rebuild SourcePackageDb getSourcePackages verbosity withRepoCtx = do @@ -2562,9 +2579,10 @@ packageHashConfigInputs -- installed packages whenever they exist. -- improveInstallPlanWithPreExistingPackages :: InstalledPackageIndex + -> Set ComponentId -> ElaboratedInstallPlan -> ElaboratedInstallPlan -improveInstallPlanWithPreExistingPackages installedPkgIndex installPlan = +improveInstallPlanWithPreExistingPackages installedPkgIndex installedExes installPlan = replaceWithPreExisting installPlan [ ipkg | InstallPlan.Configured pkg @@ -2579,8 +2597,16 @@ improveInstallPlanWithPreExistingPackages installedPkgIndex installPlan = -- since overwriting is never safe. canPackageBeImproved pkg = - PackageIndex.lookupUnitId - installedPkgIndex (installedUnitId pkg) + case PackageIndex.lookupUnitId + installedPkgIndex (installedUnitId pkg) of + Just x -> Just x + Nothing | SimpleUnitId cid <- installedUnitId pkg + , cid `Set.member` installedExes + -- Same hack as replacewithPrePreExisting + -> Just (Installed.emptyInstalledPackageInfo { + Installed.installedUnitId = installedUnitId pkg + }) + | otherwise -> Nothing replaceWithPreExisting = foldl' (\plan ipkg -> InstallPlan.preexisting From 4a9f11e66a92dc353b60702bd7be89a6e7e81724 Mon Sep 17 00:00:00 2001 From: "Edward Z. Yang" Date: Sat, 20 Aug 2016 23:33:04 -0700 Subject: [PATCH 23/23] Tweaks to plan.json format - New "exe-depends" field - Dropped "depends" when it's a package; you can use "components" to get the information Signed-off-by: Edward Z. Yang --- .../Distribution/Client/ProjectPlanOutput.hs | 21 +++++++++++-------- 1 file changed, 12 insertions(+), 9 deletions(-) diff --git a/cabal-install/Distribution/Client/ProjectPlanOutput.hs b/cabal-install/Distribution/Client/ProjectPlanOutput.hs index d51f158b713..2b6f31d50de 100644 --- a/cabal-install/Distribution/Client/ProjectPlanOutput.hs +++ b/cabal-install/Distribution/Client/ProjectPlanOutput.hs @@ -73,20 +73,23 @@ encodePlanAsJson elaboratedInstallPlan _elaboratedSharedConfig = J.object $ [ "type" J..= J.String "configured" , "id" J..= (jdisplay . installedUnitId) elab - , "depends" J..= map (jdisplay . confInstId) (elabLibDependencies elab) , "flags" J..= J.object [ fn J..= v | (PD.FlagName fn,v) <- elabFlagAssignment elab ] ] ++ case elabPkgOrComp elab of - ElabPackage pkg -> - let components = J.object - [ comp2str c J..= J.object - [ "depends" J..= map (jdisplay . confInstId) v ] - -- NB: does NOT contain non-lib dependencies - | (c,v) <- ComponentDeps.toList (pkgLibDependencies pkg) ] - in ["components" J..= components ] - ElabComponent _ -> [] + ElabPackage pkg -> + let components = J.object $ + [ comp2str c J..= J.object + [ "depends" J..= map (jdisplay . confInstId) v ] + | (c,v) <- ComponentDeps.toList (pkgLibDependencies pkg) ] ++ + [ comp2str c J..= J.object + [ "exe-depends" J..= map (jdisplay . confInstId) v ] + | (c,v) <- ComponentDeps.toList (pkgExeDependencies pkg) ] + in ["components" J..= components] + ElabComponent _ -> + ["depends" J..= map (jdisplay . confInstId) (elabLibDependencies elab) + ,"exe-depends" J..= map jdisplay (elabExeDependencies elab)] -- TODO: maybe move this helper to "ComponentDeps" module? -- Or maybe define a 'Text' instance?