diff --git a/cabal-install/Distribution/Client/CmdBench.hs b/cabal-install/Distribution/Client/CmdBench.hs index e6650d74a02..2ed14f28f80 100644 --- 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 index 80466604ced..78030b7033a 100644 --- 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/CmdInstall.hs b/cabal-install/Distribution/Client/CmdInstall.hs new file mode 100644 index 00000000000..f8e49b8b971 --- /dev/null +++ b/cabal-install/Distribution/Client/CmdInstall.hs @@ -0,0 +1,336 @@ +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE ViewPatterns #-} + +-- | cabal-install CLI command: build +-- +module Distribution.Client.CmdInstall ( + -- * The @build@ CLI and action + installCommand, + installAction, + + -- * Internals exposed for testing + TargetProblem(..), + selectPackageTargets, + selectComponentTarget + ) where + +import Prelude () +import Distribution.Client.Compat.Prelude + +import Distribution.Client.ProjectOrchestration +import Distribution.Client.CmdErrorMessages + +import Distribution.Client.Setup + ( GlobalFlags, ConfigFlags(..), ConfigExFlags, InstallFlags + , applyFlagDefaults ) +import qualified Distribution.Client.Setup as Client +import Distribution.Client.Types + ( PackageSpecifier(NamedPackage), UnresolvedSourcePackage ) +import Distribution.Client.ProjectPlanning.Types + ( pkgConfigCompiler ) +import Distribution.Client.ProjectConfig.Types + ( ProjectConfig, ProjectConfigBuildOnly(..) + , projectConfigLogsDir, projectConfigStoreDir, projectConfigShared + , projectConfigBuildOnly, projectConfigDistDir + , projectConfigConfigFile ) +import Distribution.Client.Config + ( defaultCabalDir ) +import Distribution.Client.ProjectConfig + ( readGlobalConfig, resolveBuildTimeSettings ) +import Distribution.Client.DistDirLayout + ( defaultDistDirLayout, distDirectory, mkCabalDirLayout + , ProjectRoot(ProjectRootImplicit), distProjectCacheDirectory + , storePackageDirectory, cabalStoreDirLayout ) +import Distribution.Client.RebuildMonad + ( runRebuild ) +import Distribution.Client.InstallSymlink + ( symlinkBinary ) +import Distribution.Simple.Setup + ( HaddockFlags, fromFlagOrDefault, flagToMaybe ) +import Distribution.Simple.Command + ( CommandUI(..), usageAlternatives ) +import Distribution.Simple.Compiler + ( compilerId ) +import Distribution.Types.PackageName + ( mkPackageName ) +import Distribution.Types.UnitId + ( UnitId ) +import Distribution.Types.UnqualComponentName + ( UnqualComponentName, unUnqualComponentName ) +import Distribution.Verbosity + ( Verbosity, normal ) +import Distribution.Simple.Utils + ( wrapText, die', withTempDirectory, createDirectoryIfMissingVerbose ) + +import qualified Data.Map as Map +import System.Directory ( getTemporaryDirectory, makeAbsolute ) +import System.FilePath ( () ) + +import qualified Distribution.Client.CmdBuild as CmdBuild + +installCommand :: CommandUI (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) +installCommand = CommandUI + { commandName = "new-install" + , commandSynopsis = "Install packages." + , commandUsage = usageAlternatives "new-install" [ "[TARGETS] [FLAGS]" ] + , commandDescription = Just $ \_ -> wrapText $ + "Installs one or more packages. This is done by installing them " + ++ "in the store and symlinking the executables in the directory " + ++ "specified by the --symlink-bindir flag (`~/.cabal/bin/` by default). " + ++ "If you want the installed executables to be available globally, " + ++ "make sure that the PATH environment variable contains that directory. " + ++ "\n\n" + ++ "If TARGET is a library, it will be added to the global environment. " + ++ "When doing this, cabal will try to build a plan that includes all " + ++ "the previously installed libraries. This is currently not implemented." + , commandNotes = Just $ \pname -> + "Examples:\n" + ++ " " ++ pname ++ " new-install\n" + ++ " Install the package in the current directory\n" + ++ " " ++ pname ++ " new-install pkgname\n" + ++ " Install the package named pkgname (fetching it from hackage if necessary)\n" + ++ " " ++ pname ++ " new-install ./pkgfoo\n" + ++ " Install the package in the ./pkgfoo directory\n" + + ++ cmdCommonHelpTextNewBuildBeta + , commandOptions = commandOptions CmdBuild.buildCommand + , commandDefaultFlags = commandDefaultFlags CmdBuild.buildCommand + } + + +-- | The @install@ command actually serves four different needs. It installs: +-- * Nonlocal exes: +-- For example a program from hackage. The behavior is similar to the old +-- install command, except that now conflicts between separate runs of the +-- command are impossible thanks to the store. +-- Exes are installed in the store like a normal dependency, then they are +-- symlinked uin the directory specified by --symlink-bindir. +-- To do this we need a dummy projectBaseContext containing the targets as +-- estra packages and using a temporary dist directory. +-- * Nonlocal libraries (TODO see #4558) +-- * Local exes (TODO see #4558) +-- * Local libraries (TODO see #4558) +-- +-- For more details on how this works, see the module +-- "Distribution.Client.ProjectOrchestration" +-- +installAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags) + -> [String] -> GlobalFlags -> IO () +installAction (applyFlagDefaults -> (configFlags, configExFlags, installFlags, haddockFlags)) + targetStrings globalFlags = do + -- We need a place to put a temporary dist directory + globalTmp <- getTemporaryDirectory + withTempDirectory + verbosity + globalTmp + "cabal-install." + $ \tmpDir -> do + + let packageNames = mkPackageName <$> targetStrings + packageSpecifiers = + (\pname -> NamedPackage pname []) <$> packageNames + + baseCtx <- establishDummyProjectBaseContext + verbosity + cliConfig + tmpDir + packageSpecifiers + + let targetSelectors = TargetPackageName <$> packageNames + + buildCtx <- + runProjectPreBuildPhase verbosity baseCtx $ \elaboratedPlan -> do + + -- Interpret the targets on the command line as build targets + targets <- either (reportTargetProblems verbosity) return + $ resolveTargets + selectPackageTargets + selectComponentTarget + TargetProblemCommon + elaboratedPlan + targetSelectors + + let elaboratedPlan' = pruneInstallPlanToTargets + TargetActionBuild + targets + elaboratedPlan + elaboratedPlan'' <- + if buildSettingOnlyDeps (buildSettings baseCtx) + then either (reportCannotPruneDependencies verbosity) return $ + pruneInstallPlanToDependencies (Map.keysSet targets) + elaboratedPlan' + else return elaboratedPlan' + + return (elaboratedPlan'', targets) + + printPlan verbosity baseCtx buildCtx + + buildOutcomes <- runProjectBuildPhase verbosity baseCtx buildCtx + + let compiler = pkgConfigCompiler $ elaboratedShared buildCtx + let mkPkgBinDir = ( "bin") . + storePackageDirectory + (cabalStoreDirLayout $ cabalDirLayout baseCtx) + (compilerId compiler) + + -- If there are exes, symlink them + let defaultSymlinkBindir = error "TODO: how do I get the default ~/.cabal (or ~/.local) directory? (use --symlink-bindir explicitly for now)" "bin" + symlinkBindir <- makeAbsolute $ fromFlagOrDefault defaultSymlinkBindir (Client.installSymlinkBinDir installFlags) + traverse_ (symlinkBuiltPackage mkPkgBinDir symlinkBindir) + $ Map.toList $ targetsMap buildCtx + runProjectPostBuildPhase verbosity baseCtx buildCtx buildOutcomes + where + verbosity = fromFlagOrDefault normal (configVerbosity configFlags) + cliConfig = commandLineFlagsToProjectConfig + globalFlags configFlags configExFlags + installFlags haddockFlags + + +-- | Symlink every exe from a package from the store to a given location +symlinkBuiltPackage :: (UnitId -> FilePath) -- ^ A function to get an UnitId's + -- store directory + -> FilePath -- ^ Where to put the symlink + -> ( UnitId + , [(ComponentTarget, [TargetSelector PackageId])] ) + -> IO () +symlinkBuiltPackage mkSourceBinDir destDir (pkg, components) = + traverse_ (symlinkBuiltExe (mkSourceBinDir pkg) destDir) exes + where + exes = catMaybes $ (exeMaybe . fst) <$> components + exeMaybe (ComponentTarget (CExeName exe) _) = Just exe + exeMaybe _ = Nothing + +-- | Symlink a specific exe. +symlinkBuiltExe :: FilePath -> FilePath -> UnqualComponentName -> IO Bool +symlinkBuiltExe sourceDir destDir exe = + symlinkBinary + destDir + sourceDir + exe + $ unUnqualComponentName exe + +-- | Create a dummy project context, without a .cabal or a .cabal.project file +-- (a place where to put a temporary dist directory is still needed) +establishDummyProjectBaseContext :: Verbosity + -> ProjectConfig + -> FilePath -- ^ Where to put the dist directory + -> [PackageSpecifier UnresolvedSourcePackage] -- ^ The packages to be included in the project + -> IO ProjectBaseContext +establishDummyProjectBaseContext verbosity cliConfig tmpDir localPackages = do + + cabalDir <- defaultCabalDir + + -- Create the dist directories + createDirectoryIfMissingVerbose verbosity True $ distDirectory distDirLayout + createDirectoryIfMissingVerbose verbosity True $ distProjectCacheDirectory distDirLayout + + globalConfig <- runRebuild "" + $ readGlobalConfig verbosity + $ projectConfigConfigFile + $ projectConfigShared cliConfig + let projectConfig = globalConfig <> cliConfig + + let ProjectConfigBuildOnly { + projectConfigLogsDir, + projectConfigStoreDir + } = projectConfigBuildOnly projectConfig + + mlogsDir = flagToMaybe projectConfigLogsDir + mstoreDir = flagToMaybe projectConfigStoreDir + cabalDirLayout = mkCabalDirLayout cabalDir mstoreDir mlogsDir + + buildSettings = resolveBuildTimeSettings + verbosity cabalDirLayout + projectConfig + + return ProjectBaseContext { + distDirLayout, + cabalDirLayout, + projectConfig, + localPackages, + buildSettings + } + where + mdistDirectory = flagToMaybe + $ projectConfigDistDir + $ projectConfigShared cliConfig + projectRoot = ProjectRootImplicit tmpDir + distDirLayout = defaultDistDirLayout projectRoot + mdistDirectory + +-- | This defines what a 'TargetSelector' means for the @bench@ command. +-- It selects the 'AvailableTarget's that the 'TargetSelector' refers to, +-- or otherwise classifies the problem. +-- +-- For the @build@ command select all components except non-buildable and disabled +-- tests\/benchmarks, fail if there are no such components +-- +selectPackageTargets :: TargetSelector PackageId + -> [AvailableTarget k] -> Either TargetProblem [k] +selectPackageTargets targetSelector targets + + -- If there are any buildable targets then we select those + | not (null targetsBuildable) + = Right targetsBuildable + + -- If there are targets but none are buildable then we report those + | not (null targets) + = Left (TargetProblemNoneEnabled targetSelector targets') + + -- If there are no targets at all then we report that + | otherwise + = Left (TargetProblemNoTargets targetSelector) + where + targets' = forgetTargetsDetail targets + targetsBuildable = selectBuildableTargetsWith + (buildable targetSelector) + targets + + -- When there's a target filter like "pkg:tests" then we do select tests, + -- but if it's just a target like "pkg" then we don't build tests unless + -- they are requested by default (i.e. by using --enable-tests) + buildable (TargetPackage _ _ Nothing) TargetNotRequestedByDefault = False + buildable (TargetAllPackages Nothing) TargetNotRequestedByDefault = False + buildable _ _ = True + +-- | For a 'TargetComponent' 'TargetSelector', check if the component can be +-- selected. +-- +-- For the @build@ command we just need the basic checks on being buildable etc. +-- +selectComponentTarget :: PackageId -> ComponentName -> SubComponentTarget + -> AvailableTarget k -> Either TargetProblem k +selectComponentTarget pkgid cname subtarget = + either (Left . TargetProblemCommon) Right + . selectComponentTargetBasic pkgid cname subtarget + + +-- | The various error conditions that can occur when matching a +-- 'TargetSelector' against 'AvailableTarget's for the @build@ command. +-- +data TargetProblem = + TargetProblemCommon TargetProblemCommon + + -- | The 'TargetSelector' matches targets but none are buildable + | TargetProblemNoneEnabled (TargetSelector PackageId) [AvailableTarget ()] + + -- | There are no targets at all + | TargetProblemNoTargets (TargetSelector PackageId) + deriving (Eq, Show) + +reportTargetProblems :: Verbosity -> [TargetProblem] -> IO a +reportTargetProblems verbosity = + die' verbosity . unlines . map renderTargetProblem + +renderTargetProblem :: TargetProblem -> String +renderTargetProblem (TargetProblemCommon problem) = + renderTargetProblemCommon "build" problem +renderTargetProblem (TargetProblemNoneEnabled targetSelector targets) = + renderTargetProblemNoneEnabled "build" targetSelector targets +renderTargetProblem(TargetProblemNoTargets targetSelector) = + renderTargetProblemNoTargets "build" targetSelector + +reportCannotPruneDependencies :: Verbosity -> CannotPruneDependencies -> IO a +reportCannotPruneDependencies verbosity = + die' verbosity . renderCannotPruneDependencies + diff --git a/cabal-install/Distribution/Client/CmdRun.hs b/cabal-install/Distribution/Client/CmdRun.hs index 10e15ad06f4..32129363bbb 100644 --- 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 index 054c098e995..c4c070bb960 100644 --- 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 index 2dc64d84a1c..949e1d216b0 100644 --- 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 index bcd2f36e94f..53ea9e08b09 100644 --- 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 index 4343586089a..ca67237157f 100644 --- a/cabal-install/Distribution/Client/ProjectConfig.hs +++ b/cabal-install/Distribution/Client/ProjectConfig.hs @@ -20,6 +20,7 @@ module Distribution.Client.ProjectConfig ( -- * Project config files readProjectConfig, + readGlobalConfig, readProjectLocalFreezeConfig, writeProjectLocalExtraConfig, writeProjectLocalFreezeConfig, @@ -69,6 +70,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 +887,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 +897,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 index 0004cd8a3f4..ddfeb1f0bde 100644 --- 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(..) @@ -155,7 +156,7 @@ data ProjectBaseContext = ProjectBaseContext { distDirLayout :: DistDirLayout, cabalDirLayout :: CabalDirLayout, projectConfig :: ProjectConfig, - localPackages :: [UnresolvedSourcePackage], + localPackages :: [PackageSpecifier UnresolvedSourcePackage], buildSettings :: BuildTimeSettings } @@ -498,17 +499,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 index 5a0f0e5e2f5..3f088beaf36 100644 --- a/cabal-install/Distribution/Client/ProjectPlanning.hs +++ b/cabal-install/Distribution/Client/ProjectPlanning.hs @@ -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 = diff --git a/cabal-install/Distribution/Client/TargetSelector.hs b/cabal-install/Distribution/Client/TargetSelector.hs index aa7087203e1..14117c845c2 100644 --- a/cabal-install/Distribution/Client/TargetSelector.hs +++ b/cabal-install/Distribution/Client/TargetSelector.hs @@ -16,6 +16,7 @@ module Distribution.Client.TargetSelector ( TargetSelector(..), TargetImplicitCwd(..), ComponentKind(..), + ComponentKindFilter, SubComponentTarget(..), QualLevel(..), componentKind, @@ -35,13 +36,13 @@ module Distribution.Client.TargetSelector ( ) where import Distribution.Package - ( Package(..), PackageId, PackageIdentifier(..), packageName - , mkPackageName ) + ( Package(..), PackageId, PackageIdentifier(..) + , PackageName, packageName, mkPackageName ) import Distribution.Version ( mkVersion ) import Distribution.Types.UnqualComponentName ( unUnqualComponentName ) import Distribution.Client.Types - ( PackageLocation(..) ) + ( PackageLocation(..), PackageSpecifier(..) ) import Distribution.Verbosity import Distribution.PackageDescription @@ -153,6 +154,12 @@ data TargetSelector pkg = -- | A specific component in a package. -- | TargetComponent pkg ComponentName SubComponentTarget + + -- | A named package, but not a known local package. It could for example + -- resolve to a dependency of a local package or to a package from + -- hackage. Either way, it requires further processing to resolve. + -- + | TargetPackageName PackageName deriving (Eq, Ord, Functor, Show, Generic) -- | Does this 'TargetPackage' selector arise from syntax referring to a @@ -195,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]) @@ -210,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 @@ -368,6 +376,7 @@ showTargetSelectorKind bt = case bt of TargetComponent _ _ WholeComponent -> "component" TargetComponent _ _ ModuleTarget{} -> "module" TargetComponent _ _ FileTarget{} -> "file" + TargetPackageName{} -> "package name" -- ------------------------------------------------------------ @@ -478,6 +487,8 @@ resolveTargetSelector ppinfo opinfo targetStrStatus = Unambiguous target -> Right target None errs + | TargetStringFileStatus1 str _ <- targetStrStatus + , validPackageName str -> Right (TargetPackageName (mkPackageName str)) | projectIsEmpty -> Left TargetSelectorNoTargetsInProject | otherwise -> Left (classifyMatchErrors errs) @@ -951,7 +962,6 @@ dummyPackageInfo = pinfoId = PackageIdentifier (mkPackageName "dummyPackageInfo") (mkVersion []), - pinfoLocation = unused, pinfoDirectory = unused, pinfoPackageFile = unused, pinfoComponents = unused @@ -1551,7 +1561,6 @@ dispM = display data PackageInfo = PackageInfo { pinfoId :: PackageId, - pinfoLocation :: PackageLocation (), pinfoDirectory :: Maybe (FilePath, FilePath), pinfoPackageFile :: Maybe (FilePath, FilePath), pinfoComponents :: [ComponentInfo] @@ -1599,7 +1608,6 @@ selectPackageInfo dirActions@DirActions{..} let pinfo = PackageInfo { pinfoId = packageId pkg, - pinfoLocation = fmap (const ()) loc, pinfoDirectory = pkgdir, pinfoPackageFile = pkgfile, pinfoComponents = selectComponentInfo pinfo @@ -2192,14 +2200,12 @@ ex1pinfo = [ addComponent (CExeName (mkUnqualComponentName "foo-exe")) [] ["Data.Foo"] $ PackageInfo { pinfoId = PackageIdentifier (mkPackageName "foo") (mkVersion [1]), - pinfoLocation = LocalUnpackedPackage "/the/foo", pinfoDirectory = Just ("/the/foo", "foo"), pinfoPackageFile = Just ("/the/foo/foo.cabal", "foo/foo.cabal"), pinfoComponents = [] } , PackageInfo { pinfoId = PackageIdentifier (mkPackageName "bar") (mkVersion [1]), - pinfoLocation = LocalUnpackedPackage "/the/foo", pinfoDirectory = Just ("/the/bar", "bar"), pinfoPackageFile = Just ("/the/bar/bar.cabal", "bar/bar.cabal"), pinfoComponents = [] diff --git a/cabal-install/Distribution/Client/Targets.hs b/cabal-install/Distribution/Client/Targets.hs index 46fa3a81a18..d25fd23873a 100644 --- a/cabal-install/Distribution/Client/Targets.hs +++ b/cabal-install/Distribution/Client/Targets.hs @@ -18,11 +18,6 @@ module Distribution.Client.Targets ( UserTarget(..), readUserTargets, - -- * Package specifiers - PackageSpecifier(..), - pkgSpecifierTarget, - pkgSpecifierConstraints, - -- * Resolving user targets to package specifiers resolveUserTargets, @@ -60,11 +55,9 @@ import Distribution.Package , PackageIdentifier(..), packageName, packageVersion ) import Distribution.Types.Dependency import Distribution.Client.Types - ( PackageLocation(..) - , ResolvedPkgLoc, UnresolvedSourcePackage ) + ( PackageLocation(..), ResolvedPkgLoc, UnresolvedSourcePackage + , PackageSpecifier(..) ) -import Distribution.Solver.Types.ConstraintSource -import Distribution.Solver.Types.LabeledPackageConstraint import Distribution.Solver.Types.OptionalStanza import Distribution.Solver.Types.PackageConstraint import Distribution.Solver.Types.PackagePath @@ -170,46 +163,6 @@ data UserTarget = deriving (Show,Eq) --- ------------------------------------------------------------ --- * Package specifier --- ------------------------------------------------------------ - --- | A fully or partially resolved reference to a package. --- -data PackageSpecifier pkg = - - -- | A partially specified reference to a package (either source or - -- installed). It is specified by package name and optionally some - -- required properties. Use a dependency resolver to pick a specific - -- package satisfying these properties. - -- - NamedPackage PackageName [PackageProperty] - - -- | A fully specified source package. - -- - | SpecificSourcePackage pkg - deriving (Eq, Show, Generic) - -instance Binary pkg => Binary (PackageSpecifier pkg) - -pkgSpecifierTarget :: Package pkg => PackageSpecifier pkg -> PackageName -pkgSpecifierTarget (NamedPackage name _) = name -pkgSpecifierTarget (SpecificSourcePackage pkg) = packageName pkg - -pkgSpecifierConstraints :: Package pkg - => PackageSpecifier pkg -> [LabeledPackageConstraint] -pkgSpecifierConstraints (NamedPackage name props) = map toLpc props - where - toLpc prop = LabeledPackageConstraint - (PackageConstraint (scopeToplevel name) prop) - ConstraintSourceUserTarget -pkgSpecifierConstraints (SpecificSourcePackage pkg) = - [LabeledPackageConstraint pc ConstraintSourceUserTarget] - where - pc = PackageConstraint - (ScopeTarget $ packageName pkg) - (PackagePropertyVersion $ thisVersion (packageVersion pkg)) - -- ------------------------------------------------------------ -- * Parsing and checking user targets -- ------------------------------------------------------------ diff --git a/cabal-install/Distribution/Client/Types.hs b/cabal-install/Distribution/Client/Types.hs index 203d76575ab..e27f87a1f18 100644 --- a/cabal-install/Distribution/Client/Types.hs +++ b/cabal-install/Distribution/Client/Types.hs @@ -25,13 +25,14 @@ import Distribution.Client.Compat.Prelude import Distribution.Package ( Package(..), HasMungedPackageId(..), HasUnitId(..) - , PackageIdentifier(..), PackageInstalled(..), newSimpleUnitId ) + , PackageIdentifier(..), packageVersion, packageName + , PackageInstalled(..), newSimpleUnitId ) import Distribution.InstalledPackageInfo ( InstalledPackageInfo, installedComponentId, sourceComponentName ) import Distribution.PackageDescription ( FlagAssignment ) import Distribution.Version - ( VersionRange, nullVersion ) + ( VersionRange, nullVersion, thisVersion ) import Distribution.Types.ComponentId ( ComponentId ) import Distribution.Types.MungedPackageId @@ -51,7 +52,10 @@ import Distribution.Solver.Types.PackageIndex import qualified Distribution.Solver.Types.ComponentDeps as CD 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.PackageConstraint import Distribution.Solver.Types.PackageFixedDeps import Distribution.Solver.Types.SourcePackage import Distribution.Compat.Graph (IsNode(..)) @@ -211,6 +215,48 @@ type ReadyPackage = GenericReadyPackage (ConfiguredPackage UnresolvedPkgLoc) -- | Convenience alias for 'SourcePackage UnresolvedPkgLoc'. type UnresolvedSourcePackage = SourcePackage UnresolvedPkgLoc + +-- ------------------------------------------------------------ +-- * Package specifier +-- ------------------------------------------------------------ + +-- | A fully or partially resolved reference to a package. +-- +data PackageSpecifier pkg = + + -- | A partially specified reference to a package (either source or + -- installed). It is specified by package name and optionally some + -- required properties. Use a dependency resolver to pick a specific + -- package satisfying these properties. + -- + NamedPackage PackageName [PackageProperty] + + -- | A fully specified source package. + -- + | SpecificSourcePackage pkg + deriving (Eq, Show, Generic) + +instance Binary pkg => Binary (PackageSpecifier pkg) + +pkgSpecifierTarget :: Package pkg => PackageSpecifier pkg -> PackageName +pkgSpecifierTarget (NamedPackage name _) = name +pkgSpecifierTarget (SpecificSourcePackage pkg) = packageName pkg + +pkgSpecifierConstraints :: Package pkg + => PackageSpecifier pkg -> [LabeledPackageConstraint] +pkgSpecifierConstraints (NamedPackage name props) = map toLpc props + where + toLpc prop = LabeledPackageConstraint + (PackageConstraint (scopeToplevel name) prop) + ConstraintSourceUserTarget +pkgSpecifierConstraints (SpecificSourcePackage pkg) = + [LabeledPackageConstraint pc ConstraintSourceUserTarget] + where + pc = PackageConstraint + (ScopeTarget $ packageName pkg) + (PackagePropertyVersion $ thisVersion (packageVersion pkg)) + + -- ------------------------------------------------------------ -- * Package locations and repositories -- ------------------------------------------------------------ diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 3308bd13015..5014a28d381 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -158,6 +158,7 @@ library Distribution.Client.CmdExec Distribution.Client.CmdFreeze Distribution.Client.CmdHaddock + Distribution.Client.CmdInstall Distribution.Client.CmdRepl Distribution.Client.CmdRun Distribution.Client.CmdTest diff --git a/cabal-install/changelog b/cabal-install/changelog index 2f48c20d500..6887bed17c8 100644 --- a/cabal-install/changelog +++ b/cabal-install/changelog @@ -21,6 +21,8 @@ Additionally, it can run executables across packages in a project. * Completed the 'new-bench' command (#3638). Same as above. * Completed the 'new-exec' command (#3638). Same as above. + * Added a preliminary 'new-install' command (#4558, nonlocal exes + part) which allows to quickly install executables from hackage. * '--allow-{newer,older}' syntax has been enhanced. Dependency relaxation can be now limited to a specific release of a package, plus there's a new syntax for relaxing only caret-style (i.e. '^>=') diff --git a/cabal-install/main/Main.hs b/cabal-install/main/Main.hs index 6d304ab5f0a..8a29d58cd2c 100644 --- a/cabal-install/main/Main.hs +++ b/cabal-install/main/Main.hs @@ -80,6 +80,7 @@ import qualified Distribution.Client.CmdBuild as CmdBuild import qualified Distribution.Client.CmdRepl as CmdRepl import qualified Distribution.Client.CmdFreeze as CmdFreeze import qualified Distribution.Client.CmdHaddock as CmdHaddock +import qualified Distribution.Client.CmdInstall as CmdInstall import qualified Distribution.Client.CmdRun as CmdRun import qualified Distribution.Client.CmdTest as CmdTest import qualified Distribution.Client.CmdBench as CmdBench @@ -315,6 +316,7 @@ mainWorker args = topHandler $ , regularCmd CmdRepl.replCommand CmdRepl.replAction , regularCmd CmdFreeze.freezeCommand CmdFreeze.freezeAction , regularCmd CmdHaddock.haddockCommand CmdHaddock.haddockAction + , regularCmd CmdInstall.installCommand CmdInstall.installAction , regularCmd CmdRun.runCommand CmdRun.runAction , regularCmd CmdTest.testCommand CmdTest.testAction , regularCmd CmdBench.benchCommand CmdBench.benchAction diff --git a/cabal-install/tests/IntegrationTests2.hs b/cabal-install/tests/IntegrationTests2.hs index 232cd20f1ec..9f9b9e8ac36 100644 --- 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 diff --git a/cabal-testsuite/PackageTests/NewBuild/CmdRun/Single/cabal.out b/cabal-testsuite/PackageTests/NewBuild/CmdRun/Single/cabal.out index db2a3a368e1..4b7ebcd9e40 100644 --- a/cabal-testsuite/PackageTests/NewBuild/CmdRun/Single/cabal.out +++ b/cabal-testsuite/PackageTests/NewBuild/CmdRun/Single/cabal.out @@ -15,7 +15,5 @@ Up to date # cabal new-run Up to date # cabal new-run -cabal: Unknown target 'bar'. -There is no component 'bar'. -The project has no package 'bar'. +cabal: Cannot run the package bar, it is not in this project (either directly or indirectly). If you want to add it to the project then edit the cabal.project file.