Cabal Error Refactor

Cabal/Cabal.cabal

@@ -98,6 +98,7 @@ library
     Distribution.Simple.Command
     Distribution.Simple.Compiler
     Distribution.Simple.Configure
+    Distribution.Simple.Errors
     Distribution.Simple.Flag
     Distribution.Simple.GHC
     Distribution.Simple.GHCJS

Cabal/src/Distribution/Simple/Bench.hs

@@ -31,8 +31,10 @@ import qualified Distribution.Simple.LocalBuildInfo as LBI
 import Distribution.Simple.Setup.Benchmark
 import Distribution.Simple.UserHooks
 import Distribution.Simple.Utils
+
 import Distribution.Types.UnqualComponentName
 
+import Distribution.Simple.Errors
 import System.Directory (doesFileExist)
 import System.FilePath ((<.>), (</>))
 
@@ -65,10 +67,8 @@ bench args pkg_descr lbi flags = do
             -- Check that the benchmark executable exists.
             exists <- doesFileExist cmd
             unless exists $
-              die' verbosity $
-                "Could not find benchmark program \""
-                  ++ cmd
-                  ++ "\". Did you build the package first?"
+              dieWithException verbosity $
+                NoBenchMarkProgram cmd
 
             notice verbosity $ startMessage name
             -- This will redirect the child process
@@ -92,9 +92,7 @@ bench args pkg_descr lbi flags = do
     exitSuccess
 
   when (PD.hasBenchmarks pkg_descr && null enabledBenchmarks) $
-    die' verbosity $
-      "No benchmarks enabled. Did you remember to configure with "
-        ++ "\'--enable-benchmarks\'?"
+    dieWithException verbosity EnableBenchMark
 
   bmsToRun <- case benchmarkNames of
     [] -> return enabledBenchmarks
@@ -106,11 +104,8 @@ bench args pkg_descr lbi flags = do
             Just t -> return t
             _
               | mkUnqualComponentName bmName `elem` allNames ->
-                  die' verbosity $
-                    "Package configured with benchmark "
-                      ++ bmName
-                      ++ " disabled."
-              | otherwise -> die' verbosity $ "no such benchmark: " ++ bmName
+                  dieWithException verbosity $ BenchMarkNameDisabled bmName
+              | otherwise -> dieWithException verbosity $ NoBenchMark bmName
 
   let totalBenchmarks = length bmsToRun
   notice verbosity $ "Running " ++ show totalBenchmarks ++ " benchmarks..."

Cabal/src/Distribution/Simple/Build.hs

@@ -93,6 +93,7 @@ import Distribution.Compat.Graph (IsNode (..))
 
 import Control.Monad
 import qualified Data.ByteString.Lazy as LBS
+import Distribution.Simple.Errors
 import System.Directory (doesFileExist, getCurrentDirectory, removeFile)
 import System.FilePath (takeDirectory, (<.>), (</>))
 
@@ -198,9 +199,7 @@ dumpBuildInfo verbosity distPref dumpBuildInfoFlag pkg_descr lbi flags = do
 
     (compilerProg, _) <- case flavorToProgram (compilerFlavor (compiler lbi)) of
       Nothing ->
-        die' verbosity $
-          "dumpBuildInfo: Unknown compiler flavor: "
-            ++ show (compilerFlavor (compiler lbi))
+        dieWithException verbosity $ UnknownCompilerFlavor (compilerFlavor (compiler lbi))
       Just program -> requireProgram verbosity program (withPrograms lbi)
 
     let (warns, json) = mkBuildInfo pwd pkg_descr lbi flags (compilerProg, compiler lbi) activeTargets
@@ -248,9 +247,9 @@ repl pkg_descr lbi flags suffixes args = do
       -- This seems DEEPLY questionable.
       [] -> case allTargetsInBuildOrder' pkg_descr lbi of
         (target : _) -> return target
-        [] -> die' verbosity $ "Failed to determine target."
+        [] -> dieWithException verbosity $ FailedToDetermineTarget
       [target] -> return target
-      _ -> die' verbosity $ "The 'repl' command does not support multiple targets at once."
+      _ -> dieWithException verbosity $ NoMultipleTargets
   let componentsToBuild = neededTargetsInBuildOrder' pkg_descr lbi [nodeKey target]
   debug verbosity $
     "Component build order: "
@@ -313,7 +312,7 @@ startInterpreter verbosity programDb comp platform packageDBs =
   case compilerFlavor comp of
     GHC -> GHC.startInterpreter verbosity programDb comp platform packageDBs
     GHCJS -> GHCJS.startInterpreter verbosity programDb comp platform packageDBs
-    _ -> die' verbosity "A REPL is not supported with this compiler."
+    _ -> dieWithException verbosity REPLNotSupported
 
 buildComponent
   :: Verbosity
@@ -512,7 +511,7 @@ buildComponent
   (CTest TestSuite{testInterface = TestSuiteUnsupported tt})
   _
   _ =
-    die' verbosity $ "No support for building test suite type " ++ prettyShow tt
+    dieWithException verbosity $ NoSupportBuildingTestSuite tt
 buildComponent
   verbosity
   numJobs
@@ -544,7 +543,7 @@ buildComponent
   (CBench Benchmark{benchmarkInterface = BenchmarkUnsupported tt})
   _
   _ =
-    die' verbosity $ "No support for building benchmark type " ++ prettyShow tt
+    dieWithException verbosity $ NoSupportBuildingBenchMark tt
 
 generateCode
   :: [String]
@@ -717,7 +716,7 @@ replComponent
   (CTest TestSuite{testInterface = TestSuiteUnsupported tt})
   _
   _ =
-    die' verbosity $ "No support for building test suite type " ++ prettyShow tt
+    dieWithException verbosity $ NoSupportBuildingTestSuite tt
 replComponent
   replFlags
   verbosity
@@ -742,7 +741,7 @@ replComponent
   (CBench Benchmark{benchmarkInterface = BenchmarkUnsupported tt})
   _
   _ =
-    die' verbosity $ "No support for building benchmark type " ++ prettyShow tt
+    dieWithException verbosity $ NoSupportBuildingBenchMark tt
 
 ----------------------------------------------------
 -- Shared code for buildComponent and replComponent
@@ -938,7 +937,7 @@ buildLib verbosity numJobs pkg_descr lbi lib clbi =
     GHCJS -> GHCJS.buildLib verbosity numJobs pkg_descr lbi lib clbi
     UHC -> UHC.buildLib verbosity pkg_descr lbi lib clbi
     HaskellSuite{} -> HaskellSuite.buildLib verbosity pkg_descr lbi lib clbi
-    _ -> die' verbosity "Building is not supported with this compiler."
+    _ -> dieWithException verbosity BuildingNotSupportedWithCompiler
 
 -- | Build a foreign library
 --
@@ -955,7 +954,7 @@ buildFLib
 buildFLib verbosity numJobs pkg_descr lbi flib clbi =
   case compilerFlavor (compiler lbi) of
     GHC -> GHC.buildFLib verbosity numJobs pkg_descr lbi flib clbi
-    _ -> die' verbosity "Building is not supported with this compiler."
+    _ -> dieWithException verbosity BuildingNotSupportedWithCompiler
 
 buildExe
   :: Verbosity
@@ -970,7 +969,7 @@ buildExe verbosity numJobs pkg_descr lbi exe clbi =
     GHC -> GHC.buildExe verbosity numJobs pkg_descr lbi exe clbi
     GHCJS -> GHCJS.buildExe verbosity numJobs pkg_descr lbi exe clbi
     UHC -> UHC.buildExe verbosity pkg_descr lbi exe clbi
-    _ -> die' verbosity "Building is not supported with this compiler."
+    _ -> dieWithException verbosity BuildingNotSupportedWithCompiler
 
 replLib
   :: ReplOptions
@@ -986,7 +985,7 @@ replLib replFlags verbosity pkg_descr lbi lib clbi =
     -- NoFlag as the numJobs parameter.
     GHC -> GHC.replLib replFlags verbosity NoFlag pkg_descr lbi lib clbi
     GHCJS -> GHCJS.replLib (replOptionsFlags replFlags) verbosity NoFlag pkg_descr lbi lib clbi
-    _ -> die' verbosity "A REPL is not supported for this compiler."
+    _ -> dieWithException verbosity REPLNotSupported
 
 replExe
   :: ReplOptions
@@ -1000,7 +999,7 @@ replExe replFlags verbosity pkg_descr lbi exe clbi =
   case compilerFlavor (compiler lbi) of
     GHC -> GHC.replExe replFlags verbosity NoFlag pkg_descr lbi exe clbi
     GHCJS -> GHCJS.replExe (replOptionsFlags replFlags) verbosity NoFlag pkg_descr lbi exe clbi
-    _ -> die' verbosity "A REPL is not supported for this compiler."
+    _ -> dieWithException verbosity REPLNotSupported
 
 replFLib
   :: ReplOptions
@@ -1013,7 +1012,7 @@ replFLib
 replFLib replFlags verbosity pkg_descr lbi exe clbi =
   case compilerFlavor (compiler lbi) of
     GHC -> GHC.replFLib replFlags verbosity NoFlag pkg_descr lbi exe clbi
-    _ -> die' verbosity "A REPL is not supported for this compiler."
+    _ -> dieWithException verbosity REPLNotSupported
 
 -- | Runs 'componentInitialBuildSteps' on every configured component.
 initialBuildSteps

Cabal/src/Distribution/Simple/BuildPaths.hs

@@ -50,20 +50,20 @@ module Distribution.Simple.BuildPaths
 import Distribution.Compat.Prelude
 import Prelude ()
 
+import Data.List (stripPrefix)
 import Distribution.Compiler
 import Distribution.ModuleName as ModuleName
 import Distribution.Package
 import Distribution.PackageDescription
 import Distribution.Pretty
+import Distribution.Simple.Errors
 import Distribution.Simple.LocalBuildInfo
 import Distribution.Simple.Setup.Common (defaultDistPref)
 import Distribution.Simple.Setup.Haddock (HaddockTarget (..))
 import Distribution.Simple.Utils
 import Distribution.System
 import Distribution.Utils.Path
 import Distribution.Verbosity
-
-import Data.List (stripPrefix)
 import System.FilePath (normalise, (<.>), (</>))
 
 -- ---------------------------------------------------------------------------
@@ -192,7 +192,8 @@ getSourceFiles verbosity dirs modules = flip traverse modules $ \m ->
     findFileWithExtension ["hs", "lhs", "hsig", "lhsig"] dirs (ModuleName.toFilePath m)
       >>= maybe (notFound m) (return . normalise)
   where
-    notFound module_ = die' verbosity $ "can't find source for module " ++ prettyShow module_
+    notFound module_ =
+      dieWithException verbosity $ CantFindSourceModule module_
 
 -- | The directory where we put build results for an executable
 exeBuildDir :: LocalBuildInfo -> Executable -> FilePath