haskell · dcoutts · Aug 31, 2017 · Aug 31, 2017 · Aug 31, 2017 · Sep 2, 2017
diff --git a/cabal-install/Distribution/Client/CmdBench.hs b/cabal-install/Distribution/Client/CmdBench.hs
@@ -222,10 +222,6 @@ renderTargetProblem (TargetProblemNoTargets targetSelector) =
            ++ renderTargetSelector targetSelector ++ "."
 
       _ -> renderTargetProblemNoTargets "benchmark" targetSelector
-  where
-    targetSelectorFilter (TargetAllPackages  mkfilter) = mkfilter
-    targetSelectorFilter (TargetPackage  _ _ mkfilter) = mkfilter
-    targetSelectorFilter (TargetComponent _ _ _)       = Nothing
 
 renderTargetProblem (TargetProblemComponentNotBenchmark pkgid cname) =
     "The bench command is for running benchmarks, but the target '"

diff --git a/cabal-install/Distribution/Client/CmdErrorMessages.hs b/cabal-install/Distribution/Client/CmdErrorMessages.hs
@@ -9,7 +9,7 @@ module Distribution.Client.CmdErrorMessages (
 
 import Distribution.Client.ProjectOrchestration
 import Distribution.Client.TargetSelector
-         ( componentKind, showTargetSelector )
+         ( ComponentKindFilter, componentKind, showTargetSelector )
 
 import Distribution.Package
          ( packageId, packageName )
@@ -111,6 +111,9 @@ renderTargetSelector (TargetComponent _pkgid cname (FileTarget filename)) =
 renderTargetSelector (TargetComponent _pkgid cname (ModuleTarget modname)) =
     "the module " ++ display modname ++ " in the " ++ showComponentName cname
 
+renderTargetSelector (TargetPackageName pkgname) =
+    "the package " ++ display pkgname
+
 
 renderOptionalStanza :: Plural -> OptionalStanza -> String
 renderOptionalStanza Singular TestStanzas  = "test suite"
@@ -124,19 +127,26 @@ optionalStanza (CTestName  _) = Just TestStanzas
 optionalStanza (CBenchName _) = Just BenchStanzas
 optionalStanza _              = Nothing
 
-
 -- | Does the 'TargetSelector' potentially refer to one package or many?
 --
 targetSelectorPluralPkgs :: TargetSelector a -> Plural
 targetSelectorPluralPkgs (TargetAllPackages _)     = Plural
 targetSelectorPluralPkgs (TargetPackage _ _ _)     = Singular
 targetSelectorPluralPkgs (TargetComponent _ _ _)   = Singular
+targetSelectorPluralPkgs (TargetPackageName _)     = Singular
 
 -- | Does the 'TargetSelector' refer to 
 targetSelectorRefersToPkgs :: TargetSelector a -> Bool
 targetSelectorRefersToPkgs (TargetAllPackages  mkfilter) = isNothing mkfilter
 targetSelectorRefersToPkgs (TargetPackage  _ _ mkfilter) = isNothing mkfilter
 targetSelectorRefersToPkgs (TargetComponent _ _ _)       = False
+targetSelectorRefersToPkgs (TargetPackageName _)         = True
+
+targetSelectorFilter :: TargetSelector a -> Maybe ComponentKindFilter
+targetSelectorFilter (TargetPackage  _ _ mkfilter) = mkfilter
+targetSelectorFilter (TargetAllPackages  mkfilter) = mkfilter
+targetSelectorFilter (TargetComponent _ _ _)       = Nothing
+targetSelectorFilter (TargetPackageName _)         = Nothing
 
 renderComponentKind :: Plural -> ComponentKind -> String
 renderComponentKind Singular ckind = case ckind of
@@ -311,6 +321,8 @@ renderTargetProblemNoTargets verb targetSelector =
      ++ renderComponentKind Plural kfilter
     reason ts@TargetComponent{} =
         error $ "renderTargetProblemNoTargets: " ++ show ts
+    reason (TargetPackageName _) =
+        "it does not contain any components at all"
 
 -----------------------------------------------------------
 -- Renderering error messages for CannotPruneDependencies

diff --git a/cabal-install/Distribution/Client/CmdRun.hs b/cabal-install/Distribution/Client/CmdRun.hs
@@ -388,11 +388,6 @@ renderTargetProblem (TargetProblemNoTargets targetSelector) =
            ++ renderTargetSelector targetSelector ++ "."
 
       _ -> renderTargetProblemNoTargets "run" targetSelector
-  where
-    targetSelectorFilter (TargetPackage  _ _ mkfilter) = mkfilter
-    targetSelectorFilter (TargetAllPackages  mkfilter) = mkfilter
-    targetSelectorFilter (TargetComponent _ _ _)       = Nothing
-
 
 renderTargetProblem (TargetProblemMatchesMultiple targetSelector targets) =
     "The run command is for running a single executable at once. The target '"

diff --git a/cabal-install/Distribution/Client/CmdTest.hs b/cabal-install/Distribution/Client/CmdTest.hs
@@ -225,10 +225,6 @@ renderTargetProblem (TargetProblemNoTargets targetSelector) =
            ++ renderTargetSelector targetSelector ++ "."
 
       _ -> renderTargetProblemNoTargets "test" targetSelector
-  where
-    targetSelectorFilter (TargetPackage  _ _ mkfilter) = mkfilter
-    targetSelectorFilter (TargetAllPackages  mkfilter) = mkfilter
-    targetSelectorFilter (TargetComponent _ _ _)       = Nothing
 
 renderTargetProblem (TargetProblemComponentNotTest pkgid cname) =
     "The test command is for running test suites, but the target '"

diff --git a/cabal-install/Distribution/Client/Dependency.hs b/cabal-install/Distribution/Client/Dependency.hs
@@ -71,6 +71,7 @@ import Distribution.Client.SolverInstallPlan (SolverInstallPlan)
 import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
 import Distribution.Client.Types
          ( SourcePackageDb(SourcePackageDb)
+         , PackageSpecifier(..), pkgSpecifierTarget, pkgSpecifierConstraints
          , UnresolvedPkgLoc, UnresolvedSourcePackage
          , AllowNewer(..), AllowOlder(..), RelaxDeps(..), RelaxedDep(..)
          , RelaxDepScope(..), RelaxDepMod(..), RelaxDepSubject(..), isRelaxDeps
@@ -80,7 +81,6 @@ import Distribution.Client.Dependency.Types
          , PackagesPreferenceDefault(..) )
 import Distribution.Client.Sandbox.Types
          ( SandboxPackageInfo(..) )
-import Distribution.Client.Targets
 import Distribution.Package
          ( PackageName, mkPackageName, PackageIdentifier(PackageIdentifier), PackageId
          , Package(..), packageName, packageVersion )

diff --git a/cabal-install/Distribution/Client/List.hs b/cabal-install/Distribution/Client/List.hs
@@ -47,10 +47,9 @@ import qualified Distribution.Solver.Types.PackageIndex as PackageIndex
 import           Distribution.Solver.Types.SourcePackage
 
 import Distribution.Client.Types
-         ( SourcePackageDb(..)
-         , UnresolvedSourcePackage )
+         ( SourcePackageDb(..), PackageSpecifier(..), UnresolvedSourcePackage )
 import Distribution.Client.Targets
-         ( UserTarget, resolveUserTargets, PackageSpecifier(..) )
+         ( UserTarget, resolveUserTargets )
 import Distribution.Client.Setup
          ( GlobalFlags(..), ListFlags(..), InfoFlags(..)
          , RepoContext(..) )

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
      }
 
@@ -496,17 +497,31 @@ resolveTargets selectPackageTargets selectComponentTarget liftProblem
       | otherwise
       = Left (liftProblem (TargetProblemNoSuchPackage pkgid))
 
+    checkTarget bt@(TargetPackageName pkgname)
+      | Just ats <- Map.lookup pkgname availableTargetsByPackageName
+      = case selectPackageTargets bt ats of
+          Left  e  -> Left e
+          Right ts -> Right [ (unitid, ComponentTarget cname WholeComponent)
+                            | (unitid, cname) <- ts ]
+
+      | otherwise
+      = Left (liftProblem (TargetNotInProject pkgname))
     --TODO: check if the package is in the plan, even if it's not local
     --TODO: check if the package is in hackage and return different
     -- error cases here so the commands can handle things appropriately
 
-    availableTargetsByPackage   :: Map PackageId                  [AvailableTarget (UnitId, ComponentName)]
-    availableTargetsByComponent :: Map (PackageId, ComponentName) [AvailableTarget (UnitId, ComponentName)]
-    availableTargetsByComponent = availableTargets installPlan
-    availableTargetsByPackage   = Map.mapKeysWith
-                                    (++) (\(pkgid, _cname) -> pkgid)
-                                    availableTargetsByComponent
-                      `Map.union` availableTargetsEmptyPackages
+    availableTargetsByPackage     :: Map PackageId                  [AvailableTarget (UnitId, ComponentName)]
+    availableTargetsByPackageName :: Map PackageName                [AvailableTarget (UnitId, ComponentName)]
+    availableTargetsByComponent   :: Map (PackageId, ComponentName) [AvailableTarget (UnitId, ComponentName)]
+
+    availableTargetsByComponent   = availableTargets installPlan
+    availableTargetsByPackage     = Map.mapKeysWith
+                                      (++) (\(pkgid, _cname) -> pkgid)
+                                      availableTargetsByComponent
+                        `Map.union` availableTargetsEmptyPackages
+    availableTargetsByPackageName = Map.mapKeysWith
+                                    (++) packageName
+                                    availableTargetsByPackage
 
     -- Add in all the empty packages. These do not appear in the
     -- availableTargetsByComponent map, since that only contains components

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 =