feat: add a bunch of HasCallStack

andreabedini · andreabedini · commit 6ba2c92bf4c4 · 2025-08-07T12:50:14.000+08:00
diff --git a/Cabal-syntax/src/Distribution/Compat/Graph.hs b/Cabal-syntax/src/Distribution/Compat/Graph.hs
@@ -104,6 +104,7 @@ import qualified Data.Map.Strict as Map
 import qualified Data.Set as Set
 import qualified Data.Tree as Tree
 import qualified Distribution.Compat.Prelude as Prelude
+import GHC.Stack (HasCallStack)
 
 -- | A graph of nodes @a@.  The nodes are expected to have instance
 -- of class 'IsNode'.
@@ -377,7 +378,7 @@ fromMap m =
     bounds = (0, Map.size m - 1)
 
 -- | /O(V log V)/. Convert a list of nodes (with distinct keys) into a graph.
-fromDistinctList :: (IsNode a, Show (Key a)) => [a] -> Graph a
+fromDistinctList :: HasCallStack => (IsNode a, Show (Key a)) => [a] -> Graph a
 fromDistinctList =
   fromMap
     . Map.fromListWith (\_ -> duplicateError)
diff --git a/Cabal/src/Distribution/Backpack/ComponentsGraph.hs b/Cabal/src/Distribution/Backpack/ComponentsGraph.hs
@@ -23,6 +23,7 @@ import Distribution.Utils.Generic
 
 import Distribution.Pretty (pretty)
 import Text.PrettyPrint
+import GHC.Stack (HasCallStack)
 
 ------------------------------------------------------------------------------
 -- Components graph
@@ -50,7 +51,8 @@ dispComponentsWithDeps graph =
 -- | Create a 'Graph' of 'Component', or report a cycle if there is a
 -- problem.
 mkComponentsGraph
-  :: ComponentRequestedSpec
+  :: HasCallStack
+  => ComponentRequestedSpec
   -> PackageDescription
   -> Either [ComponentName] ComponentsGraph
 mkComponentsGraph enabled pkg_descr =
diff --git a/Cabal/src/Distribution/Backpack/Configure.hs b/Cabal/src/Distribution/Backpack/Configure.hs
@@ -55,13 +55,15 @@ import qualified Data.Map as Map
 import qualified Data.Set as Set
 import Distribution.Pretty
 import Text.PrettyPrint
+import GHC.Stack (HasCallStack)
 
 ------------------------------------------------------------------------------
 -- Pipeline
 ------------------------------------------------------------------------------
 
 configureComponentLocalBuildInfos
-  :: Verbosity
+  :: HasCallStack
+  => Verbosity
   -> Bool -- use_external_internal_deps
   -> ComponentRequestedSpec
   -> Bool -- deterministic
@@ -206,7 +208,8 @@ configureComponentLocalBuildInfos
 ------------------------------------------------------------------------------
 
 toComponentLocalBuildInfos
-  :: Compiler
+  :: HasCallStack
+  => Compiler
   -> InstalledPackageIndex -- FULL set
   -> [ConfiguredPromisedComponent]
   -> PackageDescription
@@ -232,12 +235,12 @@ toComponentLocalBuildInfos
       -- since we will pay for the ALL installed packages even if
       -- they are not related to what we are building.  This was true
       -- in the old configure code.
-      external_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
+      external_graph :: HasCallStack => Graph (Either InstalledPackageInfo ReadyComponent)
       external_graph =
         Graph.fromDistinctList
           . map Left
           $ PackageIndex.allPackages installedPackageSet
-      internal_graph :: Graph (Either InstalledPackageInfo ReadyComponent)
+      internal_graph :: HasCallStack => Graph (Either InstalledPackageInfo ReadyComponent)
       internal_graph =
         Graph.fromDistinctList
           . map Right
diff --git a/Cabal/src/Distribution/Simple/Configure.hs b/Cabal/src/Distribution/Simple/Configure.hs
@@ -183,6 +183,7 @@ import Text.PrettyPrint
 import qualified Data.Maybe as M
 import qualified Data.Set as Set
 import qualified Distribution.Compat.NonEmptySet as NES
+import GHC.Stack (HasCallStack)
 
 type UseExternalInternalDeps = Bool
 
@@ -1208,7 +1209,8 @@ finalCheckPackage
         enabled
 
 configureComponents
-  :: LBC.LocalBuildConfig
+  :: HasCallStack
+  => LBC.LocalBuildConfig
   -> LBC.PackageBuildDescr
   -> PackageInfo
   -> ([PreExistingComponent], [ConfiguredPromisedComponent])
diff --git a/Cabal/src/Distribution/Types/LocalBuildInfo.hs b/Cabal/src/Distribution/Types/LocalBuildInfo.hs
@@ -132,6 +132,7 @@ import Distribution.Compat.Graph (Graph)
 import qualified Distribution.Compat.Graph as Graph
 
 import qualified System.FilePath as FilePath (takeDirectory)
+import GHC.Stack (HasCallStack)
 
 -- | Data cached after configuration step.  See also
 -- 'Distribution.Simple.Setup.ConfigFlags'.
@@ -415,7 +416,7 @@ withAllTargetsInBuildOrder' pkg_descr lbi f =
 -- the order they need to be built.
 -- Has a prime because it takes a 'PackageDescription' argument
 -- which may disagree with 'localPkgDescr' in 'LocalBuildInfo'.
-neededTargetsInBuildOrder' :: PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
+neededTargetsInBuildOrder' :: HasCallStack => PackageDescription -> LocalBuildInfo -> [UnitId] -> [TargetInfo]
 neededTargetsInBuildOrder' pkg_descr lbi@(LocalBuildInfo{componentGraph = compsGraph}) uids =
   case Graph.closure compsGraph uids of
     Nothing -> error $ "localBuildPlan: missing uids " ++ intercalate ", " (map prettyShow uids)
diff --git a/cabal-install-solver/src/Distribution/Solver/Modular/Cycles.hs b/cabal-install-solver/src/Distribution/Solver/Modular/Cycles.hs
@@ -15,6 +15,7 @@ import Distribution.Solver.Modular.Tree
 import qualified Distribution.Solver.Modular.ConflictSet as CS
 import Distribution.Solver.Types.ComponentDeps (Component)
 import Distribution.Solver.Types.PackagePath
+import GHC.Stack (HasCallStack)
 
 -- | Find and reject any nodes with cyclic dependencies
 detectCyclesPhase :: Tree d c -> Tree d c
@@ -51,7 +52,7 @@ detectCyclesPhase = go
 -- all decisions that could potentially break the cycle.
 --
 -- TODO: The conflict set should also contain flag and stanza variables.
-findCycles :: QPN -> RevDepMap -> Maybe ConflictSet
+findCycles :: HasCallStack => QPN -> RevDepMap -> Maybe ConflictSet
 findCycles pkg rdm =
     -- This function has two parts: a faster cycle check that is called at every
     -- step and a slower calculation of the conflict set.
@@ -115,6 +116,6 @@ instance G.IsNode RevDepMapNode where
   nodeKey (RevDepMapNode qpn _) = qpn
   nodeNeighbors (RevDepMapNode _ ns) = ordNub $ map snd ns
 
-revDepMapToGraph :: RevDepMap -> G.Graph RevDepMapNode
+revDepMapToGraph :: HasCallStack => RevDepMap -> G.Graph RevDepMapNode
 revDepMapToGraph rdm = G.fromDistinctList
                        [RevDepMapNode qpn ns | (qpn, ns) <- M.toList rdm]
diff --git a/cabal-install/src/Distribution/Client/Dependency.hs b/cabal-install/src/Distribution/Client/Dependency.hs
@@ -175,6 +175,7 @@ import Data.List
 import qualified Data.Map as Map
 import qualified Data.Set as Set
 import Text.PrettyPrint
+import GHC.Stack (HasCallStack)
 
 -- ------------------------------------------------------------
 
@@ -907,7 +908,8 @@ interpretPackagesPreference selected defaultPref prefs =
 -- | Make an install plan from the output of the dep resolver.
 -- It checks that the plan is valid, or it's an error in the dep resolver.
 validateSolverResult
-  :: Staged (CompilerInfo, Platform)
+  :: HasCallStack
+  => Staged (CompilerInfo, Platform)
   -> [ResolverPackage UnresolvedPkgLoc]
   -> Progress String String SolverInstallPlan
 validateSolverResult toolchains pkgs =
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs b/cabal-install/src/Distribution/Client/ProjectPlanOutput.hs
@@ -76,6 +76,7 @@ import System.FilePath
 import System.IO
 
 import Distribution.Simple.Program.GHC (packageDbArgsDb)
+import GHC.Stack (HasCallStack)
 
 -----------------------------------------------------------------------------
 -- Writing plan.json files
@@ -528,7 +529,8 @@ data PostBuildProjectStatus = PostBuildProjectStatus
 
 -- | Work out which packages are out of date or invalid after a build.
 postBuildProjectStatus
-  :: ElaboratedInstallPlan
+  :: HasCallStack 
+  => ElaboratedInstallPlan
   -> PackagesUpToDate
   -> BuildStatusMap
   -> BuildOutcomes
@@ -625,7 +627,7 @@ postBuildProjectStatus
               )
 
       -- The plan graph but only counting dependency-on-library edges
-      packagesLibDepGraph :: Graph (Node UnitId ElaboratedPlanPackage)
+      packagesLibDepGraph :: HasCallStack => Graph (Node UnitId ElaboratedPlanPackage)
       packagesLibDepGraph =
         Graph.fromDistinctList
           [ Graph.N pkg (installedUnitId pkg) libdeps
diff --git a/cabal-install/src/Distribution/Client/ProjectPlanning.hs b/cabal-install/src/Distribution/Client/ProjectPlanning.hs
@@ -236,6 +236,7 @@ import Distribution.Solver.Types.ProjectConfigPath
 import System.Directory (getCurrentDirectory)
 import System.FilePath
 import qualified Text.PrettyPrint as Disp
+import GHC.Stack (HasCallStack)
 
 -- | Check that an 'ElaboratedConfiguredPackage' actually makes
 -- sense under some 'ElaboratedSharedConfig'.
@@ -1693,7 +1694,8 @@ elaborateInstallPlan
       -- NB: We don't INSTANTIATE packages at this point.  That's
       -- a post-pass.  This makes it simpler to compute dependencies.
       elaborateSolverToComponents
-        :: (SolverId -> [ElaboratedPlanPackage])
+        :: HasCallStack
+        => (SolverId -> [ElaboratedPlanPackage])
         -> SolverPackage UnresolvedPkgLoc
         -> LogProgress [ElaboratedConfiguredPackage]
       elaborateSolverToComponents mapDep spkg@(SolverPackage _ _ _ _ _ deps0 exe_deps0) =
@@ -1830,7 +1832,8 @@ elaborateInstallPlan
                     ++ " not implemented yet"
 
           buildComponent
-            :: ( ConfiguredComponentMap
+            :: HasCallStack
+            => ( ConfiguredComponentMap
                , LinkedComponentMap
                , Map ComponentId FilePath
                )
@@ -2766,7 +2769,8 @@ extractElabBuildStyle _ = BuildAndInstall
 --    we don't instantiate the same thing multiple times.
 --
 instantiateInstallPlan
-  :: StoreDirLayout
+  :: HasCallStack
+  => StoreDirLayout
   -> Staged InstallDirs.InstallDirTemplates
   -> ElaboratedSharedConfig
   -> ElaboratedInstallPlan
@@ -3297,7 +3301,8 @@ data TargetAction
 -- will prune differently depending on what is already installed (to
 -- implement "sticky" test suite enabling behavior).
 pruneInstallPlanToTargets
-  :: TargetAction
+  :: HasCallStack
+  => TargetAction
   -> Map UnitId [ComponentTarget]
   -> ElaboratedInstallPlan
   -> ElaboratedInstallPlan
@@ -3393,7 +3398,8 @@ setRootTargets targetAction perPkgTargetsMap =
 --   are used only by unneeded optional stanzas. These pruned deps are only
 --   used for the dependency closure and are not persisted in this pass.
 pruneInstallPlanPass1
-  :: [ElaboratedPlanPackage]
+  :: HasCallStack
+  => [ElaboratedPlanPackage]
   -> [ElaboratedPlanPackage]
 pruneInstallPlanPass1 pkgs
   -- if there are repl targets, we need to do a bit more work
@@ -3753,7 +3759,8 @@ mapConfiguredPackage _ (InstallPlan.PreExisting pkg) =
 --
 -- This is not always possible.
 pruneInstallPlanToDependencies
-  :: Set UnitId
+  :: HasCallStack
+  => Set UnitId
   -> ElaboratedInstallPlan
   -> Either
       CannotPruneDependencies
diff --git a/cabal-install/src/Distribution/Client/SolverInstallPlan.hs b/cabal-install/src/Distribution/Client/SolverInstallPlan.hs
@@ -76,6 +76,7 @@ import qualified Data.Graph as OldGraph
 import qualified Data.Map as Map
 import Distribution.Compat.Graph (Graph, IsNode (..))
 import qualified Distribution.Compat.Graph as Graph
+import GHC.Stack (HasCallStack)
 
 type SolverPlanPackage = ResolverPackage UnresolvedPkgLoc
 
@@ -153,7 +154,8 @@ toMap = Graph.toMap . planIndex
 -- the dependencies of a package or set of packages without actually
 -- installing the package itself, as when doing development.
 remove
-  :: (SolverPlanPackage -> Bool)
+  :: HasCallStack
+  => (SolverPlanPackage -> Bool)
   -> SolverInstallPlan
   -> Either
       [SolverPlanProblem]
