diff --git a/Cabal/src/Distribution/Simple/Errors.hs b/Cabal/src/Distribution/Simple/Errors.hs index fb1c2875f1c..84e5f8d31f5 100644 --- a/Cabal/src/Distribution/Simple/Errors.hs +++ b/Cabal/src/Distribution/Simple/Errors.hs @@ -32,6 +32,7 @@ import Distribution.Types.BenchmarkType import Distribution.Types.LibraryName import Distribution.Types.PkgconfigVersion import Distribution.Types.TestType +import Distribution.Types.VersionRange.Internal () import Distribution.Version import Text.PrettyPrint @@ -144,6 +145,32 @@ data CabalException | CheckPackageProblems [String] | LibDirDepsPrefixNotRelative FilePath FilePath | CombinedConstraints Doc + | CantParseGHCOutput + | IncompatibleWithCabal String String + | Couldn'tFindTestProgram FilePath + | TestCoverageSupport + | Couldn'tFindTestProgLibV09 FilePath + | TestCoverageSupportLibV09 + | RawSystemStdout String + | FindFileCwd FilePath + | FindFileEx FilePath + | FindModuleFileEx ModuleName [String] [FilePath] + | MultipleFilesWithExtension String + | NoDesc + | MultiDesc [String] + | RelocRegistrationInfo + | CreatePackageDB + | WithHcPkg String + | RegisMultiplePkgNotSupported + | RegisteringNotImplemented + | NoTestSuitesEnabled + | TestNameDisabled String + | NoSuchTest String + | ConfigureProgram String FilePath + | RequireProgram String + | NoProgramFound String VersionRange + | BadVersionDb String Version VersionRange FilePath + | UnknownVersionDb String VersionRange FilePath deriving (Show, Typeable) exceptionCode :: CabalException -> Int @@ -249,6 +276,37 @@ exceptionCode e = case e of CheckPackageProblems{} -> 5559 LibDirDepsPrefixNotRelative{} -> 6667 CombinedConstraints{} -> 5000 + CantParseGHCOutput{} -> 1980 + IncompatibleWithCabal{} -> 8123 + Couldn'tFindTestProgram{} -> 5678 + TestCoverageSupport{} -> 7890 + Couldn'tFindTestProgLibV09{} -> 9012 + TestCoverageSupportLibV09{} -> 1076 + RawSystemStdout{} -> 3098 + FindFileCwd{} -> 4765 + FindFileEx{} -> 2115 + FindModuleFileEx{} -> 6663 + MultipleFilesWithExtension{} -> 3333 + NoDesc{} -> 7654 + MultiDesc{} -> 5554 + RelocRegistrationInfo{} -> 4343 + CreatePackageDB{} -> 6787 + WithHcPkg{} -> 9876 + RegisMultiplePkgNotSupported{} -> 7632 + RegisteringNotImplemented{} -> 5411 + NoTestSuitesEnabled{} -> 9061 + TestNameDisabled{} -> 8210 + NoSuchTest{} -> 8000 + ConfigureProgram{} -> 5490 + RequireProgram{} -> 6666 + NoProgramFound{} -> 7620 + BadVersionDb{} -> 8038 + UnknownVersionDb{} -> 1008 + +versionRequirement :: VersionRange -> String +versionRequirement range + | isAnyVersion range = "" + | otherwise = " version " ++ prettyShow range exceptionMessage :: CabalException -> String exceptionMessage e = case e of @@ -538,17 +596,17 @@ exceptionMessage e = case e of HowToFindInstalledPackages flv -> "don't know how to find the installed packages for " ++ prettyShow flv - PkgConfigNotFound pkg versionRequirement -> + PkgConfigNotFound pkg versionReq -> "The pkg-config package '" ++ pkg ++ "'" - ++ versionRequirement + ++ versionReq ++ " is required but it could not be found." - BadVersion pkg versionRequirement v -> + BadVersion pkg versionReq v -> "The pkg-config package '" ++ pkg ++ "'" - ++ versionRequirement + ++ versionReq ++ " is required but the version installed on the" ++ " system is version " ++ prettyShow v @@ -645,3 +703,92 @@ exceptionMessage e = case e of text "The following package dependencies were requested" $+$ nest 4 dispDepend $+$ text "however the given installed package instance does not exist." + CantParseGHCOutput -> "Can't parse --info output of GHC" + IncompatibleWithCabal compilerName packagePathEnvVar -> + "Use of " + ++ compilerName + ++ "'s environment variable " + ++ packagePathEnvVar + ++ " is incompatible with Cabal. Use the " + ++ "flag --package-db to specify a package database (it can be " + ++ "used multiple times)." + Couldn'tFindTestProgram cmd -> + "Could not find test program \"" + ++ cmd + ++ "\". Did you build the package first?" + TestCoverageSupport -> "Test coverage is only supported for packages with a library component." + Couldn'tFindTestProgLibV09 cmd -> + "Could not find test program \"" + ++ cmd + ++ "\". Did you build the package first?" + TestCoverageSupportLibV09 -> "Test coverage is only supported for packages with a library component." + RawSystemStdout errors -> errors + FindFileCwd fileName -> fileName ++ " doesn't exist" + FindFileEx fileName -> fileName ++ " doesn't exist" + FindModuleFileEx mod_name extensions searchPath -> + "Could not find module: " + ++ prettyShow mod_name + ++ " with any suffix: " + ++ show extensions + ++ " in the search path: " + ++ show searchPath + MultipleFilesWithExtension buildInfoExt -> "Multiple files with extension " ++ buildInfoExt + NoDesc -> + "No cabal file found.\n" + ++ "Please create a package description file .cabal" + MultiDesc l -> + "Multiple cabal files found.\n" + ++ "Please use only one of: " + ++ intercalate ", " l + RelocRegistrationInfo -> + "Distribution.Simple.Register.relocRegistrationInfo: \ + \not implemented for this compiler" + CreatePackageDB -> + "Distribution.Simple.Register.createPackageDB: " + ++ "not implemented for this compiler" + WithHcPkg name -> + "Distribution.Simple.Register." + ++ name + ++ ":\ + \not implemented for this compiler" + RegisMultiplePkgNotSupported -> "Registering multiple package instances is not yet supported for this compiler" + RegisteringNotImplemented -> "Registering is not implemented for this compiler" + NoTestSuitesEnabled -> + "No test suites enabled. Did you remember to configure with " + ++ "\'--enable-tests\'?" + TestNameDisabled tName -> + "Package configured with test suite " + ++ tName + ++ " disabled." + NoSuchTest tName -> "no such test: " ++ tName + ConfigureProgram name path -> + "Cannot find the program '" + ++ name + ++ "'. User-specified path '" + ++ path + ++ "' does not refer to an executable and " + ++ "the program is not on the system path." + RequireProgram progName -> "The program '" ++ progName ++ "' is required but it could not be found." + NoProgramFound progName versionRange -> + "The program '" + ++ progName + ++ "'" + ++ versionRequirement versionRange + ++ " is required but it could not be found." + BadVersionDb progName version range locationPath -> + "The program '" + ++ progName + ++ "'" + ++ versionRequirement range + ++ " is required but the version found at " + ++ locationPath + ++ " is version " + ++ prettyShow version + UnknownVersionDb progName versionRange locationPath -> + "The program '" + ++ progName + ++ "'" + ++ versionRequirement versionRange + ++ " is required but the version of " + ++ locationPath + ++ " could not be determined." diff --git a/Cabal/src/Distribution/Simple/GHC/Internal.hs b/Cabal/src/Distribution/Simple/GHC/Internal.hs index bb77d20c5cf..e5f8938fc41 100644 --- a/Cabal/src/Distribution/Simple/GHC/Internal.hs +++ b/Cabal/src/Distribution/Simple/GHC/Internal.hs @@ -51,6 +51,10 @@ module Distribution.Simple.GHC.Internal import Distribution.Compat.Prelude import Prelude () +import Data.Bool (bool) +import qualified Data.ByteString.Lazy.Char8 as BS +import qualified Data.Map as Map +import qualified Data.Set as Set import Distribution.Backpack import Distribution.Compat.Stack import qualified Distribution.InstalledPackageInfo as IPI @@ -61,6 +65,7 @@ import Distribution.Parsec (simpleParsec) import Distribution.Pretty (prettyShow) import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler +import Distribution.Simple.Errors import Distribution.Simple.Flag (Flag (NoFlag), maybeToFlag, toFlag) import Distribution.Simple.GHC.ImplInfo import Distribution.Simple.LocalBuildInfo @@ -69,6 +74,7 @@ import Distribution.Simple.Program.GHC import Distribution.Simple.Setup.Common (extraCompilationArtifacts) import Distribution.Simple.Utils import Distribution.System +import Distribution.Types.ComponentId (ComponentId) import Distribution.Types.ComponentLocalBuildInfo import Distribution.Types.LocalBuildInfo import Distribution.Types.TargetInfo @@ -78,12 +84,6 @@ import Distribution.Utils.Path import Distribution.Verbosity import Distribution.Version (Version) import Language.Haskell.Extension - -import Data.Bool (bool) -import qualified Data.ByteString.Lazy.Char8 as BS -import qualified Data.Map as Map -import qualified Data.Set as Set -import Distribution.Types.ComponentId (ComponentId) import System.Directory (getDirectoryContents, getTemporaryDirectory) import System.Environment (getEnv) import System.FilePath @@ -285,7 +285,7 @@ getGhcInfo verbosity _implInfo ghcProg = do | all isSpace ss -> return i _ -> - die' verbosity "Can't parse --info output of GHC" + dieWithException verbosity CantParseGHCOutput getExtensions :: Verbosity @@ -753,15 +753,7 @@ checkPackageDbEnvVar verbosity compilerName packagePathEnvVar = do (Just `fmap` getEnv name) `catchIO` const (return Nothing) abort = - die' verbosity $ - "Use of " - ++ compilerName - ++ "'s environment variable " - ++ packagePathEnvVar - ++ " is incompatible with Cabal. Use the " - ++ "flag --package-db to specify a package database (it can be " - ++ "used multiple times)." - + dieWithException verbosity $ IncompatibleWithCabal compilerName packagePathEnvVar _ = callStack -- TODO: output stack when erroring profDetailLevelFlag :: Bool -> ProfDetailLevel -> Flag GhcProfAuto diff --git a/Cabal/src/Distribution/Simple/Haddock.hs b/Cabal/src/Distribution/Simple/Haddock.hs index a8394c21a6c..7476f70006c 100644 --- a/Cabal/src/Distribution/Simple/Haddock.hs +++ b/Cabal/src/Distribution/Simple/Haddock.hs @@ -182,7 +182,6 @@ getHaddockProg verbosity programDb comp args quickJumpFlag = do -- various sanity checks when (hoogle && version < mkVersion [2, 2]) $ dieWithException verbosity NoSupportForHoogle - -- "Haddock 2.0 and 2.1 do not support the --hoogle flag." when (fromFlag argQuickJump && version < mkVersion [2, 19]) $ do let msg = "Haddock prior to 2.19 does not support the --quickjump flag." @@ -1116,7 +1115,7 @@ hscolour' -> HscolourFlags -> IO () hscolour' onNoHsColour haddockTarget pkg_descr lbi suffixes flags = - either onNoHsColour (\(hscolourProg, _, _) -> go hscolourProg) + either (\excep -> onNoHsColour $ exceptionMessage excep) (\(hscolourProg, _, _) -> go hscolourProg) =<< lookupProgramVersion verbosity hscolourProgram diff --git a/Cabal/src/Distribution/Simple/Program/Db.hs b/Cabal/src/Distribution/Simple/Program/Db.hs index 7e151bc06e2..5bef94e4b5f 100644 --- a/Cabal/src/Distribution/Simple/Program/Db.hs +++ b/Cabal/src/Distribution/Simple/Program/Db.hs @@ -63,7 +63,6 @@ module Distribution.Simple.Program.Db import Distribution.Compat.Prelude import Prelude () -import Distribution.Pretty import Distribution.Simple.Program.Builtin import Distribution.Simple.Program.Find import Distribution.Simple.Program.Types @@ -75,6 +74,7 @@ import Distribution.Version import Data.Tuple (swap) import qualified Data.Map as Map +import Distribution.Simple.Errors -- ------------------------------------------------------------ @@ -348,16 +348,8 @@ configureProgram verbosity prog progdb = do else findProgramOnSearchPath verbosity (progSearchPath progdb) path >>= maybe - (die' verbosity notFound) + (dieWithException verbosity $ ConfigureProgram name path) (return . Just . swap . fmap UserSpecified . swap) - where - notFound = - "Cannot find the program '" - ++ name - ++ "'. User-specified path '" - ++ path - ++ "' does not refer to an executable and " - ++ "the program is not on the system path." case maybeLocation of Nothing -> return progdb Just (location, triedLocations) -> do @@ -437,10 +429,8 @@ requireProgram requireProgram verbosity prog progdb = do mres <- needProgram verbosity prog progdb case mres of - Nothing -> die' verbosity notFound + Nothing -> dieWithException verbosity $ RequireProgram (programName prog) Just res -> return res - where - notFound = "The program '" ++ programName prog ++ "' is required but it could not be found." -- | Check that a program is configured and available to be run. -- @@ -477,7 +467,7 @@ lookupProgramVersion -> Program -> VersionRange -> ProgramDb - -> IO (Either String (ConfiguredProgram, Version, ProgramDb)) + -> IO (Either CabalException (ConfiguredProgram, Version, ProgramDb)) lookupProgramVersion verbosity prog range programDb = do -- If it's not already been configured, try to configure it now programDb' <- case lookupProgram prog programDb of @@ -485,43 +475,16 @@ lookupProgramVersion verbosity prog range programDb = do Just _ -> return programDb case lookupProgram prog programDb' of - Nothing -> return $! Left notFound + Nothing -> return $! Left $ NoProgramFound (programName prog) range Just configuredProg@ConfiguredProgram{programLocation = location} -> case programVersion configuredProg of Just version | withinRange version range -> return $! Right (configuredProg, version, programDb') | otherwise -> - return $! Left (badVersion version location) + return $! Left $ BadVersionDb (programName prog) version range (locationPath location) Nothing -> - return $! Left (unknownVersion location) - where - notFound = - "The program '" - ++ programName prog - ++ "'" - ++ versionRequirement - ++ " is required but it could not be found." - badVersion v l = - "The program '" - ++ programName prog - ++ "'" - ++ versionRequirement - ++ " is required but the version found at " - ++ locationPath l - ++ " is version " - ++ prettyShow v - unknownVersion l = - "The program '" - ++ programName prog - ++ "'" - ++ versionRequirement - ++ " is required but the version of " - ++ locationPath l - ++ " could not be determined." - versionRequirement - | isAnyVersion range = "" - | otherwise = " version " ++ prettyShow range + return $! Left $ UnknownVersionDb (programName prog) range (locationPath location) -- | Like 'lookupProgramVersion', but raises an exception in case of error -- instead of returning 'Left errMsg'. @@ -533,5 +496,5 @@ requireProgramVersion -> IO (ConfiguredProgram, Version, ProgramDb) requireProgramVersion verbosity prog range programDb = join $ - either (die' verbosity) return + either (dieWithException verbosity) return `fmap` lookupProgramVersion verbosity prog range programDb diff --git a/Cabal/src/Distribution/Simple/Register.hs b/Cabal/src/Distribution/Simple/Register.hs index fc6075dc357..4cfc5ba8801 100644 --- a/Cabal/src/Distribution/Simple/Register.hs +++ b/Cabal/src/Distribution/Simple/Register.hs @@ -71,6 +71,7 @@ import Distribution.Package import Distribution.PackageDescription import Distribution.Pretty import Distribution.Simple.Compiler +import Distribution.Simple.Errors import Distribution.Simple.Flag import Distribution.Simple.Program import qualified Distribution.Simple.Program.HcPkg as HcPkg @@ -81,7 +82,6 @@ import Distribution.System import Distribution.Utils.MapAccum import Distribution.Verbosity as Verbosity import Distribution.Version - import System.Directory import System.FilePath (isAbsolute, (<.>), ()) @@ -349,11 +349,7 @@ relocRegistrationInfo verbosity pkg lib lbi clbi abi_hash packageDb = clbi fs ) - _ -> - die' - verbosity - "Distribution.Simple.Register.relocRegistrationInfo: \ - \not implemented for this compiler" + _ -> dieWithException verbosity RelocRegistrationInfo initPackageDB :: Verbosity -> Compiler -> ProgramDb -> FilePath -> IO () initPackageDB verbosity comp progdb dbPath = @@ -373,10 +369,7 @@ createPackageDB verbosity comp progdb preferCompat dbPath = GHCJS -> HcPkg.init (GHCJS.hcPkgInfo progdb) verbosity False dbPath UHC -> return () HaskellSuite _ -> HaskellSuite.initPackageDB verbosity progdb dbPath - _ -> - die' verbosity $ - "Distribution.Simple.Register.createPackageDB: " - ++ "not implemented for this compiler" + _ -> dieWithException verbosity CreatePackageDB doesPackageDBExist :: FilePath -> IO Bool doesPackageDBExist dbPath = do @@ -424,14 +417,7 @@ withHcPkg verbosity name comp progdb f = case compilerFlavor comp of GHC -> f (GHC.hcPkgInfo progdb) GHCJS -> f (GHCJS.hcPkgInfo progdb) - _ -> - die' - verbosity - ( "Distribution.Simple.Register." - ++ name - ++ ":\ - \not implemented for this compiler" - ) + _ -> dieWithException verbosity $ WithHcPkg name registerPackage :: Verbosity @@ -449,9 +435,9 @@ registerPackage verbosity comp progdb packageDbs installedPkgInfo registerOption HaskellSuite.registerPackage verbosity progdb packageDbs installedPkgInfo _ | HcPkg.registerMultiInstance registerOptions -> - die' verbosity "Registering multiple package instances is not yet supported for this compiler" + dieWithException verbosity RegisMultiplePkgNotSupported UHC -> UHC.registerPackage verbosity comp progdb packageDbs installedPkgInfo - _ -> die' verbosity "Registering is not implemented for this compiler" + _ -> dieWithException verbosity RegisteringNotImplemented writeHcPkgRegisterScript :: Verbosity diff --git a/Cabal/src/Distribution/Simple/Test.hs b/Cabal/src/Distribution/Simple/Test.hs index 0a8406e2574..7cb695cabaf 100644 --- a/Cabal/src/Distribution/Simple/Test.hs +++ b/Cabal/src/Distribution/Simple/Test.hs @@ -38,6 +38,7 @@ import Distribution.TestSuite import qualified Distribution.Types.LocalBuildInfo as LBI import Distribution.Types.UnqualComponentName +import Distribution.Simple.Errors import System.Directory ( createDirectoryIfMissing , doesFileExist @@ -98,9 +99,7 @@ test args pkg_descr lbi flags = do exitSuccess when (PD.hasTests pkg_descr && null enabledTests) $ - die' verbosity $ - "No test suites enabled. Did you remember to configure with " - ++ "\'--enable-tests\'?" + dieWithException verbosity NoTestSuitesEnabled testsToRun <- case testNames of [] -> return $ zip enabledTests $ repeat Nothing @@ -113,11 +112,8 @@ test args pkg_descr lbi flags = do Just t -> return (t, Nothing) _ | tCompName `elem` allNames -> - die' verbosity $ - "Package configured with test suite " - ++ tName - ++ " disabled." - | otherwise -> die' verbosity $ "no such test: " ++ tName + dieWithException verbosity $ TestNameDisabled tName + | otherwise -> dieWithException verbosity $ NoSuchTest tName createDirectoryIfMissing True testLogDir diff --git a/Cabal/src/Distribution/Simple/Test/ExeV10.hs b/Cabal/src/Distribution/Simple/Test/ExeV10.hs index 927e1fce1a8..04c7e30073a 100644 --- a/Cabal/src/Distribution/Simple/Test/ExeV10.hs +++ b/Cabal/src/Distribution/Simple/Test/ExeV10.hs @@ -39,6 +39,7 @@ import System.IO (stderr, stdout) import System.Process (createPipe) import qualified Data.ByteString.Lazy as LBS +import Distribution.Simple.Errors runTest :: PD.PackageDescription @@ -62,10 +63,8 @@ runTest pkg_descr lbi clbi flags suite = do -- Check that the test executable exists. exists <- doesFileExist cmd unless exists $ - die' verbosity $ - "Could not find test program \"" - ++ cmd - ++ "\". Did you build the package first?" + dieWithException verbosity $ + Couldn'tFindTestProgram cmd -- Remove old .tix files if appropriate. unless (fromFlag $ testKeepTix flags) $ do @@ -174,7 +173,7 @@ runTest pkg_descr lbi clbi flags suite = do when isCoverageEnabled $ case PD.library pkg_descr of Nothing -> - die' verbosity "Test coverage is only supported for packages with a library component." + dieWithException verbosity TestCoverageSupport Just library -> markupTest verbosity lbi distPref (prettyShow $ PD.package pkg_descr) suite library diff --git a/Cabal/src/Distribution/Simple/Test/LibV09.hs b/Cabal/src/Distribution/Simple/Test/LibV09.hs index 4da06192141..b87897bfed7 100644 --- a/Cabal/src/Distribution/Simple/Test/LibV09.hs +++ b/Cabal/src/Distribution/Simple/Test/LibV09.hs @@ -39,6 +39,7 @@ import Distribution.Verbosity import qualified Control.Exception as CE import qualified Data.ByteString.Lazy as LBS import Distribution.Compat.Process (proc) +import Distribution.Simple.Errors import System.Directory ( canonicalizePath , createDirectoryIfMissing @@ -74,10 +75,8 @@ runTest pkg_descr lbi clbi flags suite = do -- Check that the test executable exists. exists <- doesFileExist cmd unless exists $ - die' verbosity $ - "Could not find test program \"" - ++ cmd - ++ "\". Did you build the package first?" + dieWithException verbosity $ + Couldn'tFindTestProgLibV09 cmd -- Remove old .tix files if appropriate. unless (fromFlag $ testKeepTix flags) $ do @@ -189,7 +188,7 @@ runTest pkg_descr lbi clbi flags suite = do when isCoverageEnabled $ case PD.library pkg_descr of Nothing -> - die' verbosity "Test coverage is only supported for packages with a library component." + dieWithException verbosity TestCoverageSupportLibV09 Just library -> markupTest verbosity lbi distPref (prettyShow $ PD.package pkg_descr) suite library diff --git a/Cabal/src/Distribution/Simple/Utils.hs b/Cabal/src/Distribution/Simple/Utils.hs index a2273ac9630..b66a9740338 100644 --- a/Cabal/src/Distribution/Simple/Utils.hs +++ b/Cabal/src/Distribution/Simple/Utils.hs @@ -78,6 +78,7 @@ module Distribution.Simple.Utils , IOData (..) , KnownIODataMode (..) , IODataMode (..) + , VerboseException -- * copying files , createDirectoryIfMissingVerbose @@ -1014,7 +1015,8 @@ rawSystemStdout verbosity path args = withFrozenCallStack $ do Nothing (IOData.iodataMode :: IODataMode mode) when (exitCode /= ExitSuccess) $ - die' verbosity errors + dieWithException verbosity $ + RawSystemStdout errors return output -- | Execute the given command with the given arguments, returning @@ -1127,6 +1129,7 @@ findProgramVersion versionArg selectVersion verbosity path = withFrozenCallStack str <- rawSystemStdout verbosity path [versionArg] `catchIO` (\_ -> return "") + `catch` (\(_ :: VerboseException CabalException) -> return "") `catchExit` (\_ -> return "") let version :: Maybe Version version = simpleParsec (selectVersion str) @@ -1197,7 +1200,7 @@ findFileCwd verbosity cwd searchPath fileName = [ path fileName | path <- nub searchPath ] - >>= maybe (die' verbosity $ fileName ++ " doesn't exist") return + >>= maybe (dieWithException verbosity $ FindFileCwd fileName) return -- | Find a file by looking in a search path. The file path must match exactly. findFileEx @@ -1213,7 +1216,7 @@ findFileEx verbosity searchPath fileName = [ path fileName | path <- nub searchPath ] - >>= maybe (die' verbosity $ fileName ++ " doesn't exist") return + >>= maybe (dieWithException verbosity $ FindFileEx fileName) return -- | Find a file by looking in a search path with one of a list of possible -- file extensions. The file base name should be given and it will be tried @@ -1342,13 +1345,7 @@ findModuleFileEx verbosity searchPath extensions mod_name = (ModuleName.toFilePath mod_name) where notFound = - die' verbosity $ - "Could not find module: " - ++ prettyShow mod_name - ++ " with any suffix: " - ++ show extensions - ++ " in the search path: " - ++ show searchPath + dieWithException verbosity $ FindModuleFileEx mod_name extensions searchPath -- | List all the files in a directory and all subdirectories. -- @@ -1803,7 +1800,7 @@ defaultPackageDesc verbosity = tryFindPackageDesc verbosity currentDir findPackageDesc :: FilePath -- ^ Where to look - -> IO (Either String FilePath) + -> IO (Either CabalException FilePath) -- ^ .cabal findPackageDesc = findPackageDescCwd "." @@ -1813,7 +1810,7 @@ findPackageDescCwd -- ^ project root -> FilePath -- ^ relative directory - -> IO (Either String FilePath) + -> IO (Either CabalException FilePath) -- ^ .cabal relative to the project root findPackageDescCwd cwd dir = do @@ -1829,32 +1826,21 @@ findPackageDescCwd cwd dir = , not (null name) && ext == ".cabal" ] case map fst cabalFiles of - [] -> return (Left noDesc) + [] -> return (Left NoDesc) [cabalFile] -> return (Right cabalFile) - multiple -> return (Left $ multiDesc multiple) - where - noDesc :: String - noDesc = - "No cabal file found.\n" - ++ "Please create a package description file .cabal" - - multiDesc :: [String] -> String - multiDesc l = - "Multiple cabal files found.\n" - ++ "Please use only one of: " - ++ intercalate ", " l + multiple -> return (Left $ MultiDesc multiple) -- | Like 'findPackageDesc', but calls 'die' in case of error. tryFindPackageDesc :: Verbosity -> FilePath -> IO FilePath tryFindPackageDesc verbosity dir = - either (die' verbosity) return =<< findPackageDesc dir + either (dieWithException verbosity) return =<< findPackageDesc dir -- | Like 'findPackageDescCwd', but calls 'die' in case of error. -- -- @since 3.4.0.0 tryFindPackageDescCwd :: Verbosity -> FilePath -> FilePath -> IO FilePath tryFindPackageDescCwd verbosity cwd dir = - either (die' verbosity) return =<< findPackageDescCwd cwd dir + either (dieWithException verbosity) return =<< findPackageDescCwd cwd dir -- | Find auxiliary package information in the given directory. -- Looks for @.buildinfo@ files. @@ -1877,7 +1863,7 @@ findHookedPackageDesc verbosity dir = do case buildInfoFiles of [] -> return Nothing [f] -> return (Just f) - _ -> die' verbosity ("Multiple files with extension " ++ buildInfoExt) + _ -> dieWithException verbosity $ MultipleFilesWithExtension buildInfoExt buildInfoExt :: String buildInfoExt = ".buildinfo" diff --git a/cabal-install/src/Distribution/Client/Install.hs b/cabal-install/src/Distribution/Client/Install.hs index a7eed14fbba..ad32c4237bd 100644 --- a/cabal-install/src/Distribution/Client/Install.hs +++ b/cabal-install/src/Distribution/Client/Install.hs @@ -181,6 +181,7 @@ import Distribution.Simple.Compiler , compilerInfo ) import Distribution.Simple.Configure (interpretPackageDbFlags) +import Distribution.Simple.Errors import Distribution.Simple.InstallDirs as InstallDirs ( PathTemplate , fromPathTemplate @@ -220,7 +221,8 @@ import qualified Distribution.Simple.Setup as Cabal , testCommand ) import Distribution.Simple.Utils - ( createDirectoryIfMissingVerbose + ( VerboseException + , createDirectoryIfMissingVerbose , writeFileAtomic ) import Distribution.Simple.Utils as Utils @@ -2090,6 +2092,7 @@ onFailure :: (SomeException -> BuildFailure) -> IO BuildOutcome -> IO BuildOutco onFailure result action = action `catches` [ Handler $ \ioe -> handler (ioe :: IOException) + , Handler $ \cabalexe -> handler (cabalexe :: VerboseException CabalException) , Handler $ \exit -> handler (exit :: ExitCode) ] where diff --git a/cabal-testsuite/PackageTests/Check/PackageFiles/Missing/cabal.out b/cabal-testsuite/PackageTests/Check/PackageFiles/Missing/cabal.out index a6e3af2aa82..a21b46db013 100644 --- a/cabal-testsuite/PackageTests/Check/PackageFiles/Missing/cabal.out +++ b/cabal-testsuite/PackageTests/Check/PackageFiles/Missing/cabal.out @@ -1,3 +1,4 @@ # cabal check -Error: cabal: No cabal file found. +Error: [Cabal-7654] +No cabal file found. Please create a package description file .cabal