diff --git a/Cabal/src/Distribution/PackageDescription/Check.hs b/Cabal/src/Distribution/PackageDescription/Check.hs index 4c2701d95c3..2c9806a1ae5 100644 --- a/Cabal/src/Distribution/PackageDescription/Check.hs +++ b/Cabal/src/Distribution/PackageDescription/Check.hs @@ -309,7 +309,7 @@ ppExplanation SignaturesCabal2 = "To use the 'signatures' field the package needs to specify " ++ "at least 'cabal-version: 2.0'." ppExplanation AutogenNotExposed = - "An 'autogen-module' is neither on 'exposed-modules' or 'other-modules'." + "An 'autogen-module' is neither on 'exposed-modules' nor 'other-modules'." ppExplanation AutogenIncludesNotIncluded = "An include in 'autogen-includes' is neither in 'includes' or " ++ "'install-includes'." diff --git a/Cabal/src/Distribution/Simple.hs b/Cabal/src/Distribution/Simple.hs index 10b1c9fb50e..d6f50d0af90 100644 --- a/Cabal/src/Distribution/Simple.hs +++ b/Cabal/src/Distribution/Simple.hs @@ -92,6 +92,7 @@ import Distribution.Pretty import Distribution.Simple.Bench import Distribution.Simple.BuildPaths import Distribution.Simple.ConfigureScript +import Distribution.Simple.Errors import Distribution.Simple.Haddock import Distribution.Simple.Install import Distribution.Simple.LocalBuildInfo @@ -601,16 +602,10 @@ sanityCheckHookedBuildInfo verbosity (PackageDescription{library = Nothing}) (Just _, _) = - die' verbosity $ - "The buildinfo contains info for a library, " - ++ "but the package does not have a library." + dieWithException verbosity $ NoLibraryForPackage sanityCheckHookedBuildInfo verbosity pkg_descr (_, hookExes) | exe1 : _ <- nonExistant = - die' verbosity $ - "The buildinfo contains info for an executable called '" - ++ prettyShow exe1 - ++ "' but the package does not have a " - ++ "executable with that name." + dieWithException verbosity $ SanityCheckHookedBuildInfo exe1 where pkgExeNames = nub (map exeName (executables pkg_descr)) hookExeNames = nub (map fst hookExes) @@ -777,7 +772,7 @@ autoconfUserHooks = verbosity flags lbi - else die' verbosity "configure script not found." + else dieWithException verbosity ConfigureScriptNotFound pbi <- getHookedBuildInfo verbosity (buildDir lbi) sanityCheckHookedBuildInfo verbosity pkg_descr pbi diff --git a/Cabal/src/Distribution/Simple/Build.hs b/Cabal/src/Distribution/Simple/Build.hs index 6d9aa5b3486..893ca24e187 100644 --- a/Cabal/src/Distribution/Simple/Build.hs +++ b/Cabal/src/Distribution/Simple/Build.hs @@ -181,9 +181,7 @@ checkSemaphoreSupport :: Verbosity -> Compiler -> BuildFlags -> IO () checkSemaphoreSupport verbosity comp flags = do unless (jsemSupported comp || (isNothing (flagToMaybe (buildUseSemaphore flags)))) $ - die' verbosity $ - "Your compiler does not support the -jsem flag. " - ++ "To use this feature you must use GHC 9.8 or later." + dieWithException verbosity CheckSemaphoreSupport -- | Write available build information for 'LocalBuildInfo' to disk. -- diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs index 9298ab0d763..f35f98f4fcb 100644 --- a/Cabal/src/Distribution/Simple/Configure.hs +++ b/Cabal/src/Distribution/Simple/Configure.hs @@ -150,14 +150,9 @@ import qualified System.Info import Text.PrettyPrint ( Doc , char - , comma , hsep - , nest - , punctuate , quotes - , render , renderStyle - , sep , text , ($+$) ) @@ -165,6 +160,7 @@ import Text.PrettyPrint import qualified Data.Maybe as M import qualified Data.Set as Set import qualified Distribution.Compat.NonEmptySet as NES +import Distribution.Simple.Errors import Distribution.Types.AnnotatedId type UseExternalInternalDeps = Bool @@ -425,11 +421,8 @@ configure (pkg_descr0, pbi) cfg = do case targets' of _ | null (configArgs cfg) -> return Nothing [cname] -> return (Just cname) - [] -> die' verbosity "No valid component targets found" - _ -> - die' - verbosity - "Can only configure either single component or all of them" + [] -> dieWithException verbosity NoValidComponent + _ -> dieWithException verbosity ConfigureEitherSingleOrAll let use_external_internal_deps = isJust mb_cname case mb_cname of @@ -444,7 +437,7 @@ configure (pkg_descr0, pbi) cfg = do -- configCID is only valid for per-component configure when (isJust (flagToMaybe (configCID cfg)) && isNothing mb_cname) $ - die' verbosity "--cid is only supported for per-component configure" + dieWithException verbosity ConfigCIDValidForPreComponent checkDeprecatedFlags verbosity cfg checkExactConfiguration verbosity pkg_descr0 cfg @@ -513,15 +506,11 @@ configure (pkg_descr0, pbi) cfg = do ( isJust mb_cname && (fromFlag (configTests cfg) || fromFlag (configBenchmarks cfg)) ) - $ die' verbosity - $ "--enable-tests/--enable-benchmarks are incompatible with" - ++ " explicitly specifying a component to configure." + $ dieWithException verbosity SanityCheckForEnableComponents -- Some sanity checks related to dynamic/static linking. when (fromFlag (configDynExe cfg) && fromFlag (configFullyStaticExe cfg)) $ - die' verbosity $ - "--enable-executable-dynamic and --enable-executable-static" - ++ " are incompatible with each other." + dieWithException verbosity SanityCheckForDynamicStaticLinking -- allConstraints: The set of all 'Dependency's we have. Used ONLY -- to 'configureFinalizedPackage'. @@ -539,7 +528,7 @@ configure (pkg_descr0, pbi) cfg = do ( allConstraints :: [PackageVersionConstraint] , requiredDepsMap :: Map (PackageName, ComponentName) InstalledPackageInfo ) <- - either (die' verbosity) return $ + either (dieWithException verbosity) return $ combinedConstraints (configConstraints cfg) (configDependencies cfg) @@ -657,14 +646,8 @@ configure (pkg_descr0, pbi) cfg = do (enabledBuildInfos pkg_descr enabled) let langs = unsupportedLanguages comp langlist when (not (null langs)) $ - die' verbosity $ - "The package " - ++ prettyShow (packageId pkg_descr0) - ++ " requires the following languages which are not " - ++ "supported by " - ++ prettyShow (compilerId comp) - ++ ": " - ++ intercalate ", " (map prettyShow langs) + dieWithException verbosity $ + UnsupportedLanguages (packageId pkg_descr0) (compilerId comp) (map prettyShow langs) let extlist = nub $ concatMap @@ -672,22 +655,15 @@ configure (pkg_descr0, pbi) cfg = do (enabledBuildInfos pkg_descr enabled) let exts = unsupportedExtensions comp extlist when (not (null exts)) $ - die' verbosity $ - "The package " - ++ prettyShow (packageId pkg_descr0) - ++ " requires the following language extensions which are not " - ++ "supported by " - ++ prettyShow (compilerId comp) - ++ ": " - ++ intercalate ", " (map prettyShow exts) + dieWithException verbosity $ + UnsupportedLanguageExtension (packageId pkg_descr0) (compilerId comp) (map prettyShow exts) -- Check foreign library build requirements let flibs = [flib | CFLib flib <- enabledComponents pkg_descr enabled] let unsupportedFLibs = unsupportedForeignLibs comp compPlatform flibs when (not (null unsupportedFLibs)) $ - die' verbosity $ - "Cannot build some foreign libraries: " - ++ intercalate "," unsupportedFLibs + dieWithException verbosity $ + CantFindForeignLibraries unsupportedFLibs -- Configure certain external build tools, see below for which ones. let requiredBuildTools = do @@ -968,8 +944,8 @@ configure (pkg_descr0, pbi) cfg = do ( isAbsolute (prefix dirs) || "${pkgroot}" `isPrefixOf` prefix dirs ) - $ die' verbosity - $ "expected an absolute directory name for --prefix: " ++ prefix dirs + $ dieWithException verbosity + $ ExpectedAbsoluteDirectory (prefix dirs) when ("${pkgroot}" `isPrefixOf` prefix dirs) $ warn verbosity $ @@ -1084,10 +1060,8 @@ checkExactConfiguration verbosity pkg_descr0 cfg = allFlags = map flagName . genPackageFlags $ pkg_descr0 diffFlags = allFlags \\ cmdlineFlags when (not . null $ diffFlags) $ - die' verbosity $ - "'--exact-configuration' was given, " - ++ "but the following flags were not specified: " - ++ intercalate ", " (map show diffFlags) + dieWithException verbosity $ + FlagsNotSpecified diffFlags -- | Create a PackageIndex that makes *any libraries that might be* -- defined internally to this package look like installed packages, in @@ -1246,15 +1220,7 @@ configureFinalizedPackage pkg_descr0 of Right r -> return r Left missing -> - die' verbosity $ - "Encountered missing or private dependencies:\n" - ++ ( render - . nest 4 - . sep - . punctuate comma - . map (pretty . simplifyDependency) - $ missing - ) + dieWithException verbosity $ EncounteredMissingDependency missing -- add extra include/lib dirs as specified in cfg -- we do it here so that those get checked too @@ -1328,26 +1294,17 @@ checkCompilerProblems verbosity comp pkg_descr enabled = do (all (isDefaultIncludeRenaming . mixinIncludeRenaming) . mixins) (enabledBuildInfos pkg_descr enabled) ) - $ die' verbosity - $ "Your compiler does not support thinning and renaming on " - ++ "package flags. To use this feature you must use " - ++ "GHC 7.9 or later." - + $ dieWithException verbosity CompilerDoesn'tSupportThinning when ( any (not . null . reexportedModules) (allLibraries pkg_descr) && not (reexportedModulesSupported comp) ) - $ die' verbosity - $ "Your compiler does not support module re-exports. To use " - ++ "this feature you must use GHC 7.9 or later." - + $ dieWithException verbosity CompilerDoesn'tSupportReexports when ( any (not . null . signatures) (allLibraries pkg_descr) && not (backpackSupported comp) ) - $ die' verbosity - $ "Your compiler does not support Backpack. To use " - ++ "this feature you must use GHC 8.1 or later." + $ dieWithException verbosity CompilerDoesn'tSupportBackpack -- | Select dependencies for the package. configureDependencies @@ -1410,13 +1367,8 @@ configureDependencies ( not (null internalPkgDeps) && not (newPackageDepsBehaviour pkg_descr) ) - $ die' verbosity - $ "The field 'build-depends: " - ++ intercalate ", " (map (prettyShow . packageName) internalPkgDeps) - ++ "' refers to a library which is defined within the same " - ++ "package. To use this feature the package must specify at " - ++ "least 'cabal-version: >= 1.8'." - + $ dieWithException verbosity + $ LibraryWithinSamePackage internalPkgDeps reportFailedDependencies verbosity failedDeps reportSelectedDependencies verbosity allPkgDeps @@ -1605,11 +1557,6 @@ data DependencyResolution -- polymorphism out of the 'Package' typeclass.) InternalDependency PackageId -data FailedDependency - = DependencyNotExists PackageName - | DependencyMissingInternal PackageName LibraryName - | DependencyNoVersion Dependency - -- | Test for a package dependency and record the version we have installed. selectDependency :: PackageId @@ -1718,26 +1665,7 @@ reportSelectedDependencies verbosity deps = reportFailedDependencies :: Verbosity -> [FailedDependency] -> IO () reportFailedDependencies _ [] = return () reportFailedDependencies verbosity failed = - die' verbosity (intercalate "\n\n" (map reportFailedDependency failed)) - where - reportFailedDependency (DependencyNotExists pkgname) = - "there is no version of " - ++ prettyShow pkgname - ++ " installed.\n" - ++ "Perhaps you need to download and install it from\n" - ++ hackageUrl - ++ prettyShow pkgname - ++ "?" - reportFailedDependency (DependencyMissingInternal pkgname lib) = - "internal dependency " - ++ prettyShow (prettyLibraryNameComponent lib) - ++ " not installed.\n" - ++ "Perhaps you need to configure and install it first?\n" - ++ "(This library was defined by " - ++ prettyShow pkgname - ++ ")" - reportFailedDependency (DependencyNoVersion dep) = - "cannot satisfy dependency " ++ prettyShow (simplifyDependency dep) ++ "\n" + dieWithException verbosity $ ReportFailedDependencies failed hackageUrl -- | List all installed packages in the given package databases. -- Non-existent package databases do not cause errors, they just get skipped @@ -1752,10 +1680,7 @@ getInstalledPackages -> IO InstalledPackageIndex getInstalledPackages verbosity comp packageDBs progdb = do when (null packageDBs) $ - die' verbosity $ - "No package databases have been specified. If you use " - ++ "--package-db=clear, you must follow it with --package-db= " - ++ "with 'global', 'user' or a specific file." + dieWithException verbosity NoPackageDatabaseSpecified info verbosity "Reading installed packages..." -- do not check empty packagedbs (ghc-pkg would error out) @@ -1767,9 +1692,7 @@ getInstalledPackages verbosity comp packageDBs progdb = do HaskellSuite{} -> HaskellSuite.getInstalledPackages verbosity packageDBs' progdb flv -> - die' verbosity $ - "don't know how to find the installed packages for " - ++ prettyShow flv + dieWithException verbosity $ HowToFindInstalledPackages flv where packageDBExists (SpecificPackageDB path) = do exists <- doesPathExist path @@ -1859,17 +1782,14 @@ combinedConstraints -- ^ installed dependencies -> InstalledPackageIndex -> Either - String + CabalException ( [PackageVersionConstraint] , Map (PackageName, ComponentName) InstalledPackageInfo ) combinedConstraints constraints dependencies installedPackages = do when (not (null badComponentIds)) $ Left $ - render $ - text "The following package dependencies were requested" - $+$ nest 4 (dispDependencies badComponentIds) - $+$ text "however the given installed package instance does not exist." + CombinedConstraints (dispDependencies badComponentIds) -- TODO: we don't check that all dependencies are used! @@ -2045,28 +1965,14 @@ configurePkgconfigPackages verbosity pkg_descr progdb enabled requirePkg dep@(PkgconfigDependency pkgn range) = do version <- pkgconfig ["--modversion", pkg] - `catchIO` (\_ -> die' verbosity notFound) - `catchExit` (\_ -> die' verbosity notFound) + `catchIO` (\_ -> dieWithException verbosity $ PkgConfigNotFound pkg versionRequirement) + `catchExit` (\_ -> dieWithException verbosity $ PkgConfigNotFound pkg versionRequirement) let trim = dropWhile isSpace . dropWhileEnd isSpace let v = PkgconfigVersion (toUTF8BS $ trim version) if not (withinPkgconfigVersionRange v range) - then die' verbosity (badVersion v) + then dieWithException verbosity $ BadVersion pkg versionRequirement v else info verbosity (depSatisfied v) where - notFound = - "The pkg-config package '" - ++ pkg - ++ "'" - ++ versionRequirement - ++ " is required but it could not be found." - badVersion v = - "The pkg-config package '" - ++ pkg - ++ "'" - ++ versionRequirement - ++ " is required but the version installed on the" - ++ " system is version " - ++ prettyShow v depSatisfied v = "Dependency " ++ prettyShow dep @@ -2159,14 +2065,14 @@ configCompilerEx -> ProgramDb -> Verbosity -> IO (Compiler, Platform, ProgramDb) -configCompilerEx Nothing _ _ _ verbosity = die' verbosity "Unknown compiler" +configCompilerEx Nothing _ _ _ verbosity = dieWithException verbosity UnknownCompilerException configCompilerEx (Just hcFlavor) hcPath hcPkg progdb verbosity = do (comp, maybePlatform, programDb) <- case hcFlavor of GHC -> GHC.configure verbosity hcPath hcPkg progdb GHCJS -> GHCJS.configure verbosity hcPath hcPkg progdb UHC -> UHC.configure verbosity hcPath hcPkg progdb HaskellSuite{} -> HaskellSuite.configure verbosity hcPath hcPkg progdb - _ -> die' verbosity "Unknown compiler" + _ -> dieWithException verbosity UnknownCompilerException return (comp, fromMaybe buildPlatform maybePlatform, programDb) -- ----------------------------------------------------------------------------- @@ -2370,80 +2276,9 @@ checkForeignDeps pkg lbi verbosity = explainErrors Nothing [] = return () -- should be impossible! explainErrors _ _ | isNothing . lookupProgram gccProgram . withPrograms $ lbi = - die' verbosity $ - unlines - [ "No working gcc" - , "This package depends on foreign library but we cannot " - ++ "find a working C compiler. If you have it in a " - ++ "non-standard location you can use the --with-gcc " - ++ "flag to specify it." - ] + dieWithException verbosity NoWorkingGcc explainErrors hdr libs = - die' verbosity $ - unlines $ - [ if plural - then "Missing dependencies on foreign libraries:" - else "Missing dependency on a foreign library:" - | missing - ] - ++ case hdr of - Just (Left h) -> ["* Missing (or bad) header file: " ++ h] - _ -> [] - ++ case libs of - [] -> [] - [lib] -> ["* Missing (or bad) C library: " ++ lib] - _ -> - [ "* Missing (or bad) C libraries: " - ++ intercalate ", " libs - ] - ++ [if plural then messagePlural else messageSingular | missing] - ++ case hdr of - Just (Left _) -> [headerCppMessage] - Just (Right h) -> - [ (if missing then "* " else "") - ++ "Bad header file: " - ++ h - , headerCcMessage - ] - _ -> [] - where - plural = length libs >= 2 - -- Is there something missing? (as opposed to broken) - missing = - not (null libs) - || case hdr of Just (Left _) -> True; _ -> False - - messageSingular = - "This problem can usually be solved by installing the system " - ++ "package that provides this library (you may need the " - ++ "\"-dev\" version). If the library is already installed " - ++ "but in a non-standard location then you can use the flags " - ++ "--extra-include-dirs= and --extra-lib-dirs= to specify " - ++ "where it is." - ++ "If the library file does exist, it may contain errors that " - ++ "are caught by the C compiler at the preprocessing stage. " - ++ "In this case you can re-run configure with the verbosity " - ++ "flag -v3 to see the error messages." - messagePlural = - "This problem can usually be solved by installing the system " - ++ "packages that provide these libraries (you may need the " - ++ "\"-dev\" versions). If the libraries are already installed " - ++ "but in a non-standard location then you can use the flags " - ++ "--extra-include-dirs= and --extra-lib-dirs= to specify " - ++ "where they are." - ++ "If the library files do exist, it may contain errors that " - ++ "are caught by the C compiler at the preprocessing stage. " - ++ "In this case you can re-run configure with the verbosity " - ++ "flag -v3 to see the error messages." - headerCppMessage = - "If the header file does exist, it may contain errors that " - ++ "are caught by the C compiler at the preprocessing stage. " - ++ "In this case you can re-run configure with the verbosity " - ++ "flag -v3 to see the error messages." - headerCcMessage = - "The header file contains a compile error. " - ++ "You can re-run configure with the verbosity flag " - ++ "-v3 to see the error messages from the C compiler." + dieWithException verbosity $ ExplainErrors hdr libs -- | Output package check warnings and errors. Exit if any errors. checkPackageProblems @@ -2460,7 +2295,7 @@ checkPackageProblems verbosity dir gpkg pkg = do partitionEithers (M.mapMaybe classEW $ pureChecks ++ ioChecks) if null errors then traverse_ (warn verbosity) (map ppPackageCheck warnings) - else die' verbosity (intercalate "\n\n" $ map ppPackageCheck errors) + else dieWithException verbosity $ CheckPackageProblems (map ppPackageCheck errors) where -- Classify error/warnings. Left: error, Right: warning. classEW :: PackageCheck -> Maybe (Either PackageCheck PackageCheck) @@ -2491,29 +2326,24 @@ checkRelocatable verbosity pkg lbi = -- Distribution.Simple.GHC.getRPaths checkOS = unless (os `elem` [OSX, Linux]) $ - die' verbosity $ - "Operating system: " - ++ prettyShow os - ++ ", does not support relocatable builds" + dieWithException verbosity $ + NoOSSupport os where (Platform _ os) = hostPlatform lbi -- Check if the Compiler support relocatable builds checkCompiler = unless (compilerFlavor comp `elem` [GHC]) $ - die' verbosity $ - "Compiler: " - ++ show comp - ++ ", does not support relocatable builds" + dieWithException verbosity $ + NoCompilerSupport (show comp) where comp = compiler lbi -- Check if all the install dirs are relative to same prefix packagePrefixRelative = unless (relativeInstallDirs installDirs) $ - die' verbosity $ - "Installation directories are not prefix_relative:\n" - ++ show installDirs + dieWithException verbosity $ + InstallDirsNotPrefixRelative (installDirs) where -- NB: should be good enough to check this against the default -- component ID, but if we wanted to be strictly correct we'd @@ -2554,8 +2384,8 @@ checkRelocatable verbosity pkg lbi = -- @..@s and following check will fail without @canonicalizePath@. canonicalized <- canonicalizePath libdir unless (p `isPrefixOf` canonicalized) $ - die' verbosity $ - msg libdir + dieWithException verbosity $ + LibDirDepsPrefixNotRelative libdir p | otherwise = return () -- NB: should be good enough to check this against the default @@ -2564,11 +2394,6 @@ checkRelocatable verbosity pkg lbi = installDirs = absoluteInstallDirs pkg lbi NoCopyDest p = prefix installDirs ipkgs = PackageIndex.allPackages (installedPkgs lbi) - msg l = - "Library directory of a dependency: " - ++ show l - ++ "\nis not relative to the installation prefix:\n" - ++ show p -- ----------------------------------------------------------------------------- -- Testing foreign library requirements diff --git a/Cabal/src/Distribution/Simple/Errors.hs b/Cabal/src/Distribution/Simple/Errors.hs index e086bf04cc3..fb1c2875f1c 100644 --- a/Cabal/src/Distribution/Simple/Errors.hs +++ b/Cabal/src/Distribution/Simple/Errors.hs @@ -11,6 +11,7 @@ module Distribution.Simple.Errors ( CabalException (..) + , FailedDependency (..) , exceptionCode , exceptionMessage ) where @@ -19,14 +20,26 @@ import Distribution.Compat.Prelude import Distribution.Compiler import Distribution.InstalledPackageInfo import Distribution.ModuleName +import Distribution.Package +import Distribution.PackageDescription (FlagName, UnqualComponentName) import Distribution.Pretty - ( prettyShow + ( Pretty (pretty) + , prettyShow ) +import Distribution.Simple.InstallDirs +import Distribution.System (OS) import Distribution.Types.BenchmarkType -import Distribution.Types.PackageId +import Distribution.Types.LibraryName +import Distribution.Types.PkgconfigVersion import Distribution.Types.TestType -import Distribution.Types.UnitId import Distribution.Version +import Text.PrettyPrint + +data FailedDependency + = DependencyNotExists PackageName + | DependencyMissingInternal PackageName LibraryName + | DependencyNoVersion Dependency + deriving (Show) -- Types representing exceptions thrown by functions in all the modules of Cabal Package data CabalException @@ -95,6 +108,42 @@ data CabalException | NoSupportPreProcessingTestExtras TestType | NoSupportPreProcessingBenchmarkExtras BenchmarkType | UnlitException String + | RunProgramInvocationException FilePath String + | GetProgramInvocationException FilePath String + | GetProgramInvocationLBSException FilePath String + | CheckSemaphoreSupport + | NoLibraryForPackage + | SanityCheckHookedBuildInfo UnqualComponentName + | ConfigureScriptNotFound + | NoValidComponent + | ConfigureEitherSingleOrAll + | ConfigCIDValidForPreComponent + | SanityCheckForEnableComponents + | SanityCheckForDynamicStaticLinking + | UnsupportedLanguages PackageIdentifier CompilerId [String] + | UnsupportedLanguageExtension PackageIdentifier CompilerId [String] + | CantFindForeignLibraries [String] + | ExpectedAbsoluteDirectory FilePath + | FlagsNotSpecified [FlagName] + | EncounteredMissingDependency [Dependency] + | CompilerDoesn'tSupportThinning + | CompilerDoesn'tSupportReexports + | CompilerDoesn'tSupportBackpack + | LibraryWithinSamePackage [PackageId] + | ReportFailedDependencies [FailedDependency] String + | NoPackageDatabaseSpecified + | HowToFindInstalledPackages CompilerFlavor + | PkgConfigNotFound String String + | BadVersion String String PkgconfigVersion + | UnknownCompilerException + | NoWorkingGcc + | NoOSSupport OS + | NoCompilerSupport String + | InstallDirsNotPrefixRelative (InstallDirs FilePath) + | ExplainErrors (Maybe (Either [Char] [Char])) [String] + | CheckPackageProblems [String] + | LibDirDepsPrefixNotRelative FilePath FilePath + | CombinedConstraints Doc deriving (Show, Typeable) exceptionCode :: CabalException -> Int @@ -126,7 +175,7 @@ exceptionCode e = case e of NoGHCVersionFromCompiler -> 4098 HaddockAndGHCVersionDoesntMatch{} -> 1998 MustHaveSharedLibraries{} -> 6032 - HaddockPackageFlags{} -> 4567 + HaddockPackageFlags{} -> 4569 UnknownCompilerFlavor{} -> 3102 FailedToDetermineTarget{} -> 5049 NoMultipleTargets{} -> 6091 @@ -136,7 +185,7 @@ exceptionCode e = case e of BuildingNotSupportedWithCompiler{} -> 7077 ProvideHaskellSuiteTool{} -> 7509 CannotDetermineCompilerVersion{} -> 4519 - PkgDumpFailed{} -> 2290 + PkgDumpFailed{} -> 2291 FailedToParseOutput{} -> 5500 CantFindSourceModule{} -> 8870 VersionMismatchJS{} -> 9001 @@ -164,6 +213,42 @@ exceptionCode e = case e of NoSupportPreProcessingTestExtras{} -> 7886 NoSupportPreProcessingBenchmarkExtras{} -> 9999 UnlitException{} -> 5454 + RunProgramInvocationException{} -> 8012 + GetProgramInvocationException{} -> 7300 + GetProgramInvocationLBSException{} -> 6578 + CheckSemaphoreSupport{} -> 2002 + NoLibraryForPackage{} -> 8004 + SanityCheckHookedBuildInfo{} -> 6007 + ConfigureScriptNotFound{} -> 4567 + NoValidComponent{} -> 5680 + ConfigureEitherSingleOrAll{} -> 2001 + ConfigCIDValidForPreComponent{} -> 7006 + SanityCheckForEnableComponents{} -> 5004 + SanityCheckForDynamicStaticLinking{} -> 4007 + UnsupportedLanguages{} -> 8074 + UnsupportedLanguageExtension{} -> 5656 + CantFindForeignLibraries{} -> 4574 + ExpectedAbsoluteDirectory{} -> 6662 + FlagsNotSpecified{} -> 9080 + EncounteredMissingDependency{} -> 8010 + CompilerDoesn'tSupportThinning{} -> 4003 + CompilerDoesn'tSupportReexports{} -> 3456 + CompilerDoesn'tSupportBackpack{} -> 5446 + LibraryWithinSamePackage{} -> 7007 + ReportFailedDependencies{} -> 4321 + NoPackageDatabaseSpecified{} -> 2300 + HowToFindInstalledPackages{} -> 3003 + PkgConfigNotFound{} -> 7123 + BadVersion{} -> 7600 + UnknownCompilerException{} -> 3022 + NoWorkingGcc{} -> 1088 + NoOSSupport{} -> 3339 + NoCompilerSupport{} -> 2290 + InstallDirsNotPrefixRelative{} -> 6000 + ExplainErrors{} -> 4345 + CheckPackageProblems{} -> 5559 + LibDirDepsPrefixNotRelative{} -> 6667 + CombinedConstraints{} -> 5000 exceptionMessage :: CabalException -> String exceptionMessage e = case e of @@ -189,7 +274,7 @@ exceptionMessage e = case e of SuppressingChecksOnFile -> "HcPkg.register: the compiler does not support ,suppressing checks on files." NoSupportDirStylePackageDb -> "HcPkg.writeRegistrationFileDirectly: compiler does not support dir style package dbs" OnlySupportSpecificPackageDb -> "HcPkg.writeRegistrationFileDirectly: only supports SpecificPackageDB for now" - FailedToParseOutputDescribe programId packageId -> "failed to parse output of '" ++ programId ++ " describe " ++ prettyShow packageId ++ "'" + FailedToParseOutputDescribe programId pkgId -> "failed to parse output of '" ++ programId ++ " describe " ++ prettyShow pkgId ++ "'" DumpFailed programId exception -> programId ++ " dump failed: " ++ exception FailedToParseOutputDump programId -> "failed to parse output of '" ++ programId ++ " dump'" ListFailed programId -> programId ++ " list failed" @@ -353,3 +438,210 @@ exceptionMessage e = case e of ++ "type " ++ prettyShow tt UnlitException str -> str + RunProgramInvocationException path errors -> "'" ++ path ++ "' exited with an error:\n" ++ errors + GetProgramInvocationException path errors -> "'" ++ path ++ "' exited with an error:\n" ++ errors + GetProgramInvocationLBSException path errors -> "'" ++ path ++ "' exited with an error:\n" ++ errors + CheckSemaphoreSupport -> + "Your compiler does not support the -jsem flag. " + ++ "To use this feature you must use GHC 9.8 or later." + NoLibraryForPackage -> + "The buildinfo contains info for a library, " + ++ "but the package does not have a library." + SanityCheckHookedBuildInfo exe1 -> + "The buildinfo contains info for an executable called '" + ++ prettyShow exe1 + ++ "' but the package does not have a " + ++ "executable with that name." + ConfigureScriptNotFound -> "configure script not found." + NoValidComponent -> "No valid component targets found" + ConfigureEitherSingleOrAll -> "Can only configure either single component or all of them" + ConfigCIDValidForPreComponent -> "--cid is only supported for per-component configure" + SanityCheckForEnableComponents -> + "--enable-tests/--enable-benchmarks are incompatible with" + ++ " explicitly specifying a component to configure." + SanityCheckForDynamicStaticLinking -> + "--enable-executable-dynamic and --enable-executable-static" + ++ " are incompatible with each other." + UnsupportedLanguages pkgId compilerId langs -> + "The package " + ++ prettyShow (pkgId) + ++ " requires the following languages which are not " + ++ "supported by " + ++ prettyShow (compilerId) + ++ ": " + ++ intercalate ", " langs + UnsupportedLanguageExtension pkgId compilerId exts -> + "The package " + ++ prettyShow (pkgId) + ++ " requires the following language extensions which are not " + ++ "supported by " + ++ prettyShow (compilerId) + ++ ": " + ++ intercalate ", " exts + CantFindForeignLibraries unsupportedFLibs -> + "Cannot build some foreign libraries: " + ++ intercalate "," unsupportedFLibs + ExpectedAbsoluteDirectory fPath -> "expected an absolute directory name for --prefix: " ++ fPath + FlagsNotSpecified diffFlags -> + "'--exact-configuration' was given, " + ++ "but the following flags were not specified: " + ++ intercalate ", " (map show diffFlags) + EncounteredMissingDependency missing -> + "Encountered missing or private dependencies:\n" + ++ ( render + . nest 4 + . sep + . punctuate comma + . map (pretty . simplifyDependency) + $ missing + ) + CompilerDoesn'tSupportThinning -> + "Your compiler does not support thinning and renaming on " + ++ "package flags. To use this feature you must use " + ++ "GHC 7.9 or later." + CompilerDoesn'tSupportReexports -> + "Your compiler does not support module re-exports. To use " + ++ "this feature you must use GHC 7.9 or later." + CompilerDoesn'tSupportBackpack -> + "Your compiler does not support Backpack. To use " + ++ "this feature you must use GHC 8.1 or later." + LibraryWithinSamePackage internalPkgDeps -> + "The field 'build-depends: " + ++ intercalate ", " (map (prettyShow . packageName) internalPkgDeps) + ++ "' refers to a library which is defined within the same " + ++ "package. To use this feature the package must specify at " + ++ "least 'cabal-version: >= 1.8'." + ReportFailedDependencies failed hackageUrl -> (intercalate "\n\n" (map reportFailedDependency failed)) + where + reportFailedDependency (DependencyNotExists pkgname) = + "there is no version of " + ++ prettyShow pkgname + ++ " installed.\n" + ++ "Perhaps you need to download and install it from\n" + ++ hackageUrl + ++ prettyShow pkgname + ++ "?" + reportFailedDependency (DependencyMissingInternal pkgname lib) = + "internal dependency " + ++ prettyShow (prettyLibraryNameComponent lib) + ++ " not installed.\n" + ++ "Perhaps you need to configure and install it first?\n" + ++ "(This library was defined by " + ++ prettyShow pkgname + ++ ")" + reportFailedDependency (DependencyNoVersion dep) = + "cannot satisfy dependency " ++ prettyShow (simplifyDependency dep) ++ "\n" + NoPackageDatabaseSpecified -> + "No package databases have been specified. If you use " + ++ "--package-db=clear, you must follow it with --package-db= " + ++ "with 'global', 'user' or a specific file." + HowToFindInstalledPackages flv -> + "don't know how to find the installed packages for " + ++ prettyShow flv + PkgConfigNotFound pkg versionRequirement -> + "The pkg-config package '" + ++ pkg + ++ "'" + ++ versionRequirement + ++ " is required but it could not be found." + BadVersion pkg versionRequirement v -> + "The pkg-config package '" + ++ pkg + ++ "'" + ++ versionRequirement + ++ " is required but the version installed on the" + ++ " system is version " + ++ prettyShow v + UnknownCompilerException -> "Unknown compiler" + NoWorkingGcc -> + unlines + [ "No working gcc" + , "This package depends on foreign library but we cannot " + ++ "find a working C compiler. If you have it in a " + ++ "non-standard location you can use the --with-gcc " + ++ "flag to specify it." + ] + NoOSSupport os -> + "Operating system: " + ++ prettyShow os + ++ ", does not support relocatable builds" + NoCompilerSupport comp -> + "Compiler: " + ++ comp + ++ ", does not support relocatable builds" + InstallDirsNotPrefixRelative installDirs -> "Installation directories are not prefix_relative:\n" ++ show installDirs + ExplainErrors hdr libs -> + unlines $ + [ if plural + then "Missing dependencies on foreign libraries:" + else "Missing dependency on a foreign library:" + | missing + ] + ++ case hdr of + Just (Left h) -> ["* Missing (or bad) header file: " ++ h] + _ -> [] + ++ case libs of + [] -> [] + [lib] -> ["* Missing (or bad) C library: " ++ lib] + _ -> + [ "* Missing (or bad) C libraries: " + ++ intercalate ", " libs + ] + ++ [if plural then messagePlural else messageSingular | missing] + ++ case hdr of + Just (Left _) -> [headerCppMessage] + Just (Right h) -> + [ (if missing then "* " else "") + ++ "Bad header file: " + ++ h + , headerCcMessage + ] + _ -> [] + where + plural = length libs >= 2 + -- Is there something missing? (as opposed to broken) + missing = + not (null libs) + || case hdr of Just (Left _) -> True; _ -> False + messageSingular = + "This problem can usually be solved by installing the system " + ++ "package that provides this library (you may need the " + ++ "\"-dev\" version). If the library is already installed " + ++ "but in a non-standard location then you can use the flags " + ++ "--extra-include-dirs= and --extra-lib-dirs= to specify " + ++ "where it is." + ++ "If the library file does exist, it may contain errors that " + ++ "are caught by the C compiler at the preprocessing stage. " + ++ "In this case you can re-run configure with the verbosity " + ++ "flag -v3 to see the error messages." + messagePlural = + "This problem can usually be solved by installing the system " + ++ "packages that provide these libraries (you may need the " + ++ "\"-dev\" versions). If the libraries are already installed " + ++ "but in a non-standard location then you can use the flags " + ++ "--extra-include-dirs= and --extra-lib-dirs= to specify " + ++ "where they are." + ++ "If the library files do exist, it may contain errors that " + ++ "are caught by the C compiler at the preprocessing stage. " + ++ "In this case you can re-run configure with the verbosity " + ++ "flag -v3 to see the error messages." + headerCppMessage = + "If the header file does exist, it may contain errors that " + ++ "are caught by the C compiler at the preprocessing stage. " + ++ "In this case you can re-run configure with the verbosity " + ++ "flag -v3 to see the error messages." + headerCcMessage = + "The header file contains a compile error. " + ++ "You can re-run configure with the verbosity flag " + ++ "-v3 to see the error messages from the C compiler." + CheckPackageProblems errors -> (intercalate "\n\n" $ errors) + LibDirDepsPrefixNotRelative l p -> + "Library directory of a dependency: " + ++ show l + ++ "\nis not relative to the installation prefix:\n" + ++ show p + CombinedConstraints dispDepend -> + render $ + text "The following package dependencies were requested" + $+$ nest 4 dispDepend + $+$ text "however the given installed package instance does not exist." diff --git a/Cabal/src/Distribution/Simple/Program/Run.hs b/Cabal/src/Distribution/Simple/Program/Run.hs index bfc62896d91..27ff33dce01 100644 --- a/Cabal/src/Distribution/Simple/Program/Run.hs +++ b/Cabal/src/Distribution/Simple/Program/Run.hs @@ -31,11 +31,11 @@ import Distribution.Compat.Prelude import Prelude () import Distribution.Compat.Environment +import Distribution.Simple.Errors import Distribution.Simple.Program.Types import Distribution.Simple.Utils import Distribution.Utils.Generic import Distribution.Verbosity - import System.FilePath (searchPathSeparator) import qualified Data.ByteString.Lazy as LBS @@ -157,8 +157,8 @@ runProgramInvocation (Just input) IODataModeBinary when (exitCode /= ExitSuccess) $ - die' verbosity $ - "'" ++ path ++ "' exited with an error:\n" ++ errors + dieWithException verbosity $ + RunProgramInvocationException path errors where input = encodeToIOData encoding inputStr @@ -174,8 +174,8 @@ getProgramInvocationLBS :: Verbosity -> ProgramInvocation -> IO LBS.ByteString getProgramInvocationLBS verbosity inv = do (output, errors, exitCode) <- getProgramInvocationIODataAndErrors verbosity inv IODataModeBinary when (exitCode /= ExitSuccess) $ - die' verbosity $ - "'" ++ progInvokePath inv ++ "' exited with an error:\n" ++ errors + dieWithException verbosity $ + GetProgramInvocationLBSException (progInvokePath inv) errors return output getProgramInvocationOutputAndErrors diff --git a/cabal-testsuite/PackageTests/AutogenModules/Package/setup.cabal.out b/cabal-testsuite/PackageTests/AutogenModules/Package/setup.cabal.out index 0e0ba47ae67..dd76b493185 100644 --- a/cabal-testsuite/PackageTests/AutogenModules/Package/setup.cabal.out +++ b/cabal-testsuite/PackageTests/AutogenModules/Package/setup.cabal.out @@ -1,6 +1,7 @@ # Setup configure Configuring AutogenModules-0.1... -Error: cabal: An 'autogen-module' is neither on 'exposed-modules' or 'other-modules'. +Error: [Cabal-5559] +An 'autogen-module' is neither on 'exposed-modules' nor 'other-modules'. On executable 'Exe' an 'autogen-module' is not on 'other-modules' @@ -9,7 +10,7 @@ On test suite 'Test' an 'autogen-module' is not on 'other-modules' On benchmark 'Bench' an 'autogen-module' is not on 'other-modules' # Setup sdist Distribution quality errors: -An 'autogen-module' is neither on 'exposed-modules' or 'other-modules'. +An 'autogen-module' is neither on 'exposed-modules' nor 'other-modules'. On executable 'Exe' an 'autogen-module' is not on 'other-modules' On test suite 'Test' an 'autogen-module' is not on 'other-modules' On benchmark 'Bench' an 'autogen-module' is not on 'other-modules' diff --git a/cabal-testsuite/PackageTests/AutogenModules/Package/setup.out b/cabal-testsuite/PackageTests/AutogenModules/Package/setup.out index b19916e9329..dd76b493185 100644 --- a/cabal-testsuite/PackageTests/AutogenModules/Package/setup.out +++ b/cabal-testsuite/PackageTests/AutogenModules/Package/setup.out @@ -1,6 +1,7 @@ # Setup configure Configuring AutogenModules-0.1... -Error: setup: An 'autogen-module' is neither on 'exposed-modules' or 'other-modules'. +Error: [Cabal-5559] +An 'autogen-module' is neither on 'exposed-modules' nor 'other-modules'. On executable 'Exe' an 'autogen-module' is not on 'other-modules' @@ -9,7 +10,7 @@ On test suite 'Test' an 'autogen-module' is not on 'other-modules' On benchmark 'Bench' an 'autogen-module' is not on 'other-modules' # Setup sdist Distribution quality errors: -An 'autogen-module' is neither on 'exposed-modules' or 'other-modules'. +An 'autogen-module' is neither on 'exposed-modules' nor 'other-modules'. On executable 'Exe' an 'autogen-module' is not on 'other-modules' On test suite 'Test' an 'autogen-module' is not on 'other-modules' On benchmark 'Bench' an 'autogen-module' is not on 'other-modules' diff --git a/cabal-testsuite/PackageTests/AutogenModules/Package/setup.test.hs b/cabal-testsuite/PackageTests/AutogenModules/Package/setup.test.hs index 2b52b469e22..12fb9823309 100644 --- a/cabal-testsuite/PackageTests/AutogenModules/Package/setup.test.hs +++ b/cabal-testsuite/PackageTests/AutogenModules/Package/setup.test.hs @@ -8,7 +8,7 @@ main = setupAndCabalTest $ do -- Package check messages. let libAutogenMsg = - "An 'autogen-module' is neither on 'exposed-modules' or " + "An 'autogen-module' is neither on 'exposed-modules' nor " ++ "'other-modules'" let exeAutogenMsg = "On executable 'Exe' an 'autogen-module' is not on " diff --git a/cabal-testsuite/PackageTests/Backpack/Reexport2/setup.cabal.out b/cabal-testsuite/PackageTests/Backpack/Reexport2/setup.cabal.out index 2f94ecbb228..75bc0f494a7 100644 --- a/cabal-testsuite/PackageTests/Backpack/Reexport2/setup.cabal.out +++ b/cabal-testsuite/PackageTests/Backpack/Reexport2/setup.cabal.out @@ -1,3 +1,4 @@ # Setup configure Configuring Reexport2-1.0... -Error: cabal: Duplicate modules in library: Asdf +Error: [Cabal-5559] +Duplicate modules in library: Asdf diff --git a/cabal-testsuite/PackageTests/Backpack/Reexport2/setup.out b/cabal-testsuite/PackageTests/Backpack/Reexport2/setup.out index 58f2330e0d3..75bc0f494a7 100644 --- a/cabal-testsuite/PackageTests/Backpack/Reexport2/setup.out +++ b/cabal-testsuite/PackageTests/Backpack/Reexport2/setup.out @@ -1,3 +1,4 @@ # Setup configure Configuring Reexport2-1.0... -Error: setup: Duplicate modules in library: Asdf +Error: [Cabal-5559] +Duplicate modules in library: Asdf diff --git a/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.cabal.out b/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.cabal.out index 14aba5dcbbb..391531a89e2 100644 --- a/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.cabal.out +++ b/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.cabal.out @@ -1,3 +1,4 @@ # Setup configure Configuring InternalLibrary0-0.1... -Error: cabal: The field 'build-depends: InternalLibrary0' refers to a library which is defined within the same package. To use this feature the package must specify at least 'cabal-version: >= 1.8'. +Error: [Cabal-7007] +The field 'build-depends: InternalLibrary0' refers to a library which is defined within the same package. To use this feature the package must specify at least 'cabal-version: >= 1.8'. diff --git a/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.out b/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.out index 0a464192dc9..391531a89e2 100644 --- a/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.out +++ b/cabal-testsuite/PackageTests/BuildDeps/InternalLibrary0/setup.out @@ -1,3 +1,4 @@ # Setup configure Configuring InternalLibrary0-0.1... -Error: setup: The field 'build-depends: InternalLibrary0' refers to a library which is defined within the same package. To use this feature the package must specify at least 'cabal-version: >= 1.8'. +Error: [Cabal-7007] +The field 'build-depends: InternalLibrary0' refers to a library which is defined within the same package. To use this feature the package must specify at least 'cabal-version: >= 1.8'. diff --git a/cabal-testsuite/PackageTests/BuildToolDependsInternalMissing/setup.cabal.out b/cabal-testsuite/PackageTests/BuildToolDependsInternalMissing/setup.cabal.out index fce5331e560..da5c074772e 100644 --- a/cabal-testsuite/PackageTests/BuildToolDependsInternalMissing/setup.cabal.out +++ b/cabal-testsuite/PackageTests/BuildToolDependsInternalMissing/setup.cabal.out @@ -1,3 +1,4 @@ # Setup configure Configuring build-tool-depends-missing-0.1.0.0... -Error: cabal: The package depends on a missing internal executable: build-tool-depends-missing:hello-world +Error: [Cabal-5559] +The package depends on a missing internal executable: build-tool-depends-missing:hello-world diff --git a/cabal-testsuite/PackageTests/BuildToolDependsInternalMissing/setup.out b/cabal-testsuite/PackageTests/BuildToolDependsInternalMissing/setup.out index 861f95ddeb8..da5c074772e 100644 --- a/cabal-testsuite/PackageTests/BuildToolDependsInternalMissing/setup.out +++ b/cabal-testsuite/PackageTests/BuildToolDependsInternalMissing/setup.out @@ -1,3 +1,4 @@ # Setup configure Configuring build-tool-depends-missing-0.1.0.0... -Error: setup: The package depends on a missing internal executable: build-tool-depends-missing:hello-world +Error: [Cabal-5559] +The package depends on a missing internal executable: build-tool-depends-missing:hello-world diff --git a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/AutogenExposedOther/cabal.out b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/AutogenExposedOther/cabal.out index 1d74420d541..94c22120311 100644 --- a/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/AutogenExposedOther/cabal.out +++ b/cabal-testsuite/PackageTests/Check/ConfiguredPackage/Sanity/AutogenExposedOther/cabal.out @@ -1,4 +1,4 @@ # cabal check The package will not build sanely due to these errors: -Error: An 'autogen-module' is neither on 'exposed-modules' or 'other-modules'. +Error: An 'autogen-module' is neither on 'exposed-modules' nor 'other-modules'. Error: Hackage would reject this package. diff --git a/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit-fail.out b/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit-fail.out index 3726ef6fb23..fec347864e5 100644 --- a/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit-fail.out +++ b/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit-fail.out @@ -9,5 +9,6 @@ Installing internal library sublib in Registering library 'sublib' for Lib-0.1.0.0... # Setup configure Configuring executable 'exe' for Lib-0.1.0.0... -Error: setup: Encountered missing or private dependencies: +Error: [Cabal-8010] +Encountered missing or private dependencies: Lib:sublib diff --git a/cabal-testsuite/PackageTests/InternalVersions/BuildDependsBad/setup.cabal.out b/cabal-testsuite/PackageTests/InternalVersions/BuildDependsBad/setup.cabal.out index 843f2e7808a..b03e6765cb0 100644 --- a/cabal-testsuite/PackageTests/InternalVersions/BuildDependsBad/setup.cabal.out +++ b/cabal-testsuite/PackageTests/InternalVersions/BuildDependsBad/setup.cabal.out @@ -1,3 +1,4 @@ # Setup configure Configuring build-depends-bad-version-0.1.0.0... -Error: cabal: The package has an impossible version range for a dependency on an internal library: build-depends-bad-version >=2. This version range does not include the current package, and must be removed as the current package's library will always be used. +Error: [Cabal-5559] +The package has an impossible version range for a dependency on an internal library: build-depends-bad-version >=2. This version range does not include the current package, and must be removed as the current package's library will always be used. diff --git a/cabal-testsuite/PackageTests/InternalVersions/BuildDependsBad/setup.out b/cabal-testsuite/PackageTests/InternalVersions/BuildDependsBad/setup.out index e0b6883000a..b03e6765cb0 100644 --- a/cabal-testsuite/PackageTests/InternalVersions/BuildDependsBad/setup.out +++ b/cabal-testsuite/PackageTests/InternalVersions/BuildDependsBad/setup.out @@ -1,3 +1,4 @@ # Setup configure Configuring build-depends-bad-version-0.1.0.0... -Error: setup: The package has an impossible version range for a dependency on an internal library: build-depends-bad-version >=2. This version range does not include the current package, and must be removed as the current package's library will always be used. +Error: [Cabal-5559] +The package has an impossible version range for a dependency on an internal library: build-depends-bad-version >=2. This version range does not include the current package, and must be removed as the current package's library will always be used. diff --git a/cabal-testsuite/PackageTests/InternalVersions/BuildToolDependsBad/setup.cabal.out b/cabal-testsuite/PackageTests/InternalVersions/BuildToolDependsBad/setup.cabal.out index d92e9e784e5..077f750b066 100644 --- a/cabal-testsuite/PackageTests/InternalVersions/BuildToolDependsBad/setup.cabal.out +++ b/cabal-testsuite/PackageTests/InternalVersions/BuildToolDependsBad/setup.cabal.out @@ -1,3 +1,4 @@ # Setup configure Configuring build-tool-depends-bad-version-0.1.0.0... -Error: cabal: The package has an impossible version range for a dependency on an internal executable: build-tool-depends-bad-version:hello-world >=2. This version range does not include the current package, and must be removed as the current package's executable will always be used. +Error: [Cabal-5559] +The package has an impossible version range for a dependency on an internal executable: build-tool-depends-bad-version:hello-world >=2. This version range does not include the current package, and must be removed as the current package's executable will always be used. diff --git a/cabal-testsuite/PackageTests/InternalVersions/BuildToolDependsBad/setup.out b/cabal-testsuite/PackageTests/InternalVersions/BuildToolDependsBad/setup.out index eeb1226a74f..077f750b066 100644 --- a/cabal-testsuite/PackageTests/InternalVersions/BuildToolDependsBad/setup.out +++ b/cabal-testsuite/PackageTests/InternalVersions/BuildToolDependsBad/setup.out @@ -1,3 +1,4 @@ # Setup configure Configuring build-tool-depends-bad-version-0.1.0.0... -Error: setup: The package has an impossible version range for a dependency on an internal executable: build-tool-depends-bad-version:hello-world >=2. This version range does not include the current package, and must be removed as the current package's executable will always be used. +Error: [Cabal-5559] +The package has an impossible version range for a dependency on an internal executable: build-tool-depends-bad-version:hello-world >=2. This version range does not include the current package, and must be removed as the current package's executable will always be used. diff --git a/cabal-testsuite/PackageTests/InternalVersions/BuildToolsBad/setup.cabal.out b/cabal-testsuite/PackageTests/InternalVersions/BuildToolsBad/setup.cabal.out index 44f43d8b30b..68a45e22992 100644 --- a/cabal-testsuite/PackageTests/InternalVersions/BuildToolsBad/setup.cabal.out +++ b/cabal-testsuite/PackageTests/InternalVersions/BuildToolsBad/setup.cabal.out @@ -1,3 +1,4 @@ # Setup configure Configuring build-tools-bad-version-0.1.0.0... -Error: cabal: The package has an impossible version range for a dependency on an internal executable: build-tools-bad-version:hello-world >=2. This version range does not include the current package, and must be removed as the current package's executable will always be used. +Error: [Cabal-5559] +The package has an impossible version range for a dependency on an internal executable: build-tools-bad-version:hello-world >=2. This version range does not include the current package, and must be removed as the current package's executable will always be used. diff --git a/cabal-testsuite/PackageTests/InternalVersions/BuildToolsBad/setup.out b/cabal-testsuite/PackageTests/InternalVersions/BuildToolsBad/setup.out index 06aaa652bce..68a45e22992 100644 --- a/cabal-testsuite/PackageTests/InternalVersions/BuildToolsBad/setup.out +++ b/cabal-testsuite/PackageTests/InternalVersions/BuildToolsBad/setup.out @@ -1,3 +1,4 @@ # Setup configure Configuring build-tools-bad-version-0.1.0.0... -Error: setup: The package has an impossible version range for a dependency on an internal executable: build-tools-bad-version:hello-world >=2. This version range does not include the current package, and must be removed as the current package's executable will always be used. +Error: [Cabal-5559] +The package has an impossible version range for a dependency on an internal executable: build-tools-bad-version:hello-world >=2. This version range does not include the current package, and must be removed as the current package's executable will always be used. diff --git a/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-packagedbs.out b/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-packagedbs.out index dabae31b77d..5697c77102c 100644 --- a/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-packagedbs.out +++ b/cabal-testsuite/PackageTests/PackageDB/cabal-fail-no-packagedbs.out @@ -1,2 +1,3 @@ # cabal v2-build -Error: cabal: No package databases have been specified. If you use --package-db=clear, you must follow it with --package-db= with 'global', 'user' or a specific file. +Error: [Cabal-2300] +No package databases have been specified. If you use --package-db=clear, you must follow it with --package-db= with 'global', 'user' or a specific file.