Wire up extra-packages to be included in the plan

dcoutts · dcoutts · commit e002ad4ce094 · 2017-09-02T18:39:55.000+01:00
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.
diff --git a/cabal-install/Distribution/Client/ProjectConfig.hs b/cabal-install/Distribution/Client/ProjectConfig.hs
@@ -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
 --
diff --git a/cabal-install/Distribution/Client/ProjectOrchestration.hs b/cabal-install/Distribution/Client/ProjectOrchestration.hs
@@ -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(..)
@@ -154,7 +155,7 @@ data ProjectBaseContext = ProjectBaseContext {
        distDirLayout  :: DistDirLayout,
        cabalDirLayout :: CabalDirLayout,
        projectConfig  :: ProjectConfig,
-       localPackages  :: [UnresolvedSourcePackage],
+       localPackages  :: [PackageSpecifier UnresolvedSourcePackage],
        buildSettings  :: BuildTimeSettings
      }
 
diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs
@@ -292,7 +292,8 @@ sanityCheckElaboratedPackage ElaboratedConfiguredPackage{..}
 rebuildProjectConfig :: Verbosity
                      -> DistDirLayout
                      -> ProjectConfig
-                     -> IO (ProjectConfig, [UnresolvedSourcePackage])
+                     -> IO (ProjectConfig,
+                            [PackageSpecifier UnresolvedSourcePackage])
 rebuildProjectConfig verbosity
                      distDirLayout@DistDirLayout {
                        distProjectRootDirectory,
@@ -334,7 +335,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
@@ -356,7 +358,7 @@ rebuildProjectConfig verbosity
 rebuildInstallPlan :: Verbosity
                    -> DistDirLayout -> CabalDirLayout
                    -> ProjectConfig
-                   -> [UnresolvedSourcePackage]
+                   -> [PackageSpecifier UnresolvedSourcePackage]
                    -> IO ( ElaboratedInstallPlan  -- with store packages
                          , ElaboratedInstallPlan  -- with source packages
                          , ElaboratedSharedConfig )
@@ -508,7 +510,7 @@ rebuildInstallPlan verbosity
     --
     phaseRunSolver :: ProjectConfig
                    -> (Compiler, Platform, ProgramDb)
-                   -> [UnresolvedSourcePackage]
+                   -> [PackageSpecifier UnresolvedSourcePackage]
                    -> Rebuild (SolverInstallPlan, PkgConfigDb)
     phaseRunSolver projectConfig@ProjectConfig {
                      projectConfigShared,
@@ -556,7 +558,7 @@ rebuildInstallPlan verbosity
           Map.fromList
             [ (pkgname, stanzas)
             | pkg <- localPackages
-            , let pkgname            = packageName pkg
+            , let pkgname            = pkgSpecifierTarget pkg
                   testsEnabled       = lookupLocalPackageConfig
                                          packageConfigTests
                                          projectConfig pkgname
@@ -578,7 +580,7 @@ rebuildInstallPlan verbosity
                        -> (Compiler, Platform, ProgramDb)
                        -> PkgConfigDb
                        -> SolverInstallPlan
-                       -> [SourcePackage loc]
+                       -> [PackageSpecifier (SourcePackage loc)]
                        -> Rebuild ( ElaboratedInstallPlan
                                   , ElaboratedSharedConfig )
     phaseElaboratePlan ProjectConfig {
@@ -887,7 +889,7 @@ planPackages :: Verbosity
              -> InstalledPackageIndex
              -> SourcePackageDb
              -> PkgConfigDb
-             -> [UnresolvedSourcePackage]
+             -> [PackageSpecifier UnresolvedSourcePackage]
              -> Map PackageName (Map OptionalStanza Bool)
              -> Progress String String SolverInstallPlan
 planPackages verbosity comp platform solver SolverSettings{..}
@@ -967,7 +969,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 ]
@@ -981,7 +983,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 ]
@@ -1009,7 +1011,7 @@ planPackages verbosity comp platform solver SolverSettings{..}
           | let flags = solverSettingFlagAssignment
           , not (null flags)
           , pkg <- localPackages
-          , let pkgname = packageName pkg ]
+          , let pkgname = pkgSpecifierTarget pkg ]
 
       $ stdResolverParams
 
@@ -1018,7 +1020,7 @@ planPackages verbosity comp platform solver SolverSettings{..}
       -- its own addDefaultSetupDependencies that is not appropriate for us.
       basicInstallPolicy
         installedPkgIndex sourcePkgDb
-        (map SpecificSourcePackage localPackages)
+        localPackages
 
 
 ------------------------------------------------------------------------------
@@ -1130,7 +1132,7 @@ elaborateInstallPlan
   -> DistDirLayout
   -> StoreDirLayout
   -> SolverInstallPlan
-  -> [SourcePackage loc]
+  -> [PackageSpecifier (SourcePackage loc)]
   -> Map PackageId PackageSourceHash
   -> InstallDirs.InstallDirTemplates
   -> ProjectConfigShared
@@ -1779,15 +1781,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 =
diff --git a/cabal-install/Distribution/Client/TargetSelector.hs b/cabal-install/Distribution/Client/TargetSelector.hs
@@ -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,22 +202,23 @@ 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])
 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
diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs
@@ -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
