More asserts on 'completed'

This assert would have more directly pinpointed the InstallPlan
invariant that was broken in haskell#4986.

Signed-off-by: Edward Z. Yang <[email protected]>

Author: ezyang

cabal-install/Distribution/Client/InstallPlan.hs

@@ -89,6 +89,8 @@ import           Distribution.Solver.Types.SolverId
 import           Distribution.Solver.Types.InstSolverPackage
 
 import           Distribution.Utils.LogProgress
+import           Distribution.Client.Utils.Assertion
+import           Distribution.Compat.Stack
 
 -- TODO: Need this when we compute final UnitIds
 -- import qualified Distribution.Simple.Configure as Configure
@@ -102,6 +104,7 @@ import           Distribution.Pretty
 import qualified Distribution.Compat.Graph as Graph
 import Distribution.Compat.Graph (Graph, IsNode(..))
 import Distribution.Compat.Binary (Binary(..))
+import           Distribution.Utils.Generic
 import GHC.Generics
 import Data.Typeable
 import Control.Monad
@@ -629,19 +632,26 @@ isInstalled _                = False
 -- process), along with the updated 'Processing' state.
 --
 completed :: (IsUnit ipkg, IsUnit srcpkg)
-          => GenericInstallPlan ipkg srcpkg
+          => WithCallStack (GenericInstallPlan ipkg srcpkg
           -> Processing -> UnitId
-          -> ([GenericReadyPackage srcpkg], Processing)
+          -> ([GenericReadyPackage srcpkg], Processing))
 completed plan (Processing processingSet completedSet failedSet) pkgid =
-    assert (pkgid `Set.member` processingSet) $
+    pprAssert (pkgid `Set.member` processingSet)
+      (text "Completed" <+> pretty pkgid <+> text "was not member of processing set:" $$
+       pretty (Set.toList processingSet) $$
+       text "Already completed:" <+> pretty (Set.toList completedSet) $$
+       text "Failed:" <+> pretty (Set.toList failedSet)) $
     assert (processingInvariant plan processing') $
+    pprAssert (length (ordNub newlyReadyKeys) == length newlyReadyKeys)
+      (text "Duplicate entry in newly-ready tasks:" <+> pretty newlyReadyKeys) $
 
     ( map asReadyPackage newlyReady
     , processing' )
   where
     completedSet'  = Set.insert pkgid completedSet
 
     -- each direct reverse dep where all direct deps are completed
+    newlyReadyKeys = map nodeKey newlyReady
     newlyReady     = [ dep
                      | dep <- revDirectDeps plan pkgid
                      , all ((`Set.member` completedSet') . nodeKey)