Commit b59d1f7b authored by Duncan Coutts's avatar Duncan Coutts Committed by Francesco Gazzetta
Browse files

Wire up extra-packages to be included in the plan

So you can now add `extra-packages: foo` to the cabal.projct file and
then `cabal (new-)build foo`. The extra packages are included into the
install plan and they are also resolved as build targets.

Currently this only uses the "any valid package name" target syntax
which means you can use `foo` but not `foo:tests` or any of the other
variations.
parent ec6b17b6
......@@ -69,6 +69,8 @@ import Distribution.Client.Config
import Distribution.Solver.Types.SourcePackage
import Distribution.Solver.Types.Settings
import Distribution.Solver.Types.PackageConstraint
( PackageProperty(..) )
import Distribution.Package
( PackageName, PackageId, packageId, UnitId )
......@@ -884,7 +886,7 @@ mplusMaybeT ma mb = do
-- paths.
--
readSourcePackage :: Verbosity -> ProjectPackageLocation
-> Rebuild UnresolvedSourcePackage
-> Rebuild (PackageSpecifier UnresolvedSourcePackage)
readSourcePackage verbosity (ProjectPackageLocalCabalFile cabalFile) =
readSourcePackage verbosity (ProjectPackageLocalDirectory dir cabalFile)
where
......@@ -894,17 +896,29 @@ readSourcePackage verbosity (ProjectPackageLocalDirectory dir cabalFile) = do
monitorFiles [monitorFileHashed cabalFile]
root <- askRoot
pkgdesc <- liftIO $ readGenericPackageDescription verbosity (root </> cabalFile)
return SourcePackage {
return $ SpecificSourcePackage SourcePackage {
packageInfoId = packageId pkgdesc,
packageDescription = pkgdesc,
packageSource = LocalUnpackedPackage (root </> dir),
packageDescrOverride = Nothing
}
readSourcePackage _ (ProjectPackageNamed (Dependency pkgname verrange)) =
return $ NamedPackage pkgname [PackagePropertyVersion verrange]
readSourcePackage _verbosity _ =
fail $ "TODO: add support for fetching and reading local tarballs, remote "
++ "tarballs, remote repos and passing named packages through"
-- TODO: add something like this, here or in the project planning
-- Based on the package location, which packages will be built inplace in the
-- build tree vs placed in the store. This has various implications on what we
-- can do with the package, e.g. can we run tests, ghci etc.
--
-- packageIsLocalToProject :: ProjectPackageLocation -> Bool
---------------------------------------------
-- Checking configuration sanity
--
......
......@@ -104,7 +104,8 @@ import Distribution.Client.ProjectBuilding
import Distribution.Client.ProjectPlanOutput
import Distribution.Client.Types
( GenericReadyPackage(..), UnresolvedSourcePackage )
( GenericReadyPackage(..), UnresolvedSourcePackage
, PackageSpecifier(..) )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.TargetSelector
( TargetSelector(..)
......@@ -155,7 +156,7 @@ data ProjectBaseContext = ProjectBaseContext {
distDirLayout :: DistDirLayout,
cabalDirLayout :: CabalDirLayout,
projectConfig :: ProjectConfig,
localPackages :: [UnresolvedSourcePackage],
localPackages :: [PackageSpecifier UnresolvedSourcePackage],
buildSettings :: BuildTimeSettings
}
......
......@@ -293,7 +293,8 @@ sanityCheckElaboratedPackage ElaboratedConfiguredPackage{..}
rebuildProjectConfig :: Verbosity
-> DistDirLayout
-> ProjectConfig
-> IO (ProjectConfig, [UnresolvedSourcePackage])
-> IO (ProjectConfig,
[PackageSpecifier UnresolvedSourcePackage])
rebuildProjectConfig verbosity
distDirLayout@DistDirLayout {
distProjectRootDirectory,
......@@ -335,7 +336,8 @@ rebuildProjectConfig verbosity
-- Look for all the cabal packages in the project
-- some of which may be local src dirs, tarballs etc
--
phaseReadLocalPackages :: ProjectConfig -> Rebuild [UnresolvedSourcePackage]
phaseReadLocalPackages :: ProjectConfig
-> Rebuild [PackageSpecifier UnresolvedSourcePackage]
phaseReadLocalPackages projectConfig = do
localCabalFiles <- findProjectPackages distDirLayout projectConfig
mapM (readSourcePackage verbosity) localCabalFiles
......@@ -357,7 +359,7 @@ rebuildProjectConfig verbosity
rebuildInstallPlan :: Verbosity
-> DistDirLayout -> CabalDirLayout
-> ProjectConfig
-> [UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
-> IO ( ElaboratedInstallPlan -- with store packages
, ElaboratedInstallPlan -- with source packages
, ElaboratedSharedConfig )
......@@ -509,7 +511,7 @@ rebuildInstallPlan verbosity
--
phaseRunSolver :: ProjectConfig
-> (Compiler, Platform, ProgramDb)
-> [UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
-> Rebuild (SolverInstallPlan, PkgConfigDb)
phaseRunSolver projectConfig@ProjectConfig {
projectConfigShared,
......@@ -557,7 +559,7 @@ rebuildInstallPlan verbosity
Map.fromList
[ (pkgname, stanzas)
| pkg <- localPackages
, let pkgname = packageName pkg
, let pkgname = pkgSpecifierTarget pkg
testsEnabled = lookupLocalPackageConfig
packageConfigTests
projectConfig pkgname
......@@ -579,7 +581,7 @@ rebuildInstallPlan verbosity
-> (Compiler, Platform, ProgramDb)
-> PkgConfigDb
-> SolverInstallPlan
-> [SourcePackage loc]
-> [PackageSpecifier (SourcePackage loc)]
-> Rebuild ( ElaboratedInstallPlan
, ElaboratedSharedConfig )
phaseElaboratePlan ProjectConfig {
......@@ -888,7 +890,7 @@ planPackages :: Verbosity
-> InstalledPackageIndex
-> SourcePackageDb
-> PkgConfigDb
-> [UnresolvedSourcePackage]
-> [PackageSpecifier UnresolvedSourcePackage]
-> Map PackageName (Map OptionalStanza Bool)
-> Progress String String SolverInstallPlan
planPackages verbosity comp platform solver SolverSettings{..}
......@@ -968,7 +970,7 @@ planPackages verbosity comp platform solver SolverSettings{..}
-- enable stanza preference where the user did not specify
[ PackageStanzasPreference pkgname stanzas
| pkg <- localPackages
, let pkgname = packageName pkg
, let pkgname = pkgSpecifierTarget pkg
stanzaM = Map.findWithDefault Map.empty pkgname pkgStanzasEnable
stanzas = [ stanza | stanza <- [minBound..maxBound]
, Map.lookup stanza stanzaM == Nothing ]
......@@ -982,7 +984,7 @@ planPackages verbosity comp platform solver SolverSettings{..}
(PackagePropertyStanzas stanzas))
ConstraintSourceConfigFlagOrTarget
| pkg <- localPackages
, let pkgname = packageName pkg
, let pkgname = pkgSpecifierTarget pkg
stanzaM = Map.findWithDefault Map.empty pkgname pkgStanzasEnable
stanzas = [ stanza | stanza <- [minBound..maxBound]
, Map.lookup stanza stanzaM == Just True ]
......@@ -1010,7 +1012,7 @@ planPackages verbosity comp platform solver SolverSettings{..}
| let flags = solverSettingFlagAssignment
, not (null flags)
, pkg <- localPackages
, let pkgname = packageName pkg ]
, let pkgname = pkgSpecifierTarget pkg ]
$ stdResolverParams
......@@ -1019,7 +1021,7 @@ planPackages verbosity comp platform solver SolverSettings{..}
-- its own addDefaultSetupDependencies that is not appropriate for us.
basicInstallPolicy
installedPkgIndex sourcePkgDb
(map SpecificSourcePackage localPackages)
localPackages
------------------------------------------------------------------------------
......@@ -1131,7 +1133,7 @@ elaborateInstallPlan
-> DistDirLayout
-> StoreDirLayout
-> SolverInstallPlan
-> [SourcePackage loc]
-> [PackageSpecifier (SourcePackage loc)]
-> Map PackageId PackageSourceHash
-> InstallDirs.InstallDirTemplates
-> ProjectConfigShared
......@@ -1780,15 +1782,25 @@ elaborateInstallPlan verbosity platform compiler compilerprogdb pkgConfigDB
$ map packageId
$ SolverInstallPlan.reverseDependencyClosure
solverPlan
[ PlannedId (packageId pkg)
| pkg <- localPackages ]
(map PlannedId (Set.toList pkgsLocalToProject))
isLocalToProject :: Package pkg => pkg -> Bool
isLocalToProject pkg = Set.member (packageId pkg)
pkgsLocalToProject
pkgsLocalToProject :: Set PackageId
pkgsLocalToProject = Set.fromList [ packageId pkg | pkg <- localPackages ]
pkgsLocalToProject =
Set.fromList (catMaybes (map shouldBeLocal localPackages))
--TODO: localPackages is a misnomer, it's all project packages
-- here is where we decide which ones will be local!
where
shouldBeLocal :: PackageSpecifier (SourcePackage loc) -> Maybe PackageId
shouldBeLocal NamedPackage{} = Nothing
shouldBeLocal (SpecificSourcePackage pkg) = Just (packageId pkg)
-- TODO: It's not actually obvious for all of the
-- 'ProjectPackageLocation's that they should all be local. We might
-- need to provide the user with a choice.
-- Also, review use of SourcePackage's loc vs ProjectPackageLocation
pkgsUseSharedLibrary :: Set PackageId
pkgsUseSharedLibrary =
......
......@@ -42,7 +42,7 @@ import Distribution.Version
( mkVersion )
import Distribution.Types.UnqualComponentName ( unUnqualComponentName )
import Distribution.Client.Types
( PackageLocation(..) )
( PackageLocation(..), PackageSpecifier(..) )
import Distribution.Verbosity
import Distribution.PackageDescription
......@@ -202,14 +202,14 @@ instance Binary SubComponentTarget
-- error if any are unrecognised. The possible target selectors are based on
-- the available packages (and their locations).
--
readTargetSelectors :: [SourcePackage (PackageLocation a)]
readTargetSelectors :: [PackageSpecifier (SourcePackage (PackageLocation a))]
-> [String]
-> IO (Either [TargetSelectorProblem]
[TargetSelector PackageId])
readTargetSelectors = readTargetSelectorsWith defaultDirActions
readTargetSelectorsWith :: (Applicative m, Monad m) => DirActions m
-> [SourcePackage (PackageLocation a)]
-> [PackageSpecifier (SourcePackage (PackageLocation a))]
-> [String]
-> m (Either [TargetSelectorProblem]
[TargetSelector PackageId])
......@@ -217,7 +217,8 @@ readTargetSelectorsWith dirActions@DirActions{..} pkgs targetStrs =
case parseTargetStrings targetStrs of
([], utargets) -> do
utargets' <- mapM (getTargetStringFileStatus dirActions) utargets
pkgs' <- mapM (selectPackageInfo dirActions) pkgs
pkgs' <- sequence [ selectPackageInfo dirActions pkg
| SpecificSourcePackage pkg <- pkgs ]
cwd <- getCurrentDirectory
let (cwdPkg, otherPkgs) = selectCwdPackage cwd pkgs'
case resolveTargetSelectors cwdPkg otherPkgs utargets' of
......
......@@ -18,7 +18,8 @@ import Distribution.Client.ProjectBuilding
import Distribution.Client.ProjectOrchestration
( resolveTargets, TargetProblemCommon(..), distinctTargetComponents )
import Distribution.Client.Types
( PackageLocation(..), UnresolvedSourcePackage )
( PackageLocation(..), UnresolvedSourcePackage
, PackageSpecifier(..) )
import Distribution.Client.Targets
( UserConstraint(..), UserConstraintScope(UserAnyQualifier) )
import qualified Distribution.Client.InstallPlan as InstallPlan
......@@ -370,7 +371,10 @@ testTargetSelectorAmbiguous reportSubCase = do
-> [SourcePackage (PackageLocation a)]
-> Assertion
assertAmbiguous str tss pkgs = do
res <- readTargetSelectorsWith fakeDirActions pkgs [str]
res <- readTargetSelectorsWith
fakeDirActions
(map SpecificSourcePackage pkgs)
[str]
case res of
Left [TargetSelectorAmbiguous _ tss'] ->
sort (map snd tss') @?= sort tss
......@@ -382,7 +386,10 @@ testTargetSelectorAmbiguous reportSubCase = do
-> [SourcePackage (PackageLocation a)]
-> Assertion
assertUnambiguous str ts pkgs = do
res <- readTargetSelectorsWith fakeDirActions pkgs [str]
res <- readTargetSelectorsWith
fakeDirActions
(map SpecificSourcePackage pkgs)
[str]
case res of
Right [ts'] -> ts' @?= ts
_ -> assertFailure $ "expected Right [Target...], "
......@@ -1478,7 +1485,7 @@ dirActions testdir =
type ProjDetails = (DistDirLayout,
CabalDirLayout,
ProjectConfig,
[UnresolvedSourcePackage],
[PackageSpecifier UnresolvedSourcePackage],
BuildTimeSettings)
configureProject :: FilePath -> ProjectConfig -> IO ProjDetails
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment