diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 5aedb23aeed..19d71168367 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -118,6 +118,7 @@ library Distribution.Client.CmdTarget Distribution.Client.CmdTest Distribution.Client.CmdUpdate + Distribution.Client.CmdGenBounds Distribution.Client.Compat.Directory Distribution.Client.Compat.ExecutablePath Distribution.Client.Compat.Orphans diff --git a/cabal-install/src/Distribution/Client/CmdGenBounds.hs b/cabal-install/src/Distribution/Client/CmdGenBounds.hs new file mode 100644 index 00000000000..ee15a95bfee --- /dev/null +++ b/cabal-install/src/Distribution/Client/CmdGenBounds.hs @@ -0,0 +1,256 @@ +{-# LANGUAGE NamedFieldPuns #-} + +module Distribution.Client.CmdGenBounds + ( genBounds + , genBoundsCommand + , genBoundsAction + , GenBoundsFlags (..) + , defaultGenBoundsFlags + ) where + +import Distribution.Client.Compat.Prelude +import Prelude () + +import qualified Data.Map as Map + +import Control.Monad (mapM_) + +import Distribution.Client.Errors + +import Distribution.Client.ProjectPlanning hiding (pruneInstallPlanToTargets) +import Distribution.Client.ProjectPlanning.Types +import Distribution.Client.Types.ConfiguredId (confInstId) +import Distribution.Client.Utils hiding (pvpize) +import Distribution.InstalledPackageInfo (InstalledPackageInfo, installedComponentId) +import Distribution.Package +import Distribution.PackageDescription +import Distribution.Simple.Utils +import Distribution.Version + +import Distribution.Client.Setup (CommonSetupFlags (..), ConfigFlags (..), GlobalFlags (..)) + +-- Project orchestration imports + +import Distribution.Client.CmdErrorMessages +import Distribution.Client.GenBounds +import qualified Distribution.Client.InstallPlan as InstallPlan +import Distribution.Client.NixStyleOptions +import Distribution.Client.ProjectFlags +import Distribution.Client.ProjectOrchestration +import Distribution.Client.ScriptUtils +import Distribution.Client.TargetProblem +import Distribution.Simple.Command +import Distribution.Simple.Flag +import Distribution.Types.Component +import Distribution.Verbosity + +-- | The data type for gen-bounds command flags +data GenBoundsFlags = GenBoundsFlags {} + +-- | Default values for the gen-bounds flags +defaultGenBoundsFlags :: GenBoundsFlags +defaultGenBoundsFlags = GenBoundsFlags{} + +-- | The @gen-bounds@ command definition +genBoundsCommand :: CommandUI (NixStyleFlags GenBoundsFlags) +genBoundsCommand = + CommandUI + { commandName = "v2-gen-bounds" + , commandSynopsis = "Generate dependency bounds for packages in the project." + , commandUsage = usageAlternatives "v2-gen-bounds" ["[TARGETS] [FLAGS]"] + , commandDescription = Just $ \_ -> + "Generate PVP-compliant dependency bounds for packages in the project." + , commandNotes = Just $ \pname -> + "Examples:\n" + ++ " " + ++ pname + ++ " v2-gen-bounds\n" + ++ " Generate bounds for the package in the current directory " + ++ "or all packages in the project\n" + ++ " " + ++ pname + ++ " v2-gen-bounds pkgname\n" + ++ " Generate bounds for the package named pkgname in the project\n" + ++ " " + ++ pname + ++ " v2-gen-bounds ./pkgfoo\n" + ++ " Generate bounds for the package in the ./pkgfoo directory\n" + , commandDefaultFlags = defaultNixStyleFlags defaultGenBoundsFlags + , commandOptions = + removeIgnoreProjectOption + . nixStyleOptions (const []) + } + +-- | The action for the @gen-bounds@ command when used in a project context. +genBoundsAction :: NixStyleFlags GenBoundsFlags -> [String] -> GlobalFlags -> IO () +genBoundsAction flags targetStrings globalFlags = + withContextAndSelectors RejectNoTargets Nothing flags targetStrings globalFlags OtherCommand $ \targetCtx ctx targetSelectors -> do + let verbosity = fromFlagOrDefault normal (setupVerbosity $ configCommonFlags $ configFlags flags) + + baseCtx <- case targetCtx of + ProjectContext -> return ctx + GlobalContext -> return ctx + ScriptContext path _ -> + dieWithException verbosity $ + GenBoundsDoesNotSupportScript path + + let ProjectBaseContext{distDirLayout, cabalDirLayout, projectConfig, localPackages} = baseCtx + + -- Step 1: Create the install plan for the project. + (_, elaboratedPlan, _, _, _) <- + rebuildInstallPlan + verbosity + distDirLayout + cabalDirLayout + projectConfig + localPackages + Nothing + + -- Step 2: Resolve the targets for the gen-bounds command. + targets <- + either (reportGenBoundsTargetProblems verbosity) return $ + resolveTargets + selectPackageTargets + selectComponentTarget + elaboratedPlan + Nothing + targetSelectors + + -- Step 3: Prune the install plan to the targets. + let elaboratedPlan' = + pruneInstallPlanToTargets + TargetActionBuild + targets + elaboratedPlan + + let + -- Step 4a: Find the local packages from the install plan. These are the + -- candidates for which we will generate bounds. + localPkgs :: [ElaboratedConfiguredPackage] + localPkgs = mapMaybe (InstallPlan.foldPlanPackage (const Nothing) (\p -> Just p)) (InstallPlan.toList elaboratedPlan') + + -- Step 4b: Extract which versions we chose for each package from the pruned install plan. + pkgVersionMap :: Map.Map ComponentId PackageIdentifier + pkgVersionMap = Map.fromList (map (InstallPlan.foldPlanPackage externalVersion localVersion) (InstallPlan.toList elaboratedPlan')) + + externalVersion :: InstalledPackageInfo -> (ComponentId, PackageIdentifier) + externalVersion pkg = (installedComponentId pkg, packageId pkg) + + localVersion :: ElaboratedConfiguredPackage -> (ComponentId, PackageIdentifier) + localVersion pkg = (elabComponentId pkg, packageId pkg) + + let genBoundsActionForPkg :: ElaboratedConfiguredPackage -> [GenBoundsResult] + genBoundsActionForPkg pkg = + -- Step 5: Match up the user specified targets with the local packages. + case Map.lookup (installedUnitId pkg) targets of + Nothing -> [] + Just tgts -> + map (\(tgt, _) -> getBoundsForComponent tgt pkg pkgVersionMap) tgts + + -- Process each package to find the ones needing bounds + let boundsActions = concatMap genBoundsActionForPkg localPkgs + + if (any isBoundsNeeded boundsActions) + then do + notice verbosity boundsNeededMsg + mapM_ (renderBoundsResult verbosity) boundsActions + else notice verbosity "All bounds up-to-date" + +data GenBoundsResult = GenBoundsResult PackageIdentifier ComponentTarget (Maybe [PackageIdentifier]) + +isBoundsNeeded :: GenBoundsResult -> Bool +isBoundsNeeded (GenBoundsResult _ _ Nothing) = False +isBoundsNeeded _ = True + +renderBoundsResult :: Verbosity -> GenBoundsResult -> IO () +renderBoundsResult verbosity (GenBoundsResult pid tgt bounds) = + case bounds of + Nothing -> + notice + verbosity + ("Congratulations, all dependencies for " ++ prettyShow (packageName pid) ++ ":" ++ showComponentTarget pid tgt ++ " have upper bounds!") + Just pkgBounds -> do + notice verbosity $ + "For component " ++ prettyShow (pkgName pid) ++ ":" ++ showComponentTarget pid tgt ++ ":" + let padTo = maximum $ map (length . unPackageName . packageName) pkgBounds + traverse_ (notice verbosity . (++ ",") . showBounds padTo) pkgBounds + +-- | Process a single BuildInfo to identify and report missing upper bounds +getBoundsForComponent + :: ComponentTarget + -> ElaboratedConfiguredPackage + -> Map.Map ComponentId PackageIdentifier + -> GenBoundsResult +getBoundsForComponent tgt pkg pkgVersionMap = + if null needBounds + then boundsResult Nothing + else -- All the things we depend on. + + let componentDeps = elabLibDependencies pkg + -- Match these up to package names, this is a list of Package name to versions. + -- Now just match that up with what the user wrote in the build-depends section. + depsWithVersions = mapMaybe (\cid -> Map.lookup (confInstId $ fst cid) pkgVersionMap) componentDeps + isNeeded = hasElem needBounds . packageName + in boundsResult (Just (filter isNeeded depsWithVersions)) + where + pd = elabPkgDescription pkg + -- Extract the build-depends for the right part of the cabal file. + bi = buildInfoForTarget pd tgt + + -- We need to generate bounds if + -- \* the dependency does not have an upper bound + -- \* the dependency is not the same package as the one we are processing + boundFilter dep = + (not (hasUpperBound (depVerRange dep))) + && packageName pd /= depPkgName dep + + -- The dependencies that need bounds. + needBounds = map depPkgName $ filter boundFilter $ targetBuildDepends bi + + boundsResult = GenBoundsResult (packageId pkg) tgt + +buildInfoForTarget :: PackageDescription -> ComponentTarget -> BuildInfo +buildInfoForTarget pd (ComponentTarget cname _) = componentBuildInfo $ getComponent pd cname + +-- | This defines what a 'TargetSelector' means for the @gen-bounds@ command. +-- Copy of selectPackageTargets from CmdBuild.hs +selectPackageTargets + :: TargetSelector + -> [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. Copy of selectComponentTarget from CmdBuild.hs +selectComponentTarget + :: SubComponentTarget + -> AvailableTarget k + -> Either TargetProblem' k +selectComponentTarget = selectComponentTargetBasic + +-- | Report target problems for gen-bounds command +reportGenBoundsTargetProblems :: Verbosity -> [TargetProblem'] -> IO a +reportGenBoundsTargetProblems verbosity problems = + reportTargetProblems verbosity "gen-bounds" problems diff --git a/cabal-install/src/Distribution/Client/Errors.hs b/cabal-install/src/Distribution/Client/Errors.hs index ff9ad369bef..06f965fd972 100644 --- a/cabal-install/src/Distribution/Client/Errors.hs +++ b/cabal-install/src/Distribution/Client/Errors.hs @@ -186,6 +186,7 @@ data CabalInstallException | MissingPackageList Repo.RemoteRepo | CmdPathAcceptsNoTargets | CmdPathCommandDoesn'tSupportDryRun + | GenBoundsDoesNotSupportScript FilePath deriving (Show) exceptionCodeCabalInstall :: CabalInstallException -> Int @@ -338,6 +339,7 @@ exceptionCodeCabalInstall e = case e of MissingPackageList{} -> 7160 CmdPathAcceptsNoTargets{} -> 7161 CmdPathCommandDoesn'tSupportDryRun -> 7163 + GenBoundsDoesNotSupportScript{} -> 7164 exceptionMessageCabalInstall :: CabalInstallException -> String exceptionMessageCabalInstall e = case e of @@ -860,6 +862,8 @@ exceptionMessageCabalInstall e = case e of "The 'path' command accepts no target arguments." CmdPathCommandDoesn'tSupportDryRun -> "The 'path' command doesn't support the flag '--dry-run'." + GenBoundsDoesNotSupportScript{} -> + "The 'gen-bounds' command does not support script targets." instance Exception (VerboseException CabalInstallException) where displayException :: VerboseException CabalInstallException -> [Char] diff --git a/cabal-install/src/Distribution/Client/GenBounds.hs b/cabal-install/src/Distribution/Client/GenBounds.hs index 1139bf69aed..da8d06c70dc 100644 --- a/cabal-install/src/Distribution/Client/GenBounds.hs +++ b/cabal-install/src/Distribution/Client/GenBounds.hs @@ -10,6 +10,8 @@ -- The cabal gen-bounds command for generating PVP-compliant version bounds. module Distribution.Client.GenBounds ( genBounds + , boundsNeededMsg + , showBounds ) where import Distribution.Client.Compat.Prelude diff --git a/cabal-install/src/Distribution/Client/Main.hs b/cabal-install/src/Distribution/Client/Main.hs index 39caec854cd..1e4a24692e4 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -120,6 +120,7 @@ import qualified Distribution.Client.CmdClean as CmdClean import qualified Distribution.Client.CmdConfigure as CmdConfigure import qualified Distribution.Client.CmdExec as CmdExec import qualified Distribution.Client.CmdFreeze as CmdFreeze +import qualified Distribution.Client.CmdGenBounds as CmdGenBounds import qualified Distribution.Client.CmdHaddock as CmdHaddock import qualified Distribution.Client.CmdHaddockProject as CmdHaddockProject import qualified Distribution.Client.CmdInstall as CmdInstall @@ -436,7 +437,6 @@ mainWorker args = do , regularCmd initCommand initAction , regularCmd userConfigCommand userConfigAction , regularCmd CmdPath.pathCommand CmdPath.pathAction - , regularCmd genBoundsCommand genBoundsAction , regularCmd CmdOutdated.outdatedCommand CmdOutdated.outdatedAction , wrapperCmd hscolourCommand hscolourCommonFlags , hiddenCmd formatCommand formatAction @@ -462,7 +462,9 @@ mainWorker args = do , newCmd CmdClean.cleanCommand CmdClean.cleanAction , newCmd CmdSdist.sdistCommand CmdSdist.sdistAction , newCmd CmdTarget.targetCommand CmdTarget.targetAction + , newCmd CmdGenBounds.genBoundsCommand CmdGenBounds.genBoundsAction , legacyCmd configureExCommand configureAction + , legacyCmd genBoundsCommand genBoundsAction , legacyCmd buildCommand buildAction , legacyCmd replCommand replAction , legacyCmd freezeCommand freezeAction diff --git a/cabal-testsuite/PackageTests/GenBounds/Issue6290/cabal.out b/cabal-testsuite/PackageTests/GenBounds/Issue6290/cabal.out index 08a8512a6df..009df997267 100644 --- a/cabal-testsuite/PackageTests/GenBounds/Issue6290/cabal.out +++ b/cabal-testsuite/PackageTests/GenBounds/Issue6290/cabal.out @@ -1,3 +1,3 @@ # cabal gen-bounds Resolving dependencies... -Congratulations, all your dependencies have upper bounds! +All bounds up-to-date diff --git a/cabal-testsuite/PackageTests/GenBounds/Issue7504/cabal.project b/cabal-testsuite/PackageTests/GenBounds/Issue7504/cabal.project new file mode 100644 index 00000000000..8ed8df66ab7 --- /dev/null +++ b/cabal-testsuite/PackageTests/GenBounds/Issue7504/cabal.project @@ -0,0 +1,2 @@ +packages: package-a + package-b diff --git a/cabal-testsuite/PackageTests/GenBounds/Issue7504/cabal.test.hs b/cabal-testsuite/PackageTests/GenBounds/Issue7504/cabal.test.hs new file mode 100644 index 00000000000..f2934953cfe --- /dev/null +++ b/cabal-testsuite/PackageTests/GenBounds/Issue7504/cabal.test.hs @@ -0,0 +1,11 @@ +import System.Directory (setCurrentDirectory) +import Test.Cabal.Prelude + +main = cabalTest $ recordMode DoNotRecord $ do + r <- cabal' "gen-bounds" ["all"] + assertOutputContains "For component package-a:lib:package-a:" r + assertOutputContains "For component package-b:lib:package-b:" r + assertOutputContains "For component package-b:exe:package-b:" r + assertOutputContains "text >=" r + assertOutputContains "package-a >= 0.1.0 && < 0.2" r + diff --git a/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-a/LICENSE b/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-a/LICENSE new file mode 100644 index 00000000000..00dedf4caaa --- /dev/null +++ b/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-a/LICENSE @@ -0,0 +1,28 @@ +Copyright (c) 2023, Cabal Team + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + * Neither the name of Cabal Team nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-a/package-a.cabal b/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-a/package-a.cabal new file mode 100644 index 00000000000..c1397374da1 --- /dev/null +++ b/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-a/package-a.cabal @@ -0,0 +1,15 @@ +cabal-version: 2.2 +name: package-a +version: 0.1.0.0 +synopsis: A simple package for testing gen-bounds +license: BSD-3-Clause +license-file: LICENSE +author: Cabal Team +maintainer: cabal-dev@haskell.org +build-type: Simple + +library + default-language: Haskell2010 + hs-source-dirs: src + exposed-modules: ModuleA + build-depends: base >= 4.8 && < 5, text diff --git a/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-a/src/ModuleA.hs b/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-a/src/ModuleA.hs new file mode 100644 index 00000000000..1113126f402 --- /dev/null +++ b/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-a/src/ModuleA.hs @@ -0,0 +1,5 @@ +module ModuleA (getMessage) where + +-- | Return a simple greeting message +getMessage :: String +getMessage = "Hello from package-a!" diff --git a/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/LICENSE b/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/LICENSE new file mode 100644 index 00000000000..00dedf4caaa --- /dev/null +++ b/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/LICENSE @@ -0,0 +1,28 @@ +Copyright (c) 2023, Cabal Team + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + * Neither the name of Cabal Team nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/exe/Main.hs b/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/exe/Main.hs new file mode 100644 index 00000000000..d6a4ff7d19a --- /dev/null +++ b/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/exe/Main.hs @@ -0,0 +1,6 @@ +module Main where + +import ModuleB (getEnhancedMessage) + +main :: IO () +main = putStrLn getEnhancedMessage diff --git a/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/package-b.cabal b/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/package-b.cabal new file mode 100644 index 00000000000..dd30f82d872 --- /dev/null +++ b/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/package-b.cabal @@ -0,0 +1,24 @@ +cabal-version: 2.2 +name: package-b +version: 0.1.0.0 +synopsis: A package that depends on package-a for testing gen-bounds +license: BSD-3-Clause +license-file: LICENSE +author: Cabal Team +maintainer: cabal-dev@haskell.org +build-type: Simple + +library + default-language: Haskell2010 + hs-source-dirs: src + exposed-modules: ModuleB + build-depends: base, + package-a + +executable package-b + default-language: Haskell2010 + hs-source-dirs: exe + main-is: Main.hs + build-depends: base, + package-a, + package-b diff --git a/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/src/ModuleB.hs b/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/src/ModuleB.hs new file mode 100644 index 00000000000..5ba308d35b0 --- /dev/null +++ b/cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/src/ModuleB.hs @@ -0,0 +1,7 @@ +module ModuleB (getEnhancedMessage) where + +import ModuleA (getMessage) + +-- | Return an enhanced message that uses ModuleA's functionality +getEnhancedMessage :: String +getEnhancedMessage = getMessage ++ " Enhanced by package-b!" diff --git a/changelog.d/pr-10840.md b/changelog.d/pr-10840.md new file mode 100644 index 00000000000..0652ba03ca2 --- /dev/null +++ b/changelog.d/pr-10840.md @@ -0,0 +1,28 @@ +--- +synopsis: Fix gen-bounds command to work in multi-package projects +packages: [cabal-install] +prs: 10840 +issues: [7504] +--- + +`cabal gen-bounds` now works in multi-package projects. + +The command has been reimplemented to use the cabal.project infrastructure (similar +to other v2 commands), allowing it to be aware of all packages defined in the cabal.project +file, regardless of which directory it's executed from. + +``` +$ cat cabal.project +packages: package-a/ + package-b/ + +$ cd package-b/ +$ cabal gen-bounds +Configuration is affected by the following files: +- cabal.project +Resolving dependencies... + +The following packages need bounds and here is a suggested starting point... +For component package-b:lib:package-b: +package-a >= 0.1.0 && < 0.2, +``` diff --git a/doc/cabal-commands.rst b/doc/cabal-commands.rst index 7f0b37ac48f..2e4004c3691 100644 --- a/doc/cabal-commands.rst +++ b/doc/cabal-commands.rst @@ -532,38 +532,74 @@ users see a consistent set of dependencies. For libraries, this is not recommended: users often need to build against different versions of libraries than what you developed against. +.. _cabal-gen-bounds: + cabal gen-bounds -^^^^^^^^^^^^^^^^ +^^^^^^^^^^^^^^^^^ -``cabal gen-bounds [FLAGS]`` generates bounds for all dependencies that do not -currently have them. Generated bounds are printed to stdout. You can then -paste them into your .cabal file. -The generated bounds conform to the `Package Versioning Policy`_, which is -a recommended versioning system for publicly released Cabal packages. +:: -.. code-block:: console + cabal gen-bounds [TARGETS] [FLAGS] + +Generate PVP-compliant dependency bounds for packages in the project based +on currently installed versions. This is helpful when creating or updating +package dependencies to ensure compatibility with specific version ranges. + +To use it, run `cabal gen-bounds` in a directory containing a cabal.project file or +within a subdirectory of a multi-package project. The command will analyze +the project structure and suggest appropriate version bounds for dependencies based +on the currently installed versions of those packages. + +The suggested bounds follow the Package Versioning Policy (PVP) convention, +allowing changes in the last segment of the version number. These suggestions +are formatted as Cabal constraint expressions that can be directly copied +into your .cabal file in the appropriate `build-depends` section. + +You can also specify particular packages to analyze with `cabal gen-bounds package-name`. +The command supports the same targets as `cabal build`. + +Examples: + +Basic usage: + +:: $ cabal gen-bounds -For example, given the following dependencies without bounds specified in -:pkg-field:`build-depends`: +In a multi-package project: :: - build-depends: - base, - mtl, - transformers, + $ cat cabal.project + packages: package-a/ + package-b/ + + $ cabal gen-bounds all + Configuration is affected by the following files: + - cabal.project + Resolving dependencies... + + Congratulations, all dependencies for package-a:lib:package-a are up-to-date. -``gen-bounds`` might suggest changing them to the following: + The following packages need bounds and here is a suggested starting point... + For component package-b:lib:package-b: + package-a >= 0.1.0 && < 0.2, + +You can also specify particular target to analyze: :: - build-depends: - base >= 4.15.0 && < 4.16, - mtl >= 2.2.2 && < 2.3, - transformers >= 0.5.6 && < 0.6, + $ cabal gen-bounds package-a + +The command output provides suggested version bounds for each component's +dependencies that lack proper bounds. For each component, dependencies that +need bounds are listed along with the suggested bounds, like: + +:: + For component my-package:lib:my-package: + some-dependency >= 1.2.3 && < 1.3, + another-dependency >= 2.0.0 && < 2.1, cabal outdated ^^^^^^^^^^^^^^