From 1549a7acdcad58bf4e9469ab251044573d387ac3 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Fri, 28 Mar 2025 16:42:28 +0000 Subject: [PATCH 1/2] multi-repl: Support module renaming for ghc-9.12 onwards In ghc-9.12 the -rexported-module flag was extended to add support for module renaming. Therefore now if a module uses a module renaming, then the -reexported-module flag is passed the renaming. Fixes #10181 --- Cabal/src/Distribution/Simple/Compiler.hs | 9 +++++ Cabal/src/Distribution/Simple/Errors.hs | 9 +++++ .../src/Distribution/Simple/GHC/Build/Link.hs | 40 +++++++++++++------ .../MultiRepl/ReexportedModule/cabal.project | 2 + .../MultiRepl/ReexportedModule/cabal.test.hs | 15 +++++++ .../ReexportedModule/package-a/CHANGELOG.md | 5 +++ .../package-a/package-a.cabal | 19 +++++++++ .../package-a/src/PackageA.hs | 2 + .../ReexportedModule/package-b/CHANGELOG.md | 5 +++ .../package-b/package-b.cabal | 18 +++++++++ .../package-b/src/PackageB.hs | 10 +++++ changelog.d/pr-10880.md | 12 ++++++ 12 files changed, 134 insertions(+), 12 deletions(-) create mode 100644 cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/cabal.project create mode 100644 cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-a/CHANGELOG.md create mode 100644 cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-a/package-a.cabal create mode 100644 cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-a/src/PackageA.hs create mode 100644 cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-b/CHANGELOG.md create mode 100644 cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-b/package-b.cabal create mode 100644 cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-b/src/PackageB.hs create mode 100644 changelog.d/pr-10880.md diff --git a/Cabal/src/Distribution/Simple/Compiler.hs b/Cabal/src/Distribution/Simple/Compiler.hs index c24de767172..346c4c82125 100644 --- a/Cabal/src/Distribution/Simple/Compiler.hs +++ b/Cabal/src/Distribution/Simple/Compiler.hs @@ -84,6 +84,7 @@ module Distribution.Simple.Compiler , libraryDynDirSupported , libraryVisibilitySupported , jsemSupported + , reexportedAsSupported -- * Support for profiling detail levels , ProfDetailLevel (..) @@ -432,6 +433,14 @@ jsemSupported comp = case compilerFlavor comp of where v = compilerVersion comp +-- | Does the compiler support the -reexported-modules "A as B" syntax +reexportedAsSupported :: Compiler -> Bool +reexportedAsSupported comp = case compilerFlavor comp of + GHC -> v >= mkVersion [9, 12] + _ -> False + where + v = compilerVersion comp + -- | Does this compiler support a package database entry with: -- "dynamic-library-dirs"? libraryDynDirSupported :: Compiler -> Bool diff --git a/Cabal/src/Distribution/Simple/Errors.hs b/Cabal/src/Distribution/Simple/Errors.hs index 1ce4f7ca06a..78e20a25854 100644 --- a/Cabal/src/Distribution/Simple/Errors.hs +++ b/Cabal/src/Distribution/Simple/Errors.hs @@ -171,6 +171,7 @@ data CabalException | UnknownVersionDb String VersionRange FilePath | MissingCoveredInstalledLibrary UnitId | SetupHooksException SetupHooksException + | MultiReplDoesNotSupportComplexReexportedModules PackageName ComponentName deriving (Show) exceptionCode :: CabalException -> Int @@ -304,6 +305,7 @@ exceptionCode e = case e of MissingCoveredInstalledLibrary{} -> 9341 SetupHooksException err -> setupHooksExceptionCode err + MultiReplDoesNotSupportComplexReexportedModules{} -> 9355 versionRequirement :: VersionRange -> String versionRequirement range @@ -799,3 +801,10 @@ exceptionMessage e = case e of ++ "' in package database stack." SetupHooksException err -> setupHooksExceptionMessage err + MultiReplDoesNotSupportComplexReexportedModules pname cname -> + "When attempting start the repl for " + ++ showComponentName cname + ++ " from package " + ++ prettyShow pname + ++ " a module renaming was found.\n" + ++ "Multi-repl does not work with complicated reexported-modules until GHC-9.12." diff --git a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs index e26e3890ba3..962d0d95c7a 100644 --- a/Cabal/src/Distribution/Simple/GHC/Build/Link.hs +++ b/Cabal/src/Distribution/Simple/GHC/Build/Link.hs @@ -7,9 +7,11 @@ module Distribution.Simple.GHC.Build.Link where import Distribution.Compat.Prelude import Prelude () +import Control.Monad import Control.Monad.IO.Class import qualified Data.ByteString.Lazy.Char8 as BS import qualified Data.Set as Set +import Distribution.Backpack import Distribution.Compat.Binary (encode) import Distribution.Compat.ResponseFile import Distribution.InstalledPackageInfo (InstalledPackageInfo) @@ -23,6 +25,7 @@ import Distribution.Pretty import Distribution.Simple.Build.Inputs import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler +import Distribution.Simple.Errors import Distribution.Simple.GHC.Build.Modules import Distribution.Simple.GHC.Build.Utils (exeTargetName, flibBuildName, flibTargetName, withDynFLib) import Distribution.Simple.GHC.ImplInfo @@ -740,6 +743,7 @@ runReplOrWriteFlags runReplOrWriteFlags ghcProg lbi rflags ghcOpts pkg_name target = let bi = componentBuildInfo $ targetComponent target clbi = targetCLBI target + cname = componentName (targetComponent target) comp = compiler lbi platform = hostPlatform lbi common = configCommonFlags $ configFlags lbi @@ -761,21 +765,32 @@ runReplOrWriteFlags ghcProg lbi rflags ghcOpts pkg_name target = Flag out_dir -> do let uid = componentUnitId clbi this_unit = prettyShow uid + getOpenModName (OpenModule _ mn) = Just mn + getOpenModName (OpenModuleVar{}) = Nothing reexported_modules = - [ mn | LibComponentLocalBuildInfo{componentExposedModules = exposed_mods} <- [clbi], IPI.ExposedModule mn (Just{}) <- exposed_mods + [ (from_mn, to_mn) | LibComponentLocalBuildInfo{componentExposedModules = exposed_mods} <- [clbi], IPI.ExposedModule to_mn (Just m) <- exposed_mods, Just from_mn <- [getOpenModName m] ] + renderReexportedModule (from_mn, to_mn) + | reexportedAsSupported comp = + pure $ prettyShow from_mn ++ " as " ++ prettyShow to_mn + | otherwise = + if from_mn == to_mn + then pure $ prettyShow to_mn + else dieWithException verbosity (MultiReplDoesNotSupportComplexReexportedModules pkg_name cname) hidden_modules = otherModules bi - extra_opts = - concat $ - [ ["-this-package-name", prettyShow pkg_name] - , case mbWorkDir of - Nothing -> [] - Just wd -> ["-working-dir", getSymbolicPath wd] - ] - ++ [ ["-reexported-module", prettyShow m] | m <- reexported_modules - ] - ++ [ ["-hidden-module", prettyShow m] | m <- hidden_modules - ] + render_extra_opts = do + rexp_mods <- mapM renderReexportedModule reexported_modules + pure $ + concat $ + [ ["-this-package-name", prettyShow pkg_name] + , case mbWorkDir of + Nothing -> [] + Just wd -> ["-working-dir", getSymbolicPath wd] + ] + ++ [ ["-reexported-module", m] | m <- rexp_mods + ] + ++ [ ["-hidden-module", prettyShow m] | m <- hidden_modules + ] -- Create "paths" subdirectory if it doesn't exist. This is where we write -- information about how the PATH was augmented. createDirectoryIfMissing False (out_dir "paths") @@ -783,6 +798,7 @@ runReplOrWriteFlags ghcProg lbi rflags ghcOpts pkg_name target = writeFileAtomic (out_dir "paths" this_unit) (encode ghcProg) -- Write out options for this component into a file ready for loading into -- the multi-repl + extra_opts <- render_extra_opts writeFileAtomic (out_dir this_unit) $ BS.pack $ escapeArgs $ diff --git a/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/cabal.project b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/cabal.project new file mode 100644 index 00000000000..5c1930664c8 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/cabal.project @@ -0,0 +1,2 @@ +packages: package-a package-b +multi-repl: true diff --git a/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/cabal.test.hs b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/cabal.test.hs new file mode 100644 index 00000000000..62d18087ec7 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/cabal.test.hs @@ -0,0 +1,15 @@ +import Test.Cabal.Prelude + +main = cabalTest $ recordMode DoNotRecord $ do + -- For the multi-repl command + good_ver <- isGhcVersion ">= 9.12" + skipUnlessGhcVersion ">= 9.4" + skipUnlessAnyCabalVersion ">= 3.15" + if good_ver + then do + res <- cabalWithStdin "v2-repl" ["all"] "" + assertOutputContains "Ok, two" res + else do + res <- fails $ cabalWithStdin "v2-repl" ["all"] "" + assertOutputContains "Multi-repl does not work with complicated" res + diff --git a/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-a/CHANGELOG.md b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-a/CHANGELOG.md new file mode 100644 index 00000000000..233761f5fb9 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-a/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for package-a + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-a/package-a.cabal b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-a/package-a.cabal new file mode 100644 index 00000000000..df3e89dca13 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-a/package-a.cabal @@ -0,0 +1,19 @@ +cabal-version: 3.14 +name: package-a +version: 0.1.0.0 +license: NONE +author: Matthew Pickering +maintainer: matthewtpickering@gmail.com +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: PackageA + reexported-modules: Prelude as PreludeA + build-depends: base + hs-source-dirs: src + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-a/src/PackageA.hs b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-a/src/PackageA.hs new file mode 100644 index 00000000000..9abd25cc649 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-a/src/PackageA.hs @@ -0,0 +1,2 @@ +module PackageA () where + diff --git a/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-b/CHANGELOG.md b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-b/CHANGELOG.md new file mode 100644 index 00000000000..be7e8473685 --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-b/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for package-b + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-b/package-b.cabal b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-b/package-b.cabal new file mode 100644 index 00000000000..46e3c7a3d6b --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-b/package-b.cabal @@ -0,0 +1,18 @@ +cabal-version: 3.14 +name: package-b +version: 0.1.0.0 +license: NONE +author: Matthew Pickering +maintainer: matthewtpickering@gmail.com +build-type: Simple +extra-doc-files: CHANGELOG.md + +common warnings + ghc-options: -Wall + +library + import: warnings + exposed-modules: PackageB + build-depends: package-a + hs-source-dirs: src + default-language: Haskell2010 diff --git a/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-b/src/PackageB.hs b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-b/src/PackageB.hs new file mode 100644 index 00000000000..692fffd413b --- /dev/null +++ b/cabal-testsuite/PackageTests/MultiRepl/ReexportedModule/package-b/src/PackageB.hs @@ -0,0 +1,10 @@ +{-# LANGUAGE NoImplicitPrelude #-} +module PackageB (someFunc) where + +-- reexport from package-a +import PreludeA +-- Normal import from package-a +import PackageA () + +someFunc :: IO () +someFunc = putStrLn "someFunc" diff --git a/changelog.d/pr-10880.md b/changelog.d/pr-10880.md new file mode 100644 index 00000000000..6b8defe7eb5 --- /dev/null +++ b/changelog.d/pr-10880.md @@ -0,0 +1,12 @@ +--- +synopsis: 'Fix multi-repl when using reexported-modules with renaming for GHC >= 9.12' +packages: [cabal-install, Cabal] +prs: 10880 +issues: 10181 +--- + +Since GHC 9.12, the `-reexported-module` flag has supported module renaming. Therefore +we now use that functionality when starting the multi-repl if it is needed. A new +error message is added to catch the case where you attempt to load a project which +uses this complicated export form but are using < 9.12. + From b41f09a1b1c5ca3bc8c5dc79d8721fbeb9d74295 Mon Sep 17 00:00:00 2001 From: Matthew Pickering Date: Thu, 20 Mar 2025 17:00:49 +0000 Subject: [PATCH 2/2] Implement v2-gen-bounds function This commit implements project-aware functionality for the `cabal gen-bounds` command, allowing it to work correctly in multi-package projects. Previously, running `gen-bounds` from within a package directory that depends on another local package would fail because it couldn't find the local dependency. The implementation follows the same pattern as other v2 commands, creating a full project context that knows about all packages defined in the cabal.project file. This allows `gen-bounds` to properly analyze dependencies between local packages and suggest appropriate bounds. ``` cabal gen-bounds ``` Fixes #7504 #8654 #9752 #5932 --- cabal-install/cabal-install.cabal | 1 + .../src/Distribution/Client/CmdGenBounds.hs | 256 ++++++++++++++++++ .../src/Distribution/Client/Errors.hs | 4 + .../src/Distribution/Client/GenBounds.hs | 2 + cabal-install/src/Distribution/Client/Main.hs | 4 +- .../GenBounds/Issue6290/cabal.out | 2 +- .../GenBounds/Issue7504/cabal.project | 2 + .../GenBounds/Issue7504/cabal.test.hs | 11 + .../GenBounds/Issue7504/package-a/LICENSE | 28 ++ .../Issue7504/package-a/package-a.cabal | 15 + .../Issue7504/package-a/src/ModuleA.hs | 5 + .../GenBounds/Issue7504/package-b/LICENSE | 28 ++ .../GenBounds/Issue7504/package-b/exe/Main.hs | 6 + .../Issue7504/package-b/package-b.cabal | 24 ++ .../Issue7504/package-b/src/ModuleB.hs | 7 + changelog.d/pr-10840.md | 28 ++ doc/cabal-commands.rst | 72 +++-- 17 files changed, 475 insertions(+), 20 deletions(-) create mode 100644 cabal-install/src/Distribution/Client/CmdGenBounds.hs create mode 100644 cabal-testsuite/PackageTests/GenBounds/Issue7504/cabal.project create mode 100644 cabal-testsuite/PackageTests/GenBounds/Issue7504/cabal.test.hs create mode 100644 cabal-testsuite/PackageTests/GenBounds/Issue7504/package-a/LICENSE create mode 100644 cabal-testsuite/PackageTests/GenBounds/Issue7504/package-a/package-a.cabal create mode 100644 cabal-testsuite/PackageTests/GenBounds/Issue7504/package-a/src/ModuleA.hs create mode 100644 cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/LICENSE create mode 100644 cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/exe/Main.hs create mode 100644 cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/package-b.cabal create mode 100644 cabal-testsuite/PackageTests/GenBounds/Issue7504/package-b/src/ModuleB.hs create mode 100644 changelog.d/pr-10840.md diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 3c2de564c7e..eac396f6d0e 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 1a8d945611a..c18fa54a0f0 100644 --- a/cabal-install/src/Distribution/Client/Main.hs +++ b/cabal-install/src/Distribution/Client/Main.hs @@ -123,6 +123,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 @@ -439,7 +440,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 @@ -465,7 +465,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 9ad5e716875..8ed8393df62 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 ^^^^^^^^^^^^^^