Clear STAN suggestion

commercialhaskell · Oct 18, 2023 · d1a6b9f · d1a6b9f
1 parent 7daad6b
commit d1a6b9f
Show file tree

Hide file tree

Showing 3 changed files with 12 additions and 2 deletions.
diff --git a/doc/maintainers/stack_errors.md b/doc/maintainers/stack_errors.md
@@ -361,6 +361,7 @@ to take stock of the errors that Stack itself can raise, by reference to the
         [S-3121] | TemplateHaskellNotFoundBug
         [S-6901] | HaddockIndexNotFound
         [S-5452] | ShowBuildErrorBug
+        [S-2696] | CallStackEmptyBug
         ~~~
 
     -   `Stack.Types.Build.BuildPrettyException`

diff --git a/src/Stack/Build/ConstructPlan.hs b/src/Stack/Build/ConstructPlan.hs
@@ -21,6 +21,7 @@ import           Distribution.Types.BuildType ( BuildType (Configure) )
 import           Distribution.Types.PackageName ( mkPackageName )
 import           Generics.Deriving.Monoid ( memptydefault, mappenddefault )
 import           Path ( parent )
+import qualified RIO.NonEmpty as NE
 import           RIO.Process ( HasProcessContext (..), findExecutable )
 import           RIO.State ( State, execState )
 import           Stack.Build.Cache ( tryGetFlagCache )
@@ -79,6 +80,7 @@ import           Stack.Types.SourceMap
 import           Stack.Types.Version
                    ( latestApplicableVersion, versionRangeText, withinRange )
 import           System.Environment ( lookupEnv )
+import Data.List.NonEmpty (nonEmpty)
 
 data PackageInfo
   = PIOnlyInstalled InstallLocation Installed
@@ -619,13 +621,17 @@ addDep name packageInfo = do
               Nothing -> do
                 -- This could happen for GHC boot libraries missing from
                 -- Hackage.
-                cs <- asks (L.tail . callStack)
+                cs <- asks (nonEmpty . callStack)
+                cs' <- maybe
+                  (throwIO CallStackEmptyBug)
+                  (pure . NE.tail)
+                  cs
                 prettyWarnL
                   $ flow "No latest package revision found for"
                   : style Current (fromString $ packageNameString name) <> ","
                   : flow "dependency callstack:"
                   : mkNarrativeList Nothing False
-                      (map (fromString . packageNameString) cs :: [StyleDoc])
+                      (map (fromString . packageNameString) cs' :: [StyleDoc])
                 pure Nothing
               Just (_rev, cfKey, treeKey) ->
                 pure $ Just $

diff --git a/src/Stack/Types/Build/Exception.hs b/src/Stack/Types/Build/Exception.hs
@@ -81,6 +81,7 @@ data BuildException
   | TemplateHaskellNotFoundBug
   | HaddockIndexNotFound
   | ShowBuildErrorBug
+  | CallStackEmptyBug
   deriving (Show, Typeable)
 
 instance Exception BuildException where
@@ -251,6 +252,8 @@ instance Exception BuildException where
     ++ "No local or snapshot doc index found to open."
   displayException ShowBuildErrorBug = bugReport "[S-5452]"
     "Unexpected case in showBuildError."
+  displayException CallStackEmptyBug = bugReport "[S-2696]"
+    "addDep: call stack is empty."
 
 data BuildPrettyException
   = ConstructPlanFailed