Function exceptionWithMetadata and constructors for each exception …

…type

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

@@ -36,6 +36,7 @@ import Distribution.Types.UnqualComponentName
 
 import System.Directory (doesFileExist)
 import System.FilePath ((<.>), (</>))
+import Distribution.Simple.Errors
 
 -- | Perform the \"@.\/setup bench@\" action.
 bench
@@ -66,11 +67,8 @@ bench args pkg_descr lbi flags = do
             -- Check that the benchmark executable exists.
             exists <- doesFileExist cmd
             unless exists $
-              dieWithException verbosity $ BenchMarkException
-                ( "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
             -- stdout/stderr to the parent process.
@@ -93,9 +91,8 @@ bench args pkg_descr lbi flags = do
     exitSuccess
 
   when (PD.hasBenchmarks pkg_descr && null enabledBenchmarks) $
-    dieWithException verbosity $ BenchMarkException 
-      ("No benchmarks enabled. Did you remember to configure with "
-        ++ "\'--enable-benchmarks\'?")
+    dieWithException verbosity EnableBenchMark 
+
 
   bmsToRun <- case benchmarkNames of
     [] -> return enabledBenchmarks
@@ -107,11 +104,9 @@ bench args pkg_descr lbi flags = do
             Just t -> return t
             _
               | mkUnqualComponentName bmName `elem` allNames ->
-                  dieWithException verbosity $ BenchMarkException 
-                    ("Package configured with benchmark "
-                      ++ bmName
-                      ++ " disabled.")
-              | otherwise -> dieWithException verbosity $ BenchMarkException ("no such benchmark: " ++ bmName)
+                  dieWithException verbosity $ BenchMarkNameDisable bmName
+              | otherwise -> dieWithException verbosity $ NoBenchMark bmName
+
 
   let totalBenchmarks = length bmsToRun
   notice verbosity $ "Running " ++ show totalBenchmarks ++ " benchmarks..."

Cabal/src/Distribution/Simple/Errors.hs

@@ -0,0 +1,61 @@
+-----------------------------------------------------------------------------
+
+-- Module      :  Distribution.Simple.Errors
+-- Copyright   :  
+-- License     :  
+--
+-- Maintainer  :  
+-- Portability :  
+--
+-- A collection of Exception Types used throughout 
+--the rest of the Cabal library package
+
+module Distribution.Simple.Errors
+(
+ CabalException (..)
+ ,exceptionCode
+ ,exceptionMessage
+) where
+
+import Distribution.Compat.Prelude
+import Distribution.Compiler
+import Distribution.Pretty
+  ( prettyShow
+  )
+
+
+-- Types representing exceptions thrown by functions in all the modules of Cabal Package
+data CabalException =  NoBenchMarkProgram FilePath
+                    | EnableBenchMark
+                    | BenchMarkNameDisable String
+                    | NoBenchMark String            
+                    | NoLibraryFound
+                    | CompilerNotInstalled CompilerFlavor
+                    | CantFindIncludeFile String
+                    | SourceDistException String
+ deriving (Show,Typeable)
+
+exceptionCode :: CabalException -> Int
+exceptionCode e = case e of 
+  (NoBenchMarkProgram _)   -> 1678
+  EnableBenchMark          -> 1453
+  (BenchMarkNameDisable _) -> 2781
+  (NoBenchMark _)          -> 1654
+  NoLibraryFound           -> 2546
+  (CompilerNotInstalled _) -> 7465
+  (CantFindIncludeFile _)  -> 3876
+  (SourceDistException _ ) -> 3245
+
+exceptionMessage :: CabalException -> String
+exceptionMessage e = case e of
+    NoBenchMarkProgram cmd          -> "Could not find benchmark program \"" ++ cmd ++ "\". Did you build the package first?"
+    EnableBenchMark                 -> "No benchmarks enabled. Did you remember to configure with " ++ "\'--enable-benchmarks\'?"
+    BenchMarkNameDisable bmName     -> "Package configured with benchmark " ++ bmName ++ " disabled."
+    NoBenchMark bmName              -> "no such benchmark: " ++ bmName
+    NoLibraryFound                  -> "No executables and no library found. Nothing to do."
+    CompilerNotInstalled compilerFlavor -> "installing with " ++ prettyShow compilerFlavor ++ "is not implemented"
+    CantFindIncludeFile file        -> "can't find include file " ++ file
+    (SourceDistException _ )        -> "3245"
+
+
+

Cabal/src/Distribution/Simple/Install.hs

@@ -58,7 +58,6 @@ import Distribution.Simple.Utils
   , isInSearchPath
   , noticeNoWrap
   , warn
-  , CabalException (..)
   )
 import Distribution.Utils.Path (getSymbolicPath)
 
@@ -67,6 +66,7 @@ import qualified Distribution.Simple.GHC as GHC
 import qualified Distribution.Simple.GHCJS as GHCJS
 import qualified Distribution.Simple.HaskellSuite as HaskellSuite
 import qualified Distribution.Simple.UHC as UHC
+import Distribution.Simple.Errors
 
 import System.Directory
   ( doesDirectoryExist
@@ -115,7 +115,8 @@ install pkg_descr lbi flags = do
 
     checkHasLibsOrExes =
       unless (hasLibs pkg_descr || hasForeignLibs pkg_descr || hasExes pkg_descr) $
-        dieWithException verbosity $ InstallException "No executables and no library found. Nothing to do."
+        dieWithException verbosity NoLibraryFound 
+        -- InstallException "No executables and no library found. Nothing to do."
 
 -- | Copy package global files.
 copyPackage
@@ -225,10 +226,12 @@ copyComponent verbosity pkg_descr lbi (CLib lib) clbi copydest = do
         lib
         clbi
     _ ->
-      dieWithException verbosity $ InstallException 
-        ("installing with "
-          ++ prettyShow (compilerFlavor (compiler lbi))
-          ++ " is not implemented")
+      dieWithException verbosity $ CompilerNotInstalled (compilerFlavor (compiler lbi))
+       -- InstallException 
+        -- ("installing with "
+         -- ++ prettyShow (compilerFlavor (compiler lbi))
+         -- ++ " is not implemented")
+
 copyComponent verbosity pkg_descr lbi (CFLib flib) clbi copydest = do
   let InstallDirs
         { flibdir = flibPref
@@ -243,10 +246,11 @@ copyComponent verbosity pkg_descr lbi (CFLib flib) clbi copydest = do
     GHC -> GHC.installFLib verbosity lbi flibPref buildPref pkg_descr flib
     GHCJS -> GHCJS.installFLib verbosity lbi flibPref buildPref pkg_descr flib
     _ ->
-      dieWithException verbosity $ InstallException 
-        ("installing foreign lib with "
-          ++ prettyShow (compilerFlavor (compiler lbi))
-          ++ " is not implemented")
+      dieWithException verbosity $ CompilerNotInstalled (compilerFlavor (compiler lbi))
+       -- ("installing foreign lib with "
+       --   ++ prettyShow (compilerFlavor (compiler lbi))
+       --   ++ " is not implemented")
+
 copyComponent verbosity pkg_descr lbi (CExe exe) clbi copydest = do
   let installDirs = absoluteComponentInstallDirs pkg_descr lbi (componentUnitId clbi) copydest
       -- the installers know how to find the actual location of the
@@ -281,10 +285,10 @@ copyComponent verbosity pkg_descr lbi (CExe exe) clbi copydest = do
     UHC -> return ()
     HaskellSuite{} -> return ()
     _ ->
-      dieWithException verbosity $ InstallException 
-        ("installing with "
-          ++ prettyShow (compilerFlavor (compiler lbi))
-          ++ " is not implemented")
+      dieWithException verbosity $ CompilerNotInstalled (compilerFlavor (compiler lbi))
+       -- ("installing with "
+       --   ++ prettyShow (compilerFlavor (compiler lbi))
+        --  ++ " is not implemented")
 
 -- Nothing to do for benchmark/testsuite
 copyComponent _ _ _ (CBench _) _ _ = return ()
@@ -324,7 +328,8 @@ installIncludeFiles verbosity libBi lbi buildPref destIncludeDir = do
     ]
   where
     baseDir lbi' = fromMaybe "" (takeDirectory <$> cabalFilePath lbi')
-    findInc [] file = dieWithException verbosity $ InstallException ("can't find include file " ++ file)
+    findInc [] file = dieWithException verbosity $ CantFindIncludeFile file
+    -- InstallException ("can't find include file " ++ file)
     findInc (dir : dirs) file = do
       let path = dir </> file
       exists <- doesFileExist path

Cabal/src/Distribution/Simple/SrcDist.hs

@@ -69,6 +69,7 @@ import Data.Time (UTCTime, getCurrentTime, toGregorian, utctDay)
 import System.Directory (doesFileExist)
 import System.FilePath (dropExtension, isRelative, (<.>), (</>))
 import System.IO (IOMode (WriteMode), hPutStrLn, withFile)
+import Distribution.Simple.Errors
 
 -- | Create a source distribution.
 sdist
@@ -165,9 +166,9 @@ listPackageSourcesWithDie
   -- ^ extra preprocessors (include suffixes)
   -> IO [FilePath]
   -- ^ relative paths
-listPackageSourcesWithDie verbosity rip cwd pkg_descr0 pps = do
+listPackageSourcesWithDie verbosity _rip cwd pkg_descr0 pps = do
   -- Call helpers that actually do all work.
-  listPackageSources' verbosity rip cwd pkg_descr pps
+  listPackageSources' verbosity _rip cwd pkg_descr pps
   where
     pkg_descr = filterAutogenModules pkg_descr0
 
@@ -187,7 +188,7 @@ listPackageSources'
   -- ^ extra preprocessors (include suffixes)
   -> IO [FilePath]
   -- ^ relative paths
-listPackageSources' verbosity rip cwd pkg_descr pps =
+listPackageSources' verbosity _rip cwd pkg_descr pps =
   fmap concat . sequenceA $
     [ -- Library sources.
       fmap concat
@@ -197,19 +198,19 @@ listPackageSources' verbosity rip cwd pkg_descr pps =
             , signatures = sigs
             , libBuildInfo = libBi
             } ->
-            allSourcesBuildInfo verbosity rip cwd libBi pps (modules ++ sigs)
+            allSourcesBuildInfo verbosity _rip cwd libBi pps (modules ++ sigs)
     , -- Executables sources.
       fmap concat
         . withAllExe
         $ \Executable{modulePath = mainPath, buildInfo = exeBi} -> do
-          biSrcs <- allSourcesBuildInfo verbosity rip cwd exeBi pps []
+          biSrcs <- allSourcesBuildInfo verbosity _rip cwd exeBi pps []
           mainSrc <- findMainExeFile verbosity cwd exeBi pps mainPath
           return (mainSrc : biSrcs)
     , -- Foreign library sources
       fmap concat
         . withAllFLib
         $ \flib@(ForeignLib{foreignLibBuildInfo = flibBi}) -> do
-          biSrcs <- allSourcesBuildInfo verbosity rip cwd flibBi pps []
+          biSrcs <- allSourcesBuildInfo verbosity _rip cwd flibBi pps []
           defFiles <-
             traverse
               (findModDefFile verbosity cwd flibBi pps)
@@ -222,25 +223,25 @@ listPackageSources' verbosity rip cwd pkg_descr pps =
           let bi = testBuildInfo t
           case testInterface t of
             TestSuiteExeV10 _ mainPath -> do
-              biSrcs <- allSourcesBuildInfo verbosity rip cwd bi pps []
+              biSrcs <- allSourcesBuildInfo verbosity _rip cwd bi pps []
               srcMainFile <- findMainExeFile verbosity cwd bi pps mainPath
               return (srcMainFile : biSrcs)
             TestSuiteLibV09 _ m ->
-              allSourcesBuildInfo verbosity rip cwd bi pps [m]
+              allSourcesBuildInfo verbosity _rip cwd bi pps [m]
             TestSuiteUnsupported tp ->
-              rip verbosity $ "Unsupported test suite type: " ++ show tp
+              dieWithException verbosity $ SourceDistException ("Unsupported test suite type: " ++ show tp)
     , -- Benchmarks sources.
       fmap concat
         . withAllBenchmark
         $ \bm -> do
           let bi = benchmarkBuildInfo bm
           case benchmarkInterface bm of
             BenchmarkExeV10 _ mainPath -> do
-              biSrcs <- allSourcesBuildInfo verbosity rip cwd bi pps []
+              biSrcs <- allSourcesBuildInfo verbosity _rip cwd bi pps []
               srcMainFile <- findMainExeFile verbosity cwd bi pps mainPath
               return (srcMainFile : biSrcs)
             BenchmarkUnsupported tp ->
-              rip verbosity $ "Unsupported benchmark type: " ++ show tp
+              dieWithException verbosity $ SourceDistException ("Unsupported benchmark type: " ++ show tp)
     , -- Data files.
       fmap concat
         . for (dataFiles pkg_descr)
@@ -249,15 +250,15 @@ listPackageSources' verbosity rip cwd pkg_descr pps =
               srcDataDir
                 | null srcDataDirRaw = "."
                 | otherwise = srcDataDirRaw
-          matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd (srcDataDir </> filename)
+          matchDirFileGlobWithDie verbosity _rip (specVersion pkg_descr) cwd (srcDataDir </> filename)
     , -- Extra source files.
       fmap concat . for (extraSrcFiles pkg_descr) $ \fpath ->
-        matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd fpath
+        matchDirFileGlobWithDie verbosity _rip (specVersion pkg_descr) cwd fpath
     , -- Extra doc files.
       fmap concat
         . for (extraDocFiles pkg_descr)
         $ \filename ->
-          matchDirFileGlobWithDie verbosity rip (specVersion pkg_descr) cwd filename
+          matchDirFileGlobWithDie verbosity _rip (specVersion pkg_descr) cwd filename
     , -- License file(s).
       return (map getSymbolicPath $ licenseFiles pkg_descr)
     , -- Install-include files, without autogen-include files
@@ -361,7 +362,7 @@ findModDefFile verbosity cwd flibBi _pps modDefPath =
 -- @f@. Return the name of the file and the full path, or exit with error if
 -- there's no such file.
 findIncludeFile :: Verbosity -> FilePath -> [FilePath] -> String -> IO (String, FilePath)
-findIncludeFile verbosity _ [] f = die' verbosity ("can't find include file " ++ f)
+findIncludeFile verbosity _ [] f = dieWithException verbosity $ SourceDistException ("can't find include file " ++ f)
 findIncludeFile verbosity cwd (d : ds) f = do
   let path = (d </> f)
   b <- doesFileExist (cwd </> path)
@@ -504,7 +505,7 @@ allSourcesBuildInfo
   -> [ModuleName]
   -- ^ Exposed modules
   -> IO [FilePath]
-allSourcesBuildInfo verbosity rip cwd bi pps modules = do
+allSourcesBuildInfo verbosity _rip cwd bi pps modules = do
   let searchDirs = map getSymbolicPath (hsSourceDirs bi)
   sources <-
     fmap concat $
@@ -542,13 +543,13 @@ allSourcesBuildInfo verbosity rip cwd bi pps modules = do
 
     notFound :: ModuleName -> IO [FilePath]
     notFound m =
-      rip verbosity $
-        "Could not find module: "
+      dieWithException verbosity $ SourceDistException
+        ("Could not find module: "
           ++ prettyShow m
           ++ " with any suffix: "
           ++ show suffixes
           ++ ". If the module "
-          ++ "is autogenerated it should be added to 'autogen-modules'."
+          ++ "is autogenerated it should be added to 'autogen-modules'.")
 
 -- | Note: must be called with the CWD set to the directory containing
 -- the '.cabal' file.