From 38bac14395147848cb61e024d6578c3e8d6129d6 Mon Sep 17 00:00:00 2001
From: Mike Pilgrem <mpilgrem@users.noreply.github.com>
Date: Sat, 7 Sep 2024 21:01:44 +0100
Subject: [PATCH] Re #6643 Introduce `ActionNoFilteredBug`

---
 doc/maintainers/stack_errors.md    |  3 ++-
 src/Stack/Build/ExecutePackage.hs  | 22 ++--------------------
 src/Stack/Types/Build/Exception.hs |  7 +++++++
 3 files changed, 11 insertions(+), 21 deletions(-)

diff --git a/doc/maintainers/stack_errors.md b/doc/maintainers/stack_errors.md
index 976eadbfb1..7f0d541811 100644
--- a/doc/maintainers/stack_errors.md
+++ b/doc/maintainers/stack_errors.md
@@ -5,7 +5,7 @@
 In connection with considering Stack's support of the
 [Haskell Error Index](https://errors.haskell.org/) initiative, this page seeks
 to take stock of the errors that Stack itself can raise, by reference to the
-`master` branch of the Stack repository. Last updated: 2024-08-02.
+`master` branch of the Stack repository. Last updated: 2024-09-07.
 
 *   `Stack.main`: catches exceptions from action `commandLineHandler`.
 
@@ -385,6 +385,7 @@ to take stock of the errors that Stack itself can raise, by reference to the
         [S-8100] | GHCProfOptionInvalid
         [S-1727] | NotOnlyLocal [PackageName] [Text]
         [S-6362] | CompilerVersionMismatch (Maybe (ActualCompiler, Arch)) (WantedCompiler, Arch) GHCVariant CompilerBuild VersionCheck WantedCompilerSetter Text
+        [S-4660] | ActionNotFilteredBug StyleDoc
         ~~~
 
     -   `Stack.Types.Compiler.CompilerException`
diff --git a/src/Stack/Build/ExecutePackage.hs b/src/Stack/Build/ExecutePackage.hs
index 0ab79dc14d..4a1a7a9111 100644
--- a/src/Stack/Build/ExecutePackage.hs
+++ b/src/Stack/Build/ExecutePackage.hs
@@ -996,15 +996,7 @@ singleTest topts testsToRun ac ee task installedMap = do
                       announce "rerunning previously failed test"
                       pure True
                 TSUnknown -> pure True
-          else do
-            -- This should never be reached, because the action should have been
-            -- filtered out in Stack.Build.Execute.toActions. However, we leave
-            -- it as is, for now. The alternative would be to throw a Stack bug.
-            notifyIfNoRunTests <- view $ configL . to (.notifyIfNoRunTests)
-            when notifyIfNoRunTests $
-              announce "Test running disabled by --no-run-tests flag."
-            pure False
-
+          else prettyThrowM $ ActionNotFilteredBug "singleTest"
       when toRun $ do
         buildDir <- distDirFromDir pkgDir
         hpcDir <- hpcDirFromDir pkgDir
@@ -1265,20 +1257,10 @@ singleBench beopts benchesToRun ac ee task installedMap = do
       let args = map unqualCompToString benchesToRun <> maybe []
                        ((:[]) . ("--benchmark-options=" <>))
                        beopts.additionalArgs
-
       toRun <-
         if beopts.runBenchmarks
           then pure True
-          else do
-            -- This should never be reached, because the action should have been
-            -- filtered out in Stack.Build.Execute.toActions. However, we leave
-            -- it as is, for now. The alternative would be to throw a Stack bug.
-            notifyIfNoRunBenchmarks <-
-              view $ configL . to (.notifyIfNoRunBenchmarks)
-            when notifyIfNoRunBenchmarks $
-              announce "Benchmark running disabled by --no-run-benchmarks flag."
-            pure False
-
+          else prettyThrowM $ ActionNotFilteredBug "singleBench"
       when toRun $ do
         announce "benchmarks"
         cabal CloseOnException KeepTHLoading ("bench" : args)
diff --git a/src/Stack/Types/Build/Exception.hs b/src/Stack/Types/Build/Exception.hs
index b24909459d..eb230835d7 100644
--- a/src/Stack/Types/Build/Exception.hs
+++ b/src/Stack/Types/Build/Exception.hs
@@ -261,6 +261,7 @@ data BuildPrettyException
       VersionCheck
       WantedCompilerSetter -- Way that the wanted compiler is set
       StyleDoc -- recommended resolution
+  | ActionNotFilteredBug StyleDoc
   deriving (Show, Typeable)
 
 instance Pretty BuildPrettyException where
@@ -450,6 +451,12 @@ instance Pretty BuildPrettyException where
          ]
     <> blankLine
     <> resolution
+  pretty (ActionNotFilteredBug source) = bugPrettyReport "S-4660" $
+    fillSep
+      [ source
+      , flow "is seeking to run an action that should have been filtered from \
+             \the list of actions."
+      ]
 
 instance Exception BuildPrettyException