From 5e2bb0cb1c74ba9f0be97939773066dcd6aa1674 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Thu, 31 Aug 2017 23:31:09 +0100 Subject: [PATCH 1/8] Move targetSelectorFilter util into common module Consolodate the three copies of it. --- cabal-install/Distribution/Client/CmdBench.hs | 4 ---- cabal-install/Distribution/Client/CmdErrorMessages.hs | 8 ++++++-- cabal-install/Distribution/Client/CmdRun.hs | 5 ----- cabal-install/Distribution/Client/CmdTest.hs | 4 ---- cabal-install/Distribution/Client/TargetSelector.hs | 1 + 5 files changed, 7 insertions(+), 15 deletions(-) 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..c4362bf257e 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 ) @@ -124,7 +124,6 @@ optionalStanza (CTestName _) = Just TestStanzas optionalStanza (CBenchName _) = Just BenchStanzas optionalStanza _ = Nothing - -- | Does the 'TargetSelector' potentially refer to one package or many? -- targetSelectorPluralPkgs :: TargetSelector a -> Plural @@ -138,6 +137,11 @@ targetSelectorRefersToPkgs (TargetAllPackages mkfilter) = isNothing mkfilter targetSelectorRefersToPkgs (TargetPackage _ _ mkfilter) = isNothing mkfilter targetSelectorRefersToPkgs (TargetComponent _ _ _) = False +targetSelectorFilter :: TargetSelector a -> Maybe ComponentKindFilter +targetSelectorFilter (TargetPackage _ _ mkfilter) = mkfilter +targetSelectorFilter (TargetAllPackages mkfilter) = mkfilter +targetSelectorFilter (TargetComponent _ _ _) = Nothing + renderComponentKind :: Plural -> ComponentKind -> String renderComponentKind Singular ckind = case ckind of LibKind -> "library" -- internal/sub libs? 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/TargetSelector.hs b/cabal-install/Distribution/Client/TargetSelector.hs index aa7087203e1..4d6674ad9c6 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, From c6f8d1b01f97abc47995f27371cbf30a2a94c329 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Thu, 31 Aug 2017 23:34:50 +0100 Subject: [PATCH 2/8] Add cli target support for out-of-project package names There is nothing except for syntax support, but this is a first step towards proper support for targets refering to dependencies or to out of project packages. For the moment, when used, it will report: cabal: Cannot build the package foobar, 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. Also update the test output for an integration test. --- .../Distribution/Client/CmdErrorMessages.hs | 8 ++++++++ .../Distribution/Client/ProjectOrchestration.hs | 2 ++ cabal-install/Distribution/Client/TargetSelector.hs | 13 +++++++++++-- .../PackageTests/NewBuild/CmdRun/Single/cabal.out | 4 +--- 4 files changed, 22 insertions(+), 5 deletions(-) diff --git a/cabal-install/Distribution/Client/CmdErrorMessages.hs b/cabal-install/Distribution/Client/CmdErrorMessages.hs index c4362bf257e..78030b7033a 100644 --- a/cabal-install/Distribution/Client/CmdErrorMessages.hs +++ b/cabal-install/Distribution/Client/CmdErrorMessages.hs @@ -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" @@ -130,17 +133,20 @@ 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 @@ -315,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/ProjectOrchestration.hs b/cabal-install/Distribution/Client/ProjectOrchestration.hs index 0004cd8a3f4..f2d7932dc8b 100644 --- a/cabal-install/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/Distribution/Client/ProjectOrchestration.hs @@ -498,6 +498,8 @@ resolveTargets selectPackageTargets selectComponentTarget liftProblem | otherwise = Left (liftProblem (TargetProblemNoSuchPackage pkgid)) + checkTarget (TargetPackageName pkgname) + = 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 diff --git a/cabal-install/Distribution/Client/TargetSelector.hs b/cabal-install/Distribution/Client/TargetSelector.hs index 4d6674ad9c6..c1c35fa5cb4 100644 --- a/cabal-install/Distribution/Client/TargetSelector.hs +++ b/cabal-install/Distribution/Client/TargetSelector.hs @@ -36,8 +36,8 @@ 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 ) @@ -154,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 @@ -369,6 +375,7 @@ showTargetSelectorKind bt = case bt of TargetComponent _ _ WholeComponent -> "component" TargetComponent _ _ ModuleTarget{} -> "module" TargetComponent _ _ FileTarget{} -> "file" + TargetPackageName{} -> "package name" -- ------------------------------------------------------------ @@ -479,6 +486,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) 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. From b9ce43370d70dc052d42a6fc651262364cb37f0e Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Fri, 1 Sep 2017 00:59:21 +0100 Subject: [PATCH 3/8] Move PackageSpecifier into common Types module It's currently in the old Targets module, but we'll need it in the new-build code too soon, and it's not really that closely related to targets, so it makes sense to have it live in the common Types module. --- .../Distribution/Client/Dependency.hs | 2 +- cabal-install/Distribution/Client/List.hs | 5 +- cabal-install/Distribution/Client/Targets.hs | 51 +------------------ cabal-install/Distribution/Client/Types.hs | 50 +++++++++++++++++- 4 files changed, 53 insertions(+), 55 deletions(-) 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/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 -- ------------------------------------------------------------ From bb9bc93d911fd0e80fde5a50a218a82cf989ef81 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 2 Sep 2017 12:07:12 +0100 Subject: [PATCH 4/8] Remove unused PackageLocation from PackageInfo in target selection --- cabal-install/Distribution/Client/TargetSelector.hs | 5 ----- 1 file changed, 5 deletions(-) diff --git a/cabal-install/Distribution/Client/TargetSelector.hs b/cabal-install/Distribution/Client/TargetSelector.hs index c1c35fa5cb4..22e261e1375 100644 --- a/cabal-install/Distribution/Client/TargetSelector.hs +++ b/cabal-install/Distribution/Client/TargetSelector.hs @@ -961,7 +961,6 @@ dummyPackageInfo = pinfoId = PackageIdentifier (mkPackageName "dummyPackageInfo") (mkVersion []), - pinfoLocation = unused, pinfoDirectory = unused, pinfoPackageFile = unused, pinfoComponents = unused @@ -1561,7 +1560,6 @@ dispM = display data PackageInfo = PackageInfo { pinfoId :: PackageId, - pinfoLocation :: PackageLocation (), pinfoDirectory :: Maybe (FilePath, FilePath), pinfoPackageFile :: Maybe (FilePath, FilePath), pinfoComponents :: [ComponentInfo] @@ -1609,7 +1607,6 @@ selectPackageInfo dirActions@DirActions{..} let pinfo = PackageInfo { pinfoId = packageId pkg, - pinfoLocation = fmap (const ()) loc, pinfoDirectory = pkgdir, pinfoPackageFile = pkgfile, pinfoComponents = selectComponentInfo pinfo @@ -2202,14 +2199,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 = [] From ec6b17b64f77e38e06711de4c9e4175246d08b70 Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 2 Sep 2017 15:21:14 +0100 Subject: [PATCH 5/8] resolve package name targets to any package within the project That is, any package name within the install plan. This allows targeting a dependency of a package that is local to the project. --- .../Client/ProjectOrchestration.hs | 28 +++++++++++++------ 1 file changed, 20 insertions(+), 8 deletions(-) diff --git a/cabal-install/Distribution/Client/ProjectOrchestration.hs b/cabal-install/Distribution/Client/ProjectOrchestration.hs index f2d7932dc8b..f7ddde6ae2f 100644 --- a/cabal-install/Distribution/Client/ProjectOrchestration.hs +++ b/cabal-install/Distribution/Client/ProjectOrchestration.hs @@ -498,19 +498,31 @@ resolveTargets selectPackageTargets selectComponentTarget liftProblem | otherwise = Left (liftProblem (TargetProblemNoSuchPackage pkgid)) - checkTarget (TargetPackageName pkgname) + 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 From b59d1f7be75117d55fc368d55ad7b540bf05e7af Mon Sep 17 00:00:00 2001 From: Duncan Coutts Date: Sat, 2 Sep 2017 18:39:55 +0100 Subject: [PATCH 6/8] 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. --- .../Distribution/Client/ProjectConfig.hs | 18 +++++++- .../Client/ProjectOrchestration.hs | 5 ++- .../Distribution/Client/ProjectPlanning.hs | 42 ++++++++++++------- .../Distribution/Client/TargetSelector.hs | 9 ++-- cabal-install/tests/IntegrationTests2.hs | 15 +++++-- 5 files changed, 62 insertions(+), 27 deletions(-) diff --git a/cabal-install/Distribution/Client/ProjectConfig.hs b/cabal-install/Distribution/Client/ProjectConfig.hs index 4343586089a..4b374c26f48 100644 --- 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 index f7ddde6ae2f..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 } 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 22e261e1375..14117c845c2 100644 --- 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,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 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 From 9c62e122394f83c7751201e9d1ffbaf1eab9313a Mon Sep 17 00:00:00 2001 From: Francesco Gazzetta Date: Sat, 14 Oct 2017 12:09:24 +0200 Subject: [PATCH 7/8] Add a new-install command Add the first part of the new-install command: nonlocal exes. See #4558 for the design concept. This part of the command installs executables from outside of a project (ie from hackage) in the store and then symlinks them in the cabal bin directory. This is done by creating a dummy project and adding the targets as extra packages. --- .../Distribution/Client/CmdInstall.hs | 336 ++++++++++++++++++ .../Distribution/Client/ProjectConfig.hs | 1 + cabal-install/cabal-install.cabal | 1 + cabal-install/main/Main.hs | 2 + 4 files changed, 340 insertions(+) create mode 100644 cabal-install/Distribution/Client/CmdInstall.hs 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/ProjectConfig.hs b/cabal-install/Distribution/Client/ProjectConfig.hs index 4b374c26f48..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, 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/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 From 8834c37683cb402f63fbddc29f1c8d463288321a Mon Sep 17 00:00:00 2001 From: Francesco Gazzetta Date: Fri, 27 Oct 2017 19:50:47 +0200 Subject: [PATCH 8/8] Mention new-install in the changelog [ci skip] --- cabal-install/changelog | 2 ++ 1 file changed, 2 insertions(+) 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. '^>=')