diff --git a/Cabal/src/Distribution/Simple/BuildTarget.hs b/Cabal/src/Distribution/Simple/BuildTarget.hs index 00964878130..89b6e275113 100644 --- a/Cabal/src/Distribution/Simple/BuildTarget.hs +++ b/Cabal/src/Distribution/Simple/BuildTarget.hs @@ -47,18 +47,18 @@ import Distribution.Types.LocalBuildInfo import Distribution.Types.TargetInfo import Distribution.Types.UnqualComponentName +import qualified Distribution.Compat.CharParsing as P import Distribution.ModuleName import Distribution.Package import Distribution.PackageDescription import Distribution.Parsec import Distribution.Pretty +import Distribution.Simple.Errors import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Utils import Distribution.Utils.Path import Distribution.Verbosity -import qualified Distribution.Compat.CharParsing as P - import Control.Arrow ((&&&)) import Control.Monad (msum) import Data.List (groupBy, stripPrefix) @@ -246,19 +246,8 @@ reportUserBuildTargetProblems verbosity problems = do case [target | UserBuildTargetUnrecognised target <- problems] of [] -> return () target -> - die' verbosity $ - unlines - [ "Unrecognised build target '" ++ name ++ "'." - | name <- target - ] - ++ "Examples:\n" - ++ " - build foo -- component name " - ++ "(library, executable, test-suite or benchmark)\n" - ++ " - build Data.Foo -- module name\n" - ++ " - build Data/Foo.hsc -- file name\n" - ++ " - build lib:foo exe:foo -- component qualified by kind\n" - ++ " - build foo:Data.Foo -- module qualified by component\n" - ++ " - build foo:Data/Foo.hsc -- file qualified by component" + dieWithException verbosity $ + UnrecognisedBuildTarget target showUserBuildTarget :: UserBuildTarget -> String showUserBuildTarget = intercalate ":" . getComponents @@ -407,57 +396,29 @@ reportBuildTargetProblems verbosity problems = do case [(t, e, g) | BuildTargetExpected t e g <- problems] of [] -> return () targets -> - die' verbosity $ - unlines - [ "Unrecognised build target '" - ++ showUserBuildTarget target - ++ "'.\n" - ++ "Expected a " - ++ intercalate " or " expected - ++ ", rather than '" - ++ got - ++ "'." - | (target, expected, got) <- targets - ] + dieWithException verbosity $ + ReportBuildTargetProblems $ + map (\(target, expected, got) -> (showUserBuildTarget target, expected, got)) targets case [(t, e) | BuildTargetNoSuch t e <- problems] of [] -> return () targets -> - die' verbosity $ - unlines - [ "Unknown build target '" - ++ showUserBuildTarget target - ++ "'.\nThere is no " - ++ intercalate - " or " - [ mungeThing thing ++ " '" ++ got ++ "'" - | (thing, got) <- nosuch - ] - ++ "." - | (target, nosuch) <- targets - ] - where - mungeThing "file" = "file target" - mungeThing thing = thing + dieWithException verbosity $ + UnknownBuildTarget $ + map (\(target, nosuch) -> (showUserBuildTarget target, nosuch)) targets case [(t, ts) | BuildTargetAmbiguous t ts <- problems] of [] -> return () targets -> - die' verbosity $ - unlines - [ "Ambiguous build target '" - ++ showUserBuildTarget target - ++ "'. It could be:\n " - ++ unlines - [ " " - ++ showUserBuildTarget ut - ++ " (" - ++ showBuildTargetKind bt - ++ ")" - | (ut, bt) <- amb - ] - | (target, amb) <- targets - ] + dieWithException verbosity $ + AmbiguousBuildTarget $ + map + ( \(target, amb) -> + ( showUserBuildTarget target + , (map (\(ut, bt) -> (showUserBuildTarget ut, showBuildTargetKind bt)) amb) + ) + ) + targets where showBuildTargetKind (BuildTargetComponent _) = "component" showBuildTargetKind (BuildTargetModule _ _) = "module" @@ -1093,7 +1054,7 @@ checkBuildTargets verbosity pkg_descr lbi targets = do case disabled of [] -> return () - ((cname, reason) : _) -> die' verbosity $ formatReason (showComponentName cname) reason + ((cname, reason) : _) -> dieWithException verbosity $ CheckBuildTargets $ formatReason (showComponentName cname) reason for_ [(c, t) | (c, Just t) <- enabled] $ \(c, t) -> warn verbosity $ diff --git a/Cabal/src/Distribution/Simple/ConfigureScript.hs b/Cabal/src/Distribution/Simple/ConfigureScript.hs index a97e9dbed46..c4ec2fc0f95 100644 --- a/Cabal/src/Distribution/Simple/ConfigureScript.hs +++ b/Cabal/src/Distribution/Simple/ConfigureScript.hs @@ -22,13 +22,13 @@ import Prelude () -- local import Distribution.PackageDescription +import Distribution.Pretty +import Distribution.Simple.Errors +import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Program import Distribution.Simple.Program.Db import Distribution.Simple.Setup.Common import Distribution.Simple.Setup.Config - -import Distribution.Pretty -import Distribution.Simple.LocalBuildInfo import Distribution.Simple.Utils import Distribution.System (buildPlatform) import Distribution.Utils.NubList @@ -182,18 +182,11 @@ runConfigureScript verbosity flags lbi = do (programInvocation (sh{programOverrideEnv = overEnv}) args') { progInvokeCwd = Just (buildDir lbi) } - Nothing -> die' verbosity notFoundMsg + Nothing -> dieWithException verbosity NotFoundMsg where args = configureArgs backwardsCompatHack flags backwardsCompatHack = False - notFoundMsg = - "The package has a './configure' script. " - ++ "If you are on Windows, This requires a " - ++ "Unix compatibility toolchain such as MinGW+MSYS or Cygwin. " - ++ "If you are not on Windows, ensure that an 'sh' command " - ++ "is discoverable in your path." - -- | Convert Windows path to Unix ones toUnix :: String -> String #ifdef mingw32_HOST_OS diff --git a/Cabal/src/Distribution/Simple/Errors.hs b/Cabal/src/Distribution/Simple/Errors.hs index daf40edd212..e086bf04cc3 100644 --- a/Cabal/src/Distribution/Simple/Errors.hs +++ b/Cabal/src/Distribution/Simple/Errors.hs @@ -70,12 +70,31 @@ data CabalException | PkgDumpFailed | FailedToParseOutput | CantFindSourceModule ModuleName - | VersionMisMatch FilePath Version FilePath Version - | VersionMisMatchGHC FilePath Version FilePath Version + | VersionMismatchJS FilePath Version FilePath Version + | VersionMismatchGHCJS FilePath Version FilePath Version | GlobalPackageDBLimitation | GlobalPackageDBSpecifiedFirst | MatchDirFileGlob String | MatchDirFileGlobErrors [String] + | ErrorParsingFileDoesntExist FilePath + | FailedParsing String + | NotFoundMsg + | UnrecognisedBuildTarget [String] + | ReportBuildTargetProblems [(String, [String], String)] + | UnknownBuildTarget [(String, [(String, String)])] + | AmbiguousBuildTarget [(String, [(String, String)])] + | CheckBuildTargets String + | VersionMismatchGHC FilePath Version FilePath Version + | CheckPackageDbStackPost76 + | CheckPackageDbStackPre76 + | GlobalPackageDbSpecifiedFirst + | CantInstallForeignLib + | NoSupportForPreProcessingTest TestType + | NoSupportForPreProcessingBenchmark BenchmarkType + | CantFindSourceForPreProcessFile String + | NoSupportPreProcessingTestExtras TestType + | NoSupportPreProcessingBenchmarkExtras BenchmarkType + | UnlitException String deriving (Show, Typeable) exceptionCode :: CabalException -> Int @@ -120,12 +139,31 @@ exceptionCode e = case e of PkgDumpFailed{} -> 2290 FailedToParseOutput{} -> 5500 CantFindSourceModule{} -> 8870 - VersionMisMatch{} -> 9001 - VersionMisMatchGHC{} -> 4001 + VersionMismatchJS{} -> 9001 + VersionMismatchGHCJS{} -> 4001 GlobalPackageDBLimitation{} -> 5002 GlobalPackageDBSpecifiedFirst{} -> 3901 MatchDirFileGlob{} -> 9760 MatchDirFileGlobErrors{} -> 6661 + ErrorParsingFileDoesntExist{} -> 1234 + FailedParsing{} -> 6565 + NotFoundMsg{} -> 8011 + UnrecognisedBuildTarget{} -> 3410 + ReportBuildTargetProblems{} -> 5504 + UnknownBuildTarget{} -> 4444 + AmbiguousBuildTarget{} -> 7865 + CheckBuildTargets{} -> 4733 + VersionMismatchGHC{} -> 4000 + CheckPackageDbStackPost76{} -> 3000 + CheckPackageDbStackPre76{} -> 5640 + GlobalPackageDbSpecifiedFirst{} -> 2345 + CantInstallForeignLib{} -> 8221 + NoSupportForPreProcessingTest{} -> 3008 + NoSupportForPreProcessingBenchmark{} -> 6990 + CantFindSourceForPreProcessFile{} -> 7554 + NoSupportPreProcessingTestExtras{} -> 7886 + NoSupportPreProcessingBenchmarkExtras{} -> 9999 + UnlitException{} -> 5454 exceptionMessage :: CabalException -> String exceptionMessage e = case e of @@ -186,7 +224,7 @@ exceptionMessage e = case e of PkgDumpFailed -> "pkg dump failed" FailedToParseOutput -> "failed to parse output of 'pkg dump'" CantFindSourceModule moduleName -> "can't find source for module " ++ prettyShow moduleName - VersionMisMatch ghcjsProgPath ghcjsVersion ghcjsPkgProgPath ghcjsPkgGhcjsVersion -> + VersionMismatchJS ghcjsProgPath ghcjsVersion ghcjsPkgProgPath ghcjsPkgGhcjsVersion -> "Version mismatch between ghcjs and ghcjs-pkg: " ++ show ghcjsProgPath ++ " is version " @@ -195,7 +233,7 @@ exceptionMessage e = case e of ++ show ghcjsPkgProgPath ++ " is version " ++ prettyShow ghcjsPkgGhcjsVersion - VersionMisMatchGHC ghcjsProgPath ghcjsGhcVersion ghcjsPkgProgPath ghcjsPkgVersion -> + VersionMismatchGHCJS ghcjsProgPath ghcjsGhcVersion ghcjsPkgProgPath ghcjsPkgVersion -> "Version mismatch between ghcjs and ghcjs-pkg: " ++ show ghcjsProgPath ++ " was built with GHC version " @@ -213,3 +251,105 @@ exceptionMessage e = case e of ++ "specified first and cannot be specified multiple times" MatchDirFileGlob pathError -> pathError MatchDirFileGlobErrors errors -> unlines errors + ErrorParsingFileDoesntExist filePath -> "Error Parsing: file \"" ++ filePath ++ "\" doesn't exist. Cannot continue." + FailedParsing name -> "Failed parsing \"" ++ name ++ "\"." + NotFoundMsg -> + "The package has a './configure' script. " + ++ "If you are on Windows, This requires a " + ++ "Unix compatibility toolchain such as MinGW+MSYS or Cygwin. " + ++ "If you are not on Windows, ensure that an 'sh' command " + ++ "is discoverable in your path." + UnrecognisedBuildTarget target -> + unlines + [ "Unrecognised build target '" ++ name ++ "'." + | name <- target + ] + ++ "Examples:\n" + ++ " - build foo -- component name " + ++ "(library, executable, test-suite or benchmark)\n" + ++ " - build Data.Foo -- module name\n" + ++ " - build Data/Foo.hsc -- file name\n" + ++ " - build lib:foo exe:foo -- component qualified by kind\n" + ++ " - build foo:Data.Foo -- module qualified by component\n" + ++ " - build foo:Data/Foo.hsc -- file qualified by component" + ReportBuildTargetProblems targets -> + unlines + [ "Unrecognised build target '" + ++ target + ++ "'.\n" + ++ "Expected a " + ++ intercalate " or " expected + ++ ", rather than '" + ++ got + ++ "'." + | (target, expected, got) <- targets + ] + UnknownBuildTarget targets -> + unlines + [ "Unknown build target '" + ++ target + ++ "'.\nThere is no " + ++ intercalate + " or " + [ mungeThing thing ++ " '" ++ got ++ "'" + | (thing, got) <- nosuch + ] + ++ "." + | (target, nosuch) <- targets + ] + where + mungeThing "file" = "file target" + mungeThing thing = thing + AmbiguousBuildTarget targets -> + unlines + [ "Ambiguous build target '" + ++ target + ++ "'. It could be:\n " + ++ unlines + [ " " + ++ ut + ++ " (" + ++ bt + ++ ")" + | (ut, bt) <- amb + ] + | (target, amb) <- targets + ] + CheckBuildTargets errorStr -> errorStr + VersionMismatchGHC ghcProgPath ghcVersion ghcPkgProgPath ghcPkgVersion -> + "Version mismatch between ghc and ghc-pkg: " + ++ ghcProgPath + ++ " is version " + ++ prettyShow ghcVersion + ++ " " + ++ ghcPkgProgPath + ++ " is version " + ++ prettyShow ghcPkgVersion + CheckPackageDbStackPost76 -> + "If the global package db is specified, it must be " + ++ "specified first and cannot be specified multiple times" + CheckPackageDbStackPre76 -> + "With current ghc versions the global package db is always used " + ++ "and must be listed first. This ghc limitation is lifted in GHC 7.6," + ++ "see https://gitlab.haskell.org/ghc/ghc/-/issues/5977" + GlobalPackageDbSpecifiedFirst -> + "If the global package db is specified, it must be " + ++ "specified first and cannot be specified multiple times" + CantInstallForeignLib -> "Can't install foreign-library symlink on non-Linux OS" + NoSupportForPreProcessingTest tt -> + "No support for preprocessing test " + ++ "suite type " + ++ prettyShow tt + NoSupportForPreProcessingBenchmark tt -> + "No support for preprocessing benchmark " + ++ "type " + ++ prettyShow tt + CantFindSourceForPreProcessFile errorStr -> errorStr + NoSupportPreProcessingTestExtras tt -> + "No support for preprocessing test suite type " + ++ prettyShow tt + NoSupportPreProcessingBenchmarkExtras tt -> + "No support for preprocessing benchmark " + ++ "type " + ++ prettyShow tt + UnlitException str -> str diff --git a/Cabal/src/Distribution/Simple/GHC.hs b/Cabal/src/Distribution/Simple/GHC.hs index 501ae759391..3f1ede31b16 100644 --- a/Cabal/src/Distribution/Simple/GHC.hs +++ b/Cabal/src/Distribution/Simple/GHC.hs @@ -81,6 +81,9 @@ module Distribution.Simple.GHC import Distribution.Compat.Prelude import Prelude () +import Control.Monad (forM_, msum) +import Data.Char (isLower) +import qualified Data.Map as Map import Distribution.CabalSpecVersion import Distribution.InstalledPackageInfo (InstalledPackageInfo) import qualified Distribution.InstalledPackageInfo as InstalledPackageInfo @@ -92,6 +95,7 @@ import Distribution.PackageDescription.Utils (cabalBug) import Distribution.Pretty import Distribution.Simple.BuildPaths import Distribution.Simple.Compiler +import Distribution.Simple.Errors import Distribution.Simple.Flag (Flag (..), fromFlag, fromFlagOrDefault, toFlag) import Distribution.Simple.GHC.EnvironmentParser import Distribution.Simple.GHC.ImplInfo @@ -120,10 +124,6 @@ import Distribution.Utils.Path import Distribution.Verbosity import Distribution.Version import Language.Haskell.Extension - -import Control.Monad (forM_, msum) -import Data.Char (isLower) -import qualified Data.Map as Map import System.Directory ( canonicalizePath , createDirectoryIfMissing @@ -196,16 +196,8 @@ configure verbosity hcPath hcPkgPath conf0 = do (userMaybeSpecifyPath "ghc-pkg" hcPkgPath progdb1) when (ghcVersion /= ghcPkgVersion) $ - die' verbosity $ - "Version mismatch between ghc and ghc-pkg: " - ++ programPath ghcProg - ++ " is version " - ++ prettyShow ghcVersion - ++ " " - ++ programPath ghcPkgProg - ++ " is version " - ++ prettyShow ghcPkgVersion - + dieWithException verbosity $ + VersionMismatchGHC (programPath ghcProg) ghcVersion (programPath ghcPkgProg) ghcPkgVersion -- Likewise we try to find the matching hsc2hs and haddock programs. let hsc2hsProgram' = hsc2hsProgram @@ -513,9 +505,7 @@ checkPackageDbStackPost76 _ (GlobalPackageDB : rest) | GlobalPackageDB `notElem` rest = return () checkPackageDbStackPost76 verbosity rest | GlobalPackageDB `elem` rest = - die' verbosity $ - "If the global package db is specified, it must be " - ++ "specified first and cannot be specified multiple times" + dieWithException verbosity CheckPackageDbStackPost76 checkPackageDbStackPost76 _ _ = return () checkPackageDbStackPre76 :: Verbosity -> PackageDBStack -> IO () @@ -523,14 +513,9 @@ checkPackageDbStackPre76 _ (GlobalPackageDB : rest) | GlobalPackageDB `notElem` rest = return () checkPackageDbStackPre76 verbosity rest | GlobalPackageDB `notElem` rest = - die' verbosity $ - "With current ghc versions the global package db is always used " - ++ "and must be listed first. This ghc limitation is lifted in GHC 7.6," - ++ "see https://gitlab.haskell.org/ghc/ghc/-/issues/5977" + dieWithException verbosity CheckPackageDbStackPre76 checkPackageDbStackPre76 verbosity _ = - die' verbosity $ - "If the global package db is specified, it must be " - ++ "specified first and cannot be specified multiple times" + dieWithException verbosity GlobalPackageDbSpecifiedFirst -- GHC < 6.10 put "$topdir/include/mingw" in rts's installDirs. This -- breaks when you want to use a different gcc, so we need to filter @@ -2296,10 +2281,8 @@ installFLib verbosity lbi targetDir builtDir _pkg flib = let (Platform _ os) = hostPlatform lbi when (not (null (foreignLibVersion flib os))) $ do when (os /= Linux) $ - die' - verbosity - -- It should be impossible to get here. - "Can't install foreign-library symlink on non-Linux OS" + dieWithException verbosity $ + CantInstallForeignLib #ifndef mingw32_HOST_OS -- 'createSymbolicLink file1 file2' creates a symbolic link -- named 'file2' which points to the file 'file1'. diff --git a/Cabal/src/Distribution/Simple/GHCJS.hs b/Cabal/src/Distribution/Simple/GHCJS.hs index eb7f1a75ba6..ad27c97d3d9 100644 --- a/Cabal/src/Distribution/Simple/GHCJS.hs +++ b/Cabal/src/Distribution/Simple/GHCJS.hs @@ -153,7 +153,7 @@ configure verbosity hcPath hcPkgPath conf0 = do when (ghcjsVersion /= ghcjsPkgGhcjsVersion) $ dieWithException verbosity $ - VersionMisMatch + VersionMismatchJS (programPath ghcjsProg) ghcjsVersion (programPath ghcjsPkgProg) @@ -161,7 +161,7 @@ configure verbosity hcPath hcPkgPath conf0 = do when (ghcjsGhcVersion /= ghcjsPkgVersion) $ dieWithException verbosity $ - VersionMisMatchGHC (programPath ghcjsProg) ghcjsGhcVersion (programPath ghcjsPkgProg) ghcjsPkgVersion + VersionMismatchGHCJS (programPath ghcjsProg) ghcjsGhcVersion (programPath ghcjsPkgProg) ghcjsPkgVersion -- Likewise we try to find the matching hsc2hs and haddock programs. let hsc2hsProgram' = diff --git a/Cabal/src/Distribution/Simple/PackageDescription.hs b/Cabal/src/Distribution/Simple/PackageDescription.hs index c52cea789d9..440059db7cf 100644 --- a/Cabal/src/Distribution/Simple/PackageDescription.hs +++ b/Cabal/src/Distribution/Simple/PackageDescription.hs @@ -21,6 +21,8 @@ module Distribution.Simple.PackageDescription import Distribution.Compat.Prelude import Prelude () +import qualified Data.ByteString as BS +import Data.List (groupBy) import Distribution.Fields.ParseResult import Distribution.PackageDescription import Distribution.PackageDescription.Parsec @@ -33,11 +35,9 @@ import Distribution.Parsec.Warning , PWarning (..) , showPWarning ) -import Distribution.Simple.Utils (die', equating, warn) +import Distribution.Simple.Errors +import Distribution.Simple.Utils (dieWithException, equating, warn) import Distribution.Verbosity (Verbosity, normal) - -import qualified Data.ByteString as BS -import Data.List (groupBy) import System.Directory (doesFileExist) import Text.Printf (printf) @@ -64,8 +64,8 @@ readAndParseFile readAndParseFile parser verbosity fpath = do exists <- doesFileExist fpath unless exists $ - die' verbosity $ - "Error Parsing: file \"" ++ fpath ++ "\" doesn't exist. Cannot continue." + dieWithException verbosity $ + ErrorParsingFileDoesntExist fpath bs <- BS.readFile fpath parseString parser verbosity fpath bs @@ -85,7 +85,7 @@ parseString parser verbosity name bs = do Right x -> return x Left (_, errors) -> do traverse_ (warn verbosity . showPError name) errors - die' verbosity $ "Failed parsing \"" ++ name ++ "\"." + dieWithException verbosity $ FailedParsing name -- | Collapse duplicate experimental feature warnings into single warning, with -- a count of further sites diff --git a/Cabal/src/Distribution/Simple/PreProcess.hs b/Cabal/src/Distribution/Simple/PreProcess.hs index 2578b2c5129..92c45026a94 100644 --- a/Cabal/src/Distribution/Simple/PreProcess.hs +++ b/Cabal/src/Distribution/Simple/PreProcess.hs @@ -52,10 +52,10 @@ import Distribution.ModuleName (ModuleName) import qualified Distribution.ModuleName as ModuleName import Distribution.Package import Distribution.PackageDescription as PD -import Distribution.Pretty import Distribution.Simple.BuildPaths import Distribution.Simple.CCompiler import Distribution.Simple.Compiler +import Distribution.Simple.Errors import Distribution.Simple.LocalBuildInfo import qualified Distribution.Simple.PackageIndex as PackageIndex import Distribution.Simple.PreProcess.Unlit @@ -68,7 +68,6 @@ import Distribution.Types.PackageName.Magic import Distribution.Utils.Path import Distribution.Verbosity import Distribution.Version - import System.Directory (doesDirectoryExist, doesFileExist) import System.FilePath ( dropExtensions @@ -264,20 +263,14 @@ preprocessComponent pd comp lbi clbi isSrcDist verbosity handlers = writeSimpleTestStub test testDir preProcessTest test (stubFilePath test) testDir TestSuiteUnsupported tt -> - die' verbosity $ - "No support for preprocessing test " - ++ "suite type " - ++ prettyShow tt + dieWithException verbosity $ NoSupportForPreProcessingTest tt CBench bm@Benchmark{benchmarkName = nm} -> do let nm' = unUnqualComponentName nm case benchmarkInterface bm of BenchmarkExeV10 _ f -> preProcessBench bm f $ buildDir lbi nm' nm' ++ "-tmp" BenchmarkUnsupported tt -> - die' verbosity $ - "No support for preprocessing benchmark " - ++ "type " - ++ prettyShow tt + dieWithException verbosity $ NoSupportForPreProcessingBenchmark tt where orderingFromHandlers v d hndlrs mods = foldM (\acc (_, pp) -> ppOrdering pp v d acc) mods hndlrs @@ -374,11 +367,12 @@ preprocessFile searchLoc buildLoc forSDist baseFile verbosity builtinSuffixes ha bsrcFiles <- findFileWithExtension builtinSuffixes (buildLoc : map getSymbolicPath searchLoc) baseFile case (bsrcFiles, failOnMissing) of (Nothing, True) -> - die' verbosity $ - "can't find source for " - ++ baseFile - ++ " in " - ++ intercalate ", " (map getSymbolicPath searchLoc) + dieWithException verbosity $ + CantFindSourceForPreProcessFile $ + "can't find source for " + ++ baseFile + ++ " in " + ++ intercalate ", " (map getSymbolicPath searchLoc) _ -> return () -- found a pre-processable file in one of the source dirs Just (psrcLoc, psrcRelFile) -> do @@ -467,7 +461,7 @@ ppUnlit = , ppOrdering = unsorted , runPreProcessor = mkSimplePreProcessor $ \inFile outFile verbosity -> withUTF8FileContents inFile $ \contents -> - either (writeUTF8File outFile) (die' verbosity) (unlit inFile contents) + either (writeUTF8File outFile) (dieWithException verbosity) (unlit inFile contents) } ppCpp :: BuildInfo -> LocalBuildInfo -> ComponentLocalBuildInfo -> PreProcessor @@ -947,19 +941,14 @@ preprocessExtras verbosity comp lbi = case comp of TestSuiteLibV09 _ _ -> pp $ buildDir lbi stubName test stubName test ++ "-tmp" TestSuiteUnsupported tt -> - die' verbosity $ - "No support for preprocessing test suite type " - ++ prettyShow tt + dieWithException verbosity $ NoSupportPreProcessingTestExtras tt CBench bm -> do let nm' = unUnqualComponentName $ benchmarkName bm case benchmarkInterface bm of BenchmarkExeV10 _ _ -> pp $ buildDir lbi nm' nm' ++ "-tmp" BenchmarkUnsupported tt -> - die' verbosity $ - "No support for preprocessing benchmark " - ++ "type " - ++ prettyShow tt + dieWithException verbosity $ NoSupportPreProcessingBenchmarkExtras tt where pp :: FilePath -> IO [FilePath] pp dir = do diff --git a/Cabal/src/Distribution/Simple/PreProcess/Unlit.hs b/Cabal/src/Distribution/Simple/PreProcess/Unlit.hs index a4a1e6719cd..b4ed0ed41a6 100644 --- a/Cabal/src/Distribution/Simple/PreProcess/Unlit.hs +++ b/Cabal/src/Distribution/Simple/PreProcess/Unlit.hs @@ -15,12 +15,12 @@ -- \"@>@\", \"@\\begin{code}@\", \"@\\end{code}@\", and \"@#@\" module Distribution.Simple.PreProcess.Unlit (unlit, plain) where +import Data.List (mapAccumL) import Distribution.Compat.Prelude +import Distribution.Simple.Errors import Distribution.Utils.Generic (safeInit, safeLast, safeTail) import Prelude () -import Data.List (mapAccumL) - data Classified = BirdTrack String | Blank String @@ -72,7 +72,7 @@ unclassify _ _ = internalError -- | 'unlit' takes a filename (for error reports), and transforms the -- given string, to eliminate the literate comments from the program text. -unlit :: FilePath -> String -> Either String String +unlit :: FilePath -> String -> Either String CabalException unlit file input = let (usesBirdTracks, classified) = classifyAndCheckForBirdTracks @@ -107,7 +107,7 @@ unlit file input = checkErrors ls = case [e | Error e <- ls] of [] -> Left ls - (message : _) -> Right (f ++ ":" ++ show n ++ ": " ++ message) + (message : _) -> Right (UnlitException (f ++ ":" ++ show n ++ ": " ++ message)) where (f, n) = errorPos file 1 ls errorPos f n [] = (f, n) diff --git a/cabal-testsuite/PackageTests/BuildTargetErrors/setup.out b/cabal-testsuite/PackageTests/BuildTargetErrors/setup.out index b34b03f79a2..c36afaf7672 100644 --- a/cabal-testsuite/PackageTests/BuildTargetErrors/setup.out +++ b/cabal-testsuite/PackageTests/BuildTargetErrors/setup.out @@ -1,4 +1,5 @@ # Setup configure Configuring BuildTargetErrors-1.0... # Setup build -Error: setup: Cannot process the executable 'not-buildable-exe' because the component is marked as disabled in the .cabal file. +Error: [Cabal-4733] +Cannot process the executable 'not-buildable-exe' because the component is marked as disabled in the .cabal file. diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.cabal.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.cabal.out index 204d92fb72e..8b37b69536d 100644 --- a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.cabal.out +++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.cabal.out @@ -1,3 +1,4 @@ # Setup configure Configuring SameDirectory-0.1.0.0... -Error: cabal: Version mismatch between ghc and ghc-pkg: /./ghc is version /ghc-pkg is version 9999999 +Error: [Cabal-4000] +Version mismatch between ghc and ghc-pkg: /./ghc is version /ghc-pkg is version 9999999 diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.out index 0f7d458b0b6..8b37b69536d 100644 --- a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.out +++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectory/setup.out @@ -1,3 +1,4 @@ # Setup configure Configuring SameDirectory-0.1.0.0... -Error: setup: Version mismatch between ghc and ghc-pkg: /./ghc is version /ghc-pkg is version 9999999 +Error: [Cabal-4000] +Version mismatch between ghc and ghc-pkg: /./ghc is version /ghc-pkg is version 9999999 diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.cabal.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.cabal.out index 4e65aba3ee3..914986cd6b3 100644 --- a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.cabal.out +++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.cabal.out @@ -1,3 +1,4 @@ # Setup configure Configuring SameDirectory-0.1.0.0... -Error: cabal: Version mismatch between ghc and ghc-pkg: /./ghc-7.10 is version /ghc-pkg-ghc-7.10 is version 9999999 +Error: [Cabal-4000] +Version mismatch between ghc and ghc-pkg: /./ghc-7.10 is version /ghc-pkg-ghc-7.10 is version 9999999 diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.out index 46a7aea4b16..914986cd6b3 100644 --- a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.out +++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryGhcVersion/setup.out @@ -1,3 +1,4 @@ # Setup configure Configuring SameDirectory-0.1.0.0... -Error: setup: Version mismatch between ghc and ghc-pkg: /./ghc-7.10 is version /ghc-pkg-ghc-7.10 is version 9999999 +Error: [Cabal-4000] +Version mismatch between ghc and ghc-pkg: /./ghc-7.10 is version /ghc-pkg-ghc-7.10 is version 9999999 diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.cabal.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.cabal.out index 842c722a71f..a04700e7cea 100644 --- a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.cabal.out +++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.cabal.out @@ -1,3 +1,4 @@ # Setup configure Configuring SameDirectory-0.1.0.0... -Error: cabal: Version mismatch between ghc and ghc-pkg: /./ghc-7.10 is version /ghc-pkg-7.10 is version 9999999 +Error: [Cabal-4000] +Version mismatch between ghc and ghc-pkg: /./ghc-7.10 is version /ghc-pkg-7.10 is version 9999999 diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.out index 287c52eeb3e..a04700e7cea 100644 --- a/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.out +++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SameDirectoryVersion/setup.out @@ -1,3 +1,4 @@ # Setup configure Configuring SameDirectory-0.1.0.0... -Error: setup: Version mismatch between ghc and ghc-pkg: /./ghc-7.10 is version /ghc-pkg-7.10 is version 9999999 +Error: [Cabal-4000] +Version mismatch between ghc and ghc-pkg: /./ghc-7.10 is version /ghc-pkg-7.10 is version 9999999 diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.cabal.out b/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.cabal.out index 52b1e4cbbb4..6bc050fa067 100644 --- a/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.cabal.out +++ b/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.cabal.out @@ -1,3 +1,4 @@ # Setup configure Configuring SameDirectory-0.1.0.0... -Error: cabal: Version mismatch between ghc and ghc-pkg: /./ghc is version /bin/ghc-pkg is version 9999999 +Error: [Cabal-4000] +Version mismatch between ghc and ghc-pkg: /./ghc is version /bin/ghc-pkg is version 9999999 diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.out b/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.out index 2e331c1ddbd..6bc050fa067 100644 --- a/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.out +++ b/cabal-testsuite/PackageTests/GhcPkgGuess/Symlink/setup.out @@ -1,3 +1,4 @@ # Setup configure Configuring SameDirectory-0.1.0.0... -Error: setup: Version mismatch between ghc and ghc-pkg: /./ghc is version /bin/ghc-pkg is version 9999999 +Error: [Cabal-4000] +Version mismatch between ghc and ghc-pkg: /./ghc is version /bin/ghc-pkg is version 9999999 diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.cabal.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.cabal.out index 844e752ff23..2784e5e3001 100644 --- a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.cabal.out +++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.cabal.out @@ -1,3 +1,4 @@ # Setup configure Configuring SameDirectory-0.1.0.0... -Error: cabal: Version mismatch between ghc and ghc-pkg: /./ghc is version /bin/ghc-pkg-7.10 is version 9999999 +Error: [Cabal-4000] +Version mismatch between ghc and ghc-pkg: /./ghc is version /bin/ghc-pkg-7.10 is version 9999999 diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.out index 5b99161b2a8..2784e5e3001 100644 --- a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.out +++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkGhcVersion/setup.out @@ -1,3 +1,4 @@ # Setup configure Configuring SameDirectory-0.1.0.0... -Error: setup: Version mismatch between ghc and ghc-pkg: /./ghc is version /bin/ghc-pkg-7.10 is version 9999999 +Error: [Cabal-4000] +Version mismatch between ghc and ghc-pkg: /./ghc is version /bin/ghc-pkg-7.10 is version 9999999 diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.cabal.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.cabal.out index 5cc2cf79633..ef0d6cb9925 100644 --- a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.cabal.out +++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.cabal.out @@ -1,3 +1,4 @@ # Setup configure Configuring SameDirectory-0.1.0.0... -Error: cabal: Version mismatch between ghc and ghc-pkg: /./ghc is version /bin/ghc-pkg-ghc-7.10 is version 9999999 +Error: [Cabal-4000] +Version mismatch between ghc and ghc-pkg: /./ghc is version /bin/ghc-pkg-ghc-7.10 is version 9999999 diff --git a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.out b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.out index 0cddea7e616..ef0d6cb9925 100644 --- a/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.out +++ b/cabal-testsuite/PackageTests/GhcPkgGuess/SymlinkVersion/setup.out @@ -1,3 +1,4 @@ # Setup configure Configuring SameDirectory-0.1.0.0... -Error: setup: Version mismatch between ghc and ghc-pkg: /./ghc is version /bin/ghc-pkg-ghc-7.10 is version 9999999 +Error: [Cabal-4000] +Version mismatch between ghc and ghc-pkg: /./ghc is version /bin/ghc-pkg-ghc-7.10 is version 9999999