Re #5911 Tidy up exceptions in Stack.Coverage

commercialhaskell · Oct 26, 2022 · 2ba986d · 2ba986d
1 parent 20a36eb
commit 2ba986d
Show file tree

Hide file tree

Showing 2 changed files with 26 additions and 30 deletions.
diff --git a/doc/maintainers/stack_errors.md b/doc/maintainers/stack_errors.md
@@ -74,6 +74,8 @@ to take stock of the errors that Stack itself can raise, by reference to the
 
         ~~~haskell
         = NonTestSuiteTarget PackageName
+        | NoTargetsOrTixSpecified
+        | NotLocalPackage PackageName
         ~~~
 
     -   `Stack.Ghci.Ghci.Exception`
@@ -574,24 +576,6 @@ to take stock of the errors that Stack itself can raise, by reference to the
     you think your coverage report should have meaningful results.
     ~~~
 
-*   `Stack.Coverage.generateHpcReportForTargets`:
-
-    ~~~text
-    Error: Expected a local package, but <name> is either an extra-dep or in the
-    snapshot.
-    ~~~
-
-    `throwString`
-
-*   `Stack.Coverage.generateHpcReportForTargets`:
-
-    ~~~text
-    Not generating combined report, because no targets or tix files are
-    specified.
-    ~~~
-
-    `throwString`
-
 *   `Stack.Coverage.readTixOrlog`:
 
     ~~~text

diff --git a/src/Stack/Coverage.hs b/src/Stack/Coverage.hs
@@ -46,14 +46,30 @@ import           RIO.Process
 import           Trace.Hpc.Tix
 import           Web.Browser (openBrowser)
 
-newtype CoverageException = NonTestSuiteTarget PackageName deriving Typeable
+data CoverageException
+    = NonTestSuiteTarget PackageName
+    | NoTargetsOrTixSpecified
+    | NotLocalPackage PackageName
+    deriving (Typeable)
 
-instance Exception CoverageException
 instance Show CoverageException where
-    show (NonTestSuiteTarget name) =
-        "Can't specify anything except test-suites as hpc report targets (" ++
-        packageNameString name ++
-        " is used with a non test-suite target)"
+    show (NonTestSuiteTarget name) = concat
+        [ "Error: Can't specify anything except test-suites as hpc report "
+        , "targets ("
+        , packageNameString name
+        , " is used with a non test-suite target)"
+        ]
+    show NoTargetsOrTixSpecified = concat
+        [ "Error: Not generating combined report, because no targets or tix "
+        , "files are specified."
+        ]
+    show (NotLocalPackage name) = concat
+        [ "Error: Expected a local package, but "
+        , packageNameString name
+        , " is either an extra-dep or in the snapshot."
+        ]
+
+instance Exception CoverageException
 
 -- | Invoked at the beginning of running with "--coverage"
 deleteHpcReports :: HasEnvConfig env => RIO env ()
@@ -235,10 +251,7 @@ generateHpcReportForTargets opts tixFiles targetNames = do
              targets <- view $ envConfigL.to envConfigSourceMap.to smTargets.to smtTargets
              liftM concat $ forM (Map.toList targets) $ \(name, target) ->
                  case target of
-                     TargetAll PTDependency -> throwString $
-                         "Error: Expected a local package, but " ++
-                         packageNameString name ++
-                         " is either an extra-dep or in the snapshot."
+                     TargetAll PTDependency -> throwIO $ NotLocalPackage name
                      TargetComps comps -> do
                          pkgPath <- hpcPkgPath name
                          forM (toList comps) $ \nc ->
@@ -258,8 +271,7 @@ generateHpcReportForTargets opts tixFiles targetNames = do
                                      pure (filter ((".tix" `L.isSuffixOf`) . toFilePath) files)
                              else pure []
     tixPaths <- liftM (\xs -> xs ++ targetTixFiles) $ mapM (resolveFile' . T.unpack) tixFiles
-    when (null tixPaths) $
-        throwString "Not generating combined report, because no targets or tix files are specified."
+    when (null tixPaths) $ throwIO NoTargetsOrTixSpecified
     outputDir <- hpcReportDir
     reportDir <- case hroptsDestDir opts of
         Nothing -> pure (outputDir </> relDirCombined </> relDirCustom)