Improve asserts/call stack in ProjectPlanning

- Use pprAssert is some more places - Thread CallStack through more functions for better call stack reporting Signed-off-by: Edward Z. Yang <[email protected]>
haskell · Jan 1, 2018 · 4cd0476 · 4cd0476
1 parent ba0118d
commit 4cd0476
Showing 1 changed file with 18 additions and 8 deletions.
diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs
@@ -74,6 +74,7 @@ import           Distribution.Client.Store
 import           Distribution.Client.ProjectConfig
 import           Distribution.Client.ProjectPlanOutput
 
+import           Distribution.Client.Utils.Assertion
 import           Distribution.Client.Types
 import qualified Distribution.Client.InstallPlan as InstallPlan
 import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
@@ -104,6 +105,7 @@ import           Distribution.Solver.Types.InstSolverPackage
 import           Distribution.Solver.Types.SourcePackage
 import           Distribution.Solver.Types.Settings
 
+import           Distribution.Pretty
 import           Distribution.ModuleName
 import           Distribution.Package hiding
   (InstalledPackageId, installedPackageId)
@@ -145,6 +147,7 @@ import           Distribution.Simple.Utils hiding (matchFileGlob)
 import           Distribution.Version
 import           Distribution.Verbosity
 import           Distribution.Text
+import           Distribution.Compat.Stack
 
 import qualified Distribution.Compat.Graph as Graph
 import           Distribution.Compat.Graph(IsNode(..))
@@ -216,10 +219,10 @@ import           System.FilePath
 -- | Check that an 'ElaboratedConfiguredPackage' actually makes
 -- sense under some 'ElaboratedSharedConfig'.
 sanityCheckElaboratedConfiguredPackage
-    :: ElaboratedSharedConfig
+    :: WithCallStack (ElaboratedSharedConfig
     -> ElaboratedConfiguredPackage
     -> a
-    -> a
+    -> a)
 sanityCheckElaboratedConfiguredPackage sharedConfig
                              elab@ElaboratedConfiguredPackage{..} =
     (case elabPkgOrComp of
@@ -268,10 +271,10 @@ sanityCheckElaboratedComponent ElaboratedConfiguredPackage{..}
 
 
 sanityCheckElaboratedPackage
-    :: ElaboratedConfiguredPackage
+    :: WithCallStack (ElaboratedConfiguredPackage
     -> ElaboratedPackage
     -> a
-    -> a
+    -> a)
 sanityCheckElaboratedPackage ElaboratedConfiguredPackage{..}
                              ElaboratedPackage{..} =
     -- we should only have enabled stanzas that actually can be built
@@ -280,8 +283,15 @@ sanityCheckElaboratedPackage ElaboratedConfiguredPackage{..}
 
     -- the stanzas that the user explicitly requested should be
     -- enabled (by the previous test, they are also available)
-  . assert (Map.keysSet (Map.filter id elabStanzasRequested)
-                `Set.isSubsetOf` pkgStanzasEnabled)
+  . pprAssert
+      (Map.keysSet (Map.filter id elabStanzasRequested)
+          `Set.isSubsetOf` pkgStanzasEnabled) $
+      vcat [ text "Stanzas that the user explicitly requested were not enabled:"
+           , text "Requested: " <+> pretty (Map.keys (Map.filter id elabStanzasRequested))
+           , text "Enabled: " <+> pretty (Set.toList pkgStanzasEnabled)
+           , ctx_doc ]
+  where
+    ctx_doc = text "in ElaboratedConfiguredPackage" <+> pretty elabUnitId
 
 ------------------------------------------------------------------------------
 -- * Deciding what to do: making an 'ElaboratedInstallPlan'
@@ -3031,11 +3041,11 @@ storePackageInstallDirs StoreDirLayout{ storePackageDirectory
 -- make the various Setup.hs {configure,build,copy} flags
 
 
-setupHsConfigureFlags :: ElaboratedReadyPackage
+setupHsConfigureFlags :: WithCallStack (ElaboratedReadyPackage
                       -> ElaboratedSharedConfig
                       -> Verbosity
                       -> FilePath
-                      -> Cabal.ConfigFlags
+                      -> Cabal.ConfigFlags)
 setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..})
                       sharedConfig@ElaboratedSharedConfig{..}
                       verbosity builddir =