add a bunch of HasCallStack

Author: andreabedini

Cabal-syntax/src/Distribution/Compat/Graph.hs

@@ -106,6 +106,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'.
@@ -379,7 +380,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)

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 =

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
@@ -204,7 +206,8 @@ configureComponentLocalBuildInfos
 ------------------------------------------------------------------------------
 
 toComponentLocalBuildInfos
-  :: Compiler
+  :: HasCallStack
+  => Compiler
   -> InstalledPackageIndex -- FULL set
   -> [ConfiguredPromisedComponent]
   -> PackageDescription
@@ -230,12 +233,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

Cabal/src/Distribution/Simple/Configure.hs

@@ -182,6 +182,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
 
@@ -1207,7 +1208,8 @@ finalCheckPackage
         enabled
 
 configureComponents
-  :: LBC.LocalBuildConfig
+  :: HasCallStack
+  => LBC.LocalBuildConfig
   -> LBC.PackageBuildDescr
   -> PackageInfo
   -> ([PreExistingComponent], [ConfiguredPromisedComponent])

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)

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]

cabal-install/src/Distribution/Client/Dependency.hs

@@ -167,6 +167,7 @@ import qualified Data.Map as Map
 import qualified Data.Set as Set
 import Text.PrettyPrint hiding ((<>))
 import Data.Maybe (fromJust)
+import GHC.Stack (HasCallStack)
 
 -- ------------------------------------------------------------
 
@@ -835,7 +836,7 @@ resolveDependencies toolchains pkgConfigDB installedPkgIndex params = do
     preferences :: PackageName -> PackagePreferences
     preferences = interpretPackagesPreference targets defpref prefs
 
-dumpResolverPackageIndex :: [ResolverPackage UnresolvedPkgLoc] -> Doc
+dumpResolverPackageIndex :: HasCallStack => [ResolverPackage UnresolvedPkgLoc] -> Doc
 dumpResolverPackageIndex pkgs =
   vcat
   [
@@ -1010,7 +1011,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 =

cabal-install/src/Distribution/Client/InstallPlan.hs

@@ -588,6 +588,7 @@ fromSolverInstallPlan f plan =
     (\mapDep planpkg -> return $ f mapDep planpkg)
     plan
 
+
 fromSolverInstallPlanWithProgress
   :: HasCallStack
   => ( IsNode ipkg, Key ipkg ~ key

cabal-install/src/Distribution/Client/ProjectPlanOutput.hs

@@ -73,6 +73,7 @@ import System.FilePath
 import System.IO
 
 import Distribution.Simple.Program.GHC (packageDbArgsDb)
+import GHC.Stack (HasCallStack)
 
 -----------------------------------------------------------------------------
 -- Writing plan.json files
@@ -524,7 +525,8 @@ data PostBuildProjectStatus = PostBuildProjectStatus
 
 -- | Work out which packages are out of date or invalid after a build.
 postBuildProjectStatus
-  :: ElaboratedInstallPlan
+  :: HasCallStack 
+  => ElaboratedInstallPlan
   -> PackagesUpToDate
   -> BuildStatusMap
   -> BuildOutcomes
@@ -621,7 +623,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

cabal-install/src/Distribution/Client/ProjectPlanning.hs

@@ -236,6 +236,7 @@ import Distribution.Client.Errors
 import Distribution.Solver.Types.ProjectConfigPath
 import System.FilePath
 import qualified Text.PrettyPrint as Disp
+import GHC.Stack (HasCallStack)
 
 -- | Check that an 'ElaboratedConfiguredPackage' actually makes
 -- sense under some 'ElaboratedSharedConfig'.
@@ -1538,7 +1539,8 @@ planPackages
 -- In theory should be able to make an elaborated install plan with a policy
 -- matching that of the classic @cabal install --user@ or @--global@
 elaborateInstallPlan
-  :: Verbosity
+  :: HasCallStack
+  => Verbosity
   -> Map FilePath HookAccept
   -> Staged Toolchain
   -> Staged (Maybe PkgConfigDb)
@@ -1616,12 +1618,14 @@ 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) =
         case mkComponentsGraph (elabEnabledSpec elab0) pd of
           Right g -> do
+            infoProgress $ text "here"
             let src_comps = componentsGraphToList g
             infoProgress $
               hang
@@ -1759,7 +1763,8 @@ elaborateInstallPlan
                     ++ " not implemented yet"
 
           buildComponent
-            :: ( ConfiguredComponentMap
+            :: HasCallStack
+            => ( ConfiguredComponentMap
                , LinkedComponentMap
                , Map ComponentId FilePath
                )
@@ -1832,6 +1837,7 @@ elaborateInstallPlan
                               elab1 -- knot tied
                           )
                     cc = cc0{cc_ann_id = fmap (const cid) (cc_ann_id cc0)}
+                
                 infoProgress $ dispConfiguredComponent cc
 
                 -- 4. Perform mix-in linking
@@ -1847,6 +1853,7 @@ elaborateInstallPlan
                     (elabPkgSourceId elab0)
                     (Map.union external_lc_map lc_map)
                     cc
+
                 infoProgress $ dispLinkedComponent lc
                 -- NB: elab is setup to be the correct form for an
                 -- indefinite library, or a definite library with no holes.
@@ -2673,7 +2680,8 @@ extractElabBuildStyle _ = BuildAndInstall
 --    we don't instantiate the same thing multiple times.
 --
 instantiateInstallPlan
-  :: StoreDirLayout
+  :: HasCallStack
+  => StoreDirLayout
   -> Staged InstallDirs.InstallDirTemplates
   -> ElaboratedSharedConfig
   -> ElaboratedInstallPlan
@@ -3205,7 +3213,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
@@ -3301,7 +3310,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
@@ -3661,7 +3671,8 @@ mapConfiguredPackage _ (InstallPlan.PreExisting pkg) =
 --
 -- This is not always possible.
 pruneInstallPlanToDependencies
-  :: Set UnitId
+  :: HasCallStack
+  => Set UnitId
   -> ElaboratedInstallPlan
   -> Either
       CannotPruneDependencies